Содержание
Введение
Градиентные методы оптимизации
Градиентный метод первого порядка
Алгоритм градиентного метода
Математическое описание системы и значения переменных
Построение математической модели
Алгоритм реализации решения задачи построения динамической модели
Апробирование машинной программы
Результаты работы программы
Вывод
Список литературы
Листингпрограммы
На современном этапе научно-технического прогресса необыкновенно возрастает роль средств, позволяющих рационально использовать ресурсы, выделенные для решения народнохозяйственных задач. Кибернетика предлагает такие средства, как исследование операций, теория систем, математическое моделирование, теория эксперимента, вычислительная техника и др.
Часть этих методов предназначена для увеличения эффективности научного эксперимента на всех стадиях разработки, исследования, проектирования и эксплуатации производств. Единство теории и практики эксперимента совместно с вычислительной техникой образуют комплекс автоматизированного эксперимента, предназначенный для повышения производительности научного труда.
Объекты, на которых проводятся эксперименты, отличаются прежде всего протекающими в них процессами. Объект, на котором осуществляется планируемый эксперимент, характеризуется обязательным условием — все входные переменные, или факторы, x
1
,
x
2
, ...,
xn
должны быть управляемыми. Этого требует сама постановка условий построения динамической модели, предполагающих активное вмешательство в ход эксперимента. Такой объект технологии называют объектом исследования.
Необходимыми и достаточными условием для определения любой отрасли знаний как науки является наличие: предмета исследования, метода исследования и средства для реализации этого метода. Для кибернетики как науки предметом исследования являются системы любой природы и их управляемость, методом исследования - математическое моделирование, стратегией исследования - системный анализ, а средством исследования - вычислительные машины.
Кибернетика включает в себя такие понятия, как системы, информация, хранение и переработка информации, управление системами и оптимизация систем. При этом кибернетика широко пользуется методом математического моделирования и стремится к получению конкретных результатов, позволяющих анализировать и синтезировать изучаемые системы, прогнозировать их оптимальное поведение и выявлять каналы и алгоритмы управления.
Методы кибернетики не только позволяют создавать оптимально функционирующий процесс или систему, но указывают пути выбора и использования оптимального режима, а также оптимального управления процессом или системой.
Понятие «системы» дает возможность осуществить математическую формализацию изучаемых объектов, обеспечивающую глубокое проникновение в их сущность и получение широких обобщений и количественных закономерностей.
Всякая система состоит из взаимосвязанных и взаимодействующих между собой и с внешней средой частей и в определенном смысле представляет собой замкнутое целое (иначе ее нельзя было бы назвать системой).
Система - это достаточно сложный объект, который можно расчленить (провести декомпозицию) на составляющие элементы, или подсистемы. Эти элементы информационно связаны друг с другом и с окружающей средой объекта. Совокупность связей образует структуру системы. Система имеет алгоритм функционирования, направленный на достижение определенной цели.
Системный анализ - это стратегия изучения сложных систем. В качестве метода исследования в нем используется математическое моделирование, а основным принципом является декомпозиция сложной системы на более простые подсистемы. В этом случае математическая модель системы строиться по блочному принципу: общая модель подразделяется на блоки, которым можно дать сравнительно простые математические описания. Необходимо иметь в виду, что все подсистемы взаимодействуют между собой, составляя общую единую математическую модель.
В основе стратегии системного анализа лежат следующие общие положения:
1. Четкая формулировка цели исследования;
2. Постановка задачи по реализации этой цели и определение критерия эффективности решения задачи;
3. Разработка развернутого плана исследования с указанием основных этапов и направлений решения задач;
4. Пропорционально - продвижение по всему комплексу взаимосвязанных этапов и возможных направлений;
5. Организация последовательных приближений и повторных циклов исследований наотдельных этапах;
6. Принцип нисходящей иерархии анализа и восходящей иерархии синтеза в решении составных частных задач и т.п.
Системный анализ организует наши знания об объекте таким образом, чтобы помочь выбрать нужную стратегию либо предсказать результаты одной или нескольких стратегий, представляющихся целесообразными темами, кто должен принимать решения. С позиции системного анализа решаются задачи моделирования, оптимизации, управления и оптимального проектирования систем.
Особый вклад системного анализа в решение различных проблем заключается в том, что он позволяет выявить факторы и взаимосвязи, которые в последствии могут оказаться весьма существенными, дает возможность видоизменить методику наблюдений и построить эксперимент так, чтобы эти факторы были включены в рассмотрение, и освещает слабые места гипотез и допущений. Как научный подход системный анализ с его акцентом на последовательное рассмотрение явлений в соответствии с разными уровнями иерархии и на проверку гипотез с помощью строгих выборочных процедур создает мощные инструменты познания физического мира и объединяет эти инструменты в систему гибкого, но строгого исследования сложных явлений.
Математическое моделирование осуществляется в три взаимосвязанные стадии:
1. Формализация изучаемого процесса - построение математической модели (составление математического описания);
2. Программирование решения задачи (алгоритмизация), обеспечивающего нахождение численных значений определяемых параметров;
3. Установление соответствия (адекватности) модели изучаемому процессу.
Построение математической модели:
В каждом конкретном случае математическую модель создают, исходя из целевой направленности процесса и задач исследования, с учетом требуемой точности решения и достоверности используемых исходных данных. При анализе полученных результатов возможно повторное обращение к модели с целью внесения коррективов после выполнения части расчетов.
Построение любой математической модели начинают с формализованного описания объекта моделирования. При этом аналитический аспект моделирования состоит в выражении смыслового описания объекта на языке математики в виде некоторой системы уравнений и функциональных соотношений между отдельными параметрами модели. Основным приемом построения математического описания изучаемого объекта является блочный принцип. Согласно этому принципу, после того как определен набор элементарных процессов, каждый из них исследуется по блокам в условиях, максимально приближенных к условиям эксплуатации объекта моделирования.
В результате каждому элементарному технологическому оператору ставиться в соответствие функциональный элементарный оператор с параметрами, достаточно близкими к истинным значениям.
Следующий этап моделирования состоит в агрегировании функциональных элементарных операторов в общий функциональный результирующий оператор, который и представляет математическую модель объекта. Важным фактором агрегирования является правильная взаимная координация отдельных операторов, которая не всегда возможна вследствие трудностей учета естественных причинно-следственных связей между отдельными элементарными процессами.
При выборе модели необходимо учитывать следующее:
- модель должна наиболее точно отражать характер потоков вещества и энергии при достаточно простом математическом описании;
- параметры модели могут быть определены экспериментальным или другим путем;
- в случае гетерогенных систем модели выбираются для каждой фазы в отдельности, причем для обеих фаз они могут быть одинаковыми или различными.
При построении математического описания используют уравнения таких видов:
- алгебраические уравнения;
- обыкновенные дифференциальные уравнения;
- дифференциальные уравнения в частных производных.
Алгоритмизация математических моделей:
После составления математического описания и выбора соответствующих начальных и граничных условий необходимо провести второй этап моделирования - довести задачу до логического конца, т. е. выбрать метод решения и составить программу (алгоритм).
В простейших случаях, когда возможно аналитическое решение системы уравнений математического описания, необходимость в специальной разработке моделирующего алгоритма, естественно, отпадает, так как вся информация может быть получена из соответствующих аналитических решений. Когда математическое описание представляет собой сложную систему конечных и дифференциальных уравнений, от возможности построения достаточно эффективного моделирующего алгоритма может существенно зависеть практическая применимость математической модели. В особенности это важно при использовании модели для решения задач, в которых она входит в качестве составной части более общего алгоритма, например, алгоритма оптимизации. Как правило, в таких случаях для реализации математической модели приходиться применять средства вычислительной техники; фактически без них нельзя ставить и решать сколько-нибудь сложные задачи математического моделирования и тем более задачи оптимизации, при решении которых расчеты по уравнениям математического описания обычно многократно повторяются.
Широко развитые в настоящее время методы численного анализа позволяют решать широкий круг задач математического моделирования.
Выбор численного метода:
При выборе метода для решения уравнений математического описания обычно ставиться задача обеспечения максимального быстродействия при минимуме занимаемой программой памяти. Естественно, при этом должна обеспечиваться заданная точность решения. Прежде чем выбрать тот или иной численный метод, необходимо проанализировать ограничения, связанные с его использованием, например, подвергнуть функцию или систему уравнений аналитическому исследованию, в результате которого выявиться возможность использования данного метода. При этом весьма часто исходная функция или система уравнений должна быть соответствующим образом преобразована с тем, чтобы можно было эффективно применить численный метод. Преобразованием или введением новых функциональных зависимостей часто удается значительно упростить задачу.
При выборе метода существенным моментом является размерность задачи. Некоторые методы эффективны при решении небольших задач, однако, с увеличением числа переменных объем вычислений настолько возрастает, что от них приходиться отказаться. Задачи такого класса обычно встречаются при решении систем уравнений, поиске оптимальных значений параметров многомерных функций. При соответствующем выборе метода можно уменьшить время, затрачиваемое на решение задачи и объем занимаемой машиной памяти.
Составление алгоритма решения:
Желательно составить четкое описание последовательности вычислительных и логических действий, обеспечивающих решение, т.е. составить алгоритм решения задачи. Основными требованиями к форме и содержанию записи алгоритма являются его наглядность, компактность и выразительность. В практике математического обеспечения вычислительных машин широкое распространение получил графический способ описания алгоритмов. Этот способ основан на представлении отдельных элементов алгоритма графическими символами, а всего алгоритма - в виде блок схемы. При этом набор графических символов не является произвольным, он регламентирован технической документацией по математическому обеспечению ЭВМ и соответствующими ГОСТами.
Методы оптимизации:
Оптимизация заключается в нахождении оптимума рассматриваемой функции или оптимальных условий проведения данного процесса. Для оценки оптимума необходимо прежде всего выбрать критерий оптимизации. В зависимости от конкретных условий в качестве критерия оптимизации можно взять технологический критерий, например максимальный съем продукции с единицы объема аппарата, экономический критерий - минимальную стоимость продукта при заданной производительности.
На основе выбранного критерия оптимизации составляется так называемая целевая функция, или функция выгоды, представляющая собой зависимость критерия оптимизации от параметров, влияющих на его значение. Задача оптимизации сводиться к нахождению экстремума (максимума или минимума) целевой функции.
Следует иметь в виду, что проблема оптимизации возникает в тех случаях, когда необходимо решать компромиссную задачу преимущественного улучшения двух или более количественных характеристик, различным образом влияющих на переменные процесса при условии их взаимной балансировки. Например, эффективность процесса балансируют с производительностью, качество - с количеством, запас единиц продукции - с их реализацией, производительность - с затратами.
Для автоматически управляемых процессов или систем различают две стадии оптимизации: статическую и динамическую.
Проблема создания и реализации оптимального стационарного режима процесса решает статическая оптимизация, создания и реализации системы оптимального управления процессом - динамическая оптимизация.
В зависимости от характера рассматриваемых математических моделей применяются различные математические методы оптимизации. Многие из них сводятся к нахождению минимума или максимума целевой функции. Линии, вдоль которых целевая функция сохраняет постоянное значение при изменении входящих в нее параметров, называются контурными или линиями уровня.
При выборе метода оптимизации необходимо учитывать возможные вычислительные трудности, обусловленные объемом вычислений, сложностью самого метода, размерностью самой задачи и т.п.
Целесообразно по возможности проводить предварительную оценку положения оптимума какой-либо конкретной задачи. Для этого необходимо рассмотреть исходные и основные соотношения между переменными. Для сокращения размерности задач часто используется прием выделения наиболее существенных переменных
Согласно принятой терминологии факторы x1
, x2
, ..., xn
— это измеряемые и регулируемые входные переменные объекта (независимые переменные); помехи f1
, f2
, ..., fs
— это не контролируемые, случайным образом изменяющиеся переменные объекта; выходные переменные y1
, y2
, ..., ym
— это контролируемые переменные, которые определяются факторами и связаны с целью исследования. Часто в планируемом эксперименте у называют параметром оптимизации (технологический или экономический показатель процесса).
Факторы x
1
,
x
2
, ...,
xn
иногда называют основными, поскольку они определяют условия эксперимента. Помехи f
1
,
f
2
, ...,
fs
— как правило недоступны для измерения. Они проявляются лишь в том, что изменяют влияние факторов на выходные переменные. Объект исследования может иметь несколько выходных переменных. Опыт показывает, что в большинстве случаев удается ограничиться одним параметром оптимизации, и тогда вектор Y
превращается в скаляр y
.
Количество факторов и характер их взаимосвязей с выходной переменной определяют сложность объекта исследования. При наличии качественной статистической информации о факторах и зависящей от них выходной переменной можно построить математическую модель объекта исследования и функцию отклика y
=
f
(
x
1
,
x
2
, ...,
xn
),
связывающую параметр оптимизации с факторами, которые варьируются при проведении опытов.
Пространство с координатами x
1
,
x
2
, ...,
xn
принято называть факторным, а графическое изображение функции отклика в факторном пространстве — поверхностью отклика.
При описании объектов, находящихся в стационарном состоянии, математическая модель чаще всего представляется полиномом:
Y
=
f
(
x
1
,
x
2
, ...,
xn
, Я1
, Я2
, ... , Я
n
). (1)
Поскольку в реальном процессе всегда существуют неуправляемые и неконтролируемые переменные, величина у
носит случайный характер. Поэтому при обработке экспериментальных данных получаются так называемые выборочные коэффициенты регрессии b
0
,
b
1
, ...,
bi
, ...,
bn
,
являющиеся оценками коэффициентов Я0
, Я1
, ..., Я
i
, ..., Я
n
.
Тогда математическая модель в форме уравнения регрессии в общем случае будет иметь вид:
(2)
Если анализируются нестационарные, т. е. изменяющиеся во времени состояния объекта, что характерно для динамического процесса, приходится рассматривать не случайные величины, как ранее, а случайные процессы. Случайный процесс можно рассматривать как систему, состоящую из бесконечного множества случайных величин. При моделировании таких объектов использовать модель в виде (2)
уже недопустимо — необходимо переходить к специальным интегрально-дифференциальным моделям и методам. В нашем случае – это градиентный метод первого порядка.
Составлению плана эксперимента всегда должны предшествовать сбор априорной информации для составления характеристики объекта исследования, опыты по наладке экспериментальной установки и при необходимости — опыты для установления области определения наиболее существенных факторов и выходной переменной.
Теорией и практикой эксперимента выработаны определенные требования (условия), которым должны удовлетворять независимые и зависимые переменные. Поэтому на стадии подготовки к проведению эксперимента весьма полезны приведенные ниже рекомендации.
1. При выборе выходной переменной необходимо учитывать, что она должна иметь количественную характеристику, т. е. должна измеряться; должна однозначно оценивать (измерять) работоспособность объекта исследования; быть статистически эффективной, т. е. иметь возможно меньшую дисперсию при проведении опытов (это позволяет четко различать опыты); отражать как можно более широкий спектр исследуемого явления, т. е. обладать универсальностью (практически это требование обеспечить трудно, тогда рекомендуют пользоваться так называемой обобщенной переменной); иметь достаточно четкий физический смысл.
2. При выборе факторов нужно выполнять следующие требования: фактор должен быть регулируемым, т. е. определенным регулирующим устройством фактор должен изменяться от значения x
’
i
до значения x
’’
i
; точность изменения и управления фактором должна быть известна и достаточно высока (хотя бы на порядок выше точности измерения выходной переменной), очевидно, что низкая точность измерения фактора уменьшает возможности воспроизведения эксперимента; связь между факторами должна быть как можно меньшей (в пределе должна отсутствовать), это свойство называют однозначностью факторов, что соответствует независимости одного фактора от другого.
Ряд требований предъявляется одновременно к факторам и выходной переменной: факторы и выходная переменная должны иметь области определения, заданными технологическими или принципиальными ограничениями; области определения факторов должны быть таковы, чтобы при их предельных значениях значение выходной переменной оставалось в своих границах; между факторами и выходной переменной должно существовать однозначное соответствие (причинно-следственная связь).
Успех современного экспериментирования в значительной степени обязан теории эксперимента, которая призвана дать экспериментатору ответы на следующие вопросы:
1. Как нужно организовать эксперимент, чтобы наилучшим образом решить поставленную задачу (в смысле затрат времени, средств или точности результатов).
2. Как следует обрабатывать результаты эксперимента, чтобы получить максимальное количество информации об исследуемом объекте.
3. Какие обоснованные выводы можно сделать об исследуемом объекте по результатам эксперимента.
Основой теории эксперимента является статистическое представление об эксперименте (рассматриваются случайные величины или случайные функции). Это представление отвечает действительности: как правило, итоги эксперимента связаны с некоторой неопределенностью, получающейся в результате влияния неконтролируемых факторов, случайного характера процесса на микроуровне, изменений условий эксперимента, ошибок измерения и др.
Теория эксперимента указывает исследователю точную логическую схему и способы поиска решения задач на разных этапах исследования. Можно представить весь процесс исследования циклами, повторяющимися после решения каждой из последовательных задач исследования, причем объем знаний об объекте непрерывно увеличивается.
Цель настоящей работы состоит в построении динамической модели заданного эксперимента, широко используемой при решении задач лабораторных и промышленных исследований. В работе рассмотрены основные методы и алгоритмы, относящиеся к идентификации динамических систем градиентным методом первого порядка.
Моделирование и программирование динамических систем
Метод динамического программирования применяется для многостадийных процессов, характеризуемых последовательностью решений и тем, что состояние системы зависит только от предыдущего шага, т. е. не зависит от ранее сделанных шагов.
В таких случаях используется принцип оптимальности, который формулируется в следующем виде: оптимальная стратегия обладает таким свойством, что, каково бы ни было начальное состояние и начальное решение, последующие решения должны приниматься, исходя из оптимальной стратегии относительно состояния, получаемого в результате первого решения.
Основная идея динамического программирования и заключается в том, что если какой-либо поток изменяется на каждой стадии процесса, то, если на последней стадии режим работы (независимо от режима работы на всех стадиях) не будет оптимальным по отношению к поступающему на нее потоку, не будет оптимальным и режим всего многостадийного процесса в целом.
Применение метода динамического программирования состоит в определении такого режима работы стадии, который максимизирует доход на этой и всех последующих стадиях для любых возможных состояний поступающего на нее потока. Обычно рассмотрение начинается с последней стадии процесса. Оптимальный режим всего процесса определяется постадийно.
Таким образом, метод динамического программирования предполагает разбиение анализируемого процесса во времени или пространстве на стадии или ступени. В качестве стадии можно принять единицу времени (минута или час), единичный элемент оборудования (тарелка в ректификационной колонне или реактор в цепочке реакторов).
В любом случае стадия или ступень – это математическая абстракция, применяемая для представления непрерывной переменной в дискретном виде. Состояние системы характеризуется совокупностью переменных, описывающих систему на любой стадии процесса.
Каждая стадия характеризуется входными xi
-1
и выходными xi
параметрами, а также параметрами управления ui
. При помощи управляющих воздействий оптимизируется результирующая оценка эффективности многостадийного процесса, определяемая как аддитивная функция результатов, получаемых на каждой стадии ui(x1
i
-1
, ui
):
(1)
Значение критерия оптимальности RN
зависит от совокупности uN
управляющих воздействий на всех стадиях. Совокупность управлений называется стратегией управления многостадийным процессом.
Основным уравнением динамического программирования является функциональное уравнение вида:
, (2)
где - оптимизируемая функция N-стадийного процесса, максимальное значение критерия RN
.
Максимизация первого слагаемого r1
(x0
,u1
), представляющего собой частный критерий, характеризующий первую стадию, проводится только по управлению u1
.
Член есть значение оптимизируемой функции на последующих N-1 стадиях и максимизируется выбором управлений на всех стадиях, ui
(I = 1,…,N), поскольку значение x1
зависит от управления u1
.
Выражение (2) представляет собой рекуррентное соотношение, характеризующее последовательность функций последняя из которых отвечает искомому решению оптимальной задачи. Стратегия решения выражается системой выбранных значений ui
– членов уравнения (2), где i = 1, 2, ..., N; система дает решение функционального уравнения. Оптимальная стратегия выражается системой функций ui
, которые максимизируют правую часть уравнения (2), а именно: для i = 1, 2, ..., N.
Часто важно знать сам характер оптимальной стратегии, нежели значение оптимизируемой функции. В ходе определения функции fN
(x) получают одновременно последовательность решений ui
или стратегию также в виде функции номера стадии i.
Решение рекуррентных уравнений обычно выполняется численными методами. Часто используется следующая последовательность расчета с применением вычислительной машины: сначала находят f1
(x), затем по найденному значению функции f1
(x) по уравнению ( 1 ) определяют функцию f2
(x); далее последовательно определяют f3
(x) из f2
(x) и т.д.
При решении задач оптимизации и моделировании динамической системы методом динамического программирования необходимо обратить внимание на следующие основные положения:
А) оптимизируемый процесс должен быть дискретно-распределенным во времени или пространстве (многостадийный процесс);
Б) отдельные стадии процесса должны обладать относительной независимостью, т.е. вектор выходных параметров любой стадии должен зависеть только от вектора входных параметров на эту стадию и управления на ней;
В) критерий оптимальности всего процесса должен быть сформулирован как аддитивная функция критериев оптимальности каждой стадии.
Если выполняются эти условия, необходимо правильно сформулировать задачу оптимизации. При формулировке задачи оптимизации и моделирования должны быть выявлены: 1) параметры, характеризующие состояние каждой стадии; 2) управляющие параметры на каждой стадии; 3) ограничения, которые накладываются на параметры состояния процесса и управляющие параметры. Кроме того, должно быть составлено математическое описание для каждой стадии и определен критерий оптимальности.
Градиентные методы оптимизации относятся к численным методам поискового типа. Они универсальны, хорошо приспособлены для работы с современными цифровыми вычислительными машинами и в большинстве случаев весьма эффективны при поиске экстремального значения нелинейных функций с ограничениями и без них, а также тогда, когда аналитический вид функции вообще неизвестен. Вследствие этого градиентные, или поисковые, методы широко применяются на практике.
Сущность указанных методов заключается в определении значений независимых переменных, дающих наибольшие изменения целевой функции. Обычно для этого двигаются вдоль градиента, ортогонального к контурной поверхности в данной точке.
Различные поисковые методы в основном отличаются один от другого способом определения направления движения к оптимуму, размером шага и продолжительностью поиска вдоль найденного направления, критериями окончания поиска, простотой алгоритмизации и применимостью для различных ЭВМ. Техника поиска экстремума основана на расчетах, которые позволяют определить направление наиболее быстрого изменения оптимизируемого критерия.
Если критерий задан уравнением
, (3)
то его градиент в точке (x1
, x2
,…, xn
) определяется вектором:
. (4)
Частная производная пропорциональна косинусу угла, образуемого вектором градиента с i-й осью координат. При этом
(5)
Наряду с определением направления градиентного вектора основным вопросом, решаемым при использовании градиентных методов, является выбор шага движения по градиенту. Величина шага в направлении gradF в значительной степени зависит от вида поверхности. Если шаг слишком мал, потребуются продолжительные расчеты; если слишком велик, можно проскочить оптимум. Размер шага должен удовлетворять условию, при котором все шаги от базисной точки лежат в том же самом направлении, что и градиент в базисной точке. Размеры шага по каждой переменной xi
вычисляются из значений частных производных в базовой (начальной) точке:
, (6)
где К – константа, определяющая размеры шага и одинаковая для всех i-х направлений. Только в базовой точке градиент строго ортогонален к поверхности. Если же шаги слишком велики в каждом i-м направлении, вектор из базисной точки не будет ортогонален к поверхности в новой точке.
Если выбор шага был удовлетворительным, производная в следующей точке существенно близка к производной в базисной точке.
Для линейных функций градиентное направление не зависит от положения на поверхности, для которой оно вычисляется. Если поверхность имеет вид
то
и компонента градиента в i-м направлении равна
. (7)
Для нелинейной функции направление градиентного вектора зависит от точки на поверхности, в которой он вычисляется.
Несмотря на существующие различия между градиентными методами, последовательность операций при поиске оптимума в большинстве случаев одинакова и сводится к следующему:
а) выбирается базисная точка;
б) определяется направление движения от базисной точки;
в) находится размер шага;
г) определяется следующая точка поиска;
д) значение целевой функции в данной точке сравнивается с ее значением в предыдущей точке;
е) вновь определяется направление движения и процедура повторяется до достижения оптимального значения.
При оптимизации методом градиента оптимум исследуемого объекта ищут в направлении наиболее быстрого возрастания (убывания) выходной переменной, т.е. в направлении градиента. Но прежде чем сделать шаг в направлении градиента, необходимо его рассчитать. Градиент можно рассчитать либо по имеющейся модели
grad y(X)= ,
моделирование динамический градиентный полиномиальный
где - частная производная по i-му фактору;
i, j, k – единичные векторы в направлении координатных осей факторного пространства, либо по результатам n пробных движений в направлении координатных осей.
Если математическая модель статистического процесса имеет вид линейного полинома, коэффициенты регрессии bi
которого являются частными производными разложения функции y = f(X) в ряд Тейлора по степеням xi
, то оптимум ищут в направлении градиента с некоторым шагом hi
:
пкфв н(Ч)= и1
р1
+и2
р2
+…+ит
рт
Направление корректируют после каждого шага.
Метод градиента вместе с его многочисленными модификациями является распространенным и эффективным методом поиска оптимума исследуемых объектов. Рассмотрим одну из модификаций метода градиента – метод крутого восхождения.
Метод крутого восхождения, или иначе метод Бокса-Уилсона, объединяет в себе достоинства трех методов - метода Гаусса-Зейделя, метода градиентов и метода полного (или дробного) факторного экспериментов, как средства получения линейной математической модели. Задача метода крутого восхождения заключается в том, чтобы шаговое движение осуществлять в направлении наискорейшего возрастания (или убывания) выходной переменной, то есть по grad y(X). В отличии от метода градиентов, направление корректируется не после каждого следующего шага, а при достижении в некоторой точке на данном направлении частного экстремума целевой функции, как это делается в методе Гаусса-Зейделя. В точке частного экстремума ставится новый факторный эксперимент, определяется математическая модель и вновь осуществляется крутое восхождение. В процессе движения к оптимуму указанным методом регулярно проводиться статистический анализ промежуточных результатов поиска. Поиск прекращается, когда квадратичные эффекты в уравнении регрессии становятся значимыми. Это означает, что достигнута область оптимума.
Опишем принцип использования градиентных методов на примере функции двух переменных
(8)
при наличии двух дополнительных условий:
, .(9)
Этот принцип (без изменения) можно применить при любом числе переменных, а также дополнительных условий. Рассмотрим плоскость x1
, x2
(Рис. 1). Согласно формуле (8) каждой точке соответствует некоторое значение F. На Рис.1 линии F = const, принадлежащие этой плоскости, представлены замкнутыми кривыми, окружающими точку M*
, в которой F минимально. Пусть в начальный момент значения x1
и x2
соответствуют точке M0
. Цикл расчета начинается с серии пробных шагов. Сначала величине x1
дается небольшое приращение ; в это время значение x2
неизменно. Затем определяется полученное при этом приращение величины F, которое можно считать пропорциональным значению частной производной
(10)
(если величина всегда одна и та же).
Рис.1
Далее дается приращение величине x2
. В это время x1
= const. Получаемое при этом приращение величины F является мерой другой частной производной:
. (11)
Определение частных производных ( 10 ) и ( 11 ) означает, что найден вектор с координатами и , который называется градиентом величины F и обозначается так:
. (12)
Известно, что направление этого вектора совпадает с направлением наиболее крутого возрастания величины F. Противоположное ему направление – это «наискорейший спуск», другими словами, наиболее крутое убывание величины F.
После нахождения составляющих градиента пробные движения прекращаются и осуществляются рабочие шаги в направлении, противоположном направлению градиента, причем величина шага тем больше, чем больше абсолютная величина вектора gradF. Эти условия осуществляются, если величины рабочих шагов и пропорциональны полученным ранее значениям частных производных:
, , (13)
где α – положительная константа.
После каждого рабочего шага оценивается приращение величины F. Если оно оказывается отрицательным, то движение происходит в правильном направлении и нужно двигаться в том же направлении M0
M1
дальше. Если же в точке M1
результат измерения показывает, что , то рабочие движения прекращаются и начинается новая серия пробных движений. При этом определяется градиент gradF в новой точке M1
, затем рабочее движение продолжается по новому найденному направлению наискорейшего спуска, т. е. по линии M1
M2
, и т.д. Этот метод называется методом наискорейшего спуска/крутого восхождения.
Когда система находится вблизи минимума, показателем чего является малое значение величины
(14)
происходит переключение на более «осторожный» метод поиска, так называемый метод градиента. От метода наискорейшего спуска он отличается тем, что после определения градиента gradF делается лишь один рабочий шаг, а затем в новой точке опять начинается серия пробных движений. Такой метод поиска обеспечивает более точное установление минимума по сравнению с методом наискорейшего спуска, между тем как последний позволяет быстрее приблизиться к минимуму. Если в процессе поиска точка М доходит до границы допустимой области и хотя бы одна из величин М1
, М2
меняет знак, метод меняется и точка М начинает двигаться вдоль границы области.
Эффективность метода крутого восхождения зависит от выбора масштаба переменных и вида поверхности отклика. Поверхность со сферическими контурами обеспечивает быстрое стягивание к оптимуму.
К недостаткам метода крутого восхождения следует отнести:
1. Ограниченность экстраполяции. Двигаясь вдоль градиента, мы основываемся на экстраполяции частных производных целевой функции по соответствующим переменным. Однако форма поверхности отклика может изменяться и необходимо изменять направление поиска. Другими словами, движение на плоскости не может быть продолжительным.
2. Трудность поиска глобального оптимума. Метод применим для отыскания только локальных оптимумов.
Представим последовательность расчета: расчет составляющих градиента.
Практически расчет составляющих градиента реализуется вычислением произведений коэффициентов регрессии на соответствующие интервалы варьирования значимых факторов.
Тогда уравнение
пкфв н(Ч) = и1
р1
+ и2
р2
+ … + ит
рт
примет вид
grad (X)= b1
+ b2
+ … + bn
т.е. в качестве шагов крутого восхождения выбираются интервалы варьирования факторов.
Выбор базового фактора:
Фактор, для которого произведение коэффициента регрессии на интервал варьирования максимально, принимается базовым:
max (bi
) = a
Выбор шага крутого восхождения:
Для базового (или другого) фактора выбирают шаг крутого восхождения ha
. Обычно его выбирают по совету технологов или по имеющейся априорной информации.
Пересчет составляющих градиента:
Здесь используется условие: умножение составляющих градиента на любое положительное число дает точки, также лежащие на градиенте.
Составляющие градиента пересчитывают по выбранному шагу крутого восхождения базового фактора:
hi
= (*)
Коэффициенты bi
в выражении (*) берутся со своими знаками, шаги hi
округляют.
Принятие решений после крутого восхождения:
После того, как экспериментальная проверка определила некоторую оптимальную точку, крутое восхождение считается завершенным. Здесь, как и ранее, необходимо принимать решения, которые зависят, прежде всего, от эффективности крутого восхождения. Большое влияние на результаты принятия решений оказывает информация об адекватности или неадекватности линейной модели и о положении области оптимума. Конечно, сведения о положении области оптимума носят весьма неопределенный характер и зависят от конкретной задачи, где переменная состояния – например, прочность материала на разрыв. Однако можно безошибочно оценить положение оптимума, если переменная состояния - выход целевого продукта в процентах.
В нашем случае имеем:
При построении математической модели определённого в условии технологического процесса одновременно решается задача оптимизации поверхности отклика , то есть определяются значения факторов, при которых , что означает, что . Известно, что одним из наиболее эффективных методов решеня задачи является градиентный метод. Согласно ему в данном случае (исходя из условий задачи) из каждой точки направление движения осуществляется в сторону, противоположную самому градиенту. Отсюда в каждой точке необходимо провести расчет градиента следующего вида:
, где i и k – единичные орты
Как правило, определить всю математическую модель процесса достаточно сложно, поэтому здесь нужно воспользоваться следующей процедурой:
1. В окрестности начальной точки
производится полный факторный эксперимент или дробный факторный эксперимент. Мы будем использовать полный факторный эксперимент.
Следует охарактеризовать общие положения проведения полного факторного эксперимента:
Применение полного факторного эксперимента позволяет найти оптимальное расположение точек в факторном пространстве и осуществить линейное преобразование координат, благодаря чему обеспечивается возможность преодолеть недостатки классического регрессионного анализа, в частности корреляцию между коэффициентами уравнения регрессии.
Некоторые обозначения для дальнейшего понимания изложения материала:
Xj-факторы;
Рj- регрессионные коэффициенты системы;
Y- выходная переменная (функция отклика);
М [f]- математическое ожидание помехи;
D [f] – дисперсия помехи;
l – число уровней ;
k – количество факторов;
Уровень факторов – граница исследования области по данному параметру;
Точка с координатами (Х0
(1),Х0
(2),…) - центр плана, или основной уровень;
- единица варьирования, или интервал варьирования;
S – дисперсия;
вектор В - вектор коэффициентов регрессии;
N - число опытов в матрице планирования;
Р - коэффициент взаимодействия;
bj
- несмешанные оценки;
- генеральные коэффициенты;
S2воспр
- дисперсия воспроизводимости;
tj
- критерий Стьюдента;
F – критерий Фишера.
Выбор плана исследования эксперимента определяется постановкой задачи исследования и особенностями объекта. Пусть имеем математическую модель системы:
Также нам известны характер помехи и статистические параметры: М[f] = 0 и D[f] = 0,8. Необходимо отметить, что под помехами понимают ряд факторов, искажающих результаты опыта. Если существуют определённые априорные сведения об источнике помех, то можно построить оптимальные планы исследования, учитывающие их влияние, и повысить таким образом точность анализа результата.
В данной задаче требуется провести полный факторный эксперимент.
Полный факторный эксперимент, или метод планирования эксперимента позволяет свести к минимуму число необходимых опытов и одновременно получить оптимальные значения искомых функций. При планировании эксперимента, условия опыта представляют собой фиксированное число значений для каждого фактора. Полный факторный эксперимент фактически представляет собой применение классических метода наименьших квадратов и регрессионного анализа, проводимых по определённому плану.
Процесс исследования обычно разбивается на отдельные этапы. Информация, полученная после каждого этапа, определяет дальнейшую стратегию эксперимента. Таким образом возникает возможность оптимального управления экспериментом. Планирование эксперимента позволяет одновременно варьировать все факторы и получать количественные оценки основных эффектов и эффектов взаимодействия.
Интересующие исследователя эффекты определяются со значительно меньшей ошибкой, чем та, которая характерна для других методов исследования.
В конечном счете, применение методов планирования эксперимента значительно повышает эффективность эксперимента.
Так как при планировании по схеме полного факторного эксперимента реализуются все возможные комбинации факторов на всех выбранных для исследования уровнях, то необходимое число опытов N при полном факторном эксперименте определяется по формуле: N=lk
.
Если эксперименты проводятся только на двух уровнях при двух значениях факторов и при этом в процессе эксперимента осуществляются все возможные комбинации из k факторов, то такой план носит название полный факторный эксперимент типа 2k
.
Описание алгоритма моделирования сводится к следующему:
1.
Определяется для любого фактора:
Х0
j
= (Хj
max
+ Хj
min
) / 2,
= (Хjmax
- Хjmin
) / 2, j = 1,2,…..k ;
2.
От основной системы координат (Х1
, Х2
, …Хn
) переходим к безразмерной системе координат (U1
, U2
, …Un
) c помощью формулы перехода:
Uj
= (Хj
- Хj
0
) / , j = 1,2,…..k;
В безразмерной системе координат верхний уровень равен +1, а нижний равен –1, координаты центра плана равны нулю и совпадают с началом координат.
3.
План эксперимента:
В матрицу планирования (Табл. 1.1) записываются все возможные значения граничных величин в натуральном масштабе.
Таблица 1.1
Номер опыта |
Значения факторов в натуральном масштабе |
выход |
X1
|
X2
|
… |
Xn
|
Y |
1 |
X11
|
X 12
|
… |
X 1 n
|
Y1
|
2 |
X 21
|
X2 2
|
… |
X 2 n
|
Y2
|
…. |
… |
… |
… |
… |
... |
N |
X N1
|
X N2
|
… |
XNn
|
YN
|
4. Введём фиктивный столбец U0
в матрицу и запишем матрицу в безразмерной форме (Табл.1.2):
Таблица 1.2
Номер опыта |
фиктивный столбец |
Значения факторов в безразмерной системе координат |
Выход |
U0
|
U1
|
U2
|
… |
Un
|
У |
1 |
+1 |
+1 |
+1 |
… |
+1 |
У1
|
2 |
+1 |
-1 |
+1 |
… |
+1 |
У2
|
... |
… |
… |
… |
… |
…. |
… |
N |
+1 |
-1 |
-1 |
… |
-1 |
УN
|
5.
Приведём полную матрицу планирования (Табл. 1.3.):
Таблица 1.3
Номер
опыта
|
Значения факторов |
Выход |
В натуральном масштабе |
В безразмернойсистеме координат |
X1
|
X2
|
… |
Xn
|
U 0
|
U1
|
U2
|
… |
Un
|
Y |
1 |
X11
|
X12
|
… |
X1n
|
+1 |
+1 |
+1 |
… |
+1 |
Y1
|
2 |
X21
|
X22
|
… |
X2
n
|
+1 |
-1 |
+1 |
… |
+1 |
Y2
|
… |
… |
… |
… |
… |
… |
… |
… |
… |
… |
… |
N |
XN1
|
X N2
|
… |
XNn
|
+1 |
-1 |
-1 |
… |
-1 |
YN
|
Предложенный план эксперимента обладает следующими свойствами:
Свойство симметричности.
;
Свойство нормировки.
;
Свойство ортогональности.
, ( l
j , l,i = 1…k );
Следует отметить, что ортогональные планы полный факторный эксперимент ( для линейных моделей ) обладают также рототабельностью. Последнее предполагает равенство и минимальность дисперсий предсказанных значений выходной переменной для всех точек факторного пространства. По закону накопления ошибок для дисперсии предсказанных уравнением регрессии значений выходной переменной можно записать:
s2
y
= s2
b
0
+ s2
b
1
U1
2
+ … + s2
bn
Un
2
Дисперсии коэффициентов регрессии равны между собою, поэтому
s2
y
= s2
bi
С учетом того, что
,
Где - радиус сферы имеем
s2
y
= s2
bi
.
Отсюда ясно, что дисперсия предсказанного значения выходной переменной зависит только от радиуса сферы. Это свойство рототабельности эквивалентно независимости дисперсии выходной переменной от вращения координат в центре плана и оправдано при поиске оптимума градиентными методами. Интуитивно понятно, что исследователю удобно иметь дело с такой информацией, содержащейся в уравнении регрессии, которая равномерно «размазана» по сфере радиусом . Действительно такое положение можно признать разумным, ибо с помощью уравнения регрессии будут предприниматься попытки предсказать положение ещё неизвестных участков факторного пространства. Равноценность этих участков в смысле ошибки предсказания, по-видимому, является необходимой.
Свойство ортогональности существенно облегчает процесс вычисления коэффициентов, так как корреляционная матрица (UТ
U)-1
становится диагональной, и коэффициенты будут равны 1/N;
6.
С учетом свойства ортогональности можно вычислить вектор В коэффициентов регрессии:
Следовательно, любой коэффициент уравнения регрессии bj определяется скалярным произведением столбца Y на соответствующий столбец Uj, деленным на число опытов N в матрице планирования:
Вычислим коэффициенты регрессии линейного уравнения :
Если в рассмотрение ввести более полное уравнение регрессии с коэффициентами взаимодействия Р, то используя процедуру метода наименьших квадратов , получим:
.
Пользуясь планом, представленным в табл. 1.2, можно перечислить коэффициенты регрессии и записать в табл.1.4:
Y= Р0
+ Р1
U1
+ Р2
U2
+ … + Рn
Un
+ … +
+…+P13
U1
U3
+ P23
U2
U3
+…+ P123
U1
U2
U3
…
Таблица 1.4
Номер опыта |
U0
|
U1
|
U2
|
… |
Un
|
… |
|
|
|
… |
У |
1 |
+1 |
+1 |
+1 |
… |
+1 |
…
|
-1 |
+1 |
+1 |
…
|
У1
|
2 |
+1 |
-1 |
+1 |
… |
+1 |
…
|
-1 |
-1 |
+1 |
…
|
У2
|
… |
… |
… |
… |
… |
… |
… |
… |
… |
… |
… |
… |
N |
+1 |
-1 |
-1 |
… |
-1 |
…
|
-1 |
+1 |
+1 |
…
|
УN
|
P12
, P23
- эффекты двойного взаимодействия, а P123
- эффекты тройного взаимодействия. Эффекты взаимодействия определяют аналогично линейным эффектам:
.
7.
Проверка однородности дисперсии и значимости коэффициентов регрессии.
Если дополнительно поставить параллельные опыты, можно определить s2
воспр
- дисперсию воспроизводимости, проверить значимость коэффициентов регрессии, а при наличии степеней свободы – адекватность уравнения.
В связи с тем, что корреляционная матрица (U*U)-1
для спланированного эксперимента есть матрица диагональная
,
коэффициенты уравнения регрессии некоррелированы между собой. Значимость коэффициентов уравнения регрессии можно проверять для каждого коэффициента в отдельности, пользуясь критерием Стьюдента : . Исключение из уравнения регрессии незначимого коэффициента не скажется на значениях остальных коэффициентов. При этом выборочные коэффициенты bj
оказываются так называемыми несмешанными оценками для соответствующих генеральных коэффициентов βj
:
bj
βj
, т. е. величины коэффициентов уравнения регрессии характеризуют вклад каждого фактора в величину y.
Диагональные элементы корреляционной матрицы равны между собой, поэтому все коэффициенты уравнений
Y = и Y = Р0
+ Р1
U1
+ Р2
U2
+ … + Рn
Un
+ … +
+ … +
oпределяются с одинаковой точностью:
sbj
= s2
воспр
8
. Проверка адекватности уравнения
Проверка адекватности уравнения проводится по критерию Фишера:
Рассчитывается значение
F= s2
ост
/ s2
воспр
; s2
ост
,
где m - число значимых коэффициентов в уравнении регрессии.
2. После проведения полного факторного эксперимента определены коэффициенты регрессии
Тогда частные производные будут пропорциональны .
3. Делая, с учетом последнего выражения, шаг в сторону, противоположную среднему, определяем новую точку и опять проводим эксперимент.
4. Повторяем первые три шага, пока не приблизимся к точке экстремума. При приближении к точке экстремума алгоритм начинает работать плохо при близости к нулю частных производных, то есть линейная модель становится неадекватной и требует введения квадратичных членов.
По условию дано:
, T = 20, U(t) = 15 – 0.1t, .
Уравнение выхода системы:
, , .
Значение параметров системы:
, .
Характер помехи и ее статистические параметры:
Нормальное распределение
.
Здесь - вектор состояния системы; - вектор наблюдения; - вектор помехи; А, В, С – матрицы коэффициентов (параметров) системы; [0, T] – интервал определения системы.
Необходимо
- составить в соответствии с математическим ожиданием системы ее имитационную модель для формирования реализации вектора и состояния системы на интервале определения;
- составить алгоритм и программу решения задачи построения динамической модели в соответствии с заданным типом модели методом идентификации и точностью решения задачи;
- отладить программу;
- провести расчеты и анализ полученных результатов.
Учитывая характер помехи можно составить следующую имитационную модель системы для формирования реализации вектора и состояния системы на интервале определения:
,
, ;
.
Здесь - вектор состояния системы; - вектор состояния модели; - матрицы коэффициентов модели.
, T = 20, U(t) = 15 – 0.1t, .
Здесь [0, T] – интервал определения системы.
Уравнение выхода системы:
, , .
Здесь - вектор наблюдения; - вектор помехи; С – матрица коэффициентов (параметров) системы.
Значение параметров системы:
, .
Здесь А, В – матрицы коэффициентов (параметров) системы.
Характер помехи и ее статистические параметры:
Помеха имеет нормальное распределение с математическим ожиданием, равным .
Идея построения требуемой динамической системы состоит в следующем: для заданного значения параметра tс его интервала определения градиентным методом первого порядка находим соответствующее значение параметра x, который изменяется динамически. Поэтому необходимо в каждый момент ti
найти оптимальное соответствующее значение фактора х и функции отклика у, которые наиболее близко описывали бы исходную систему. Помеха имеет нормальное распределение, поэтому включаем ее в функцию отклика таким образом, как показано в выше предложенных формулах.
Для поиска решения необходимо рассчитать оптимальный шаг .
Это делается по выше указанной формуле ( 6 ) – поиск шага варьирования. Именно так и реализуем в программном решении данной задачи.
Для поиска оптимального решения используем матрицы коэффициентов модели , с помощью которых определяем соответствующее значение функции отклика. Все выше сказанное реализовано в предлагаемой программе, в которой реализовано решение задачи построения динамической модели в соответствии с заданным типом модели методом идентификации и точностью решения задачи. Программа отлажена на упрощенных тестовых примерах с использованием информации, полученной от имитационной тестовой модели.
Проведен анализ полученных результатов, что также отражено в предложенной программе.
Как было отмечено ранее, в данной программе кроме ручного ввода исходных значений факторов Х (т. е. задание так называемой «нулевой точки») существует задание количества факторов и количества опытов, как по умолчанию, так и непосредственно пользователем.
Программа исследований программного эксперимента:
Решает задачу оптимизации поверхности отклика. В начале работы требуется задать значения функции отклика Y, для которых и будет найдены соответствующие значения факторов X, при которых функция отклика принимает максимальное значение.
1.Задаем количество факторов и экспериментов
Получаем значения факторов в натуральном масштабе, заполняем матрицу планирования.
2.Производим кодирование в безразмерной системе координат, для каждого фактора определяются нулевые уровни и интервалы варьирования. Они будут использованы для определения градиента в данной точке.
3.Получаем значения коэффициентов регрессии.
4.Считаем выборочные дисперсии, и если они однородны, выводим значение дисперсии воспроизводимости
5.Проверяем на значимость коэффициенты регрессии.
В данном случае все коэффициенты значимы.
6. Получаем информацию о том, описывает ли уравнение эксперимент адекватно.
7. Делаем шаг в сторону, противоположную градиенту и находим новую точку (набор факторов).
8. Для нового набора переходим к шагу 2. Выполняем указанные действия до тех пор, пока не приблизимся к точке экстремума, на что указывает убыль последующих значений функции отклика.
Матрица значений функции отклика системы:
.
Матрица помех:
.
Найденные значения факторов, про которых функция отклика принимает максимальное значение:
Вывод
В данном курсовом проекте рассматривался градиентный метод первого порядка, в качестве ядра которого использовался полный факторный эксперимент первого порядка, что предполагает такое проведение исследований, которое позволяет некоторым оптимальным образом получить информацию об объекте, оформить её в виде полиномиальной линейной модели и провести её статистический анализ. Так же в работе был составлен алгоритм моделирования , на основе которого была написана программа для проведения исследований градиентным методом.
Список литературы
1. Ю.П. Зайченко. Исследование операций. “Вища школа”. Киев 1988.
2. А.Г. Бондарь, Г.А. Статюха, Т. В. Землянкин , И.А. Потяженко. Планирование эксперимента при оптимизации процессов химической технологии. “Вища школа”. Киев 1980.
3. В.В. Кафаров. Методы кибернетики в химии и химической технологии. Москва. «Химия». 1985.
4. А.В. Бондаренко, Г.А. Статюха. Планирование эксперимента в химической технологии. “Вища школа”. Киев 1976.
5. А. Кофман, Р. Крюон “Массовое обслуживание. Теория и приложения”.
6. Е.С. Венцель “Исследование операций”.
unit MainUnit;
interface
uses Windows,Classes,Graphics,SysUtils,StdCtrls,Math,Grids, ListControl,
Forms;
type
SelType = (stNONE,stPOINT,stCON); // Типтекущегоэлемента
PPoint = ^TPoint;
TPoint = record
UIN : integer;
Value : integer;
X,Y : integer;
end;
PConnection = ^TConnection;
TConnection = record
toPoint : PPoint;
fromPoint : PPoint;
Value : integer;
end;
CurElement = record
ceType : SelType;
element : pointer;
end;
TGraph = class
private
WasChanged : boolean;
ChangedAfter : boolean;
PointRadius : integer;
MaxUIN : integer;
Points : TList;
Connections : TList;
Selected,Current : CurElement;
function CheckCicle(FP,TP:PPoint):boolean;
function MouseOverPoint(X,Y:integer):PPoint;
function MouseOverConnection(X,Y:integer):PConnection;
procedure
DrawConnections(C:TCanvas;minW,minH,maxW,maxH:integer);
procedure DrawPoints(C:TCanvas;minW,minH,maxW,maxH:integer);
procedure Clear;
public
constructor Create;
destructor Destroy;override;
function MouseOver(X,Y:integer):CurElement;
function DeleteSelected:boolean;
procedure DrawGraph(C:TCanvas;minW,minH,maxW,maxH:integer);
procedure AddPoint(X,Y:integer;Value:integer);
function AddConnection(fromPoint,toPoint:PPoint;Value:integer):boolean;
procedure ChangeCur(dX,dY:integer);
procedure
ChangeCurAndDrawContur(X,Y,GridDelta:integer;C:TCanvas;DrawFirst,D
rawSecond:boolean);
procedure GetDeltaOfCurrent(X,Y:integer;var dX,dY:integer);
procedure SaveToFile(filename:string);
procedure OpenFromFile(filename:string);
procedure SelectCurrent;
procedure DeselectCurrent;
procedure MoveOnTop;
function IsChanged:boolean;
function WasChangedAfter:boolean;
function GetPoints:TList;
function GetConnections:TList;
function GetPointByID(ID:integer):PPoint;
procedure ZoomOn(coef:extended);
procedure ZoomOff(coef:extended);
procedure ChangeValue(Elem:CurElement;Value:integer);
function GetConsCount:integer;
function GetPointsCount:integer;
end;
PProcCon = ^TProcCon;
PProcPoint = ^TProcPoint;
TProcCon = record
Value : integer;
toPoint : PProcPoint;
Next : PProcCon;
end;
TProcPoint = record
UIN : integer;
Value : integer;
Merged : boolean;
UBorder,DBorder : integer;
UCon,DCon : integer;
UFixed,DFixed : boolean;
Prev,Next : PProcCon;
end;
PWay = ^TWay;
TWay = record
Numbers : string;
Length : integer;
Weight : integer;
Current : PProcPoint;
end;
PLinkTask = ^TLinkTask;
PProcTask = ^TProcTask;
PHolder = ^THolder;
THolder = record
Task : PProcTask;
Link : PLinkTask;
Next : PHolder;
end;
TProcTask = record
UIN : integer;
ProcNum : integer;
StartTime : integer;
Length : integer;
Prev : PHolder;
MayBeBefore : boolean;
MayBeAfter : boolean;
Ready : integer;
end;
TLinkTask = record
fromUIN : integer;
toUIN : integer;
fromProc : integer;
toProc : integer;
fromTask : PProcTask;
toTask : PProcTask;
StartTime : integer;
Length : integer;
PrevLink : PLinkTask;
PrevTask : PProcTask;
end;
PPossibleMove = ^TPossibleMove;
TPossibleMove = record
UIN : integer;
processor : integer;
afterUIN : integer;
ProcCount,Time:integer;
CurrentState : boolean;
end;
TSubMerger = class
private
Selected : PProcTask;
MinProcNum:integer;
MaxProcNum:integer;
Points : TList;
Procs : TList;
Links : TList;
AllProcTasks : Tlist;
function GetProcPointByUIN(UIN:integer):PProcPoint;
function GetProcTaskByUIN(UIN:integer):PProcTask;
procedure Clear;
procedure ClearProcs(FreeElements:boolean);
procedure ClearLinks(FreeElements:boolean);
procedure FormLinkTasksAndSetTimes(NumOfProcs:integer);
// -- Optimization -- //
procedure ClearPossibleMoves(var List:TList);
function GetPossibleMoves(UIN:integer):TList;
function GetTime:integer;
function GetProcCount:integer;
procedure SaveBackUp(var List:Tlist);
procedure RestoreBackUp(var
List:Tlist;NOP:integer;ClearCurrent:boolean);
public
constructor Create;
procedure Init(GPoints,GConnections:TList);
procedure DoBazovoe;
procedure SelectTask(UIN:integer);
procedure DeselectTask;
procedure MoveSelectedAfter(ProcNum,UIN:integer);
procedure ShowSubMerging(SG:TStringGrid);
function IncNumOfProc:boolean;
function DecNumOfProc:boolean;
function OptimizeOneStep(L1,L2:TLabel):boolean;
procedure OptimizeAuto(Form:TForm;L1,L2:TLabel);
end;
// --- --- --- //
function MinInt(I1,I2:integer):integer;
function MaxInt(I1,I2:integer):integer;
procedure MinMaxInt(I1,I2:integer;Var Min,Max:integer);
implementation
// -- Native functions -- //
function MinInt(I1,I2:integer):integer;
begin
if I1<I2 then Result:=I1 else Result:=I2
end;
function MaxInt(I1,I2:integer):integer;
begin
if I1>I2 then Result:=I1 else Result:=I2
end;
procedure MinMaxInt(I1,I2:integer;Var Min,Max:integer);
begin
if I1<I2 then
begin
Min:=I1;
Max:=I2
end
else
begin
Min:=I2;
Max:=I1
end
end;
// -- Objects -- //
function TGraph.GetConsCount:integer;
begin
Result:=Connections.Count
end;
function TGraph.GetPointsCount:integer;
begin
Result:=Points.Count
end;
procedure TGraph.ZoomOn(coef:extended);
var PP:PPoint;
i:integer;
begin
for i:=0 to Points.Count-1 do
begin
PP:=Points[i];
PP.X:=round(PP.X*coef);
PP.Y:=round(PP.Y*coef);
end;
end;
procedure TGraph.ZoomOff(coef:extended);
var PP:PPoint;
i:integer;
begin
for i:=0 to Points.Count-1 do
begin
PP:=Points[i];
PP.X:=round(PP.X/coef);
PP.Y:=round(PP.Y/coef);
end;
end;
constructor TGraph.Create;
begin
inherited Create;
MaxUIN:=0;
Points:=TList.Create;
Connections:=TList.Create;
Current.ceType := stNONE;
Current.element := nil;
Selected.ceType := stNONE;
Selected.element := nil;
PointRadius := 15;
WasChanged := false;
ChangedAfter := false;
end;
destructor TGraph.Destroy;
begin
Clear;
Points.Destroy;
Connections.Destroy;
inherited Destroy
end;
procedure TGraph.Clear;
begin
while Points.Count<>0 do
begin
dispose(PPoint(Points.first));
Points.delete(0);
end;
while Connections.Count<>0 do
begin
dispose(PConnection(Connections.first));
Connections.delete(0);
end;
MaxUIN:=0;
Current.ceType := stNONE;
Current.element := nil;
Selected.ceType := stNONE;
Selected.element := nil;
end;
function TGraph.DeleteSelected:boolean;
var i:integer;
PP:PPoint;
PC:PConnection;
begin
if Selected.ceType = stNONE
then Result:=false
else
begin
WasChanged:=true;
ChangedAfter:=true;
Result:=true;
if Selected.ceType = stCON then
begin
PC:=Selected.element;
for i:=0 to Connections.Count-1 do
begin
if Connections[i] = PC then
begin
Connections.delete(i);
break
end;
end;
dispose(PC);
end
else
begin
PP:=Selected.element;
for i:=0 to Points.Count-1 do
begin
if Points[i] = PP then
begin
Points.delete(i);
break
end;
end;
i:=0;
while i<Connections.Count do
begin
PC:=Connections[i];
if(PC.toPoint=PP)or(PC.fromPoint=PP)then
begin
Connections.delete(i);
dispose(PC)
end
else
i:=i+1
end;
dispose(PP)
end;
Selected.ceType:=stNONE;
Selected.element:=nil
end;
end;
procedure TGraph.MoveOnTop;
var PP:PPoint;
num:integer;
begin
if Current.ceType = stPoint then
begin
WasChanged:=true;
// ChangedAfter:=true;
PP:=Current.element;
num:=0;
while num<Points.count do
begin
if Points[num]=PP then break;
num:=num+1
end;
Points.delete(num);
Points.add(PP)
end;
end;
procedure TGraph.SelectCurrent;
begin
Selected:=Current
end;
procedure TGraph.DeselectCurrent;
begin
Selected.ceType:=stNONE;
Selected.element:=nil
end;
function TGraph.MouseOverPoint(X,Y:integer):PPoint;
var PP:PPoint;
d,i:integer;
begin
Result:=nil;
for i:=Points.Count-1 downto 0 do
begin
PP:=Points[i];
d := round(sqrt((X-PP.X)*(X-PP.X)+(Y-PP.Y)*(Y-PP.Y)));
if d<=15 then
begin
Result:=Points[i];
break
end;
end;
end;
function TGraph.MouseOverConnection(X,Y:integer):PConnection;
var PC:PConnection;
i:integer;
TX,TY,FX,FY,d:integer;
begin
Result:=nil;
for i:=Connections.Count-1 downto 0 do
begin
PC:=Connections[i];
if MinInt(PC.fromPoint.X,PC.toPoint.X) = PC.fromPoint.X then
begin
FX:=PC.fromPoint.X;
FY:=PC.fromPoint.Y;
TX:=PC.toPoint.X;
TY:=PC.toPoint.Y
end
else
begin
FX:=PC.toPoint.X;
FY:=PC.toPoint.Y;
TX:=PC.fromPoint.X;
TY:=PC.fromPoint.Y
end;
if (X>=FX-5)and(X<=TX+5)then
begin
d := (TY-FY)*X + (FX-TX)*Y + TX*FY - FX*TY;
d := abs(round(d/sqrt((TY-FY)*(TY-FY)+(FX-TX)*(FX-TX))));
if d<=5 then
begin
Result:=Connections[i];
break
end
end
end
end;
function TGraph.MouseOver(X,Y:integer):CurElement;
begin
current.element:=MouseOverPoint(X,Y);
if current.element<>nil then current.ceType:=stPOINT
else
begin
current.element:=MouseOverConnection(X,Y);
if current.element<>nil then current.ceType:=stCON
else current.ceType:=stNONE
end;
Result:=current;
end;
procedure TGraph.GetDeltaOfCurrent(X,Y:integer;var dX,dY:integer);
var PP:PPoint;
begin
PP:=current.element;
if PP<>nil then
begin
dX:=X - PP.X;
dY:=Y - PP.Y
end
else
begin
dX:=0;
dY:=0
end;
end;
procedure TGraph.ChangeCur(dX,dY:integer);
var PP:PPoint;
begin
WasChanged:=true;
// ChangedAfter:=true;
PP:=current.element;
if PP<>nil then
begin
PP.X:=PP.X+dx;
PP.Y:=PP.Y+dy
end
end;
procedure
TGraph.ChangeCurAndDrawContur(X,Y,GridDelta:integer;C:TCanvas;Dra
wFirst,DrawSecond:boolean);
var PP:PPoint;
begin
WasChanged:=true;
// ChangedAfter:=true;
if current.ceType<>stNONE then
begin
PP:=current.element;
C.Brush.Style:=bsClear;
C.Pen.Mode := pmNotXor;
C.Pen.Color:=clBlack;
C.Pen.Width:=1;
if DrawFirst then C.Ellipse(PP.X-PointRadius,PP.Y-
PointRadius,PP.X+PointRadius,PP.Y+PointRadius);
if GridDelta>1 then
begin
PP.X:=round(X/GridDelta)*GridDelta;
PP.Y:=round(Y/GridDelta)*GridDelta
end
else
begin
PP.X:=X;
PP.Y:=Y
end;
if DrawSecond then C.Ellipse(PP.X-PointRadius,PP.Y-
PointRadius,PP.X+PointRadius,PP.Y+PointRadius);
C.Pen.Mode := pmCopy;
C.Brush.Style:=bsSolid;
end;
end;
procedure getArrowCoord(Fx,Fy,Tx,Ty:integer;R,Alpha:Integer;var
Ar1X,Ar1Y,Ar2X,Ar2Y:integer);
var CosV,SinV,D,CosAd2:extended;
a,b,c,Descr:extended;
y1,y2,x1,x2:extended;
RCosAd2,RSinAd2:integer;
begin
D := sqrt((FX-TX)*(FX-TX)+(FY-TY)*(FY-TY));
if D<>0 then CosV := (FX-TX) / D else CosV:=0;
if CosV = 0 then
begin
RCosAd2 := round(R*Cos(Pi*Alpha/360));
RSinAd2 := round(R*Sin(Pi*Alpha/360));
Ar1X := TX + RSinAd2;
Ar2X := TX - RSinAd2;
if TY>FY then Ar1Y := TY - RCosAd2
else Ar1Y := TY + RCosAd2;
Ar2Y := Ar1Y;
end
else
begin
SinV := (FY-TY) / D;
CosAd2 := Cos(Pi*Alpha/360);
a:=1;
b:=-2*CosAd2*SinV;
c:=CosAd2*CosAd2-CosV*CosV;
Descr := b*b - 4*a*c;
y1 := (-b - sqrt(Descr))/(2*a);
y2 := (-b + sqrt(Descr))/(2*a);
x1 := (cosAd2 - sinV*y1) / cosV;
x2 := (cosAd2 - sinV*y2) / cosV;
Ar1X:=round(x1*R)+Tx;
Ar2X:=round(x2*R)+Tx;
Ar1Y:=round(y1*R)+Ty;
Ar2Y:=round(y2*R)+Ty;
end
end;
procedure
TGraph.DrawConnections(C:TCanvas;minW,minH,maxW,maxH:integer);
var i:integer;
PC:PConnection;
Ar1X,Ar1Y,Ar2X,Ar2Y:integer;
Poly:array[0..2]of Windows.TPoint;
D:extended;
FX,FY,TX,TY:integer;
s:string;
W,H,X,Y:integer;
begin
C.Pen.Color := clBlue;
for i:=0 to Connections.Count-1 do
begin
C.Brush.Color := clBlue;
PC:=Connections[i];
if Selected.element = PC then C.Pen.Width:=2
else C.Pen.Width:=1;
C.moveto(PC.fromPoint.X,PC.fromPoint.Y);
C.lineto(PC.toPoint.X,PC.toPoint.Y);
FX:=PC.fromPoint.X;
FY:=PC.fromPoint.Y;
TX:=PC.toPoint.X;
TY:=PC.toPoint.Y;
D := sqrt((FX-TX)*(FX-TX)+(FY-TY)*(FY-TY));
if D<>0 then
begin
TX := round( TX - PointRadius*(TX-FX)/D );
TY := round( TY - PointRadius*(TY-FY)/D );
end;
getArrowCoord(FX,FY,TX,TY,10,45,Ar1X,Ar1Y,Ar2X,Ar2Y);
//
getArrowCoord(PC.fromPoint.X,PC.fromPoint.Y,PC.toPoint.X,PC.toPoint.
Y,Poin tRadius,10,45,Ar1X,Ar1Y,Ar2X,Ar2Y);
Poly[0].x := TX;
Poly[0].y := TY;
Poly[1].x := Ar1X;
Poly[1].y := Ar1Y;
Poly[2].x := Ar2X;
Poly[2].y := Ar2Y;
C.Polygon(Poly);
s:=inttostr(PC.Value);
H:=C.TextHeight('A');
W:=C.TextWidth(s);
X:=round((FX+TX-W)/2)-3;
Y:=round((FY+TY-H)/2)-1;
C.Brush.Color := clWhite;
C.Rectangle(X,Y,X+W+7,Y+H+2);
C.Brush.style:=bsClear;
C.TextOut(X+3,Y+1,s);
C.Brush.style:=bsSolid;
{ C.moveto(Ar1X,Ar1Y);
C.lineto(PC.toPoint.X,PC.toPoint.Y);
C.moveto(Ar2X,Ar2Y);
C.lineto(PC.toPoint.X,PC.toPoint.Y);
}
end
end;
procedure
TGraph.DrawPoints(C:TCanvas;minW,minH,maxW,maxH:integer);
var i:integer;
PP:PPoint;
H,W:integer;
X1,X2,Y1,Y2:integer;
s:string;
begin
C.Brush.Style := bsSolid;
C.Brush.Color := clWhite;
C.Pen.Color := clBlack;
for i:=0 to Points.Count-1 do
begin
PP:=Points[i];
if Selected.element = PP then C.Pen.Width:=2
else C.Pen.Width:=1;
// C.Ellipse(PP.X-PointRadius,PP.Y-
PointRadius,PP.X+PointRadius,PP.Y+PointRadius+10);
X1:=PP.X-PointRadius;
Y1:=PP.Y-PointRadius;
X2:=PP.X+PointRadius;
Y2:=PP.Y+PointRadius;
if(X1<maxW)and(Y2<=maxH)and(X2>minW)and(Y2>minH)then
C.Ellipse(X1,Y1,X2,Y2);
s:=inttostr(PP.Value);
H:=C.TextHeight('A');
W:=C.TextWidth(s);
C.TextOut(round(PP.X-W/2),round(PP.Y-H/2),s)
end;
C.Brush.Style := bsClear;
C.Font.Color:=clBlack;
C.Font.Style:=[fsBold];
for i:=0 to Points.Count-1 do
begin
PP:=Points[i];
s:=inttostr(PP.UIN);
H:=C.TextHeight('A');
W:=C.TextWidth(s);
C.TextOut(round(PP.X+PointRadius-W/2),PP.Y-PointRadius-H-1,s)
end;
C.Font.Style:=[];
C.Brush.Style := bsSolid;
end;
procedure
TGraph.DrawGraph(C:TCanvas;minW,minH,maxW,maxH:integer);
begin
DrawConnections(C,minW,minH,maxW,maxH);
DrawPoints(C,minW,minH,maxW,maxH);
end;
procedure TGraph.AddPoint(X,Y:integer;Value:integer);
var PP:PPoint;
begin
WasChanged:=true;
ChangedAfter:=true;
MaxUIN:=MaxUIN+1;
new(PP);
PP.UIN:=MaxUIN;
PP.X:=X;
PP.Y:=Y;
PP.Value:=Value;
Points.Add(PP);
end;
function TGraph.CheckCicle(FP,TP:PPoint):boolean;
var List : TList;
PC:PConnection;
CurP:PPoint;
i:integer;
begin
Result:=true;
List:= TList.create;
List.add(TP);
while List.Count<>0 do
begin
CurP:=List.first;
List.delete(0);
if CurP = FP then
begin
Result:=false;
break
end;
for i:=0 to Connections.Count-1 do
begin
PC:=Connections[i];
if PC.fromPoint = CurP then List.Add(PC.toPoint)
end
end;
List.clear;
List.Destroy
end;
function
TGraph.AddConnection(fromPoint,toPoint:PPoint;Value:integer):boolean;
var PC:PConnection;
begin
if(fromPoint<>toPoint) and CheckCicle(fromPoint,toPoint) then
begin
WasChanged:=true;
ChangedAfter:=true;
new(PC);
PC.fromPoint:=fromPoint;
PC.toPoint:=toPoint;
PC.Value:=Value;
Connections.Add(PC);
Result:=true
end
else
Result:=false
end;
procedure TGraph.SaveToFile(filename:string);
var f:file;
PP:PPoint;
PC:PConnection;
i:integer;
begin
assign(f,filename);
rewrite(f,1);
BlockWrite(f,Points.Count,SizeOf(integer));
BlockWrite(f,Connections.Count,SizeOf(integer));
for i:=0 to Points.Count-1 do
begin
PP:=Points[i];
BlockWrite(f,PP,SizeOf(PP));
BlockWrite(f,PP^,SizeOf(PP^));
end;
for i:=0 to Connections.Count-1 do
begin
PC:=Connections[i];
// BlockWrite(f,PC,SizeOf(PC));
BlockWrite(f,PC^,SizeOf(PC^));
end;
close(f);
end;
procedure TGraph.OpenFromFile(filename:string);
type
PAddr = ^TAddr;
TAddr = record
Old,New:pointer;
end;
var f:file;
Addresses:TList;
PA:PAddr;
PP:PPoint;
PC:PConnection;
p:pointer;
i,NOP,NOC:integer;
procedure SetNewAddr(iOld,iNew:pointer);
var PA:PAddr;
begin
new(PA);
PA.Old:=iOld;
Pa.New:=iNew;
Addresses.add(PA)
end;
function GetNewAddr(Old:pointer):pointer;
var i:integer;
begin
Result:=nil;
for i:=0 to Addresses.Count-1 do
if PAddr(Addresses[i]).Old = Old then
begin
Result:=PAddr(Addresses[i]).New;
Break
end;
end;
begin
MaxUIN:=0;
Clear;
WasChanged:=false;
ChangedAfter:=false;
Addresses:=TList.Create;
assign(f,filename);
reset(f,1);
BlockRead(f,NOP,SizeOf(integer));
BlockRead(f,NOC,SizeOf(integer));
for i:=0 to NOP-1 do
begin
new(PP);
BlockRead(f,p,SizeOf(p));
BlockRead(f,PP^,SizeOf(PP^));
Points.Add(PP);
SetNewAddr(p,PP);
If MaxUIN < PP.UIN then MaxUIN:=PP.UIN
end;
for i:=0 to NOC-1 do
begin
new(PC);
BlockRead(f,PC^,SizeOf(PC^));
PC.toPoint:=GetNewAddr(PC.toPoint);
PC.fromPoint:=GetNewAddr(PC.fromPoint);
Connections.Add(PC);
end;
close(f);
while Addresses.Count<>0 do
begin
PA:=Addresses.first;
Addresses.Delete(0);
dispose(PA);
end;
Addresses.Destroy
end;
function TGraph.IsChanged:boolean;
begin
Result:=WasChanged
end;
function TGraph.WasChangedAfter:boolean;
begin
Result:=ChangedAfter;
ChangedAfter:=false;
end;
function TGraph.GetPointByID(ID:integer):PPoint;
var PP:PPoint;
i:integer;
begin
Result:=nil;
for i:=0 to Points.Count-1 do
begin
PP:=Points[i];
if PP.UIN=ID then
begin
Result:=PP;
break
end;
end;
end;
function TGraph.GetPoints:TList;
begin
Result:=Points
end;
function TGraph.GetConnections:TList;
begin
Result:=Connections
end;
procedure TGraph.ChangeValue(Elem:CurElement;Value:integer);
begin
if Elem.element<>nil then
begin
case Elem.ceType of
stPOINT:PPoint(Elem.element).Value:=Value;
stCON :PConnection(Elem.element).Value:=Value;
end;
WasChanged:=true;
ChangedAfter:=true
end
end;
// --- SubMerger --- //
constructor TSubMerger.Create;
begin
Points := TList.Create;
AllProcTasks := TList.Create;
Procs:=TList.Create;
Links:=TList.Create
end;
procedure TSubMerger.ClearProcs(FreeElements:boolean);
var PPT:PProcTask;
PH:PHolder;
tmpPoint:pointer;
List:TList;
begin
Selected:=nil;
while Procs.Count<>0 do
begin
List:=Procs.first;
Procs.delete(0);
while List.Count<>0 do
begin
PPT:=List.first;
List.delete(0);
PH:=PPT.Prev;
while PH<>nil do
begin
tmpPoint:=PH.Next;
dispose(PH);
PH:=tmpPoint
end;
PPT.Prev:=nil;
PPT.MayBeAfter:=false;
PPT.MayBeBefore:=false;
if FreeElements then dispose(PPT);
end;
List.destroy;
end;
if FreeElements then AllProcTasks.clear;
end;
procedure TSubMerger.ClearLinks(FreeElements:boolean);
var PLT:PLinkTask;
List:TList;
begin
while Links.Count<>0 do
begin
List:=Links.first;
Links.delete(0);
while List.Count<>0 do
begin
PLT:=List.first;
List.delete(0);
PLT.PrevLink:=nil;
PLT.PrevTask:=nil;
if FreeElements then dispose(PLT);
end;
List.destroy;
end;
end;
procedure TSubMerger.Clear;
var PPP:PProcPoint;
PPC:PProcCon;
begin
while Points.Count<>0 do
begin
PPP:=Points.first;
Points.delete(0);
while PPP.Prev<>nil do
begin
PPC:=PPP.Prev.Next;
dispose(PPP.Prev);
PPP.Prev:=PPC
end;
while PPP.Next<>nil do
begin
PPC:=PPP.Next.Next;
dispose(PPP.Next);
PPP.Next:=PPC
end;
dispose(PPP)
end;
ClearLinks(true);
ClearProcs(true);
AllProcTasks.Clear;
{
while FProcTasks.Count<>0 do
begin
PPT:=FProcTasks.first;
FProcTasks.delete(0);
dispose(PPT)
end;
while FLinkTasks.Count<>0 do
begin
PLT:=FLinkTasks.first;
FLinkTasks.delete(0);
dispose(PLT)
end;
}
end;
function TSubMerger.GetProcPointByUIN(UIN:integer):PProcPoint;
var i:integer;
begin
Result:=nil;
for i:=0 to Points.Count-1 do
if PProcPoint(Points[i]).UIN = UIN then
begin
Result:=Points[i];
break
end;
end;
function TSubMerger.GetProcTaskByUIN(UIN:integer):PProcTask;
var i:integer;
begin
Result:=nil;
for i:=0 to AllProcTasks.Count-1 do
if PProcTask(AllProcTasks[i]).UIN = UIN then
begin
Result:=AllProcTasks[i];
break
end;
end;
procedure TSubMerger.Init(GPoints,GConnections:TList);
var i:integer;
PP:PPoint;
PC:PConnection;
PPP:PProcPoint;
PPC:PProcCon;
begin
Clear;
for i:=0 to GPoints.Count-1 do
begin
PP:=GPoints[i];
new(PPP);
PPP.UIN := PP.Uin;
PPP.Value := PP.Value;
PPP.UBorder:=0;
PPP.DBorder:=$8FFFFFFF;
PPP.UFixed:=false;
PPP.DFixed:=false;
PPP.UCon:=0;
PPP.DCon:=0;
PPP.Prev:=nil;
PPP.Next:=nil;
Points.Add(PPP);
end;
for i:=0 to GConnections.Count-1 do
begin
PC:=GConnections[i];
PPP := GetProcPointByUIN(PC.fromPoint.UIN);
new(PPC);
PPC.Value := PC.Value;
PPC.toPoint := GetProcPointByUIN(PC.toPoint.UIN);
PPC.Next := PPP.Next;
PPP.Next := PPC;
PPP := GetProcPointByUIN(PC.toPoint.UIN);
new(PPC);
PPC.Value := PC.Value;
PPC.toPoint := GetProcPointByUIN(PC.fromPoint.UIN);
PPC.Next := PPP.Prev;
PPP.Prev := PPC;
end;
end;
procedure SetUBorderToPPP(PPP:PProcPoint;Value:integer);
var PPC:PProcCon;
Fix:boolean;
begin
if PPP.UBorder < Value then PPP.UBorder := Value;
PPC:=PPP.Prev;
Fix:=true;
while PPC<>nil do
begin
if not PPC.toPoint.DFixed then
begin
Fix:=false;
Break
end;
PPC:=PPC.Next
end;
PPP.UFixed:=Fix
end;
procedure SetDBorderToPPP(PPP:PProcPoint;Value:integer);
var PPC:PProcCon;
Fix:boolean;
begin
if PPP.DBorder > Value then PPP.DBorder := Value;
PPC:=PPP.Next;
Fix:=true;
while PPC<>nil do
begin
if not PPC.toPoint.UFixed then
begin
Fix:=false;
Break
end;
PPC:=PPC.Next
end;
PPP.DFixed:=Fix
end;
procedure SetUBorderDown(PPP:PProcPoint;Value:integer);
var PPC:PProcCon;
workPPP:PProcPoint;
List:TList;
begin
List:=TList.create;
if PPP.UBorder < Value then
begin
PPP.UBorder := Value;
List.Add(PPP);
while List.Count<>0 do
begin
workPPP:=List[0];
List.delete(0);
PPC:=workPPP.Next;
while PPC<>nil do
begin
if PPC.toPoint.UBorder < workPPP.UBorder+1 then
begin
PPC.toPoint.UBorder:=workPPP.UBorder+1;
List.Add(PPC.toPoint)
end;
PPC:=PPC.Next
end;
end;
end;
List.Destroy;
end;
procedure SetDBorderUp(PPP:PProcPoint;Value:integer);
var PPC:PProcCon;
workPPP:PProcPoint;
List:TList;
begin
List:=TList.create;
if PPP.DBorder > Value then
begin
PPP.DBorder := Value;
List.Add(PPP);
while List.Count<>0 do
begin
workPPP:=List[0];
List.delete(0);
PPC:=workPPP.Prev;
while PPC<>nil do
begin
if PPC.toPoint.DBorder > workPPP.DBorder-1 then
begin
PPC.toPoint.DBorder:=workPPP.DBorder-1;
List.Add(PPC.toPoint)
end;
PPC:=PPC.Next
end;
end;
end;
List.Destroy;
end;
procedure SetProcToPPP(PPP:PProcPoint;Value:integer);
var PPC:PProcCon;
begin
PPP.UBorder:=Value;
PPP.DBorder:=Value;
PPP.UFixed:=true;
PPP.DFixed:=true;
PPP.Merged:=true;
PPC:=PPP.Prev;
while PPC<>nil do
begin
if not PPC.toPoint.Merged then
begin
//if PPC.toPoint.DBorder>PPP.UBorder-1 then
SetDBorderToPPP(PPC.toPoint,PPP.UBorder-1);
SetDBorderToPPP(PPC.toPoint,PPP.UBorder-1);
PPC.toPoint.DCon:=PPC.toPoint.DCon+PPC.Value;
end;
PPC:=PPC.Next;
end;
PPC:=PPP.Next;
while PPC<>nil do
begin
if not PPC.toPoint.Merged then
begin
//if PPC.toPoint.UBorder<PPP.DBorder+1 then
SetUBorderToPPP(PPC.toPoint,PPP.DBorder+1);
SetUBorderToPPP(PPC.toPoint,PPP.DBorder+1);
PPC.toPoint.UCon:=PPC.toPoint.UCon+PPC.Value;
end;
PPC:=PPC.Next;
end;
end;
procedure TSubMerger.DoBazovoe;
var i,j,p:integer;
PPP:PProcPoint;
PPC:PProcCon;
PW,newPW:PWay;
WorkList : TList;
WaysList : TList;
MaxWayLength : integer;
s : string;
//-->>
Pretender:PProcPoint;
NoChange:boolean;
PretenderCon : integer;
//-->>
PPT:PProcTask;
begin
ClearLinks(true);
ClearProcs(true);
AllProcTasks.Clear;
WaysList := TList.Create;
WorkList := TList.Create;
for i:=0 to Points.Count-1 do
begin
PPP:=Points[i];
PPP.UBorder:=0;
PPP.DBorder:=$7FFFFFFF;
PPP.UCon:=0;
PPP.DCon:=0;
PPP.UFixed:=false;
PPP.DFixed:=false;
PPP.Merged:=false;
WorkList.Add(PPP)
end;
for i:=0 to Points.Count-1 do
begin
PPP:=Points[i];
PPC:=PPP.Next;
while PPC<>nil do
begin
for j:=0 to WorkList.Count-1 do
if PPC.toPoint = WorkList[j] then
begin
WorkList.delete(j);
break
end;
PPC:=PPC.Next
end;
end;
for i:=0 to WorkList.Count-1 do
begin
PPP:=WorkList[i];
new(PW);
PW.Length:=1;
PW.Numbers:=inttostr(PPP.UIN)+',';
PW.Weight:=PPP.Value;
PW.Current:=PPP;
WorkList[i]:=PW
end;
while WorkList.Count<>0 do
begin
PW:=WorkList.first;
WorkList.delete(0);
if PW.Current.Next=nil then WaysList.Add(PW)
else
begin
PPC:=PW.Current.Next;
while PPC<>nil do
begin
new(newPW);
newPW.Length:=PW.Length+1;
newPW.Weight:=PW.Weight+PPC.Value+PPC.toPoint.Value;
newPW.Numbers:=PW.Numbers+inttostr(PPC.toPoint.UIN)+',';
newPW.Current:=PPC.toPoint;
WorkList.Add(newPW);
PPC:=PPC.Next
end;
dispose(PW)
end;
end;
MaxWayLength := 0;
for i:=0 to WaysList.Count-1 do
begin
PW:=WaysList[i];
if PW.Length > MaxWayLength then MaxWayLength:=PW.Length
end;
for i:=0 to Points.Count-1 do
begin
PPP:=Points[i];
if PPP.Prev = nil then SetUBorderDown(PPP,1);
if PPP.Next = nil then SetDBorderUp(PPP,MaxWayLength);
end;
for i:=0 to Points.Count-1 do
begin
PPP:=Points[i];
if PPP.UBorder = PPP.DBorder then SetProcToPPP(PPP,PPP.UBorder);
end;
Pretender:=nil;
PretenderCon:=0;
repeat
NoChange:=true;
for i:=0 to Points.Count-1 do
begin
PPP:=Points[i];
if not PPP.merged then
begin
if PPP.UFixed and PPP.DFixed then
begin
if PPP.UCon > PPP.DCon then SetProcToPPP(PPP,PPP.UBorder)
else SetProcToPPP(PPP,PPP.DBorder);
Pretender:=nil;
NoChange:=false;
break
end
else
begin
if PPP.UFixed then
begin
if(Pretender = nil)or(PretenderCon < PPP.UCon) then
begin
Pretender:=PPP;
PretenderCon := PPP.UCon
end;
end
else
if PPP.DFixed then
begin
if(Pretender = nil)or(PretenderCon < PPP.DCon) then
begin
Pretender:=PPP;
PretenderCon := PPP.DCon
end;
end;
end;
end;
end;
if Pretender<>nil then
begin
if Pretender.UFixed then SetProcToPPP(Pretender,Pretender.UBorder)
else SetProcToPPP(Pretender,Pretender.DBorder);
Pretender:=nil;
PretenderCon:=0;
NoChange:=false;
end;
until NoChange;
for i:=0 to Points.Count-1 do
begin
PPP:=Points[i];
new(PPT);
PPT.ProcNum:=PPP.UBorder;
PPT.ProcNum:=PPP.DBorder;
PPT.Ready:=0;
PPT.UIN:=PPP.UIN;
PPT.StartTime:=0;
PPT.Length:=PPP.Value;
PPT.Prev:=nil;
PPT.MayBeAfter:=false;
PPT.MayBeBefore:=false;
PPC:=PPP.Prev;
while PPC<>nil do
begin
PPT.Ready:=PPT.Ready+1;
PPC:=PPC.next
end;
j:=0;
while j<=AllProcTasks.Count-1 do
begin
if PProcTask(AllProcTasks[j]).Ready > PPT.Ready then break;
j:=j+1;
end;
AllProcTasks.Add(PPT);
end;
FormLinkTasksAndSetTimes(MaxWayLength);
end;
procedure SetProcTimes(List:TList);
var i,j:integer;
PPT:PProcTask;
PH:PHolder;
Time,dTime:integer;
begin
Time:=1;
for i:=0 to List.Count-1 do
begin
PPT:=List[i];
PPT.StartTime:=Time;
Time:=Time+PPT.Length;
end;
for i:=0 to List.Count-1 do
begin
PPT:=List[i];
Time:=PPT.StartTime;
PH:=PPT.Prev;
while PH<>nil do
begin
if PH.Task<>nil then
begin
if Time < PH.Task.StartTime+PH.Task.Length then
Time:= PH.Task.StartTime+PH.Task.Length
end
else
begin
if Time < PH.Link.StartTime+PH.Link.Length then
Time:= PH.Link.StartTime+PH.Link.Length
end;
PH:=PH.Next
end;
if Time > PPT.StartTime then
begin
dTime:=Time-PPT.StartTime;
PPT.StartTime:=Time;
for j:=i+1 to List.Count-1 do
PProcTask(List[j]).StartTime:=PProcTask(List[j]).StartTime+dTime
end;
end;
end;
procedure SetProcStartTimes(List:TList);
var i:integer;
PPT:PProcTask;
Time:integer;
begin
Time:=1;
for i:=0 to List.Count-1 do
begin
PPT:=List[i];
PPT.StartTime:=Time;
Time:=Time+PPT.Length;
end;
end;
function PLT_TimeCompare(I1,I2:Pointer):integer;
var D1,D2:integer;
Item1,Item2:PLinkTask;
begin
Item1:=I1;
Item2:=I2;
if Item1.StartTime<Item2.StartTime then Result:=-1
else
if Item1.StartTime>Item2.StartTime then Result:=1
else
begin
if Item1.toProc = Item2.toProc then
begin
if Item1.toTask.StartTime<Item2.toTask.StartTime then Result:=-1
else
if Item1.toTask.StartTime>Item2.toTask.StartTime then Result:=1
else Result:=0
end
else
begin
D1:=Item1.toProc - Item1.fromProc;
D2:=Item2.toProc - Item2.fromProc;
if D1>D2 then Result:=1
else
if D1<D2 then Result:=-1
else
begin
if Item1.toProc<Item2.toProc then Result:=-1
else
if Item1.toProc>Item2.toProc then Result:=1
else
Result:=0
end;
end;
end;
end;
procedure SetLinkTimes(List:TList);
var i:integer;
PLT:PLinkTask;
Time:integer;
begin
for i:=0 to List.Count-1 do
begin
PLT:=List[i];
if PLT.PrevTask<>nil then
Time:= PLT.PrevTask.StartTime+PLT.PrevTask.Length
else
Time:= PLT.PrevLink.StartTime+PLT.PrevLink.Length;
PLT.StartTime:=Time;
end;
List.Sort(PLT_TimeCompare);
Time:=1;
for i:=0 to List.Count-1 do
begin
PLT:=List[i];
if Time>PLT.StartTime then PLT.StartTime:=Time;
Time:=PLT.StartTime+PLT.Length;
end;
end;
зrocedure TSubMerger.FormLinkTasksAndSetTimes(NumOfProcs:integer);
var i,j,k:integer;
PPT,toPPT:PProcTask;
PLT:PLinkTask;
PPP:PProcPoint;
PPC:PProcCon;
PH:PHolder;
tmpPoint : pointer;
List:TList;
begin
ClearLinks(true);
ClearProcs(false);
if NumOfProcs<>0 then
begin
List:=TList.Create;;
Procs.Add(list);
for i:=1 to NumOfProcs-1 do
begin
List:=TList.Create;;
Procs.Add(list);
List:=TList.Create;
Links.Add(List)
end;
end;
for i:=0 to AllProcTasks.Count-1 do
begin
PPT:=AllProcTasks[i];
List:=Procs[PPT.ProcNum-1];
List.Add(PPT);
end;
// Формированик Линков
for i:=1 to Procs.Count-1 do
begin
List:=Procs[i];
for j:=0 to List.Count-1 do
begin
PPT:=List[j];
PPP:=GetProcPointByUIN(PPT.UIN);
PPC:=PPP.Prev;
while PPC<>nil do
begin
toPPT:=GetProcTaskByUIN(PPC.toPoint.UIN);
if toPPT.ProcNum = PPT.ProcNum then
begin
new(PH);
PH.Task:=toPPT;
PH.Link:=nil;
PH.Next:=PPT.Prev;
PPT.Prev:=PH;
end
else
begin
new(PLT);
PLT.length:=PPC.Value;
PLT.fromUIN:=toPPT.UIN;
PLT.fromProc:=toPPT.ProcNum;
PLT.toUIN:=PPT.UIN;
PLT.toProc:=PPT.ProcNum;
PLT.fromTask:=toPPT;
PLT.toTask:=PPT;
PLT.StartTime:=0;
PLT.PrevTask:=toPPT;
PLT.PrevLink:=nil;
Tlist(Links[toPPT.ProcNum-1]).Add(PLT);
tmpPoint:=PLT;
for k:=toPPT.ProcNum to PPT.ProcNum-2 do
begin
new(PLT);
PLT.length:=PPC.Value;
PLT.fromUIN:=toPPT.UIN;
PLT.fromProc:=toPPT.ProcNum;
PLT.toUIN:=PPT.UIN;
PLT.toProc:=PPT.ProcNum;
PLT.fromTask:=toPPT;
PLT.toTask:=PPT;
PLT.StartTime:=0;
PLT.PrevTask:=nil;
PLT.PrevLink:=tmpPoint;
Tlist(Links[k]).Add(PLT);
tmpPoint:=PLT
end;
new(PH);
PH.Task:=nil;
PH.Link:=tmpPoint;
PH.Next:=PPT.Prev;
PPT.Prev:=PH;
end;
PPC:=PPC.next
end;
end;
end;
for i:=0 to Procs.Count-1 do
SetProcStartTimes(Procs[i]);
for i:=0 to Procs.Count+Links.Count-1 do
if i mod 2 = 0 then SetProcTimes(Procs[i div 2])
else SetLinkTimes(Links[i div 2])
end;
procedure TSubMerger.ShowSubMerging(SG:TStringGrid);
var i,j,k:integer;
NumOfRows:integer;
List:TList;
PPT:PProcTask;
PLT:PLinkTask;
begin
NumOfRows:=1;
for i:=0 to Procs.Count-1 do
begin
List:=Procs[i];
if List.Count<>0 then
begin
PPT:=List.last;
if NumOfRows<PPT.StartTime+PPT.Length then
NumOfRows:=PPT.StartTime+PPT.Length;
end;
end;
for i:=0 to Links.Count-1 do
begin
List:=Links[i];
if List.Count<>0 then
begin
PLT:=List.last;
if NumOfRows<PLT.StartTime+PLT.Length then
NumOfRows:=PLT.StartTime+PLT.Length;
end;
end;
// Чистимсетку //
SG.RowCount:=NumOfRows;
if Procs.Count<>0 then SG.ColCount:=2*Procs.Count
else SG.ColCount:=0;
for i:=1 to SG.RowCount-1 do
for j:=1 to SG.ColCount-1 do SG.Cells[j,i]:='';
for i:=1 to SG.RowCount-1 do
SG.Cells[0,i]:=inttostr(i);
for i:=1 to SG.ColCount-1 do
if i mod 2 = 1 then SG.Cells[i,0]:=inttostr((i div 2)+1)
else SG.Cells[i,0]:='->';
if Selected<>nil then
for i:=MinProcNum-1 to MaxProcNum-1 do
begin
List:=Procs[i];
if List.Count<>0 then
begin
if(PProcTask(List.first).MayBeBefore)or(Selected=List.first)then
SG.Cells[2*i+1,0]:='m'+SG.Cells[2*i+1,0]
end
else
SG.Cells[2*i+1,0]:='m'+SG.Cells[2*i+1,0]
end;
SG.Cells[0,0]:='';
if SG.ColCount<>1 then
begin
SG.FixedCols:=1;
SG.FixedRows:=1;
end;
// Вывод
for i:=0 to Procs.Count-1 do
begin
List:=Procs[i];
for j:=0 to List.Count-1 do
begin
PPT:=List[j];
for k:=PPT.StartTime to PPT.StartTime+PPT.Length-1 do
begin
SG.Cells[2*i+1,k]:=inttostr(PPT.UIN);
if Selected = PPT then SG.Cells[2*i+1,k]:='s'+SG.Cells[2*i+1,k]
else
if PPT.MayBeAfter then SG.Cells[2*i+1,k]:='m'+SG.Cells[2*i+1,k]
end
end;
end;
for i:=0 to Links.Count-1 do
begin
List:=Links[i];
for j:=0 to List.Count-1 do
begin
PLT:=List[j];
for k:=PLT.StartTime to PLT.StartTime+PLT.Length-1 do
SG.Cells[2*i+2,k]:=inttostr(PLT.fromUIN)+':'+inttostr(PLT.toUIN);
end;
end;
end;
procedure TSubMerger.SelectTask(UIN:integer);
var i,j:integer;
PPP,tmpPPP:PProcPoint;
PPC,prevPPC:PProcCon;
PPT:PProcTask;
PH:PHolder;
List:TList;
newStartIndex,StartIndex,EndIndex:integer;
Reset:boolean;
begin
Selected:=GetProcTaskByUIN(UIN);
for i:=0 to AllProcTasks.Count-1 do
begin
PPT:=AllProcTasks[i];
PPT.MayBeAfter:= PPT.UIN<>UIN;
PPT.MayBeBefore:=PPT.MayBeAfter
end;
List:=TList.Create;
MinProcNum:=1;
MaxProcNum:=Procs.Count;
PPP:=GetProcPointByUIN(UIN);
PPC:=PPP.Prev;
while PPC<>nil do
begin
PPT:=GetProcTaskByUIN(PPC.toPoint.UIN);
if PPT.ProcNum > MinProcNum then MinProcNum:=PPT.ProcNum;
PPC:=PPC.Next
end;
PPC:=PPP.Next;
while PPC<>nil do
begin
PPT:=GetProcTaskByUIN(PPC.toPoint.UIN);
if PPT.ProcNum < MaxProcNum then MaxProcNum:=PPT.ProcNum;
PPC:=PPC.Next
end;
PPC:=PPP.Next;
while PPC<>nil do
begin
List.Add(PPC.toPoint);
PPC:=PPC.Next
end;
while List.Count<>0 do
begin
tmpPPP:=List.first;
GetProcTaskByUIN(tmpPPP.UIN).MayBeAfter:=false;
List.Delete(0);
PPC:=tmpPPP.Next;
while PPC<>nil do
begin
List.Add(PPC.toPoint);
PPC:=PPC.next
end;
end;
PPC:=PPP.Prev;
while PPC<>nil do
begin
List.Add(PPC.toPoint);
PPC:=PPC.Next
end;
while List.Count<>0 do
begin
tmpPPP:=List.first;
GetProcTaskByUIN(tmpPPP.UIN).MayBeBefore:=false;
List.Delete(0);
PPC:=tmpPPP.Prev;
while PPC<>nil do
begin
List.Add(PPC.toPoint);
PPC:=PPC.next
end;
end;
{ PPC:=PPP.Prev;
while PPC<>nil do
begin
PPT:=GetProcTaskByUIN(PPC.toPoint.UIN);
PPT.MayBeAfter:= not (PPT.ProcNum < MinProcNum);
prevPPC:=PPC.toPoint.Prev;
while prevPPC<>nil do
begin
List.Add(prevPPC.toPoint);
prevPPC:=prevPPC.Next
end;
PPC:=PPC.Next
end;
while List.Count<>0 do
begin
tmpPPP:=List.First;
List.delete(0);
PPT:=GetProcTaskByUIN(tmpPPP.UIN);
PPT.MayBeAfter:=false;
PPC:=tmpPPP.Prev;
while PPC<>nil do
begin
List.Add(PPC.toPoint);
PPC:=PPC.Next
end;
end;
//<<<
PPC:=PPP.Next;
while PPC<>nil do
begin
PPT:=GetProcTaskByUIN(PPC.toPoint.UIN);
PPT.MayBeBefore:= not (PPT.ProcNum > MaxProcNum);
prevPPC:=PPC.toPoint.Next;
while prevPPC<>nil do
begin
List.Add(prevPPC.toPoint);
prevPPC:=prevPPC.Next
end;
PPC:=PPC.Next
end;
while List.Count<>0 do
begin
tmpPPP:=List.First;
List.delete(0);
PPT:=GetProcTaskByUIN(tmpPPP.UIN);
PPT.MayBeBefore:=false;
PPC:=tmpPPP.Next;
while PPC<>nil do
begin
List.Add(PPC.toPoint);
PPC:=PPC.Next
end;
end;
}
List.Destroy;
for i:=1 to MinProcNum-1 do
begin
List:=Procs[i-1];
for j:=0 to List.Count-1 do
begin
PPT:= PProcTask(List[j]);
PPT.MayBeAfter:=false;
PPT.MayBeBefore:=false
end;
end;
for i:=MaxProcNum+1 to Procs.Count do
begin
List:=Procs[i-1];
for j:=0 to List.Count-1 do
begin
PPT:= PProcTask(List[j]);
PPT.MayBeAfter:=false;
PPT.MayBeBefore:=false
end;
end;
for i:=MinProcNum to MaxProcNum do
begin
List:=Procs[i-1];
Reset:=false;
for j:=0 to List.Count-1 do
if Selected<>List[j] then
begin
if Reset then
begin
PPT:=PProcTask(List[j]);
PPT.MayBeAfter:=false;
end
else Reset:=not PProcTask(List[j]).MayBeAfter
end;
Reset:=false;
for j:=List.Count-1 downto 0 do
if Selected<>List[j] then
begin
if Reset then
begin
PPT:=PProcTask(List[j]);
PPT.MayBeAfter:=false;
PPT.MayBeBefore:=false;
end
else Reset:=not PProcTask(List[j]).MayBeBefore
end;
end;
end;
procedure TSubMerger.DeselectTask;
var i:integer;
PPT:PProcTask;
begin
Selected:=nil;
for i:=0 to AllProcTasks.Count-1 do
begin
PPT:=AllProcTasks[i];
PPT.MayBeAfter:= false;
PPT.MayBeBefore:=false;
end;
end;
procedure TSubMerger.MoveSelectedAfter(ProcNum,UIN:integer);
var i:integer;
PPT:PProcTask;
begin
if Selected<>nil then
begin
if UIN<>-1 then
begin
PPT:=GetProcTaskByUIN(UIN);
if PPT.MayBeAfter then
begin
Selected.ProcNum:=PPT.ProcNum;
AllProcTasks.delete(AllProcTasks.IndexOf(Selected));
AllProcTasks.insert(AllProcTasks.IndexOf(PPT)+1,Selected);
FormLinkTasksAndSetTimes(Procs.Count);
end;
end
else
begin
Selected.ProcNum:=ProcNum;
AllProcTasks.delete(AllProcTasks.IndexOf(Selected));
i:=0;
while i<AllProcTasks.Count do
begin
if PProcTask(AllProcTasks[i]).ProcNum=ProcNum then break;
i:=i+1
end;
AllProcTasks.insert(i,Selected);
end;
FormLinkTasksAndSetTimes(Procs.Count);
end;
end;
function TSubMerger.IncNumOfProc:boolean;
var List:TList;
begin
if Procs.Count<>0 then
begin
List:=TList.Create;
Procs.Add(List);
List:=TList.Create;
Links.Add(List);
List:=nil;
Result:=true
end
else Result:=false
end;
function TSubMerger.DecNumOfProc:boolean;
var i,FoundNum:integer;
PPT:PProcTask;
begin
FoundNum:=0;
while FoundNum<Procs.Count do
begin
if TList(Procs[FoundNum]).Count=0 then break;
FoundNum:=FoundNum+1
end;
if FoundNum<Procs.Count then
begin
Procs.Delete(FoundNum);
for i:=0 to AllProcTasks.Count-1 do
begin
PPT:=AllProcTasks[i];
if PPT.ProcNum>FoundNum then PPT.ProcNum:=PPT.ProcNum-1;
end;
FormLinkTasksAndSetTimes(Procs.Count);
Result:=true
end
else Result:=false;
end;
procedure TSubMerger.ClearPossibleMoves(var List:TList);
var PMT:PPossibleMove;
begin
while List.Count<>0 do
begin
PMT:=List.first;
List.delete(0);
dispose(PMT)
end;
List.Destroy
end;
function TSubMerger.GetPossibleMoves(UIN:integer):TList;
var i:integer;
PMT:PPossibleMove;
PPT:PProcTask;
List:TList;
begin
Result:=TList.Create;
SelectTask(UIN);
for i:=MinProcNum-1 to MaxProcNum-1 do
begin
List:=Procs[i];
if(List.Count=0)or((List.Count<>0)and(PProcTask(List.first).MayBeBefore)
or(Selected=List.first))then
begin
new(PMT);
PMT.UIN:=UIN;
PMT.processor:=i+1;
PMT.afterUIN:=-1;
PMT.Time:=$7FFFFFFF;
PMT.ProcCount:=$7FFFFFFF;
PMT.CurrentState:=false;
Result.Add(PMT);
end;
end;
for i:=0 to AllProcTasks.Count-1 do
begin
PPT:=AllProcTasks[i];
if PPT.MayBeAfter then
begin
new(PMT);
PMT.UIN:=UIN;
PMT.processor:=PPT.ProcNum;
PMT.afterUIN:=PPT.UIN;
PMT.Time:=$7FFFFFFF;
PMT.ProcCount:=$7FFFFFFF;
PMT.CurrentState:=false;
Result.Add(PMT);
end;
end;
DeselectTask;
end;
function TSubMerger.GetTime:integer;
var i:integer;
PPT:PProcTask;
List:TList;
begin
Result:=0;
for i:=0 to Procs.Count-1 do
begin
List:=Procs[i];
if List.Count<>0 then
begin
PPT:=List.Last;
if Result < PPT.StartTime+PPT.Length-1 then Result :=
PPT.StartTime+PPT.Length-1
end;
end;
end;
function TSubMerger.GetProcCount:integer;
var i:integer;
begin
Result:=0;
for i:=0 to Procs.Count-1 do
if TList(Procs[i]).Count<>0 then Result:=Result+1
end;
function TSubMerger.OptimizeOneStep(L1,L2:TLabel):boolean;
var i,j:integer;
List,AllMoves:TList;
PPM,bestPPM,workPPM:PPossibleMove;
PPT:PProcTask;
BackUpList:TList;
BackUpNOP:integer;
BestFit:integer;
CurProcCount,CurTime:integer;
MinTime:integer;
Unique:boolean;
PH:PHolder;
CurUIN,MinProcessor:integer;
begin
DeselectTask;
AllMoves:=TList.create;
for i:=0 to AllProcTasks.Count-1 do
begin
PPT:=AllProcTasks[i];
List:=GetPossibleMoves(PPT.UIN);
for j:=0 to List.Count-1 do AllMoves.add(List[j]);
List.clear;
List.Destroy;
end;
CurProcCount:=GetProcCount;
CurTime:=GetTime;
BackUpNOP:=Procs.Count;
SaveBackUp(BackUpList);
for i:=0 to AllMoves.Count-1 do
begin
PPM:=AllMoves[i];
Selected:=GetProcTaskByUIN(PPM.UIN);
Unique:=true;
if Selected.ProcNum = PPM.processor then
begin
List:=Procs[Selected.ProcNum-1];
PPT:=nil;
for j:=0 to List.Count-1 do
begin
if PProcTask(List[j]).UIN = PPM.UIN then break;
PPT:=List[j];
end;
if((PPT<>nil)and(PPT.UIN=PPM.afterUIN))or
((PPT=nil)and(PPM.afterUIN=-1))then Unique:=false;
end;
PPM.CurrentState := not Unique;
if Unique then
begin
if PPM.afterUIN<>-1 then
(GetProcTaskByUIN(PPM.afterUIN)).MayBeAfter:=true;
MoveSelectedAfter(PPM.processor,PPM.afterUIN);
while GetProcCount<>Procs.Count do DecNumOfProc;
PPM.Time:=GetTime;
PPM.ProcCount:=Procs.Count;
RestoreBackUp(BackUpList,BackUpNOP,false);
end
else
begin
PPM.Time:=CurTime;
PPM.ProcCount:=CurProcCount;
end;
end;
Selected:=nil;
RestoreBackUp(BackUpList,BackUpNOP,true); //??
MinTime:=$7FFFFFFF;
for i:=0 to AllMoves.Count-1 do
if MinTime>PPossibleMove(AllMoves[i]).Time then
MinTime:=PPossibleMove(AllMoves[i]).Time;
//-->>
{ Memo.Lines.Clear;
for i:=0 to AllMoves.Count-1 do
begin
PPM:=AllMoves[i];
Memo.Lines.Add(inttostr(PPM.UIN)+' <>
'+inttostr(PPM.processor)+':'+inttostr(PPM.afterUIN)+' Time=
'+inttostr(PPM.Time)+' PC='+inttostr(PPM.ProcCount));
if PPM.CurrentState then Memo.Lines.Add('Was current state!')
end;}
//<<--
// выделяем минимальные времена
i:=0;
while i<>AllMoves.Count do
begin
PPM:=AllMoves[i];
if PPM.Time > MinTime then
begin
AllMoves.delete(i);
dispose(PPM);
end
else i:=i+1
end;
MinProcessor:=$7FFFFFFF;
for i:=0 to AllMoves.Count-1 do
if MinProcessor>PPossibleMove(AllMoves[i]).ProcCount then
MinProcessor:=PPossibleMove(AllMoves[i]).ProcCount;
i:=0;
while i<>AllMoves.Count do
begin
PPM:=AllMoves[i];
if PPM.ProcCount > MinProcessor then
begin
AllMoves.delete(i);
dispose(PPM);
end
else i:=i+1
end;
i:=0;
CurUIN:=0;
MinProcessor:=0;
while i<>AllMoves.Count do
begin
PPM:=AllMoves[i];
if PPM.UIN<>CurUIN then
begin
CurUIN:=PPM.UIN;
MinProcessor:=PPM.processor;
j:=i+1;
while j<>AllMoves.Count do
begin
workPPM:=AllMoves[j];
if workPPM.UIN<>CurUIN then break;
if workPPM.processor<MinProcessor then
MinProcessor:=workPPM.processor;
j:=j+1;
end;
end;
if (PPM.CurrentState)or(PPM.processor>MinProcessor)
then
begin
AllMoves.delete(i);
dispose(PPM);
end
else i:=i+1
end;
i:=0;
if MinTime = CurTime then
while i<AllMoves.Count do
begin
PPM:=AllMoves[i];
PPT:=GetProcTaskByUIN(PPM.UIN);
if PPM.processor = PPT.ProcNum then
begin
AllMoves.delete(i);
dispose(PPM);
end
else i:=i+1
end;
BestFit:=AllMoves.Count-1;
for i:=0 to AllMoves.Count-2 do
begin
PPM:=AllMoves[i];
bestPPM:=AllMoves[BestFit];
if(PPM.Time<bestPPM.Time)or
((PPM.Time=bestPPM.Time)and(PPM.ProcCount<bestPPM.ProcCount))
then BestFit:=i
end;
if BestFit<>-1 then
begin
bestPPM:=AllMoves[BestFit];
Selected:=GetProcTaskByUIN(bestPPM.UIN);
if bestPPM.afterUIN<>-1 then
(GetProcTaskByUIN(bestPPM.afterUIN)).MayBeAfter:=true;
MoveSelectedAfter(bestPPM.processor,bestPPM.afterUIN);
while GetProcCount<>Procs.Count do DecNumOfProc;
if L1<>nil then L1.Caption:=inttostr(bestPPM.Time);
if L2<>nil then L2.Caption:=inttostr(bestPPM.ProcCount);
Result:=true
end
else Result:=false;
//-->>
{ Memo.Lines.Add('');
Memo.Lines.Add('--- Min ---');
Memo.Lines.Add('');
for i:=0 to AllMoves.Count-1 do
begin
PPM:=AllMoves[i];
Memo.Lines.Add(inttostr(PPM.UIN)+' <>
'+inttostr(PPM.processor)+':'+inttostr(PPM.afterUIN)+' Time=
'+inttostr(PPM.Time)+' PC='+inttostr(PPM.ProcCount));
if PPM.CurrentState then Memo.Lines.Add('Was current state!')
end;}
//<<--
ClearPossibleMoves(AllMoves);
DeselectTask;
end;
function ComparePPT(Item1, Item2: Pointer): Integer;
begin
if PProcTask(Item1).StartTime<PProcTask(Item2).StartTime then Result:=-
1
else
if PProcTask(Item1).StartTime>PProcTask(Item2).StartTime then Result:=1
else Result:=0
end;
procedure TSubMerger.OptimizeAuto(Form:TForm;L1,L2:TLabel);
var i,j,k:integer;
List,UINList:TList;
PPT,nextPPT:PProcTask;
Time:integer;
MatchError:boolean;
NewProc:TList;
NOP:integer;
NoChange:boolean;
StartFrom,NewStartFrom:integer;
BackList:TList;
BackTime:integer;
begin
while OptimizeOneStep(L1,L2) do Form.Update;
Time:=GetTime;
UINList:=TList.Create;
NewStartFrom:=0;
repeat
StartFrom:=NewStartFrom;
NoChange:=true;
for i:=0 to Procs.Count-2 do
begin
NewStartFrom:=i+1;
List:=Procs[i];
for j:=0 to List.Count-1 do UINList.Add(List[j]);
List:=Procs[i+1];
for j:=0 to List.Count-1 do UINList.Add(List[j]);
UINList.Sort(ComparePPT);
MatchError:=false;
PPT:=UINList.first;
for j:=1 to UINList.Count-1 do
begin
nextPPT:=UINList[j];
if (PPT.StartTime = nextPPT.StartTime) or
(PPT.StartTime+PPT.Length>nextPPT.StartTime) then
begin
MatchError:=true;
break
end;
PPT:=nextPPT;
end;
if not MatchError then
begin
SaveBackUp(BackList);
BackTime:=GetTime;
NOP:=Procs.Count-1;
ClearLinks(true);
ClearProcs(false);
for j:=0 to UINList.Count-1 do
begin
PPT:=UINList[j];
PPT.ProcNum:=i+1;
AllProcTasks.delete(AllProcTasks.indexOf(PPT));
end;
for j:=0 to AllProcTasks.Count-1 do
begin
PPT:=AllProcTasks[j];
if PPT.ProcNum>i+1 then PPT.ProcNum:=PPT.ProcNum-1
end;
for j:=0 to UINList.Count-1 do AllProcTasks.add(UINList[j]);
FormLinkTasksAndSetTimes(NOP);
if BackTime>=GetTime then
begin
NoChange:=false;
NewStartFrom:=0;
while BackList.Count<>0 do
begin
PPT:=BackList.first;
BackList.delete(0);
dispose(PPT)
end;
end
else RestoreBackUp(BackList,NOP+1,true);
break;
end;
UINList.Clear;
end;
UINList.Clear;
until NoChange;
UINList.Destroy;
end;
procedure TSubMerger.SaveBackUp(var List:Tlist);
var backPPT,PPT:PProcTask;
i:integer;
begin
List:=TList.Create;
for i:=0 to AllProcTasks.Count-1 do
begin
PPT:=AllProcTasks[i];
new(backPPT);
backPPT^:=PPT^;
backPPT.Prev:=nil;
List.add(backPPT);
end;
end;
procedure TSubMerger.RestoreBackUp(var
List:Tlist;NOP:integer;ClearCurrent:boolean);
var backPPT,PPT:PProcTask;
i:integer;
begin
Selected:=nil;
ClearLinks(true);
ClearProcs(true);
for i:=0 to List.Count-1 do
begin
backPPT:=List[i];
new(PPT);
PPT^:=backPPT^;
AllProcTasks.add(PPT);
if ClearCurrent then dispose(backPPT);
end;
if ClearCurrent then List.Destroy;
FormLinkTasksAndSetTimes(NOP);
end;
end.
|