Книга знаний

Рекламное место пустует
1С:Предприятие

Решение транспортной задачи в 1С:Предприятие 8.2

Решение транспортной задачи для 1С:Предприятие 8.2 (релиз 8.2.14.532). Поиск начального решения производится методами северо-западного угла, минимальной стоимости и Фогеля (можно выбрать любой из трех методов). Окончательное решение выполняется методом потенциалов.Автор статьи: romix | Редакторы:
Последняя редакция №2 от 08.01.16 | История
URL: http://kb.mista.ru/article.php?id=859

Ключевые слова: Транспортная задача, программный код, алгоритм расчета, работающий пример, метод северо-западного угла, метод минимальных тарифов, метод Фогеля, метод потенциалов


// Решение транспортной задачи для 1С:Предприятие 8.2 (релиз 8.2.14.532)
// Поиск начального решения производится методами северо-западного угла, минимальной стоимости и Фогеля
// (можно выбрать любой из трех методов). Тестовые примеры (код и алгоритм изменены) были взяты отсюда: 
// http://code.activestate.com/recipes/576575-stepping-stone-algorithum-for-solving-the-tranship/
// Подробное описание алгоритма см. тут: http://cyclowiki.org/wiki/Транспортная_задача
// x-romix, 2011

перем m,n; //Размер таблицы
перем u,v; //Потенциалы
перем БазисныеЯчейки; //Базисные ячейки (занятые перевозками)
перем iЦикл, jЦикл; //Массивы с координатами цикла
перем Цены, Спрос, Предложение, Отгрузки; // Массивы транспортной задачи
перем i1, j1; //Ячейка начала цикла пересчета
перем СпросОстаток, ПредложениеОстаток; //Массивы для метода "северо-западного угла"
перем гл_сч;
перем Фогель_i, Фогель_j;
перем гсч; //Генератор случайных чисел

Функция Пример1()
    m=4;
    n=6;
    
    Цены = Новый Массив(m+1, n+1);
    Цены[1][1]=2;
    Цены[1][2]=1;
    Цены[1][3]=3;
    Цены[1][4]=3;
    Цены[1][5]=2;
    Цены[1][6]=5;

    Цены[2][1]=3;
    Цены[2][2]=2;
    Цены[2][3]=2;
    Цены[2][4]=4;
    Цены[2][5]=3;
    Цены[2][6]=4;
    
    Цены[3][1]=3;
    Цены[3][2]=5;
    Цены[3][3]=4;
    Цены[3][4]=2;
    Цены[3][5]=4;
    Цены[3][6]=1;
    
    Цены[4][1]=4;
    Цены[4][2]=2;
    Цены[4][3]=2;
    Цены[4][4]=1;
    Цены[4][5]=2;
    Цены[4][6]=2;

    Спрос = Новый Массив(n+1);
    Спрос[1]=30;
    Спрос[2]=50;
    Спрос[3]=20;
    Спрос[4]=40;
    Спрос[5]=30;
    Спрос[6]=11;

    Предложение = Новый Массив(m+1);
    Предложение[1]=50;
    Предложение[2]=40;
    Предложение[3]=60;
    Предложение[4]=31;
    
КонецФункции

Функция Пример2()
    m=4;
    n=6;
    Цены = Новый Массив(m+1, n+1);
    Цены[1][1]=1;
    Цены[1][2]=2;
    Цены[1][3]=1;
    Цены[1][4]=4;
    Цены[1][5]=5;
    Цены[1][6]=2;

    Цены[2][1]=3;
    Цены[2][2]=3;
    Цены[2][3]=2;
    Цены[2][4]=1;
    Цены[2][5]=4;
    Цены[2][6]=3;
    
    Цены[3][1]=4;
    Цены[3][2]=2;
    Цены[3][3]=5;
    Цены[3][4]=9;
    Цены[3][5]=6;
    Цены[3][6]=2;
    
    Цены[4][1]=3;
    Цены[4][2]=1;
    Цены[4][3]=7;
    Цены[4][4]=3;
    Цены[4][5]=4;
    Цены[4][6]=6;

    Спрос = Новый Массив(n+1);
    Спрос[1]=20;
    Спрос[2]=40;
    Спрос[3]=30;
    Спрос[4]=10;
    Спрос[5]=50;
    Спрос[6]=25;

    Предложение = Новый Массив(m+1);
    Предложение[1]=30;
    Предложение[2]=50;
    Предложение[3]=75;
    Предложение[4]=20;
