Транспортная задача по критерию времени

-- Блокируем в матрице временных затрат те элементы,

-- которые больше максимального времени перевозок, соответсвующего

опорному плану, или равны ему.

tBl = [[(case aV of

1 → (if (i ≡ mRC - 1) ∨ ((t !! i !! j) ≥ maxi)

then blok

else t !! i !! j)

2 → (if (j ≡ mCC - 1) ∨ ((t !! i !! j) ≥ maxi)

then blok

else (t !! i !! j))

3 → (if (t !! i !! j) ≥ maxi

then blok

else (t !! i !! j))) |

j ← [0‥mCC-1] ] |

i ← [0‥mRC-1] ]

--sumNew = sum ◊ zipWith (*) (map round plan) ◊ concat t

nonClosedModelTime = (case aV of

1 → listToArrayList (concat ◊ init tBl) mCC

2 → listToArrayList (concat ◊ [ init i | i ← tBl ]) (mCC-1)

3 → listToArrayList (concat ◊ tBl) mCC)

nonDPlan = listToArrayList plan mCC

-- Вычисляем потенциалы

pts = potentials tBl plan ([(0,0)],[])

-- Рассчитываем матрицу T1

t1 = [[ (tBl !! i !! j) - ((fromJust ◊ lookup j ◊ snd pts) - (fromJust

◊ lookup i ◊ fst pts)) |

j ← [0‥mCC-1] ] |

i ← [0‥mRC-1] ]

fstSum = sum ◊ zipWith (*) (mkNonClsdPlan nonDPlan mCC aV) ◊ concat t

-- Проверяем на наличие отрицательных элементов в T1

in if null [ minimum i | i ← t1, (minimum i) < 0 ]

then

-- Если нету, то выдаем ответ.

if null dec

then [(([nonDPlan,nonDPlan], [tBl,t1]), ([maxi,maxi],[fstSum,fstSum]))]

else dec {-++ [([nonDPlan], [t1⊕[[maxi]]])]-}

-- Иначе строим новый, улучшенный план.

else (let newStepsPlan = fst ◊ mkNewPlan t1 nonDPlan mRC mCC

-- После предварительного этапа и первой итерации приступаем к следующим

итеррациям и находим

-- оптимальный план при данных условиях.

planT = mkNonClsdPlan newStepsPlan mCC aV

maximm = maximum [ t !! i !! j |

i ← [0‥rC-1], j ← [0‥cC-1], (planT !! (i*cC + j)) ≠ 0]

sndSum = sum ◊ zipWith (*) (mkNonClsdPlan newStepsPlan mCC aV) ◊

concat ◊ mkNonClsdPlan2 tBl aV

decision = potentialsMethod (mkNonClsdPlan2 tBl aV) []

([maxi,maxi,maximm],[fstSum,fstSum,sndSum]) mCC aV True

[nonDPlan, nonDPlan, newStepsPlan] [tBl, t1]

pl = last ◊ fst ◊ fst decision

-- Убираем из оптимального плана добавленную при переходе к закрытой модели

строку или столбец,

-- если модель была открытой.

newPlan = mkNonClsdPlan pl mCC aV

newPlan1 = mkNonClsdPlan1 pl mCC aV

in if or

[(fst el) `elem` (map fst ◊ filter ( λa → snd a≥ 0.9) newPlan1) |

el ← (filter (λa → snd a > (blok `div` 2)) nonClosedModelTime) ]

then dec ⊕ [decision]

else addConditions plan t mRC mCC rC cC aV

(maximum [ t !! i !! j |

i ← [0‥rC-1], j ← [0‥cC-1], newPlan !! (i*cC + j) > 0 ])

(dec ⊕ [decision])))

mkNonClsdPlan :: Plan → Int → Int → [Int]

mkNonClsdPlan plan mCC addV =

13

let mRC = (length plan) `div` mCC

