Anonymous user
Transportation problem: Difference between revisions
Undo revision 317430 by Dylanomics (talk)
No edit summary |
(Undo revision 317430 by Dylanomics (talk)) |
||
Line 2,532:
solution vector of quantities = [20.000000008747048, 0.0, 4.9999996490783145, 0.0, 30.000000007494098, 5.0000003509216855]
minimum total cost = 179.99999927567436</pre>
=={{header|Phix}}==
The simplest solution I could think of.<br>
Assumes 0 cost is not allowed, but using say -1 as the "done" cost instead should be fine.
<lang Phix>procedure solve(sequence needs, avail, costs)
sequence res = repeat(repeat(0,length(needs)),length(avail))
while true do
integer best = 0, supplier, customer
for s=1 to length(costs) do
for c=1 to length(costs[s]) do
integer csc = costs[s][c]
if csc!=0 and (best=0 or csc<best) then
best = csc
supplier = s
customer = c
end if
end for
end for
if best=0 then exit end if -- all costs examined
integer amt = min(avail[supplier],needs[customer])
-- obviously amt can be 0, in which case this just
-- removes cost entry from further consideration.
avail[supplier] -= amt
needs[customer] -= amt
res[supplier,customer] = amt
costs[supplier,customer] = 0
end while
pp(res,{pp_Nest,1})
end procedure
constant needs = {20,30,10}, -- (customers)
avail = {25,35}, -- (suppliers)
costs = {{3,5,7}, -- (length suppliers rows of
{3,2,5}} -- length customers columns)
solve(needs,avail,costs)</lang>
{{out}}
<pre>
{{20,0,5},
{0,30,5}}
</pre>
===stepping stones===
Obviously I did not really quite understand the problem when I rattled out the above... this does much better.
{{trans|Go}}
<lang Phix>-- demo\rosetta\Transportation_problem.exw
enum QTY, COST, R, C -- (a shipment)
constant eps = 1e-12
function print_matrix(sequence matrix)
atom total_costs = 0.0
for r=1 to length(matrix) do
for c=1 to length(matrix[r]) do
object s = matrix[r][c]
string st = " - "
if s!=0 and s[R]==r and s[C]==c then
atom qty = round(s[QTY]) -- (remove +/-eps)
if qty!=0 then
st = sprintf(" %3d ", qty)
total_costs += qty * s[COST]
end if
end if
puts(1,st)
end for
printf(1,"\n")
end for
return total_costs
end function
procedure print_result(sequence transport, atom expected)
sequence matrix = transport[4]
printf(1,"Optimal solution\n\n")
atom total_costs = print_matrix(matrix)
printf(1,"\nTotal costs: %g (expected %g)\n\n", {total_costs,expected})
end procedure
function get_neighbors(sequence shipment, lst)
sequence nbrs = {0,0}
for e=1 to length(lst) do
sequence o = lst[e]
if o!=shipment then
if o[R]==shipment[R] and nbrs[1]==0 then
nbrs[1] = o
elsif o[C]==shipment[C] and nbrs[2]==0 then
nbrs[2] = o
end if
if nbrs[1]!=0 and nbrs[2]!=0 then
exit
end if
end if
end for
return nbrs
end function
function matrix_to_list(sequence matrix)
sequence l = {}
for r=1 to length(matrix) do
for c=1 to length(matrix[r]) do
if matrix[r,c]!=0 then
l = append(l,matrix[r,c])
end if
end for
end for
return l
end function
function get_closed_path(sequence matrix, shipment)
sequence path = matrix_to_list(matrix)
path = prepend(path,shipment)
-- remove (and keep removing) elements that do not have a
-- vertical AND horizontal neighbor
while true do
integer removals = 0
for e=length(path) to 1 by -1 do
sequence nbrs = get_neighbors(path[e], path)
if nbrs[1]==0 or nbrs[2]==0 then
path[e..e] = {}
removals += 1
end if
end for
if removals==0 then exit end if
end while
-- place the remaining elements in the correct plus-minus order
sequence stones = repeat(0,length(path)),
prev = shipment
for i=1 to length(stones) do
stones[i] = prev
prev = get_neighbors(prev, path)[mod(i,2)+1]
end for
return stones
end function
function fix_degenerate_case(sequence matrix, costs)
if length(matrix)+length(matrix[1])-1 != length(matrix_to_list(matrix)) then
printf(1,"fixing degenerate case...\n")
for r=1 to length(matrix) do
for c=1 to length(matrix[r]) do
if matrix[r][c] == 0 then
sequence dummy = {eps, costs[r][c], r, c}
if length(get_closed_path(matrix,dummy)) == 0 then
matrix[r][c] = dummy
return matrix
end if
end if
end for
end for
?9/0 -- ??
end if
return matrix
end function
function initialise(sequence tests, integer t)
sequence {src,dst,costs} = tests[t]
string cs = ppf(costs,{pp_Nest,1,pp_StrFmt,3,pp_IntCh,false,pp_Indent,7})
printf(1,"test %d:\nsrc: %v,\ndst: %v,\ncosts: %s\n",{t,src,dst,cs})
-- check for and fix any imbalance
atom totalSrc = sum(src),
totalDst = sum(dst),
diff = totalSrc-totalDst
if diff>0 then
puts(1,"adding dummy consumer...\n")
dst = append(dst, diff)
for i=1 to length(costs) do
costs[i] &= 0
end for
elsif diff<0 then
puts(1,"adding dummy supplier...\n")
src = append(src, -diff)
costs = append(costs,repeat(0,length(dst)))
end if
printf(1,"generating initial feasible solution using northwest corner method...\n")
sequence matrix = repeat(repeat(0,length(dst)),length(src))
integer northwest = 1
for r=1 to length(src) do
for c=northwest to length(dst) do
atom qty = min(src[r],dst[c])
if qty>0 then
matrix[r][c] = {qty,costs[r,c],r,c}
src[r] -= qty
dst[c] -= qty
if src[r]=0 then
northwest = c
exit
end if
end if
end for
end for
printf(1,"\nTotal costs: %g\n\n", print_matrix(matrix))
return {src,dst,costs,matrix}
end function
function stepping_stone(sequence transport)
sequence {src, dst, costs, matrix} = transport
atom maxReduction = 0
object move = NULL, leaving
matrix = fix_degenerate_case(matrix, costs)
for r=1 to length(src) do
for c=1 to length(dst) do
if matrix[r][c] = 0 then
sequence trial_shipment = {0, costs[r][c], r, c},
path = get_closed_path(matrix,trial_shipment)
atom reduction = 0.0,
lowestQuantity = 1e308
object leavingCandidate = 0
bool plus = true
for i=1 to length(path) do
sequence s = path[i]
if plus then
reduction += s[COST]
else
reduction -= s[COST]
if s[QTY] < lowestQuantity then
leavingCandidate = s
lowestQuantity = s[QTY]
end if
end if
plus = not plus
end for
if reduction < maxReduction then
move = path
leaving = leavingCandidate
maxReduction = reduction
end if
end if
end for
end for
if move!=NULL then
atom q = leaving[QTY]
bool plus = true
for i=1 to length(move) do
sequence s = move[i]
if plus then
s[QTY] += q
else
s[QTY] -= q
end if
if s[QTY] == 0 then
matrix[s[R]][s[C]] = 0
else
matrix[s[R]][s[C]] = s
end if
plus = not plus
end for
{src, dst, costs, matrix} = stepping_stone({src, dst, costs, matrix})
end if
return {src, dst, costs, matrix}
end function
-- -- source dest costs expected total
constant tests = {{{25,35}, {20,30,10}, {{3,5,7},
{3,2,5}}, 180},
{{12,40,33}, {20,30,10}, {{3,5,7},
{2,4,6},
{9,1,8}}, 130},
{{14,10,15,12}, {10,15,12,15}, {{10,30,25,15},
{20,15,20,10},
{10,30,20,20},
{30,40,35,45}}, 1000},
{{100,300,300}, {300,200,200}, {{50,40,30},
{80,40,30},
{90,70,50}}, 39000},
{{40,60,50}, {20,30,50,50}, {{4,6,8,8},
{6,8,6,7},
{5,7,6,8}}, 920},
{{12,1,5}, {10,8}, {{ 2, 4},
{ 8,12},
{12, 6}}, 68},
{{7,9,18}, {5,8,7,14}, {{19,30,50,10},
{70,30,40,60},
{40, 8,70,20}}, 743},
{{12,11,14,8}, {10,11,15,5,4}, {{ 7,12, 1, 5, 6},
{15, 3,12, 6,14},
{ 8,16,10,12, 7},
{18, 8,17,11,16}}, 259},
{{50,75,25}, {20,20,50,60}, {{3,5,7,6},
{2,5,8,2},
{3,6,9,2}}, 610}}
--for i=1 to length(tests) do
for i=3 to 3 do
print_result(stepping_stone(initialise(tests,i)),tests[i][4])
end for</lang>
{{out}}
(Obviously the other eight tests all work fine and produce similar output.)
<pre>
test 3:
src: {14,10,15,12},
dst: {10,15,12,15},
costs: {{10,30,25,15},
{20,15,20,10},
{10,30,20,20},
{30,40,35,45}}
adding dummy supplier...
generating initial feasible solution using northwest corner method...
10 4 - -
- 10 - -
- 1 12 2
- - - 12
- - - 1
Total costs: 1220
fixing degenerate case...
Optimal solution
- - - 14
- 9 - 1
10 - 5 -
- 5 7 -
- 1 - -
Total costs: 1000 (expected 1000)
</pre>
Note that [[Vogel%27s_approximation_method#Phix]] gets a few of the others wrong and loops on #2, then again that is unbalanced (needs a dummy customer), and I'm not sure whether throwing such at VAM is fair or not.
=={{header|Racket}}==
| |||