При отыскании Fmin в индексной строке должны быть отрицательные и нулевые оценки.

При отыскании Fmax в индексной строке должны быть нулевые и положительные оценки.

Переход ко второй итерации:

Для этого отыскиваем ключевой (главный) столбец и ключевую (главную) строку.

Ключевым столбцом является тот в котором находится наибольший положительный элемент индексной строки при отыскании Fmin или наименьший отрицательный элемент при отыскании Fmax.

Ключевой строкой называется та, в которой содержится наименьшее положительное частное от деления элементов столбца H на соответствующие элементы ключевого столбца.

На пересечении строки и столбца находится разрешающий элемент.

На этом этапе осуществляется к переходу к последующим итерациям.

Переход к итерациям:

Выводится базис ключевой строки, уступая место переменной из ключевого столбца со своим коэффициентом.

Заполняется строка вновь введенного базиса путем деления соответствующих элементов выделенной строки предыдущей итерации на разрешающий элемент.

Если в главной строке содержится нулевой элемент, то столбец, в котором находиться этот элемент переноситься в последующую итерацию без изменения.

Если в главном столбце имеется нулевой элемент, то строка, в которой он находиться переноситься без изменения в последующую итерацию.

Остальные элементы переносятся по формуле:

3. Формализация поставленной задачи

Прежде всего, покажем, что характерные свойства МАД и известные сведения из теории линейных операторов позволяют экспертизу АОМ и установление ПДВ формализовать в виде двух зависимых математических задач.

Пусть суммарное загрязнение ВБ города отдельной примесью характеризуется функцией C(X,t) пространственных координат и времени. Загрязнение считается допустимым при C(X,t) < N(X) _, где N - норматив. Если C(X,t) > N(X), то необходимы АО мероприятия по достижению норматива. При их планировании из суммарного загрязнения атмосферы требуется выделить вклады Cj(X,t), j=1,…,J от J заданных источников, под которыми могут подразумеваться как отдельные трубы, аэрационные фонари и т.д., так и их совокупности, объединенные по различным признакам (по принадлежности к одному цеху, предприятию, ведомству по высоте выброса и т.д.). Пусть выбросы источников есть Q = (Q ₁,Q ₂,…,Q_J). Предположим, что остальные параметры (высота, координаты и т.д.) в результате АОМ не изменяются. Тогда возникающую при экспертизе планов АОМ города задачу - определить изменение dC характеристик загрязнения ВБ по сравнению с базовым (предплановым) периодом - можно записать в виде:

dC = C₀ - C_P = A(Q) - A(X) (3.21)

где А- оператор модельной зависимости C от Q; величины C с индексом '₀' относятся к базовому периоду, а с индексом '_P' - к ожидаемому после реализации запланированных АОМ. Заметим, что не только ожидаемый C_P, но и существующий уровень загрязнения C₀, суммарное значение которого в некоторых точках промышленного города регулярно измеряется [78], требует в (1.21) модельного представления C₀ = A(Q₀), поскольку в общем случае методы контроля загрязнения не могут указать вклад конкретного источника в измеряемую величину. Соотношение (3.21) показывает, что формализация выделенной задачи сводится к построению и надлежащему применению оператора А, позволяющего переходить от выбросов к характеристикам загрязнения ВБ и различать заданный источник на фоне всех остальных.

Пользуясь линейностью модели ОНД-86 по выбросам источников можно представить загрязнение атмосферы в контрольных точках жилой зоны в виде линейной формы:

,

где - концентрация в i-ой точке, - выброс j-го источника, - вклад j-го источника в i-й точке, который в дальнейшем будем называть коэффициентом влияния. Отметим, что на практике (поскольку число источников и контрольных точек конечно) оператор А представляет собой матрицу, состоящую из коэффициентов влияния a_ij.

Санитарные требования приводят к системе линейных неравенств:

,

решение которой ищется на интервале

,

где - технологически обоснованный минимум выброса j-го источника.

На сегодняшний день в методической литературе описаны два метода нахождения решения поставленной задачи: МРН-87 [24] и метод равного квотирования [26]. Оба метода кратко рассмотрены в параграфе . Они дают частное решение поставленной системы неравенств из соображений удобства нахождения единственного решения. Однако любое предприятие заинтересовано в минимальных затратах, необходимых для установления нормативных выбросов . Для этой цели, к поставленной системе неравенств добавляем целевую функцию:

Где в общем случае - стоимость снижения на единицу выброса для j-го источника. В данном виде решение X_j дает минимум затрат на достижение нормативного загрязнения атмосферы.

В предположении

,

что эквивалентно .

Следовательно, задача сводится к поиску максимально допустимого по сумме сочетания выбросов X_j данного предприятия, позволяющего достичь нормативного загрязнения атмосферы. В связи с линейностью модели ОНД-86 по отношению к выбросам для поиска решения поставленной задачи может быть применён Симплекс-метод.



4. Программная реализация и пример практического применения

Для достижения поставленной задачи по разработке интегрированного в ПК ЭРА-ВОЗДУХ программного модуля расчета оптимальных ПДВ проведено изучение структуры файлов, в которых головной модуль передают данные расчетного блоку УПРЗА ЭРА. Разработаны соответствующие процедуры для автоматизированного чтения всех необходимых файлов.

4.1 Выбор загрязняющих веществ

После указания директории с данными для расчета, программа сканирует файлы в папке WORK по маске «htop*.ppp», таким образом выбирая загрязняющие вещества, для которых имеются начальные данные и возможно провести расчет.

Далее для каждого отмеченного вещества независимо от других будет производиться считывание значений и расчет ПДВ (Xj).

4.2 Обработка точек с повышенным загрязнением

procedure get_point (s:string;var countPoint:integer;var point_pdk:tExtArray);

Процедура извлекает значения N_i (ПДК), а так же количество точек I (i=1,..,I), в которых выбросы превышают N_i, из файла вида «htop*.ppp» в директории /WORK/.

Внутренняя структура htop*.ppp представляет собой текстовый файл, содержащий таблицу с данными о контрольных точках. Значение N_i содержатся в 8-ом столбце. Чаще всего N_i в точках равно 1 или 0.8 для особо охраняемых территорий (санатории, зоны отдыха).

4.3 Обработка источников

procedure get_funnel(s:string; var countFunnel : integer ; var funnel_name : tsArray; var funnel_m:tExtArray;var funnel_min:tExtArray);

Процедура извлекает данные из файла вида «ist_*.txt», которые находятся в директории /DAT/. «ist_*.txt» - это текстовый файл, в котором в табличном виде представлена информация об источниках выбросов, в том числе:

· количество источников J;

· уникальный код источника;

· существующий выброс источника Qj;

· минимально возможный выброс Qjmin (не всегда указывается).

4.4 Обработка таблиц влияния источников на точки

procedure get_pointfunnel ( s : string; countPoint : integer; countfunnel : integer; funnel_name : tsArray; funnel_m : tExtArray; var pointfunnelx2 : tExtArrayx2; var point_cf : tExtArray);