КонецФункции

Функция Пример3()
    m=3;
    n=5;
    Цены = Новый Массив(m+1, n+1);
    Цены[1][1]=5;
    Цены[1][2]=3;
    Цены[1][3]=6;
    Цены[1][4]=2;
    Цены[1][5]=0;

    Цены[2][1]=4;
    Цены[2][2]=7;
    Цены[2][3]=9;
    Цены[2][4]=1;
    Цены[2][5]=0;
    
    Цены[3][1]=3;
    Цены[3][2]=4;
    Цены[3][3]=7;
    Цены[3][4]=5;
    Цены[3][5]=0;
    
    Спрос = Новый Массив(n+1);
    Спрос[1]=16;
    Спрос[2]=18;
    Спрос[3]=30;
    Спрос[4]=25;
    Спрос[5]=1;

    Предложение = Новый Массив(m+1);
    Предложение[1]=19;
    Предложение[2]=37;
    Предложение[3]=34;

КонецФункции

//Функция распределяет Отгрузки[i][j простейшим методом "северо-западного угла"
//Также заполняет БазисныеЯчейки[i][j] значениями 1 или 0 (если есть ненулевая 
//отгрузка, то ячейка - базисная).
Функция РаспределениеМетодомСевероЗападногоУгла()
    
    Для j=1 по n Цикл
        СпросОстаток[j]=Спрос[j];
    КонецЦикла;    
    
    Для i=1 по m Цикл
        ПредложениеОстаток[i]=Предложение[i];
    КонецЦикла;    
    
    Для i=1 по m Цикл
        Для j=1 по n Цикл
            БазисныеЯчейки[i][j]=0;
            Отгрузки[i][j]=0;
        КонецЦикла;    
    КонецЦикла;    
    
    Для i=1 по m Цикл
        Для j=1 по n Цикл
            Если ПредложениеОстаток[i]=0 Тогда
                Прервать;
            ИначеЕсли ПредложениеОстаток[i]<0 Тогда
                ВызватьИсключение("Ошибка: остаток предложения меньше 0");
            КонецЕсли;
            
            чОбъем=СпросОстаток[j];
            Если чОбъем=0 Тогда
                Продолжить;
            ИначеЕсли чОбъем<0 Тогда    
                ВызватьИсключение("Ошибка: остаток спроса меньше 0");
            КонецЕсли;
            
            Если ПредложениеОстаток[i]<чОбъем Тогда
                чОбъем=ПредложениеОстаток[i];
            КонецЕсли;    
            
            СпросОстаток[j]=СпросОстаток[j]-чОбъем;
            ПредложениеОстаток[i]=ПредложениеОстаток[i]-чОбъем;
            БазисныеЯчейки[i][j]=1;
            Отгрузки[i][j]=чОбъем;
            
        КонецЦикла;    
    КонецЦикла;    
КонецФункции

