Transportation problem: Difference between revisions
Content added Content deleted
(Undo revision 317425 by Dylanomics (talk)) |
(Undo revision 317424 by Dylanomics (talk)) |
||
Line 2,532: | Line 2,532: | ||
solution vector of quantities = [20.000000008747048, 0.0, 4.9999996490783145, 0.0, 30.000000007494098, 5.0000003509216855] |
solution vector of quantities = [20.000000008747048, 0.0, 4.9999996490783145, 0.0, 30.000000007494098, 5.0000003509216855] |
||
minimum total cost = 179.99999927567436</pre> |
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}}== |
=={{header|Racket}}== |