Процедура извлекает коэффициенты влияния a_ij из файлов вида «10pd*.ppp», где «10pd*.ppp» - текстовый файл, содержащий отчет о результатах работы программы.

4.5 Применении симплекс-метода

procedure get_simplexsolve ( countPoint : integer; countFunnel : integer ; point_pdk : tExtArray; point_cf : tExtArray; funnel_m : tExtArray; funnel_min : tExtArray; pointfunnelx2 : tExtArrayx2; var x : tExtArray; var s_temp : string);

Процедура, используя данные расчетов программы «ЭРА-воздух», при помощи симплекс-метода рассчитывает оптимальные выбросы Xj для источников при заданных условиях.

4.6 Вывод полученных результатов

Результаты полученных вычислений выводятся на форму программы, а так же в файлы вида: «h_pd*.gpv», где * - это код вещества, для которого производился расчет.

4.7 Сравнение различных методов расчета ПДВ для реального предприятия

В расчете загрязнения атмосферы диоксидом азота на расчетном прямоугольнике 9 на 9 км с шагом 500 метров проведен расчет максимальных разовых концентраций, создаваемых 70-ю источниками выброса различного типа и высоты. В итоге получено поле максимальных концентраций, в которых есть области превышения норматива N, который в данном случае равен ПДК.

Картина загрязнения представлена на рисунке 1:

Рис 1. Загрязнение атмосферы в окрестности исследуемого предприятия.

Программный комплекс Эра-Воздух производит автоматический выбор точек превышения норматива N и позволяет найти расчетные значения ПДВ на основе методов МРН-87 и Метода равного квотирования.

При выполнении работы в программный комплекс добавлен новый модуль, в соответствии с алгоритмом описанным в пункте 5. Этот модуль позволяет рассчитать оптимальное значение ПДВ с использованием симплексного метода. Результаты расчетов ПДВ различными методами представлено ниже в таблицах 4.1, 4.2 и 4.3.

Таблица 4.1. Результаты расчета ПДВ (методом равного квотирования)

ПРИМЕСЬ=0301 Азот(IV) оксид (Азота диоксид)

Город :001 Кемерово, Объект : 0025

-----------------------------------------------------------------------------

| Код |Высота |Существую-|Минимально| Коэфф. | Расчетное |Кратность|

N | источника |источн.|щий выброс|возможный | норми- | значение |снижения |

п/п| выброса | м | г/с | выброс |рования | П Д В |выброса |

---|-----------|-------|----------|---г/с----|--------|----г/с----|---------|

15 00250010354 40.0 8.2390 0.0 0.485 3.9961 2.062

53 00250010944 40.0 8.2370 0.0 0.461 3.7941 2.171

Остальные источники не подлежат нормированию.

-----------------------------------------------------------------------------

В сумме по 0301 51.8545 0.0 0.832 43.1687 1.201

-----------------------------------------------------------------------------

Таблица 4.2. Результаты расчета ПДВ (метод МРН-87)

ПРИМЕСЬ=0301 Азот(IV) оксид (Азота диоксид)

Город :001 Кемерово, Объект :0025

-----------------------------------------------------------------------------

| Код |Высота |Существую-|Минимально| Коэфф. | Расчетное |Кратность|

N | источника |источн.|щий выброс|возможный | норми- | значение |снижения |

п/п| выброса | м | г/с | выброс |рования | П Д В |выброса |

---|-----------|-------|----------|---г/с----|--------|----г/с----|---------|

14 00250010353 33.4 1.0750 0.0 0.739 0.7942 1.354

15 00250010354 40.0 8.2390 0.0 0.739 6.0867 1.354

16 00250010356 60.0 2.1500 0.0 0.739 1.5884 1.354

24 00250010656 45.0 1.5000 0.0 0.739 1.1082 1.354

41 00250010892 60.0 9.0430 0.0 0.739 6.6807 1.354

52 00250010943 33.4 0.5280 0.0 0.739 0.3901 1.354

53 00250010944 40.0 8.2370 0.0 0.739 6.0852 1.354

54 00250010946 45.0 2.1470 0.0 0.739 1.5861 1.354

63 00250011198 24.4 0.5110 0.0 0.739 0.3775 1.354

66 00250011225 24.4 0.5890 0.0 0.739 0.4351 1.354

Остальные источники не подлежат нормированию.

----------------------------------------------------------------------------

В сумме по 0301 51.8545 0.0 0.829 42.9676 1.207

----------------------------------------------------------------------------

Таблица 4.3. Результаты расчета ПДВ (симплекс метод)

ПРИМЕСЬ=0301 Азот(IV) оксид (Азота диоксид)

Город :001 Кемерово, Объект :0025

---------------------------------------------------------

| Код |Существую-|Минимально| Расчетное | коэфф. |

| источника |щий выброс|возможный | значение | норми- |

| выброса | г/с | выброс | П Д В | рования |

|-----------|----------|---г/с----|----г/с----|---------|

|00250010353| 1.075000 | 0.000000 | 0.0196222 | 0.01825 |

|00250010943| 0.528000 | 0.000000 | 0.0000000 | 0.00000 |

|00250011225| 0.589000 | 0.000000 | 0.0000000 | 0.00000 |

- - - - - - - - - - - - - - - - - - - - - - - - - - - - -

| в сумме: 51.854470 49.682092 | 0.95811 |

---------------------------------------------------------

Решение задачи линейного программирования показывает, что максимально возможный выброс по заводу в целом можно обеспечить при достижении нормы загрязнения, если закрыть источники 1225 и 0943, а на источнике 0353 снизить выброс примерно в 50 раз. О реальности такого решения могут судить технологические службы предприятия.

Итоговая таблица сравнения трех методов:

Метод	Существующий выброс	Расчетное значение	Процент снижения
Равного квотирования	51.8545	43.1687	16,75
МРН-87	51.8545	42.9676	17,14
Симплексный	51.8545	49.6820	4,19

Заключение

· Таким образом, в процессе выполнения дипломной работы проведен обзор существующей системы установления ПДВ для источников загрязнения атмосферы промышленных предприятий. При этом рассмотрена система обеспечения нормативных задач управления выбросами в атмосферу исходными данными. Исследована структура исходных данных их качество. Рассмотрены нормативные требования к загрязнению атмосферы населенных мест, которые накладывают ограничения на выбросы промышленных предприятий в атмосферу. Показано, что эти требования и свойство линейности нормативной модели расчета загрязнения атмосферы ОНД-86 по отношению к выбросам ИЗА позволяют представить процедуру нахождения расчетных значений ПДВ в виде задачи линейного программирования.

· Рассмотрены существующие в методической литературе способы расчета ПДВ в виде методов равного квотирования и МРН-87. Данные методы не имеют целевой функции и дают некоторые частные решения поставленной задачи.