//Метод минимальных тарифов - сначала отгружает по путям с на именьшей стоимостью.
Функция РаспределениеМетодомМинимальныхТарифов()
    
    Для j=1 по n Цикл
        СпросОстаток[j]=Спрос[j];
    КонецЦикла;    
    
    Для i=1 по m Цикл
        ПредложениеОстаток[i]=Предложение[i];
    КонецЦикла;    
    
    Для i=1 по m Цикл
        Для j=1 по n Цикл
            БазисныеЯчейки[i][j]=0;
            Отгрузки[i][j]=0;
        КонецЦикла;    
    КонецЦикла;
    
    Для й=1 по m*n Цикл // Максимальное число итераций
        мин_тариф=НеОпределено;
        i_мин=НеОпределено;
        j_мин=НеОпределено;
        ВесьГрузРаспределен=Истина;
        Для i=1 по m Цикл
            Для j=1 по n Цикл
                Если БазисныеЯчейки[i][j]=1 Тогда
                    Продолжить;
                КонецЕсли;    
                
                Если ПредложениеОстаток[i]=0 Тогда
                    Продолжить;
                ИначеЕсли ПредложениеОстаток[i]<0 Тогда
                    ВызватьИсключение("Ошибка: остаток предложения меньше 0");
                КонецЕсли;
                
                Если СпросОстаток[j]=0 Тогда
                    Продолжить;
                ИначеЕсли СпросОстаток[j]<0 Тогда    
                    ВызватьИсключение("Ошибка: остаток спроса меньше 0");
                КонецЕсли;
                
                ВесьГрузРаспределен=Ложь;
                
                ц=Цены[i][j];
                Если мин_тариф=НеОпределено Тогда
                    мин_тариф=ц;
                    i_мин=i;
                    j_мин=j;
                Иначе
                    Если ц<мин_тариф Тогда
                        мин_тариф=ц;
                        i_мин=i;
                        j_мин=j;
                    КонецЕсли;    
                КонецЕсли;    
            КонецЦикла;    
        КонецЦикла;
        i=i_мин;
        j=j_мин;
        
        Если ВесьГрузРаспределен=Истина Тогда
            Возврат Истина;
        КонецЕсли;    
        Если мин_тариф=НеОпределено Тогда
            ВызватьИсключение("Не удалось определить минимальный тариф");
        КонецЕсли;
        
        //Минимальный тариф найден в ячейке i, j
        
        чОбъем=СпросОстаток[j];
        Если ПредложениеОстаток[i]<чОбъем Тогда
            чОбъем=ПредложениеОстаток[i];
        КонецЕсли;        
        //Сообщить("Объем в ячейке ="+чОбъем);
        
        СпросОстаток[j]=СпросОстаток[j]-чОбъем;
        ПредложениеОстаток[i]=ПредложениеОстаток[i]-чОбъем;
        БазисныеЯчейки[i][j]=1;
        Отгрузки[i][j]=чОбъем;

    КонецЦикла;
    ВызватьИсключение("Не удалось распределить методом минимальных тарифов");
КонецФункции

//Получение начального решения методом Фогеля (альтернатива двум предыдущим методам)
Функция РаспределениеМетодомФогеля()
    Для j=1 по n Цикл
        СпросОстаток[j]=Спрос[j];
    КонецЦикла;    
    
    Для i=1 по m Цикл
        ПредложениеОстаток[i]=Предложение[i];
    КонецЦикла;    
    
    Для i=1 по m Цикл
        Для j=1 по n Цикл
            БазисныеЯчейки[i][j]=0;
            Отгрузки[i][j]=0;
        КонецЦикла;    
    КонецЦикла;
    
    Для й=1 по 100 Цикл
    
        макс1=НеОпределено;
        макс1_i=НеОпределено;
        Для i=1 по m Цикл
            Если ПредложениеОстаток[i]=0 Тогда
                Продолжить;
            КонецЕсли;    
            дельта=Фогель_РазницаМеждуМинимальнымиЦенамиПоСтроке(i);
            Если макс1_i=НеОпределено Тогда
                макс1=дельта;
                макс1_i=i;
            Иначе
                Если макс1<дельта Тогда 
                    макс1=дельта;
                    макс1_i=i;
                КонецЕсли;    
            КонецЕсли;
        КонецЦикла;    
        
        
        макс2=НеОпределено;
        макс2_j=НеОпределено;
        Для j=1 по n Цикл
            Если СпросОстаток[j]=0 Тогда
                Продолжить;
            КонецЕсли;    
            дельта=Фогель_РазницаМеждуМинимальнымиЦенамиПоСтолбцу(j);
            Если макс2_j=НеОпределено Тогда
                макс2=дельта;
                макс2_j=j;
            Иначе
                Если макс2<дельта Тогда 
                    макс2=дельта;
                    макс2_j=j;
                КонецЕсли;    
            КонецЕсли;
        КонецЦикла;
        
        Если (макс1=НеОпределено) и (макс2=НеОпределено) Тогда
            //Всё отгрузили
            Прервать;
        ИначеЕсли (макс1=НеОпределено) Тогда
            макс1=макс2-1;
        ИначеЕсли (макс2=НеОпределено) Тогда 
            макс2=макс1-1;
        КонецЕсли;    
        
        Если макс1>макс2 Тогда
            //Предпочтительна строка макс1_i
            зн=Фогель_ПерваяМинимальнаяЦенаПоСтроке(макс1_i);
            i=макс1_i;
            j=Фогель_j;
        Иначе
            //Предпочтителен столбец макс2_j
            зн=Фогель_ПерваяМинимальнаяЦенаПоСтолбцу(макс2_j);
            i=Фогель_i;
            j=макс2_j;
        КонецЕсли;
    
        чОбъем=СпросОстаток[j];
        Если ПредложениеОстаток[i]<чОбъем Тогда
            чОбъем=ПредложениеОстаток[i];
        КонецЕсли;
        СпросОстаток[j]=СпросОстаток[j]-чОбъем;
        ПредложениеОстаток[i]=ПредложениеОстаток[i]-чОбъем;
        БазисныеЯчейки[i][j]=1;
        Отгрузки[i][j]=чОбъем;
    КонецЦикла;