in (case addV of

1 → map (round∘snd) ◊ take ((mRC-1)*mCC) plan

2 → map (round∘snd) ◊ concat [ init ◊ drop ((i-1)*mCC) ◊ take

(i*mCC) plan | i ← [1‥mRC] ]

3 → map (round∘snd) plan)

mkNonClsdPlan2 :: [[a]] → Int → [[a]]

mkNonClsdPlan2 plan addV =

(case addV of

1 → init plan

2 → map init plan

3 → plan)

mkNonClsdPlan1 :: [a] → Int → Int → [a]

mkNonClsdPlan1 plan mCC addV =

let mRC = (length plan) `div` mCC

in (case addV of

1 → take ((mRC-1)*mCC) plan

2 → concat [ init ◊ drop ((i-1)*mCC) ◊ take (i*mCC) plan | i ← [1‥

mRC] ]

3 → plan)

mkNewPlan :: [[Int]] → Plan → Int → Int → (Plan, Int)

mkNewPlan t1 nonDPlan mRC mCC =

let minEl = minimum [ minimum i | i ← t1, (minimum i) < 0 ]

rowOfMinEl = head [ i |

i ← [1‥length t1],

(findIndex (≡ minEl) (t1 !! (i-1))) ≠ Nothing ]

colOfMinEl = 1 + fromJust (findIndex (≡ minEl) (t1 !!

(rowOfMinEl-1)))

-- Далее находим подматрицу в опорном плане, содержащую цикл, и число

колонок в этой подматрице.

mCycle = findCycle rowOfMinEl colOfMinEl mCC 1 nonDPlan

mCol = length ◊ filter (≡(fst ◊ fst ◊ head mCycle)) ◊ map

(fst∘fst) mCycle

-- Находим номер нулевого элемента плана, который соотетствует минимальному

отрицательному марицы T1

indexX = fromJust ◊ findIndex (≡((rowOfMinEl, colOfMinEl), 0.0))

mCycle

-- Составляем цикл

cy = getCycle ((indexX `div` mCol)+1) ((indexX `mod` mCol)+1)

mCol mCycle

-- Находим минимальный нечетный элемент

cymin = minimum [ snd (cy !! (i-1)) | i ← [1‥length cy], even

i]

-- Отнимаем его из нечётных, и прибавляем к чsum ◊ zipWith (*) plan ◊

concat tbaseётным

tempCycle = [ if even i

then (fst (cy !! (i-1)), snd (cy !! (i-1)) - cymin)

else (fst (cy !! (i-1)), snd (cy !! (i-1)) + cymin) | i ←

[1‥length cy] ]

-- Находим в преобразованном цикле нулевые элементы

zeroMass = [ fst ◊ (tempCycle !! (i-1)) |

i ← [1‥length tempCycle],

(even i) ∧ (snd (tempCycle !! (i-1)) ≡ 0) ]

-- Если число нулевых елементов больше 1, то заменяем все , кроме одного, на

0.0001

modifiedCycle = if (length zeroMass) > 1

then [ if(findIndex (≡(fst (tempCycle !! (i-1)))) ◊ tail

zeroMass) ≠ Nothing

then ((fst (tempCycle !! (i-1))), 0.000001)

else tempCycle !! (i-1) | i ← [1‥length tempCycle]]

else tempCycle

-- Записываем полученную цепочку в матрицу опроного плана вместо

первоначальных значений.

in ([ (if (lookup (i+1,j+1) modifiedCycle) ≠ Nothing

14

then ((i+1,j+1), fromJust (lookup (i+1,j+1) modifiedCycle))

else (nonDPlan !! (i*mCC + j))) |

i ← [0‥ mRC-1], j ← [0‥ mCC-1] ], minEl * round

cymin)

potentialsMethod :: [[Int]] → [[Int]] → ([Int],[Int]) → Int → Int → Bool →

[Plan] → [[[Int]]] → Ansset

potentialsMethod tbase cbase sm colCount aV byTime x1 t1 =

let x = last x1

t = last t1