· Изучен программный комплекс ЭРА-Воздух и форматы хранения и передачи данных между его модулями.

· Разработана процедура автоматического считывания исходных данных и результатов из ПК ЭРА-Воздух для полного обеспечения задачи линейного программирования исходными данными.

· Разработана программа расчета ПДВ на основе симплекс метода.

· Решена практическая задача по расчету ПДВ для одного из крупных предприятий г. Кемерово как встроенными в ПК ЭРА-ВОЗДУХ методами (МРН-87, равное квотирование), так и с использованием симплекс метода.

· Показано, что использование оптимизационного метода расчета ПДВ позволяет обеспечить нормативное загрязнение атмосферы при больших суммарных выбросах. В случае технологической приемлемости такого решения предприятие может существенно снизить платежи за сверхнормативный выброс в атмосферу.

Список литературы

Методическое пособие по расчету, нормированию и контролю выбросов загрязняющих веществ в атмосферный воздух. - СПб.: НИИ Атмосфера МПР РФ, 2002.

ОНД-86. Методика расчета концентраций в атмосферном воздухе вредных веществ, содержащихся в выбросах предприятий. Л.: Гидрометеоиздат, 1987.

Постановление Правительства Российской Федерации N182 от 2 марта 2000 г. «О порядке установления и пересмотра экологических и гигиенических нормативов качества атмосферного воздуха, предельно допустимых уровней физических воздействий на атмосферный воздух и государственной регистрации вредных (загрязняющих) веществ и потенциально опасных веществ». М., 2000.

Постановление Правительства Российской Федерации от 2 марта 2000 г. N 183 «О нормативах выбросов вредных (загрязняющих) веществ в атмосферный воздух и вредных физических воздействий на него». М., 2000.

Федеральный Закон «Об охране окружающей среды». М., 2002.

Рязанов В.А. О критериях и методах обоснования максимально допустимых концентраций атмосферных загрязнений в СССР.- В кн.: Предельно допустимые концентрации атмосферных загрязнений. Вып.8. - М.: Медицина, 1964, с. 5-21.

Перечень и коды веществ, загрязняющих атмосферный воздух. СПб., 2000.

Беспамятнов Г.П., Кротов Ю.А. Предельно допустимые концентрации химических веществ в окружающей среде - Л.: «Химия», 1985.

Пинигин М.А. Значение вероятностного подхода при решении вопросов гигиенического регламентирования атмосферных загрязнений. В кн. ”Медицинские проблемы охраны окружающей среды”. М.: 1981, с.95-102.

Берлянд М.Е. Прогноз и регулирование загрязнения атмосферы. -Л.: Гидрометеоиздат, 1985, 272с.

Безуглая Э.Ю. Мониторинг состояния загрязнения атмосферы в городах. Л.: Гидрометеоиздат, 1986, 200с.

Безуглая Э.Ю., Ковалевский А.Г., Расторгуева Г.П. Особенности распределения промышленных примесей в атмосфере городов различных типов. Тр. ГГО, вып. 467, 1983, с.81-87.

Перечень методик выполнения измерений концентраций загрязняющих веществ в выбросах промышленных предприятий СПб., 2001.

Перечень документов по расчету выделений (выбросов) загрязняющих веществ в атмосферный воздух, действующих в 2001-2002 годах. СПб., 2001.

Инструкция по инвентаризации выбросов загрязняющих веществ в атмосферу. Л., 1990.

СанПиН 2.1.6.1032-01 «Гигиенические требования к обеспечению качества атмосферного воздуха населенных мест». М., 2001.

.Атмосферная турбулентность и моделирование распространения примесей /под.ред. Ньистадта Ф.Т.М., Ван-Допа Х.- Л.: Гидрометеоиздат, 1985,-350 c.

Пененко В.В., Алоян А.Е. Модели и методы для задач охраны окружающей среды. -Новосибирск.: Наука, 1985.-256с.

Постановление Совета Министров РСФСР. Об утверждении на 1991 год нормативов за выбросы загрязняющих веществ в природную среду и порядка их применения./9 января 1991г. N 13 /. Собрание постановлений правительства РСФСР. -М.: N9, 1991.

Hanna S.R. Review of Atmospheric Diffusion Models for Regulatory Application.- WMO Tecnical Notes, No.177, 1982-42p.

Методы анализа загрязнений воздуха./Дугов Ю.С., Беликов А.Б., Дьяков Г.А., Тульчинский В.М.-М.: Химия, 1984,-384 с.

Вольберг Н.Ш., Егорова Е.Д., Кузьмина Т.А. Метрологические характеристики фотометрических методов анализа загрязнения атмосферы. - Тр. ГГО, 1982, No 450.c.107-111.

Израэль Ю.А, Гасилина Н.К., Ровинский Ф.Я. Система наблюдений и контроля загрязнения природной среды в СССР.- Метеорология и гидрология, 1978, No 10, c.5-12.

Методика расчета нормативов допустимых выбросов загрязняющих веществ в атмосферу для групп источников. МРН-87. - М., Госкомгидромет, Институт прикладной геофизики. 1987. -30с.

Рекомендации по определению допустимых вкладов в загрязнение атмосферы выбросов загрязняющих веществ предприятиями с использованием сводных расчетов загрязнения воздушного бассейна города (региона) выбросами промышленности и автотранспорта. СПб., 1999.-97с.

Васильев Ф.П. Методы решения экстремальных задач. М: Наука, 1980.-518с.

Вспомогательные указатели

Перечень сокращений

ЗВ - загрязняющее (вредное) вещество

ИЗА - источник загрязнения атмосферы

ПДВ - предельно допустимый выброс (допустимый выброс)

СЗЗ - санитарно-защитная зона

ПДК_р - максимальная разовая предельно допустимая концентрация загрязняющего вещества в атмосферном воздухе населенных мест

ПДК_с - среднесуточная предельно допустимая концентрация загрязняющего вещества в атмосферном воздухе населенных мест

ОБУВ - ориентировочный безопасный уровень воздействия загрязняющих веществ в атмосферном воздухе населенных мест

ГВС - газовоздушная смесь

ГОУ - газоочистная установка

ОНД - общесоюзный нормативный документ

НМУ - неблагоприятные метеорологические условия

УПРЗА - унифицированная программа расчета загрязнения атмосферы

Приложения

Unit1.pas

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ShellAPI, ShlObj, StdCtrls, Buttons, CheckLst,Masks,inifiles,

ComCtrls,simplex, Menus;

const MyDecimalSeparator='.';

type

tsArray = array of string;

tExtArrayx2 = array of tExtArray;

TForm1 = class(TForm)

Edit1: TEdit;

GroupBox1: TGroupBox;

CheckListBox1: TCheckListBox;

Label1: TLabel;

BitBtn1: TBitBtn;

Button3: TButton;

Memo1: TMemo;

SpeedButton1: TSpeedButton;

CheckBox1: TCheckBox;

SpeedButton2: TSpeedButton;