КонецФункции


//Вычисляет первую минимальную цену в указанной строке
//Обходит стороной ячейки, где остаток спроса = 0.
//Возвращает минимальную цену, а j минимальной ячейки - в переменной Фогель_j
Функция Фогель_ПерваяМинимальнаяЦенаПоСтроке(i)
    
    мин1=НеОпределено;
    Фогель_j=НеОпределено;
    Для j=1 по n Цикл
        Если СпросОстаток[j]=0 Тогда
            Продолжить;
        ИначеЕсли СпросОстаток[j]<0 Тогда    
            ВызватьИсключение("Ошибка: остаток спроса меньше 0");
        КонецЕсли;
        ц=Цены[i][j];
        Если мин1=НеОпределено Тогда
            мин1=ц;
            Фогель_j=j;
        Иначе
            Если мин1>ц Тогда
                мин1=ц;
                Фогель_j=j;
            КонецЕсли;    
        КонецЕсли;    
    КонецЦикла;    
    Возврат мин1;
КонецФункции

//Вычисляет первую минимальную цену в указанной строке
//Обходит стороной ячейки, где остаток спроса = 0, а также Фогель_j.
//Возвращает вторую минимальную цену.
Функция Фогель_ВтораяМинимальнаяЦенаПоСтроке(i)
    мин2=НеОпределено;
    Если Фогель_j=НеОпределено Тогда
        Возврат НеОпределено;
    КонецЕсли;    
    Для j=1 по n Цикл
        Если j=Фогель_j Тогда
            Продолжить;
        КонецЕсли;    
        Если СпросОстаток[j]=0 Тогда
            Продолжить;
        КонецЕсли;
        ц=Цены[i][j];
        Если мин2=НеОпределено Тогда
            мин2=ц;
        Иначе
            Если мин2>ц Тогда
                мин2=ц;
            КонецЕсли;    
        КонецЕсли;    
    КонецЦикла;    
    Возврат мин2;
КонецФункции

//Вычисляет первую минимальную цену по указанному столбцу.
//Обходит стороной ячейки, где остаток предложения = 0.
//Возвращает минимальную цену, а i минимальной ячейки - в переменной Фогель_i
Функция Фогель_ПерваяМинимальнаяЦенаПоСтолбцу(j)
    мин1=НеОпределено;
    Фогель_i=НеОпределено;
    Для i=1 по m Цикл
        Если ПредложениеОстаток[i]=0 Тогда
            Продолжить;
        ИначеЕсли ПредложениеОстаток[i]<0 Тогда    
            ВызватьИсключение("Ошибка: остаток предложения меньше 0");
        КонецЕсли;
        ц=Цены[i][j];
        Если мин1=НеОпределено Тогда
            мин1=ц;
            Фогель_i=i;
        Иначе
            Если мин1>ц Тогда
                мин1=ц;
                Фогель_i=i;
            КонецЕсли;    
        КонецЕсли;    
    КонецЦикла;    
    Возврат мин1;
КонецФункции

//Вычисляет вторую минимальную цену по указанному столбцу.
//Обходит стороной ячейки, где остаток предложения = 0, а также Фогель_i.
//Возвращает минимальную цену, а i минимальной ячейки - в переменной Фогель_i
Функция Фогель_ВтораяМинимальнаяЦенаПоСтолбцу(j)
    мин2=НеОпределено;
    Если Фогель_i=НеОпределено Тогда
        Возврат НеОпределено;
    КонецЕсли;    
    Для i=1 по m Цикл
        Если i=Фогель_i Тогда
            Продолжить;
        КонецЕсли;    
        Если ПредложениеОстаток[i]=0 Тогда
            Продолжить;
        КонецЕсли;
        ц=Цены[i][j];
        Если мин2=НеОпределено Тогда
            мин2=ц;
            Фогель_i=i;
        Иначе
            Если мин2>ц Тогда
                мин2=ц;
                Фогель_i=i;
            КонецЕсли;    
        КонецЕсли;    
    КонецЦикла;    
    Возврат мин2;