significantIndices = [ fst i |

i ← x,

(snd i ≠ 0) ∧ ((t !! ((fst ◊ fst i)-1) !! ((snd ◊ fst i)-1)) ≡ 0) ]

minEl = minimum [ minimum i | i ← t ]

rowOfMinEl = head [ i |

i ← [1‥length t],

(findIndex (≡ minEl) (t !! (i-1))) ≠ Nothing ]

newT = processMarkedRnC

(getMarkedRowsNColoumns [(1, rowOfMinEl)] significantIndices)

minEl

t

rowCount = (length x) `div` colCount

in if null [filter (<0) i | i ← newT, ￢ (null (filter (<0) i)) ]

then ((x1, t1 ⊕[newT]), sm)

else let newX = mkNewPlan newT x rowCount colCount

plan = mkNonClsdPlan (fst newX) colCount aV

calcMax = maximum [ tbase !! i !! j |

i ← [0‥(length tbase)-1], j ← [0‥(length ◊ head

tbase)-1],

(plan !! (i*(length ◊ head tbase) + j)) ≠ 0]

calcSum = if byTime

then sum ◊ zipWith (*) plan ◊ concat tbase

else sum ◊ zipWith (*) plan ◊ concat cbase

in if(calcSum ≡ (last ◊ snd sm) + (snd newX))

then potentialsMethod tbase cbase

((fst sm) ⊕ [calcMax],(snd sm) ⊕ [calcSum])

colCount aV byTime (x1 ⊕ [fst ◊ newX]) (t1 ⊕ [newT])

else error ("potentialsMethod: error!! " ⊕ (show ◊ length x1))

-- | Функция прибавляет модуль минимального отрицательного элемента ко всем

строкам

-- и отнимает из столбцов матрицы Ti

processMarkedRnC :: [(Int, Int)] → Int → [[Int]] → [[Int]]

processMarkedRnC indices mint t =

let isRow = fst ◊ head indices

vecNumber = snd ◊ head indices

in if null indices

then t

else if isRow ≡ 1

then processMarkedRnC (tail indices) mint

[ if i ≡ vecNumber

then map (+(- mint)) (t !! (i-1))

else t !! (i-1) |

i ← [1‥length t] ]

else processMarkedRnC (tail indices) mint

[[ if j ≡ vecNumber

then (t !! (i-1) !! (j-1)) + mint

else (t !! (i-1) !! (j-1))

| j ← [1‥length ◊ head t] ] |

i ← [1‥length t] ]

-- | Функция ищет по списку индексов существенных нулей те строки и столбцы, к

элементам

-- которых нужно соотвеветсвенно добавить или отнять модуль минимального

-- отрицательного элемента матрицы времени (стоимости).

getMarkedRowsNColoumns :: [(Int,Int)] → [(Int,Int)] → [(Int,Int)]

15

getMarkedRowsNColoumns indices arr =

let indicesGroup = last ◊ groupBy (λa b → (fst a ≡ fst b)) indices

newEl = if (fst ◊ head indicesGroup) ≡ 1

then [ (2, snd j) |

i ← indicesGroup,

j ← arr,

(snd i ≡ fst j) ∧ ￢ ((2, snd j) `elem` indices) ]

else [ (1, fst j) |

i ← indicesGroup,

j ← arr,

(snd i ≡ snd j) ∧ ￢ ((1, fst j) `elem` indices) ]

in if null newEl

then indices

else getMarkedRowsNColoumns (indices ⊕ newEl) arr

-- | Фукнция находит в плане X подматрицу, которая содержит цикл.

findCycle :: Int → Int → Int → Int → Plan → Plan

findCycle i j colCount counter plan

| colCount < 1 = []

| counter > (colCount + (length plan) `div` colCount) = plan

| otherwise =

let rowCount = (length plan) `div` colCount

rowMass = [ fst ◊ fst ◊ (plan !! (n*colCount)) |

n ← [0‥rowCount-1] ]

colMass = map (snd∘fst) ◊ drop ((rowCount - 1) * colCount) plan

in (if counter ≤ rowCount

then