SpeedButton3: TSpeedButton;

SpeedButton4: TSpeedButton;

procedure FormCreate(Sender: TObject);

procedure FormActivate(Sender: TObject);

procedure BitBtn1Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure N2Click(Sender: TObject);

procedure SpeedButton1Click(Sender: TObject);

procedure SpeedButton2Click(Sender: TObject);

procedure SpeedButton3Click(Sender: TObject);

procedure SpeedButton4Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

dir_path:string;

IniFile: TIniFile;

implementation

{$R *.dfm}

//запись в ini файл

procedure SaveIni(s:string);

var

IniPath: string;

FileName: string;

begin

GetDir(0,IniPath);

FileName:=IniPath+'\sav.ini';

IniFile:=TIniFile.Create(FileName);

Inifile.WriteString('patch','dir',s);

IniFile.Free;

end;

//чтение ini файла

function ReadIni:string;

var

IniPath: string;

FileName: string;

s:string;

begin

GetDir(0,IniPath);

FileName:=IniPath+'\sav.ini';

IniFile:=TIniFile.Create(FileName);

ReadIni:=Inifile.ReadString('patch','dir',s);

IniFile.Free;

end;

//--------- Удаляет пробел или запятую с краёв строки --------------------------

Function DelSpaceAndCap(s:string):string;

begin

while pos(copy(s,1,1),' ')<>0 do delete(s,1,1);

while pos(copy(s,length(s),1),' ')<>0 do delete(s,length(s),1);

result:=s;

end;

//--------- вырезает из строки имя ---------------------------------------------

Function ReturnSubString(Var s:string):string;

var

position,i : integer;

begin

s:=DelSpaceAndCap(s);

position:=0;

for i:=1 to length(s)-1 do

if (pos(copy(s,i,1),' ')<>0) and (position=0) then

position:=i;

if position=0 then begin

result:=s;

s:='';

end else begin

result := DelSpaceAndCap(copy(s,1,position));

Delete(s,1,position);

s:=DelSpaceAndCap(s);

end;

end;

//вывод ограничений

//==============================================================================

procedure vv(a:real;mas:tExtArray; Sign: TOperation);

var

i:integer;

s,s2,s3:string;

begin

s:=floattostr(mas[0]);

for i:=1 to length(mas)-1 do

s:=s+'+'+floattostr(mas[i]);

if Sign=less then s2:=' < ';

if Sign=Greater then s2:=' > ';

if Sign=Equal then s2:=' = ';

form1.memo1.lines.Add(s+s2+floattostr(a));

end;

//==============================================================================

//==============================================================================

//замена в строке всех вхождений одной подстроки на другую

function StrReplace(Str, Str1, Str2 : string):string;

var

p, L : integer;

s:string;

begin

s:=str;

L:=length(str1);

repeat

p:=pos(str1, s);

if p>0 then begin

Delete(s,p,L);

insert(str2, s, P);

end;

until P = 0;

StrReplace:=s;

end;

//==============================================================================

//==============================================================================

//========================= считывание таблиц влияния таблиц источников на точки

procedure get_pointfunnel(s:string;countPoint:integer;countfunnel:integer;funnel_name:tsArray;funnel_m:tExtArray;

var pointfunnelx2:tExtArrayx2; var point_cf:tExtArray);

var

h:textfile;

k,m:integer;

s_temp,s_temp2,s_temp3:string;

flag:boolean;

begin

SetLength(PointFunnelx2,countPoint,countFunnel);

SetLength(point_cf,countPoint);

for k:=0 to countPoint-1 do begin

point_cf[k]:=0;

for m:=0 to countFunnel-1 do

PointFunnelx2[k,m]:=0;

end;