КонецФункции

Функция Фогель_РазницаМеждуМинимальнымиЦенамиПоСтроке(i)
    ц1=Фогель_ПерваяМинимальнаяЦенаПоСтроке(i);
    Если ц1=НеОпределено Тогда
        Возврат 0;
    КонецЕсли;    
    ц2=Фогель_ВтораяМинимальнаяЦенаПоСтроке(i);
    Если ц2=НеОпределено Тогда
        Возврат 0;
    КонецЕсли;    
    Возврат ц2-ц1;
КонецФункции

Функция Фогель_РазницаМеждуМинимальнымиЦенамиПоСтолбцу(j)
    ц1=Фогель_ПерваяМинимальнаяЦенаПоСтолбцу(j);
    Если ц1=НеОпределено Тогда
        Возврат 0;
    КонецЕсли;    
    ц2=Фогель_ВтораяМинимальнаяЦенаПоСтолбцу(j);
    Если ц2=НеОпределено Тогда
        Возврат 0;
    КонецЕсли;    
    Возврат ц2-ц1;
КонецФункции

//Проверяет правильность отгрузок: отгрузки по каждой строке должны быть равны предложению,
//а отгрузки по каждому столбцу - спросу потребителя.
Функция ПроверкаПравильностиОтгрузок()
    Для i=1 по m Цикл
        стр="Отгрузки: ";
        Для j=1 по n Цикл
            стр=стр+Отгрузки[i][j]+" ";
        КонецЦикла;    
        Сообщить(стр);
    КонецЦикла;        
    Для i=1 по m Цикл
        чОбъем=0;
        Для j=1 по n Цикл
            чОбъем=чОбъем+Отгрузки[i][j];
        КонецЦикла;    
        Если чОбъем<>Предложение[i] Тогда
            ВызватьИсключение("Ошибка: отгрузки по строке не равны предложению в строке "+i);
        КонецЕсли;
    КонецЦикла;    
    Для j=1 по n Цикл
        чОбъем=0;
        Для i=1 по m Цикл
            чОбъем=чОбъем+Отгрузки[i][j];
        КонецЦикла;    
        Если чОбъем<>Спрос[j] Тогда
            ВызватьИсключение("Ошибка: отгрузки по столбцу не равны спросу в столбце "+j);
        КонецЕсли;
    КонецЦикла;    
    Возврат Истина;
КонецФункции    

//Вычисление потенциалов u[i] и v[j]
Функция ВычислениеПотенциалов()
    перем i, j;
    Для i=1 по m Цикл
        u[i]=НеОпределено;
    КонецЦикла;
    
    Для j=1 по n Цикл
        v[j]=НеОпределено;
    КонецЦикла;
    u[1]=0;
    гл_сч=m*n; // Максимальное число итераций
    ВычислениеПотенциаловПоГоризонтали(1); //Начало рекурсии
    //Проверка
    Для i=1 по m Цикл
        Если u[i]=НеОпределено Тогда
            Сообщить("Не удалось вычислить потенциал u["+i+"]");
            Возврат Ложь;
        КонецЕсли;    
    КонецЦикла;
    
    Для j=1 по n Цикл
        Если v[j]=НеОпределено Тогда
            Сообщить("Не удалось вычислить потенциал v["+j+"]");
            Возврат Ложь;
        КонецЕсли;    
    КонецЦикла;
    Возврат Истина;
КонецФункции

Функция ВычислениеПотенциаловПоВертикали(j)
    Если v[j]=НеОпределено Тогда 
        ВызватьИсключение("Ошибка получения потенциала v["+j+"]");
    КонецЕсли;    
    Для i=1 по m Цикл
        Если БазисныеЯчейки[i][j]=0 Тогда
            Продолжить;
        КонецЕсли;
        Если u[i]<>НеОпределено Тогда
            Продолжить;
        Иначе
            u[i]=Цены[i][j]-v[j];
            ВычислениеПотенциаловПоГоризонтали(i);
        КонецЕсли;    
    КонецЦикла;    
КонецФункции    