AssignFile(h,dir_path+'\RESULT\'+'10pd'+s+'.ppp');

reset(h);

for k:=1 to 22 do readln(h,s_temp);

s_temp:=StrReplace(s_temp,'|',' ');

s_temp2:=s_temp;

for m:= 0 to CountPoint-1 do begin //общий цикл

flag:=true;

while flag do begin

if ReturnSubString(s_temp2)='Фоновая' then begin

point_cf[m]:=strtofloat(copy(s_temp,pos('%',s_temp)-4,4));

end else begin

s_temp3:=ReturnSubString(s_temp);

s_temp3:=ReturnSubString(s_temp);

s_temp3:=ReturnSubString(s_temp);

for k:=1 to 6 do s_temp2:=ReturnSubString(s_temp);

//showmessage(s_temp2);

for k:=0 to countFunnel-1 do

if s_temp3=copy(funnel_name[k],8,4) then

PointFunnelx2[m,k]:=strtofloat(s_temp2);//*funnel_m[k];

end;

readln(h,s_temp);

s_temp:=StrReplace(s_temp,'|',' ');

s_temp2:=s_temp;

if ReturnSubString(s_temp2)='В' then flag:=false;

end;

for k:=1 to 16 do readln(h,s_temp);

s_temp:=StrReplace(s_temp,'|',' ');

s_temp2:=s_temp;

end;

closefile(h);

end;

//==============================================================================

//==============================================================================

//========================================================= получение источников

procedure get_funnel(s:string; var countFunnel:integer;var funnel_name:tsArray;

var funnel_m:tExtArray;var funnel_min:tExtArray);

var

h,h2 : textfile;

index_funnel : integer;

i,j : integer;

s_temp,s_temp2:string;

begin

AssignFile(h,dir_path+'\DAT\'+'ist_'+s+'.txt');

reset(h);

index_funnel:=-11;

while s_temp<>'endI' do begin //чтение файла (установка размера массива)

readln(h,s_temp);

inc(index_funnel);

end;

closefile(h);

CountFunnel:=index_funnel;

setLength(funnel_m,CountFunnel);

setLength(funnel_min,CountFunnel);

setLength(funnel_name,CountFunnel);

for i:=0 to countFunnel-1 do begin

funnel_m[i]:=0;

funnel_min[i]:=0;

funnel_name[i]:='';

end;

AssignFile(h2,dir_path+'\DAT\'+'ist_'+s+'.txt');

reset(h2);

for j:=1 to 9 do

readln(h2,s_temp);

for i:= 0 to CountFunnel-1 do begin

readln(h2,s_temp);

funnel_name[i]:=ReturnSubString(s_temp);

for j:=1 to 14 do

s_temp2:=ReturnSubString(s_temp);

funnel_m[i]:=strtofloat(ReturnSubString(s_temp));

if DelSpaceAndCap(s_temp)<>'' then

funnel_min[i]:=strtofloat(DelSpaceAndCap(s_temp))

else funnel_min[i]:=0;

end;

closefile(h2);

end;

//==============================================================================

//==============================================================================

//============================================================= получение точек

procedure get_point (s:string;var countPoint:integer;var point_pdk:tExtArray);

var

index_point : integer;

i,j : integer;

h,h2 : textfile;

s_temp : string;

begin

index_point:=-2; // переменная для подсчета кол-ва точек

AssignFile(h,dir_path+'\WORK\'+'htop'+s+'.ppp');

reset(h);

while s_temp<>'000' do begin//чтение файла (установка размера массива)

readln(h,s_temp);

inc(index_point);

end;

closefile(h);

CountPoint:=index_point;

setLength(point_pdk,countPoint);

for i:=0 to countPoint-1 do

point_pdk[i]:=0; //зануление

AssignFile(h2,dir_path+'\WORK\'+'htop'+s+'.ppp');

reset(h2);

readln(h2,s_temp);

for i:= 0 to countPoint-1 do begin

readln(h2,s_temp);

for j:=1 to 8 do

point_pdk[i]:=strtofloat(ReturnSubString(s_temp));

end;

closefile(h2);

end;

//==============================================================================

//==============================================================================

//=========================================== решение при помощи симплекс метода

procedure get_simplexsolve(countPoint:integer;countFunnel:integer;point_pdk:tExtArray;

point_cf:tExtArray;funnel_m:tExtArray;funnel_min:tExtArray;

pointfunnelx2:tExtArrayx2;var x:tExtArray;var s_temp:string);

var

mas_temp : tExtArrayx2;

i,j : integer;

sim : TSimplex;

L : tExtArray;

begin

setLength(mas_temp,countFunnel,countFunnel);

setLength(L,countFunnel);

setLength(x,countFunnel);

for i:=0 to countFunnel-1 do

for j:=0 to countFunnel-1 do begin

if i=j then mas_temp[i,j]:=1 else mas_temp[i,j]:=0;

L[j]:=1;

end;

Sim:=TSimplex.Create(L,true);

for i:=0 to countPoint-1 do begin

//showmessage(vv(point_pdk[i],pointfunnelx2[i]));

Sim.AddCons(point_pdk[i],pointfunnelx2[i],less);

if form1.CheckBox1.Checked then vv(point_pdk[i],pointfunnelx2[i],less);

end;

for i:=0 to countFunnel-1 do begin

Sim.AddCons(funnel_m[i],mas_temp[i],less);

if funnel_min[i]>0 then begin

Sim.AddCons(funnel_min[i],mas_temp[i],Greater);

if form1.CheckBox1.Checked then vv(funnel_min[i],mas_temp[i],Greater);

end;

end;

if (Sim.Solve=SIMPLEX_DONE) then begin

s_temp:='решение найдено';

x:=Sim.GetSolution;

end

else s_temp:='Решения не существует';

end;

//==============================================================================

//==============================================================================

//==================================================== общий модуль для подсчета

procedure TForm1.Button3Click(Sender: TObject);

var

s,s_temp,ss : string;

countPoint : integer;

countfunnel : integer;

point_pdk : tExtArray;

point_cf : tExtArray;

funnel_m : tExtArray;

funnel_min : tExtArray;

funnel_name : tsArray;

pointfunnelx2 : tExtArrayx2;

i,j : integer;

x : tExtArray;

empty : boolean;

h : textfile;

funnelSumM,sumX:real;

begin

funnelSumM:=0;

sumX:=0;

memo1.Clear;

for i:=0 to checkListBox1.Items.Count-1 do begin

if CheckListBox1.Checked[i] then begin

application.ProcessMessages;

s:=checklistbox1.Items.Strings[i];

s:=returnSubString(s);

application.ProcessMessages;

get_point (s,countPoint,point_pdk);

get_funnel(s,countFunnel,funnel_name,funnel_m,funnel_min);

get_pointfunnel(s,countPoint,countfunnel,funnel_name,funnel_m,pointfunnelx2,point_cf);

get_simplexsolve(countPoint,CountFunnel,point_pdk,point_cf,funnel_m,funnel_min,pointfunnelx2,x,s_temp);

AssignFile(h,dir_path+'\RESULT\'+'h_pd'+s+'.gpv');

rewrite(h);

if s_temp='решение найдено' then begin

memo1.lines.Add('');

memo1.lines.Add(' Результаты расчета ПДВ (симплекс метод):');

memo1.lines.Add(' ПРИМЕСЬ='+s);

memo1.lines.Add('');

memo1.lines.Add('---------------------------------------------------------');

memo1.lines.Add('| Код |Существую-|Минимально| Расчетное | коэфф. |');

memo1.lines.Add('| источника |щий выброс|возможный | значение | норми- |');

memo1.lines.Add('| выброса | г/с | выброс | П Д В | рования |');

memo1.lines.Add('|-----------|----------|---г/с----|----г/с----|---------|');

writeln(h,'');

writeln(h,' Результаты расчета ПДВ (симплекс метод):');

writeln(h,' ПРИМЕСЬ='+s);

writeln(h,'');

writeln(h,'---------------------------------------------------------');

writeln(h,'| Код |Существую-|Минимально| Расчетное | коэфф. |');

writeln(h,'| источника |щий выброс|возможный | значение | норми- |');

writeln(h,'| выброса | г/с | выброс | П Д В | рования |');

writeln(h,'|-----------|----------|---г/с----|----г/с----|---------|');

empty:=true;

for j:=0 to countFunnel-1 do begin

funnelSumM:=FunnelSumM+funnel_m[j];

sumX:=SumX+x[j];

if abs(x[j]-funnel_m[j])>0.0000001 then

begin

ss:='|'+funnel_name[j]+'| '+FloatToStrF(funnel_m[j],ffFixed,1000,6)+' | '+FloatToStrF(funnel_min[j],ffFixed,1000,6);

ss:=ss+' | '+FloatToStrF(x[j],ffFixed,1000,7)+' | '+FloatToStrF(x[j]/funnel_m[j],ffFixed,1000,5)+' |';

memo1.lines.Add(ss);

writeln(h,ss);

empty:=false;

end;

end;

ss:='| в сумме: '+FloatToStrF(funnelSumM,ffFixed,1000,6)+' ';

ss:=ss+FloatToStrF(sumX,ffFixed,1000,6)+' | '+ FloatToStrF(sumX/funnelSumM,ffFixed,1000,5)+' |';

if empty then begin

memo1.lines.Add('| Нет выбросов для снижения |');

writeln(h,'| Нет выбросов для снижения |');

end;

if not empty then begin

memo1.lines.Add('- - - - - - - - - - - - - - - - - - - - - - - - - - - - -');

memo1.lines.Add(ss);

writeln(h,'- - - - - - - - - - - - - - - - - - - - - - - - - - - - -');

writeln(h,ss);

end;

memo1.lines.Add('---------------------------------------------------------');

memo1.lines.Add('');

memo1.lines.Add('');

writeln(h,'---------------------------------------------------------');

writeln(h,'');

writeln(h,'');

end else begin

memo1.lines.Add('');

memo1.lines.Add(' Результаты расчета ПДВ (симплекс метод):');

memo1.lines.Add(' ПРИМЕСЬ='+s);

memo1.lines.Add('');

memo1.lines.Add('---------------------------------------------------------');

memo1.lines.Add('| Решение не найдено |');

memo1.lines.Add('---------------------------------------------------------');

writeln(h,'');

writeln(h,' Результаты расчета ПДВ (симплекс метод):');

writeln(h,' ПРИМЕСЬ='+s);

writeln(h,'');

writeln(h,'---------------------------------------------------------');

writeln(h,'| Решение не найдено |');

writeln(h,'---------------------------------------------------------');

end;

closefile(h);

end;

// closefile(h);

end;

end;

//==============================================================================

//поиск файла по маске

procedure FindFiles(StartFolder, Mask: string; List: TStrings;

ScanSubFolders: Boolean = True);

var

SearchRec: TSearchRec;

FindResult: Integer;

begin

List.BeginUpdate;

try

StartFolder := IncludeTrailingBackslash(StartFolder);

FindResult := FindFirst(StartFolder + '*.*', faAnyFile, SearchRec);

try

while FindResult = 0 do

with SearchRec do

begin

if (Attr and faDirectory) <> 0 then

begin

if ScanSubFolders and (Name <> '.') and (Name <> '..') then

FindFiles(StartFolder + Name, Mask, List, ScanSubFolders);

end

else

begin

if MatchesMask(Name, Mask) then begin

List.Add(copy(Name,5,4));

//showmessage(StartFolder + Name);

end;

end;

FindResult := FindNext(SearchRec);

end;

finally

FindClose(SearchRec);

end;

finally

List.EndUpdate;

end;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

DecimalSeparator:=MyDecimalSeparator;

end;

procedure TForm1.FormActivate(Sender: TObject);

begin

dir_path:=ReadIni;

edit1.Text:=dir_path;

{--}

end;

procedure TForm1.BitBtn1Click(Sender: TObject);

var

h,h2:textfile;

i,j,k,n:integer;

s_temp:string;

s: array of array of string;

begin

dir_path:=edit1.Text;

checklistbox1.Items.Clear;

i:=0;

AssignFile(h,dir_path+'\WORK\activ2.txt');

reset(h);

//readln(h,s_temp);

while not EOF(h) do begin//чтение файла (установка размера массива)

readln(h,s_temp);

inc(i);

end;

closefile(h);

setlength(s,i,2);

AssignFile(h2,dir_path+'\WORK\activ2.txt');

reset(h2);

for j:=0 to i-1 do begin

readln(h2,s_temp);

s[j,0]:=copy(s_temp,24,4);

s[j,1]:=copy(s_temp,30,55);

end;

closefile(h2);

FindFiles(dir_path, 'htop*.ppp', checklistbox1.items, true);

n:=checklistbox1.items.Count-1;

for j:=0 to n do begin

for k:=0 to i-1 do begin

//showmessage(s[k,0]+' -| ');

if checklistbox1.items[0]=s[k,0] then begin

//showmessage(s[j,0]+' | '+s[j,1]);

checklistbox1.items.Delete(0);

checklistbox1.items.Add(s[k,0]+' '+s[k,1]);

end;

end;

end;

end;

procedure TForm1.N2Click(Sender: TObject);

var

TitleName : string;

lpItemID : PItemIDList;

BrowseInfo : TBrowseInfo;

DisplayName : array[0..MAX_PATH] of char;

TempPath : array[0..MAX_PATH] of char;

begin

FillChar(BrowseInfo, siCeof(TBrowseInfo), #0);

BrowseInfo.hwndOwner := Form1.Handle;

BrowseInfo.psCDisplayName := @DisplayName;

TitleName := 'Please specify a directory';

BrowseInfo.lpsCTitle := PChar(TitleName);

BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS;

lpItemID := SHBrowseForFolder(BrowseInfo);

if lpItemId <> nil then

begin

SHGetPathFromIDList(lpItemID, TempPath);

edit1.Text:=TempPath;

GlobalFreePtr(lpItemID);

end;

//showmessage(tempPath);

dir_path:=tempPath;

//FindFiles(tempPath, 'htop*.ppp', checkmemo1.lines, true); //старая версия

SaveIni(dir_path);

end;

procedure TForm1.SpeedButton1Click(Sender: TObject);

var

TitleName : string;

lpItemID : PItemIDList;

BrowseInfo : TBrowseInfo;

DisplayName : array[0..MAX_PATH] of char;

TempPath : array[0..MAX_PATH] of char;

begin

FillChar(BrowseInfo, siCeof(TBrowseInfo), #0);

BrowseInfo.hwndOwner := Form1.Handle;

BrowseInfo.psCDisplayName := @DisplayName;

TitleName := 'Please specify a directory';

BrowseInfo.lpsCTitle := PChar(TitleName);

BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS;

lpItemID := SHBrowseForFolder(BrowseInfo);

if lpItemId <> nil then

begin

SHGetPathFromIDList(lpItemID, TempPath);

edit1.Text:=TempPath;

GlobalFreePtr(lpItemID);

end;

//showmessage(tempPath);

dir_path:=tempPath;

//FindFiles(tempPath, 'htop*.ppp', checkmemo1.lines, true); //старая версия

SaveIni(dir_path);

end;

procedure TForm1.SpeedButton2Click(Sender: TObject);

var

i:integer;

begin

for i:=0 to checklistbox1.Items.Count-1 do

checklistbox1.Checked[i]:=true;

end;

procedure TForm1.SpeedButton3Click(Sender: TObject);

var

i:integer;

begin

for i:=0 to checklistbox1.Items.Count-1 do

checklistbox1.Checked[i]:=false;

end;

procedure TForm1.SpeedButton4Click(Sender: TObject);

var

i:integer;

begin

for i:=0 to checklistbox1.Items.Count-1 do

if checklistbox1.Checked[i] then checklistbox1.Checked[i]:=false

else checklistbox1.Checked[i]:=true;

end;

end.

Simplex.pas

unit simplex;

interface

const

SIMPLEX_DONE = 0; // оптимизация успешно завершена

SIMPLEX_NO_SOLUTION = 1; // задача не имеет решения (не удается найти базис)

SIMPLEX_NO_BOTTOM = 2; // решения нет, т.к. линейная форма не ограничена снизу

SIMPLEX_NEXT_STEP = 3; // для получения решения нужно сделать еще хотя бы один шаг

MAX_VAL = 0.1e-12; //точность (значение, удовлетворяющее -MAX_VAL < X < MAX_VAL считается нулем)

type

TOperation = (Equal,Less,Greater);

TExtArray = array of extended;

TConstrain = record

A : TExtArray;

B : extended;

Sign : TOperation;

isT : boolean;

end;

TSimplex = class

M,N : integer; { M - число строк, N - число столбцов}

RealN : integer; {реальное число переменных, изначально вошедших в задачу}

Cons : array of TConstrain;

C : TExtArray;

L : extended;

Basis : array of integer;

Max : boolean; { направление оптимизации: минимизация или максимизация }

Constructor Create(_C:TExtArray; MaximiCe:boolean=false);

Constructor CreateBasis(const Simplex:TSimplex);

Constructor Copy(const Simplex:TSimplex);

Procedure AddCons(_B:extended; _A:TExtArray; Sign:TOperation);

Procedure SetAllLengths(Len:integer);

Function SimplexStep:integer;

Function CheckBasis:boolean;

Function FoundInBasis(num:integer): integer;

Function DoPrec(num:extended): extended;

Procedure NormaliCe;

Procedure MulString(Number:integer; Value:extended);

Procedure AddString(Num1,Num2:integer; Value:extended); {суммирование строки 1 со строкой 2, домноженной на коэффициент Value }

Function Solve:integer;

Function GetMin:extended;

Function GetSolution:TExtArray;

Destructor Free;

end;

TIntSimplex = class(TSimplex)

// CurX : TExtArray;

//CurL : extended;

// CurFound : boolean;

Constructor Create(_C:TExtArray; MaximiCe:boolean=false);

// Procedure DelLastCons;

Function IntSolve:integer;

Function GetIntMin:extended;

Function IsInteger(value:extended):boolean;

Function GetIntSolution:TExtArray;

// Function SearchCons(_B:extended;_A:TExtArray):integer;

end;

implementation

uses Math;

{ TSimplex }

Function TSimplex.DoPrec(num:extended): extended;

begin

if ((num < MAX_VAL) and (num > -MAX_VAL)) then

num := 0;

Result := num;

end;

procedure TSimplex.AddCons(_B: extended; _A: TExtArray; Sign: TOperation);

var

j : integer;

begin

if (Length(_A)>N) then SetAllLengths(Length(_A));

inc(M);

SetLength(Cons,M);

//if ((_B=0) and (Sign=Less)) then Sign:=Equal; //???

Cons[M-1].B:=_B;

Cons[M-1].Sign:=Sign;

SetLength(Cons[M-1].A,N);

for j:=0 to Length(_A)-1 do Cons[M-1].A[j]:=_A[j];

if Length(_A)<N then for j:=Length(_A) to N-1 do Cons[M-1].A[j]:=0;

end;

{суммирование строки 1 со строкой 2, домноженной на коэффициент Value }

procedure TSimplex.AddString(Num1, Num2: integer; Value: extended);

var

j : integer;

begin

for j:=0 to N-1 do Cons[Num1].A[j]:=Cons[Num1].A[j]+Cons[Num2].A[j]*Value;

Cons[Num1].B:=Cons[Num1].B+Cons[Num2].B*Value;

end;

function TSimplex.CheckBasis: boolean;

var

i,j,k : integer;

f : boolean;

begin

SetLength(Basis,M);

for i:=0 to M-1 do Basis[i]:=-1;

for j:=0 to N-1 do begin

f:=true;

k:=-1;

i:=0;

while (f and (i<M)) do begin

if ((Cons[i].A[j]<>0) and (Cons[i].A[j]<>1)) then f:=false;

if (Cons[i].A[j]=1) then begin

if (k=-1) then k:=i

else f:=false;

end;

inc(i);

end;

if (f and (k<>-1)) then Basis[k]:=j;

end;

f:=true;

for i:=0 to M-1 do f:=f and (Basis[i]<>-1);

Result:=f;

end;

constructor TSimplex.Create(_C: TExtArray; MaximiCe:boolean);

var

j : integer;

begin

N:=Length(_C);

RealN := N;

M:=0;

SetLength(C,N);

Max:=MaximiCe;

if (not MaximiCe) then for j:=0 to N-1 do C[j]:=-_C[j]

else for j:=0 to N-1 do C[j]:=_C[j];

Max:=MaximiCe;

L := 0;

end;

constructor TSimplex.Copy(const Simplex: TSimplex);

var

i,j : integer;

begin

M:=Simplex.M;

N:=Simplex.N;

RealN := Simplex.RealN;

SetLength(Cons,M);

SetLength(Basis,M);

SetLength(C,N);

Max:=Simplex.Max;

for i:=0 to M-1 do begin

SetLength(Cons[i].A,N);

Basis[i]:=-1;

for j:=0 to N-1 do Cons[i].A[j]:=Simplex.Cons[i].A[j];

Cons[i].B:=Simplex.Cons[i].B;

Cons[i].Sign:=Simplex.Cons[i].Sign;

end;

for i:=0 to Simplex.N-1 do C[i]:=Simplex.C[i];

L := Simplex.L;

end;

constructor TSimplex.CreateBasis(const Simplex: TSimplex);

var

i,j : integer;

begin

M:=Simplex.M;

N:=Simplex.N;

RealN := Simplex.RealN;

L := 0;

SetLength(Cons,M);

SetLength(Basis,M);

SetLength(C,N);

for i:=0 to N-1 do C[i]:=0;

for i:=0 to M-1 do begin

SetLength(Cons[i].A,N);

for j:=0 to N-1 do Cons[i].A[j]:=Simplex.Cons[i].A[j];

Cons[i].B:=Simplex.Cons[i].B;

Cons[i].Sign:=equal;

Cons[i].isT := false;

end;

for i:=0 to M-1 do begin

if (Simplex.Basis[i]<>-1) then Basis[i]:=Simplex.Basis[i]

else begin

SetAllLengths(N+1);

for j:=0 to M-1 do Cons[j].A[N-1]:=0;

Cons[i].A[N-1]:=1;

Cons[i].isT := true;

C[N-1] := 0;

for j:=0 to Simplex.N-1 do C[j] := C[j] + Simplex.Cons[i].A[j];

L := L + Cons[i].B;

end;

end;

end;

destructor TSimplex.Free;

begin

SetLength(C,0);

SetLength(Basis,0);

SetLength(Cons,0);

M:=0;

N:=0;

RealN := 0;

end;

function TSimplex.GetMin: extended;

var

i : integer;

begin

if (Max) then

Result := -L

else

Result := L;

end;

function TSimplex.GetSolution: TExtArray;

var

Solution : TExtArray;

i,j : integer;

begin

SetLength(Solution,RealN);

for j:=0 to RealN-1 do begin

Solution[j]:=0;

i:=0;

while ((i<M) and (Basis[i]<>j)) do inc(i);

if ((Basis[i]=j) and (i<M)) then Solution[j]:=Cons[i].B;

end;

Result:=Solution;

end;

procedure TSimplex.MulString(Number: integer; Value: extended);

var

j : integer;

begin

for j:=0 to N-1 do Cons[Number].A[j]:=Cons[Number].A[j]*Value;

Cons[Number].B:=Cons[Number].B*Value;

end;

procedure TSimplex.NormaliCe;

var

i : integer;

begin

for i:=0 to M-1 do if (Cons[i].Sign<>Equal) then begin

SetAllLengths(N+1);

if (Cons[i].Sign=Greater) then Cons[i].A[N-1]:=-1

else Cons[i].A[N-1]:=1;

Cons[i].Sign := Equal;

end;

end;

procedure TSimplex.SetAllLengths(Len: integer);

var

i, j : integer;

OldN : integer;

begin

OldN:=N;

N:=Len;

SetLength(C,N);

for i:=0 to M-1 do SetLength(Cons[i].A,N);

if (OldN<N) then begin

for j:=OldN to N-1 do begin

C[j]:=0;

for i:=0 to M-1 do Cons[i].A[j]:=0;

end;

end;

end;

function TSimplex.FoundInBasis(num:integer): integer;

var

i:integer;

f:boolean;

begin

f := false;

i := 0 ;

while (not f and (i<M)) do

begin

f := (Basis[i] = num);

inc(i);

end;

if (f) then

Result := i-1

else

Result := -1;

end;

function TSimplex.SimplexStep: integer;

var

i,j : integer;

f,opt : boolean;

x,y : integer; //координаты опорного элемента

CurMax : extended;

temp : array of TConstrain;

tempC : TExtArray;

begin

opt := true;

CurMax := -1;

for i := 0 to N-1 do

begin

//проверка на разрешимость

if (C[i] > 0) then

begin

opt := false; //а это попутная проверка на оптимальность

if (C[i] > CurMax) then //а это поиск ведущего столбца (максимальный элемент в C[i])

begin

CurMax := C[i];

x := i;

end;

f := true;

for j := 0 to M-1 do

f := f and (Cons[j].A[i] < 0);

if (f) then

begin

Result := SIMPLEX_NO_BOTTOM;

exit;

end;

end;

end;

if (opt) then

Result := SIMPLEX_DONE

else

begin

//зная номер ведущего столбца, ищем номер ведущей строки

CurMax := MaxExtended; //на самом деле тут будем искать минимум, а не Max

for j := 0 to M-1 do

if (Cons[j].A[x] > 0) then //идем только по положительным элементам

if (Cons[j].B/Cons[j].A[x] < CurMax) then

begin

CurMax := Cons[j].B/Cons[j].A[x];

y := j;

end

else if (DoPrec(Cons[j].B/Cons[j].A[x] - CurMax) = 0) then

if (Cons[j].isT) then

y := j;

//сохраняем текущие значения

SetLength(temp, M);

for j := 0 to M-1 do

begin

SetLength(temp[j].A, N);

for i := 0 to N-1 do

temp[j].A[i] := Cons[j].A[i];

temp[j].B := Cons[j].B;

end;

SetLength(tempC, N);

for i := 0 to N-1 do

tempC[i] := C[i];

//делаем пересчет таблицы

//строка делиться на ведущий элемент

MulString(y, 1/Cons[y].A[x]);

//преобразование остальных элементов

for j := 0 to M-1 do

begin

if (j <> y) then

begin

for i := 0 to N-1 do

begin

Cons[j].A[i] := DoPrec(temp[j].A[i] - temp[j].A[x]*temp[y].A[i]/temp[y].A[x]);

end;

Cons[j].B := DoPrec(temp[j].B - temp[j].A[x]*temp[y].B/temp[y].A[x]);

end

else

begin

for i := 0 to N-1 do

Cons[j].A[i] := DoPrec(Cons[j].A[i]);

end;

end;

//и строка с коэффициентами функции

for i := 0 to N-1 do

begin

C[i] := DoPrec(tempC[i] - tempC[x]*temp[y].A[i]/temp[y].A[x]);

end;

Basis[y] := x;

//и сама функция:

L := DoPrec(L - tempC[x]*temp[y].B/temp[y].A[x]);

for i:= 0 to M-1 do

SetLength(temp[i].A, 0);

SetLength(temp, 0);

SetLength(tempC, 0);

Result := SIMPLEX_NEXT_STEP;

end;

end;

function TSimplex.Solve: integer;

var

i,j : integer;

Simplex : TSimplex;

f : boolean;

Step : integer;

cc : extended;

begin

//oldN := N;

NormaliCe;

f:=false;

if (not CheckBasis) then begin

Simplex:=TSimplex.CreateBasis(self);

Simplex.Solve;

f:=Simplex.GetMin<>0;

if (not f) then for i:=0 to M-1 do begin

for j:=0 to N-1 do Cons[i].A[j]:=Simplex.Cons[i].A[j];

Cons[i].B:=Simplex.Cons[i].B;

Cons[i].isT := false;

Basis[i]:=Simplex.Basis[i];

cc := C[Basis[i]];

for j:=0 to N-1 do

C[j] := DoPrec(C[j] - cc*Cons[i].A[j]);

L := DoPrec(L - cc*Cons[i].B);

end;

Simplex.Free;

end;

if (f) then Step:=SIMPLEX_NO_SOLUTION

else repeat

Step:=SimplexStep;

until (Step<>SIMPLEX_NEXT_STEP);

//SetAllLengths(OldN);

Result:=Step;

end;

{ TIntSimplex }

constructor TIntSimplex.Create(_C:TExtArray; MaximiCe:boolean=false);

begin

//CurFound:=false;

inherited;

end;

function TIntSimplex.GetIntMin: extended;

begin

Result:=GetMin;

end;

function TIntSimplex.GetIntSolution: TExtArray;

begin

Result:=GetSolution;

end;

function TIntSimplex.IsInteger(Value:extended):boolean;

begin

Result:=((Value=floor(Value)) or (Value=ceil(Value)));

end;

function TIntSimplex.IntSolve: integer;

var

i : integer;

OldN : integer;

FractCol : integer;

FractRow : integer;

TmpX : TExtArray;

TmpCons : TExtArray;

NewValue : extended;

begin

if (Solve=SIMPLEX_DONE) then begin

//if (not CurFound or ((Simplex.GetMin<CurL) and not Max) or ((Simplex.GetMin>CurL) and Max)) then begin

TmpX:=GetSolution;

i:=0;

while ((i<RealN) and IsInteger(TmpX[i])) do inc(i);

FractCol:=i;

if (FractCol<>RealN) then begin // если найдена хотя бы одна нецелая переменная

OldN:=N;

SetLength(TmpCons,N);

FractRow := FoundInBasis(FractCol);

for i := 0 to N-1 do

if (FoundInBasis(i) = -1) then

TmpCons[i] := Cons[FractRow].A[i] - Floor(Cons[FractRow].A[i])

else

TmpCons[i] := 0;

NewValue := Cons[FractRow].B - Floor(Cons[FractRow].B);

//if (Max) then

AddCons(NewValue, TmpCons, Greater);

//else

// AddCons(NewValue, TmpCons, Less);

Result := IntSolve;

SetAllLengths(OldN); // удаляем пустые столбцы в конце, если они есть

end

else begin // если полученное решение - целочисленное\

Result := SIMPLEX_DONE;

end;

//end;

end

else

Result:=SIMPLEX_NO_SOLUTION;

end;

end.