Функция ВычислениеПотенциаловПоГоризонтали(i)
    гл_сч=гл_сч-1;
    Если гл_сч=0 Тогда
        ВызватьИсключение("Зацикливание при вычислении потенциалов");
    КонецЕсли;    
    Если u[i]=НеОпределено Тогда 
        ВызватьИсключение("Ошибка получения потенциала u["+i+"]");
    КонецЕсли;    
    Для j=1 по n Цикл
        Если БазисныеЯчейки[i][j]=0 Тогда
            Продолжить;
        КонецЕсли;
        Если v[j]<>НеОпределено Тогда
            Продолжить;
        Иначе
            v[j]=Цены[i][j]-u[i];
            ВычислениеПотенциаловПоВертикали(j);
        КонецЕсли;    
    КонецЦикла;    
КонецФункции    

//По известным потенциалам u и v, а также ценам, вычисляет
//оптимальное ли решение (возвращает Истина или Ложь).
//Если решение не оптимально, находит ячейку i1,j1 с минимальной отрицательной дельтой,
//откуда будем строить цикл.
Функция ПроверкаОптимальности()
    перем чРешениеОптимально, чМинимальнаяДельта, i, j, Дельта;
    чРешениеОптимально=Истина;
    чМинимальнаяДельта=НеОпределено;
    Для i=1 по m Цикл
        стр="Дельта=";
        Для j=1 по n Цикл
            Если БазисныеЯчейки[i][j]=1 Тогда
                Дельта=0;
            Иначе
                Дельта = Цены[i][j]-u[i]-v[j];
            КонецЕсли;    
            
            стр=стр+Дельта+" ";
            Если Дельта<0 Тогда
                чРешениеОптимально=Ложь;
            КонецЕсли;
            Если чМинимальнаяДельта=НеОпределено Тогда
                чМинимальнаяДельта=Дельта;
                i1=i;
                j1=j;
            Иначе
                Если Дельта<чМинимальнаяДельта Тогда
                    чМинимальнаяДельта=Дельта;
                    i1=i;
                    j1=j;
                КонецЕсли;        
            КонецЕсли;    
        КонецЦикла;    
        //Сообщить(стр);
    КонецЦикла;
    Возврат чРешениеОптимально;
КонецФункции


Функция СтоимостьПеревозки()
    чСумма=0;
    Для i=1 по m Цикл
        Для j=1 по n Цикл
            чСумма=чСумма+(Отгрузки[i][j]*Цены[i][j]);
        КонецЦикла;    
    КонецЦикла;
    Возврат чСумма;
КонецФункции    


//Если решение вырождено, то надо ввести в число базисных переменную с нулевой отгрузкой.
Функция ПоискНулевойЯчейкиДляВводаВБазис()
    
    //Проверка на всякий случай
    ок=0;
    Для i=1 по m Цикл
        Для j=1 по n Цикл
            Если БазисныеЯчейки[i][j]=0 Тогда
                ок=1;
                Прервать;
            КонецЕсли;
        КонецЦикла;
        Если ок=1 Тогда
            Прервать;
        КонецЕсли;
    КонецЦикла;    
    Если ок=0 Тогда
        ВызватьИсключение("Не существует не базисной (нулевой) ячейки для ввода в базис");
    КонецЕсли;

    Пока 1=1 Цикл
        //Случайные значения для предотвращения зацикливания, согласно рекомендации Данцига
        //Дж. Данциг «Линейное программирование, его применения и обобщения» М:Прогресс, 1966 стр. 312
        i=ГСЧ.СлучайноеЧисло(1, m);
        j=ГСЧ.СлучайноеЧисло(1, n);
    
        Если БазисныеЯчейки[i][j]=1 Тогда
            //Пропускаем базисные ячейки
            Продолжить;
        КонецЕсли;
        Если Отгрузки[i][j]<>0 Тогда
            ВызватьИсключение("Ненулевые отгрузки для не базисной ячейки");
        КонецЕсли;
        //Если НайтиЦикл(i, j)=Истина Тогда
        //    //Пропускаем ячейки, которые образуют цикл
        //    Продолжить;
        //КонецЕсли;    
        БазисныеЯчейки[i][j]=1;
        Сообщить("В базис введена ячейка "+i+" "+j);
        Возврат Истина; //Удалось ввести ячейку в базис
    КонецЦикла;
КонецФункции

//Поиск цикла для перераспределения поставок. 
//Заполняет массивы iЦикл и jЦикл с координатами вершин цикла.
//Возвращает Истина, если цикл найден и Ложь, если не удалось найти цикл.
Функция НайтиЦикл(i0, j0)
    гл_сч = m*n; // максимальное число итераций
    iЦикл.Очистить();
    jЦикл.Очистить();
    Если НайтиЦикл_ПоГоризонтали(i0, j0) Тогда
        Возврат Истина; //Цикл найден успешно
    КонецЕсли;
    Возврат Ложь;//Цикл не найден
КонецФункции

Функция НайтиЦикл_ПоГоризонтали(i0, j0)
    гл_сч=гл_сч-1;
    Если гл_сч=0 Тогда
        ВызватьИсключение("Слишком большое число итераций при поиске цикла");
    КонецЕсли;    
    Для j=1 по n Цикл
        Если j=j0 Тогда
            Продолжить;
        КонецЕсли;
        Если БазисныеЯчейки[i0][j]=0 Тогда
            Продолжить;
        КонецЕсли;
        Если НайтиЦикл_ПоВертикали(i0, j) Тогда
            iЦикл.Добавить(i0);
            jЦикл.Добавить(j);
            Возврат Истина;
        КонецЕсли;    
    КонецЦикла;
    Возврат Ложь; // Не найден цикл
КонецФункции    

Функция НайтиЦикл_ПоВертикали(i0, j0)
    Для i=1 по m Цикл
        Если (j0=j1) и (i=i1) Тогда
            //Попали в начальную точку цикла
                iЦикл.Добавить(i);
                jЦикл.Добавить(j0);
                Возврат Истина; //Цикл завершен
        КонецЕсли;    
        Если i=i0 Тогда
            Продолжить;
        КонецЕсли;
        Если БазисныеЯчейки[i][j0]=0 Тогда
            Продолжить;
        КонецЕсли;
        Если НайтиЦикл_ПоГоризонтали(i, j0) Тогда
            iЦикл.Добавить(i);
            jЦикл.Добавить(j0);
            Возврат Истина;
        КонецЕсли;    
    КонецЦикла;    
    Возврат Ложь; // Не найден цикл
КонецФункции

//Перераспределение объемов отгрузки по найденному циклу iЦикл, jЦикл
Функция ПерераспределениеПоЦиклу()
    Сообщить("Перераспределение по циклу "+iЦикл.Количество());
    Если jЦикл.Количество()<>iЦикл.Количество() Тогда
        ВызватьИсключение("Не одинаковые размерности для координат цикла");
    КонецЕсли;
    Если iЦикл.Количество()<4 Тогда
        ВызватьИсключение("Цикл имеет меньше 4 элементов");
    КонецЕсли;    
    Тета=НеОпределено;
    Знак="+";
    Для й=0 по iЦикл.ВГраница() Цикл
        i=iЦикл[й];
        j=jЦикл[й];
        Если Знак="-" Тогда
            Объем=Отгрузки[i][j];
            Если Тета=НеОпределено Тогда
                Тета=Объем;
            Иначе
                Если Объем<Тета Тогда
                    Тета=Объем;
                КонецЕсли;    
            КонецЕсли;    
            Знак="+";
        Иначе
            Знак="-";
        КонецЕсли;    
    КонецЦикла;    
    Если Тета=НеОпределено Тогда
        ВызватьИсключение("Не удалось вычислить переменную тета.");
    КонецЕсли;
    Сообщить("Тета="+Тета);
    Если Тета=0 Тогда
        Возврат Ложь;
    КонецЕсли;
    Знак="+";
    Для й=0 по iЦикл.ВГраница() Цикл
        i=iЦикл[й];
        j=jЦикл[й];
        Если Знак="-" Тогда
            Отгрузки[i][j]=Отгрузки[i][j]-Тета;
            Знак="+";
        Иначе
            Отгрузки[i][j]=Отгрузки[i][j]+Тета;
            Знак="-";
        КонецЕсли;    
    КонецЦикла;
    Возврат Истина;
КонецФункции

//Главная функция - точка входа
Функция РешениеТранспортнойЗадачи()
    //Раскомментируйте нужный пример
    //Пример1();
    Пример2();
    //Пример3();
    
    
    ГСЧ = Новый ГенераторСлучайныхЧисел();
    
    
    БазисныеЯчейки = Новый Массив(m+1,n+1);
    Отгрузки = Новый Массив(m+1,n+1);
    СпросОстаток=Новый Массив(n+1);
    ПредложениеОстаток=Новый Массив(m+1);
    u=Новый Массив(m+1);
    v=Новый Массив(n+1);
    iЦикл = Новый Массив;
    jЦикл = Новый Массив;

    чСпрос=0;
    Для j=1 по n Цикл
        чСпрос=чСпрос+Спрос[j];
    КонецЦикла;    
    
    чПредложение=0;
    Для i=1 по m Цикл
        чПредложение=чПредложение+Предложение[i];
    КонецЦикла;
    
    Если чПредложение>чСпрос Тогда
        Сообщить("Предложение больше спроса на "+(чПредложение-чСпрос)+" единиц груза. Создайте фиктивного потребителя.");
        Возврат Ложь;
    ИначеЕсли чПредложение<чСпрос Тогда
        Сообщить("Предложение меньше спроса на "+(чСпрос-чПредложение)+" единиц груза. Создайте фиктивного поставщика.");
        Возврат Ложь;
    КонецЕсли;        
    
    
    //Добавление возмущений (эпсилон) во избежание зацикливания транспортной задачи. См. литературу:
    //Дж. Данциг «Линейное программирование, его применения и обобщения» М:Прогресс, 1966 стр. 303
    //С.Гасс. «Линейное программирование (методы и приложения)», М:1961 стр. 195
    //В данном случае закомментировано, поскольку применен метод случайного включения нулевой перевозки
    //в базис, который также, согласно Данцигу, страхует от зацикливания. 
    
    //epsilon = 0.0001;
    //epsilon1= 0;
    //
    //Для j=1 по n Цикл
    //    Спрос[j]=Спрос[j]+epsilon;
    //    epsilon1=epsilon1+epsilon;
    //КонецЦикла;    
    //Предложение[1]=Предложение[1]+epsilon1;
    
    РаспределениеМетодомСевероЗападногоУгла();
    чСумма=СтоимостьПеревозки();
    Сообщить("Стоимость перевозки методом северо-западного угла: "+чСумма);
    РаспределениеМетодомМинимальныхТарифов();
    чСумма=СтоимостьПеревозки();
    Сообщить("Стоимость перевозки методом минимальных тарифов: "+чСумма);
    РаспределениеМетодомФогеля();
    чСумма=СтоимостьПеревозки();
    Сообщить("Стоимость перевозки методом Фогеля: "+чСумма);
    
    Пока 1=1 Цикл
        ПроверкаПравильностиОтгрузок();
        
        счБазисных=0;
        Для i=1 по m Цикл
            Для j=1 по n Цикл
                Если Отгрузки[i][j]>0 Тогда
                    БазисныеЯчейки[i][j]=1;
                    счБазисных=счБазисных+1;
                ИначеЕсли Отгрузки[i][j]<0 Тогда    
                    ВызватьИсключение("Отгрузки не должны быть отрицательными");
                Иначе
                    БазисныеЯчейки[i][j]=0;
                КонецЕсли;    
            КонецЦикла;    
        КонецЦикла;
        
        Пока счБазисных<(m+n-1) Цикл
            Сообщить("Решение вырождено");
            ПоискНулевойЯчейкиДляВводаВБазис();
            счБазисных=счБазисных+1;
        КонецЦикла;
        
        Если ВычислениеПотенциалов()=Ложь Тогда
            Продолжить;
        КонецЕсли;    
        Если ПроверкаОптимальности()=Истина Тогда
            Сообщить("РЕШЕНИЕ ОПТИМАЛЬНО");
            Прервать; // Решение найдено
        КонецЕсли;
        Сообщить("Решение не оптимальное");
        
        Если НайтиЦикл(i1, j1)= Ложь Тогда
            ВызватьИсключение("Не удалось найти цикл");
        КонецЕсли;
        ПерераспределениеПоЦиклу();
        
        чСумма=СтоимостьПеревозки();
        Сообщить("***");
        Сообщить("Стоимость перевозки: "+чСумма);
    КонецЦикла;    
    Возврат Истина;
КонецФункции


&НаКлиенте
Процедура КомандаРассчитать(Команда)
    РешениеТранспортнойЗадачи();
КонецПроцедуры
Закладка

Описание | Рубрикатор | Поиск | ТелепатБот | Захваченные статьи | Установки | Форум
© Станислав Митичкин (Волшебник), 2005-2011 | Mista.ru

Яндекс.Метрика