Vogel's approximation method: Difference between revisions

From Rosetta Code
Content added Content deleted
m (→‎{{header|Phix}}: syntax coloured)
Line 1,490: Line 1,490:
{{trans|YaBasic}}
{{trans|YaBasic}}
{{trans|Go}}
{{trans|Go}}
<lang Phix>sequence supply = {50,60,50,50},
<!--<lang Phix>(phixonline)-->
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
demand = {30,20,70,30,60},
<span style="color: #004080;">sequence</span> <span style="color: #000000;">supply</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">50</span><span style="color: #0000FF;">,</span><span style="color: #000000;">60</span><span style="color: #0000FF;">,</span><span style="color: #000000;">50</span><span style="color: #0000FF;">,</span><span style="color: #000000;">50</span><span style="color: #0000FF;">},</span>
costs = {{16,16,13,22,17},
<span style="color: #000000;">demand</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">30</span><span style="color: #0000FF;">,</span><span style="color: #000000;">20</span><span style="color: #0000FF;">,</span><span style="color: #000000;">70</span><span style="color: #0000FF;">,</span><span style="color: #000000;">30</span><span style="color: #0000FF;">,</span><span style="color: #000000;">60</span><span style="color: #0000FF;">},</span>
{14,14,13,19,15},
<span style="color: #000000;">costs</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{{</span><span style="color: #000000;">16</span><span style="color: #0000FF;">,</span><span style="color: #000000;">16</span><span style="color: #0000FF;">,</span><span style="color: #000000;">13</span><span style="color: #0000FF;">,</span><span style="color: #000000;">22</span><span style="color: #0000FF;">,</span><span style="color: #000000;">17</span><span style="color: #0000FF;">},</span>
{19,19,20,23,50},
<span style="color: #0000FF;">{</span><span style="color: #000000;">14</span><span style="color: #0000FF;">,</span><span style="color: #000000;">14</span><span style="color: #0000FF;">,</span><span style="color: #000000;">13</span><span style="color: #0000FF;">,</span><span style="color: #000000;">19</span><span style="color: #0000FF;">,</span><span style="color: #000000;">15</span><span style="color: #0000FF;">},</span>
{50,12,50,15,11}}
<span style="color: #0000FF;">{</span><span style="color: #000000;">19</span><span style="color: #0000FF;">,</span><span style="color: #000000;">19</span><span style="color: #0000FF;">,</span><span style="color: #000000;">20</span><span style="color: #0000FF;">,</span><span style="color: #000000;">23</span><span style="color: #0000FF;">,</span><span style="color: #000000;">50</span><span style="color: #0000FF;">},</span>

<span style="color: #0000FF;">{</span><span style="color: #000000;">50</span><span style="color: #0000FF;">,</span><span style="color: #000000;">12</span><span style="color: #0000FF;">,</span><span style="color: #000000;">50</span><span style="color: #0000FF;">,</span><span style="color: #000000;">15</span><span style="color: #0000FF;">,</span><span style="color: #000000;">11</span><span style="color: #0000FF;">}}</span>
sequence row_done = repeat(false,length(supply)),
col_done = repeat(false,length(demand))
<span style="color: #004080;">sequence</span> <span style="color: #000000;">row_done</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #004600;">false</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">supply</span><span style="color: #0000FF;">)),</span>

<span style="color: #000000;">col_done</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #004600;">false</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">demand</span><span style="color: #0000FF;">))</span>
function diff(integer j, leng, bool is_row)
integer min1 = #3FFFFFFF, min2 = min1, min_p = -1
<span style="color: #008080;">function</span> <span style="color: #000000;">diff</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">j</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">leng</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">bool</span> <span style="color: #000000;">is_row</span><span style="color: #0000FF;">)</span>
for i=1 to leng do
<span style="color: #004080;">integer</span> <span style="color: #000000;">min1</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">#3FFFFFFF</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">min2</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">min1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">min_p</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span>
if not iff(is_row?col_done:row_done)[i] then
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">leng</span> <span style="color: #008080;">do</span>
integer c = iff(is_row?costs[j,i]:costs[i,j])
<span style="color: #008080;">if</span> <span style="color: #008080;">not</span> <span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #000000;">is_row</span><span style="color: #0000FF;">?</span><span style="color: #000000;">col_done</span><span style="color: #0000FF;">:</span><span style="color: #000000;">row_done</span><span style="color: #0000FF;">)[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #008080;">then</span>
if c<min1 then
<span style="color: #004080;">integer</span> <span style="color: #000000;">c</span> <span style="color: #0000FF;">=</span> <span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #000000;">is_row</span><span style="color: #0000FF;">?</span><span style="color: #000000;">costs</span><span style="color: #0000FF;">[</span><span style="color: #000000;">j</span><span style="color: #0000FF;">,</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]:</span><span style="color: #000000;">costs</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">,</span><span style="color: #000000;">j</span><span style="color: #0000FF;">])</span>
min2 = min1
<span style="color: #008080;">if</span> <span style="color: #000000;">c</span><span style="color: #0000FF;"><</span><span style="color: #000000;">min1</span> <span style="color: #008080;">then</span>
min1 = c
<span style="color: #000000;">min2</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">min1</span>
min_p = i
<span style="color: #000000;">min1</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">c</span>
elsif c<min2 then
<span style="color: #000000;">min_p</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">i</span>
min2 = c
<span style="color: #008080;">elsif</span> <span style="color: #000000;">c</span><span style="color: #0000FF;"><</span><span style="color: #000000;">min2</span> <span style="color: #008080;">then</span>
end if
<span style="color: #000000;">min2</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">c</span>
end if
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
end for
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
return {min2-min1,min1,min_p,j}
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
end function
<span style="color: #008080;">return</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">min2</span><span style="color: #0000FF;">-</span><span style="color: #000000;">min1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">min1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">min_p</span><span style="color: #0000FF;">,</span><span style="color: #000000;">j</span><span style="color: #0000FF;">}</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
function max_penalty(integer len1, len2, bool is_row)
integer pc = -1, pm = -1, mc = -1, md = -#3FFFFFFF
<span style="color: #008080;">function</span> <span style="color: #000000;">max_penalty</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">len1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">len2</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">bool</span> <span style="color: #000000;">is_row</span><span style="color: #0000FF;">)</span>
for i=1 to len1 do
<span style="color: #004080;">integer</span> <span style="color: #000000;">pc</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">pm</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">mc</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">md</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">#3FFFFFFF</span>
if not iff(is_row?row_done:col_done)[i] then
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">len1</span> <span style="color: #008080;">do</span>
sequence res2 = diff(i, len2, is_row)
<span style="color: #008080;">if</span> <span style="color: #008080;">not</span> <span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #000000;">is_row</span><span style="color: #0000FF;">?</span><span style="color: #000000;">row_done</span><span style="color: #0000FF;">:</span><span style="color: #000000;">col_done</span><span style="color: #0000FF;">)[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #008080;">then</span>
if res2[1]>md then
<span style="color: #004080;">sequence</span> <span style="color: #000000;">res2</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">diff</span><span style="color: #0000FF;">(</span><span style="color: #000000;">i</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">len2</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">is_row</span><span style="color: #0000FF;">)</span>
{md,mc,pc,pm} = res2
<span style="color: #008080;">if</span> <span style="color: #000000;">res2</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]></span><span style="color: #000000;">md</span> <span style="color: #008080;">then</span>
end if
<span style="color: #0000FF;">{</span><span style="color: #000000;">md</span><span style="color: #0000FF;">,</span><span style="color: #000000;">mc</span><span style="color: #0000FF;">,</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">,</span><span style="color: #000000;">pm</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">res2</span>
end if
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
end for
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
return {md,mc}&iff(is_row?{pm,pc}:{pc,pm})
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
end function
<span style="color: #008080;">return</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">md</span><span style="color: #0000FF;">,</span><span style="color: #000000;">mc</span><span style="color: #0000FF;">}&</span><span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #000000;">is_row</span><span style="color: #0000FF;">?{</span><span style="color: #000000;">pm</span><span style="color: #0000FF;">,</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">}:{</span><span style="color: #000000;">pc</span><span style="color: #0000FF;">,</span><span style="color: #000000;">pm</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
integer supply_left = sum(supply),
total_cost = 0
<span style="color: #004080;">integer</span> <span style="color: #000000;">supply_left</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">sum</span><span style="color: #0000FF;">(</span><span style="color: #000000;">supply</span><span style="color: #0000FF;">),</span>

<span style="color: #000000;">total_cost</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
sequence results = repeat(repeat(0,length(demand)),length(supply))
<span style="color: #004080;">sequence</span> <span style="color: #000000;">results</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">demand</span><span style="color: #0000FF;">)),</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">supply</span><span style="color: #0000FF;">))</span>
while supply_left>0 do
sequence cell = min(max_penalty(length(supply), length(demand), true),
<span style="color: #008080;">while</span> <span style="color: #000000;">supply_left</span><span style="color: #0000FF;">></span><span style="color: #000000;">0</span> <span style="color: #008080;">do</span>
max_penalty(length(demand), length(supply), false))
<span style="color: #004080;">sequence</span> <span style="color: #000000;">cell</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">min</span><span style="color: #0000FF;">(</span><span style="color: #000000;">max_penalty</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">supply</span><span style="color: #0000FF;">),</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">demand</span><span style="color: #0000FF;">),</span> <span style="color: #004600;">true</span><span style="color: #0000FF;">),</span>
integer {{},{},r,c} = cell,
<span style="color: #000000;">max_penalty</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">demand</span><span style="color: #0000FF;">),</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">supply</span><span style="color: #0000FF;">),</span> <span style="color: #004600;">false</span><span style="color: #0000FF;">))</span>
q = min(demand[c], supply[r])
<span style="color: #004080;">integer</span> <span style="color: #0000FF;">{{},{},</span><span style="color: #000000;">r</span><span style="color: #0000FF;">,</span><span style="color: #000000;">c</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">cell</span><span style="color: #0000FF;">,</span>
demand[c] -= q
<span style="color: #000000;">q</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">min</span><span style="color: #0000FF;">(</span><span style="color: #000000;">demand</span><span style="color: #0000FF;">[</span><span style="color: #000000;">c</span><span style="color: #0000FF;">],</span> <span style="color: #000000;">supply</span><span style="color: #0000FF;">[</span><span style="color: #000000;">r</span><span style="color: #0000FF;">])</span>
col_done[c] = (demand[c]==0)
<span style="color: #000000;">demand</span><span style="color: #0000FF;">[</span><span style="color: #000000;">c</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">-=</span> <span style="color: #000000;">q</span>
supply[r] -= q
<span style="color: #000000;">col_done</span><span style="color: #0000FF;">[</span><span style="color: #000000;">c</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">(</span><span style="color: #000000;">demand</span><span style="color: #0000FF;">[</span><span style="color: #000000;">c</span><span style="color: #0000FF;">]==</span><span style="color: #000000;">0</span><span style="color: #0000FF;">)</span>
row_done[r] = (supply[r]==0)
<span style="color: #000000;">supply</span><span style="color: #0000FF;">[</span><span style="color: #000000;">r</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">-=</span> <span style="color: #000000;">q</span>
results[r, c] = q
<span style="color: #000000;">row_done</span><span style="color: #0000FF;">[</span><span style="color: #000000;">r</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">(</span><span style="color: #000000;">supply</span><span style="color: #0000FF;">[</span><span style="color: #000000;">r</span><span style="color: #0000FF;">]==</span><span style="color: #000000;">0</span><span style="color: #0000FF;">)</span>
supply_left -= q
<span style="color: #000000;">results</span><span style="color: #0000FF;">[</span><span style="color: #000000;">r</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">c</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">q</span>
total_cost += q * costs[r, c]
<span style="color: #000000;">supply_left</span> <span style="color: #0000FF;">-=</span> <span style="color: #000000;">q</span>
end while
<span style="color: #000000;">total_cost</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">q</span> <span style="color: #0000FF;">*</span> <span style="color: #000000;">costs</span><span style="color: #0000FF;">[</span><span style="color: #000000;">r</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">c</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
printf(1," A B C D E\n")
for i=1 to length(supply) do
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">" A B C D E\n"</span><span style="color: #0000FF;">)</span>
printf(1,"%c ",'Z'-length(supply)+i)
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">supply</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
for j=1 to length(demand) do
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%c "</span><span style="color: #0000FF;">,</span><span style="color: #008000;">'Z'</span><span style="color: #0000FF;">-</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">supply</span><span style="color: #0000FF;">)+</span><span style="color: #000000;">i</span><span style="color: #0000FF;">)</span>
printf(1,"%4d",results[i,j])
<span style="color: #008080;">for</span> <span style="color: #000000;">j</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">demand</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
end for
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%4d"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">results</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">,</span><span style="color: #000000;">j</span><span style="color: #0000FF;">])</span>
printf(1,"\n")
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
end for
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"\n"</span><span style="color: #0000FF;">)</span>
printf(1,"\nTotal cost = %d\n", total_cost)</lang>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"\nTotal cost = %d\n"</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">total_cost</span><span style="color: #0000FF;">)</span>
<!--</lang>-->
{{out}}
{{out}}
<pre>
<pre>
Line 1,569: Line 1,572:
</pre>
</pre>
Using the sample from Ruby:
Using the sample from Ruby:
<!--<lang Phix>(phixonline)-->
<lang Phix>sequence supply = {461, 277, 356, 488, 393},
<span style="color: #004080;">sequence</span> <span style="color: #000000;">supply</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">461</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">277</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">356</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">488</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">393</span><span style="color: #0000FF;">},</span>
demand = {278, 60, 461, 116, 1060},
<span style="color: #000000;">demand</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">278</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">60</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">461</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">116</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">1060</span><span style="color: #0000FF;">},</span>
costs = {{46, 74, 9, 28, 99},
<span style="color: #000000;">costs</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{{</span><span style="color: #000000;">46</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">74</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">9</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">28</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">99</span><span style="color: #0000FF;">},</span>
{12, 75, 6, 36, 48},
<span style="color: #0000FF;">{</span><span style="color: #000000;">12</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">75</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">6</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">36</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">48</span><span style="color: #0000FF;">},</span>
{35, 199, 4, 5, 71},
<span style="color: #0000FF;">{</span><span style="color: #000000;">35</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">199</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">4</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">5</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">71</span><span style="color: #0000FF;">},</span>
{61, 81, 44, 88, 9},
<span style="color: #0000FF;">{</span><span style="color: #000000;">61</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">81</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">44</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">88</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">9</span><span style="color: #0000FF;">},</span>
{85, 60, 14, 25, 79}}</lang>
<span style="color: #0000FF;">{</span><span style="color: #000000;">85</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">60</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">14</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">25</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">79</span><span style="color: #0000FF;">}}</span>
<!--</lang>-->
{{Out}}
{{Out}}
Note this agrees with C and Go but not Ruby
Note this agrees with C and Go but not Ruby

Revision as of 21:53, 19 April 2022

Task
Vogel's approximation method
You are encouraged to solve this task according to the task description, using any language you may know.

Vogel's Approximation Method (VAM) is a technique for finding a good initial feasible solution to an allocation problem.

The powers that be have identified 5 tasks that need to be solved urgently. Being imaginative chaps, they have called them “A”, “B”, “C”, “D”, and “E”. They estimate that:

  • A will require 30 hours of work,
  • B will require 20 hours of work,
  • C will require 70 hours of work,
  • D will require 30 hours of work, and
  • E will require 60 hours of work.

They have identified 4 contractors willing to do the work, called “W”, “X”, “Y”, and “Z”.

  • W has 50 hours available to commit to working,
  • X has 60 hours available,
  • Y has 50 hours available, and
  • Z has 50 hours available.

The cost per hour for each contractor for each task is summarized by the following table:

   A  B  C  D  E
W 16 16 13 22 17
X 14 14 13 19 15
Y 19 19 20 23 50
Z 50 12 50 15 11

The task is to use VAM to allocate contractors to tasks. It scales to large problems, so ideally keep sorts out of the iterative cycle. It works as follows:

Step 1: Balance the given transportation problem if either (total supply>total demand) or (total supply<total demand)
Step 2: Determine the penalty cost for each row and column by subtracting the lowest cell cost in the row or column from the next lowest cell cost in the same row or column.
Step 3: Select the row or column with the highest penalty cost (breaking ties arbitrarily or choosing the lowest-cost cell).
Step 4: Allocate as much as possible to the feasible cell with the lowest transportation cost in the row or column with the highest penalty cost.
Step 5: Repeat steps 2, 3 and 4 until all requirements have been meet.
Step 6: Compute total transportation cost for the feasible allocations.

For this task assume that the model is balanced.

For each task and contractor (row and column above) calculating the difference between the smallest two values produces:

        A       B       C       D       E       W       X       Y       Z
1       2       2       0       4       4       3       1       0       1   E-Z(50)

Determine the largest difference (D or E above). In the case of ties I shall choose the one with the lowest price (in this case E because the lowest price for D is Z=15, whereas for E it is Z=11). For your choice determine the minimum cost (chosen E above so Z=11 is chosen now). Allocate as much as possible from Z to E (50 in this case limited by Z's supply). Adjust the supply and demand accordingly. If demand or supply becomes 0 for a given task or contractor it plays no further part. In this case Z is out of it. If you choose arbitrarily, and chose D see here for the working.

Repeat until all supply and demand is met:

2       2       2       0       3       2       3       1       0       -   C-W(50)
3       5       5       7       4      35       -       1       0       -   E-X(10)
4       5       5       7       4       -       -       1       0       -   C-X(20)
5       5       5       -       4       -       -       0       0       -   A-X(30)
6       -      19       -      23       -       -       -       4       -   D-Y(30)
        -       -       -       -       -       -       -       -       -   B-Y(20)

Finally calculate the cost of your solution. In the example given it is £3100:

   A  B  C  D  E
W       50
X 30    20    10
Y    20    30
Z             50

The optimal solution determined by GLPK is £3100:

   A  B  C  D  E
W       50
X 10 20 20    10
Y 20       30
Z             50
Cf.

11l

Translation of: Python

<lang 11l>V costs = [‘W’ = [‘A’ = 16, ‘B’ = 16, ‘C’ = 13, ‘D’ = 22, ‘E’ = 17],

          ‘X’ = [‘A’ = 14, ‘B’ = 14, ‘C’ = 13, ‘D’ = 19, ‘E’ = 15],
          ‘Y’ = [‘A’ = 19, ‘B’ = 19, ‘C’ = 20, ‘D’ = 23, ‘E’ = 50],
          ‘Z’ = [‘A’ = 50, ‘B’ = 12, ‘C’ = 50, ‘D’ = 15, ‘E’ = 11]]

V demand = [‘A’ = 30, ‘B’ = 20, ‘C’ = 70, ‘D’ = 30, ‘E’ = 60] V cols = sorted(demand.keys()) V supply = [‘W’ = 50, ‘X’ = 60, ‘Y’ = 50, ‘Z’ = 50] V res = Dict(costs.keys().map(k -> (k, DefaultDict[Char, Int]()))) [Char = [Char]] g L(x) supply.keys()

  g[x] = sorted(costs[x].keys(), key' g -> :costs[@x][g])

L(x) demand.keys()

  g[x] = sorted(costs.keys(), key' g -> :costs[g][@x])

L !g.empty

  [Char = Int] d
  L(x) demand.keys()
     d[x] = I g[x].len > 1 {(costs[g[x][1]][x] - costs[g[x][0]][x])} E costs[g[x][0]][x]
  [Char = Int] s
  L(x) supply.keys()
     s[x] = I g[x].len > 1 {(costs[x][g[x][1]] - costs[x][g[x][0]])} E costs[x][g[x][0]]
  V f = max(d.keys(), key' n -> @d[n])
  V t = max(s.keys(), key' n -> @s[n])
  (t, f) = I d[f] > s[t] {(f, g[f][0])} E (g[t][0], t)
  V v = min(supply[f], demand[t])
  res[f][t] += v
  demand[t] -= v
  I demand[t] == 0
     L(k, n) supply
        I n != 0
           g[k].remove(t)
     g.pop(t)
     demand.pop(t)
  supply[f] -= v
  I supply[f] == 0
     L(k, n) demand
        I n != 0
           g[k].remove(f)
     g.pop(f)
     supply.pop(f)

L(n) cols

  print("\t "n, end' ‘ ’)

print() V cost = 0 L(g) sorted(costs.keys())

  print(g" \t", end' ‘ ’)
  L(n) cols
     V y = res[g][n]
     I y != 0
        print(y, end' ‘ ’)
     cost += y * costs[g][n]
     print("\t", end' ‘ ’)
  print()

print("\n\nTotal Cost = "cost)</lang>

Output:
         A       B       C       D       E
W                        50
X                        20              40
Y        30      20
Z                                30      20


Total Cost =  3130

C

Translation of: Kotlin

<lang c>#include <stdio.h>

  1. include <limits.h>
  1. define TRUE 1
  2. define FALSE 0
  3. define N_ROWS 4
  4. define N_COLS 5

typedef int bool;

int supply[N_ROWS] = { 50, 60, 50, 50 }; int demand[N_COLS] = { 30, 20, 70, 30, 60 };

int costs[N_ROWS][N_COLS] = {

   { 16, 16, 13, 22, 17 },
   { 14, 14, 13, 19, 15 },
   { 19, 19, 20, 23, 50 },
   { 50, 12, 50, 15, 11 }

};

bool row_done[N_ROWS] = { FALSE }; bool col_done[N_COLS] = { FALSE };

void diff(int j, int len, bool is_row, int res[3]) {

   int i, c, min1 = INT_MAX, min2 = min1, min_p = -1;
   for (i = 0; i < len; ++i) {
       if((is_row) ? col_done[i] : row_done[i]) continue;
       c = (is_row) ? costs[j][i] : costs[i][j];
       if (c < min1) {
           min2 = min1;
           min1 = c;
           min_p = i;
       }
       else if (c < min2) min2 = c;
   }
   res[0] = min2 - min1; res[1] = min1; res[2] = min_p;

}

void max_penalty(int len1, int len2, bool is_row, int res[4]) {

   int i, pc = -1, pm = -1, mc = -1, md = INT_MIN;
   int res2[3];
   for (i = 0; i < len1; ++i) {
       if((is_row) ? row_done[i] : col_done[i]) continue;
       diff(i, len2, is_row, res2);
       if (res2[0] > md) {
           md = res2[0];  /* max diff */
           pm = i;        /* pos of max diff */
           mc = res2[1];  /* min cost */
           pc = res2[2];  /* pos of min cost */
       }
   }
   if (is_row) {
       res[0] = pm; res[1] = pc;
   }
   else {
       res[0] = pc; res[1] = pm;
   }
   res[2] = mc; res[3] = md;

}

void next_cell(int res[4]) {

   int i, res1[4], res2[4];
   max_penalty(N_ROWS, N_COLS, TRUE, res1);
   max_penalty(N_COLS, N_ROWS, FALSE, res2);
   if (res1[3] == res2[3]) {
       if (res1[2] < res2[2])
           for (i = 0; i < 4; ++i) res[i] = res1[i];
       else
           for (i = 0; i < 4; ++i) res[i] = res2[i];
       return;
   }
   if (res1[3] > res2[3])
       for (i = 0; i < 4; ++i) res[i] = res2[i];
   else
       for (i = 0; i < 4; ++i) res[i] = res1[i];

}

int main() {

   int i, j, r, c, q, supply_left = 0, total_cost = 0, cell[4];
   int results[N_ROWS][N_COLS] = { 0 };
   for (i = 0; i < N_ROWS; ++i) supply_left += supply[i];
   while (supply_left > 0) {
       next_cell(cell);
       r = cell[0];
       c = cell[1];
       q = (demand[c] <= supply[r]) ? demand[c] : supply[r];
       demand[c] -= q;
       if (!demand[c]) col_done[c] = TRUE;
       supply[r] -= q;
       if (!supply[r]) row_done[r] = TRUE;
       results[r][c] = q;
       supply_left -= q;
       total_cost += q * costs[r][c];
   }
   printf("    A   B   C   D   E\n");
   for (i = 0; i < N_ROWS; ++i) {
       printf("%c", 'W' + i);
       for (j = 0; j < N_COLS; ++j) printf("  %2d", results[i][j]);
       printf("\n");
   }
   printf("\nTotal cost = %d\n", total_cost);
   return 0;

}</lang>

Output:
    A   B   C   D   E
W   0   0  50   0   0
X  30   0  20   0  10
Y   0  20   0  30   0
Z   0   0   0   0  50

Total cost = 3100

If the program is changed to this (to accomodate the second Ruby example): <lang go>#include <stdio.h>

  1. include <limits.h>
  1. define TRUE 1
  2. define FALSE 0
  3. define N_ROWS 5
  4. define N_COLS 5

typedef int bool;

int supply[N_ROWS] = { 461, 277, 356, 488, 393 }; int demand[N_COLS] = { 278, 60, 461, 116, 1060 };

int costs[N_ROWS][N_COLS] = {

   { 46,  74,  9, 28, 99 },
   { 12,  75,  6, 36, 48 },
   { 35, 199,  4,  5, 71 },
   { 61,  81, 44, 88,  9 },
   { 85,  60, 14, 25, 79 }

};

// etc

int main() {

   // etc
   printf("     A    B    C    D    E\n");
   for (i = 0; i < N_ROWS; ++i) {
       printf("%c", 'V' + i);
       for (j = 0; j < N_COLS; ++j) printf("  %3d", results[i][j]);
       printf("\n");
   }
   printf("\nTotal cost = %d\n", total_cost);
   return 0;

}</lang>

then the output, which agrees with the Phix output but not with the Ruby output itself is:

     A    B    C    D    E
V    0    0  461    0    0
W  277    0    0    0    0
X    1    0    0    0  355
Y    0    0    0    0  488
Z    0   60    0  116  217

Total cost = 60748

C++

Translation of: Java

<lang cpp>#include <iostream>

  1. include <numeric>
  2. include <vector>

template <typename T> std::ostream &operator<<(std::ostream &os, const std::vector<T> &v) {

   auto it = v.cbegin();
   auto end = v.cend();
   os << '[';
   if (it != end) {
       os << *it;
       it = std::next(it);
   }
   while (it != end) {
       os << ", " << *it;
       it = std::next(it);
   }
   return os << ']';

}

std::vector<int> demand = { 30, 20, 70, 30, 60 }; std::vector<int> supply = { 50, 60, 50, 50 }; std::vector<std::vector<int>> costs = {

   {16, 16, 13, 22, 17},
   {14, 14, 13, 19, 15},
   {19, 19, 20, 23, 50},
   {50, 12, 50, 15, 11}

};

int nRows = supply.size(); int nCols = demand.size();

std::vector<bool> rowDone(nRows, false); std::vector<bool> colDone(nCols, false); std::vector<std::vector<int>> result(nRows, std::vector<int>(nCols, 0));

std::vector<int> diff(int j, int len, bool isRow) {

   int min1 = INT_MAX;
   int min2 = INT_MAX;
   int minP = -1;
   for (int i = 0; i < len; i++) {
       if (isRow ? colDone[i] : rowDone[i]) {
           continue;
       }
       int c = isRow
           ? costs[j][i]
           : costs[i][j];
       if (c < min1) {
           min2 = min1;
           min1 = c;
           minP = i;
       } else if (c < min2) {
           min2 = c;
       }
   }
   return { min2 - min1, min1, minP };

}

std::vector<int> maxPenalty(int len1, int len2, bool isRow) {

   int md = INT_MIN;
   int pc = -1;
   int pm = -1;
   int mc = -1;
   for (int i = 0; i < len1; i++) {
       if (isRow ? rowDone[i] : colDone[i]) {
           continue;
       }
       std::vector<int> res = diff(i, len2, isRow);
       if (res[0] > md) {
           md = res[0];    // max diff
           pm = i;         // pos of max diff
           mc = res[1];    // min cost
           pc = res[2];    // pos of min cost
       }
   }
   return isRow
       ? std::vector<int> { pm, pc, mc, md }
   : std::vector<int>{ pc, pm, mc, md };

}

std::vector<int> nextCell() {

   auto res1 = maxPenalty(nRows, nCols, true);
   auto res2 = maxPenalty(nCols, nRows, false);
   if (res1[3] == res2[3]) {
       return res1[2] < res2[2]
           ? res1
           : res2;
   }
   return res1[3] > res2[3]
       ? res2
       : res1;

}

int main() {

   int supplyLeft = std::accumulate(supply.cbegin(), supply.cend(), 0, [](int a, int b) { return a + b; });
   int totalCost = 0;
   while (supplyLeft > 0) {
       auto cell = nextCell();
       int r = cell[0];
       int c = cell[1];
       int quantity = std::min(demand[c], supply[r]);
       demand[c] -= quantity;
       if (demand[c] == 0) {
           colDone[c] = true;
       }
       supply[r] -= quantity;
       if (supply[r] == 0) {
           rowDone[r] = true;
       }
       result[r][c] = quantity;
       supplyLeft -= quantity;
       totalCost += quantity * costs[r][c];
   }
   for (auto &a : result) {
       std::cout << a << '\n';
   }
   std::cout << "Total cost: " << totalCost;
   return 0;

}</lang>

Output:
[0, 0, 50, 0, 0]
[30, 0, 20, 0, 10]
[0, 20, 0, 30, 0]
[0, 0, 0, 0, 50]
Total cost: 3100

D

Strongly typed version (but K is not divided in Task and Contractor types to keep code simpler).

Translation of: Python

<lang d>void main() {

   import std.stdio, std.string, std.algorithm, std.range;
   enum K { A, B, C, D, E,  X, Y, Z, W }
   immutable int[K][K] costs = cast() //**
       [K.W: [K.A: 16, K.B: 16, K.C: 13, K.D: 22, K.E: 17],
        K.X: [K.A: 14, K.B: 14, K.C: 13, K.D: 19, K.E: 15],
        K.Y: [K.A: 19, K.B: 19, K.C: 20, K.D: 23, K.E: 50],
        K.Z: [K.A: 50, K.B: 12, K.C: 50, K.D: 15, K.E: 11]];
   int[K] demand, supply;
   with (K)
       demand = [A: 30, B: 20, C: 70, D: 30, E: 60],
       supply = [W: 50, X: 60, Y: 50, Z: 50];
   auto cols = demand.keys.sort().release;
   auto res = costs.byKey.zip((int[K]).init.repeat).assocArray;
   K[][K] g;
   foreach (immutable x; supply.byKey)
       g[x] = costs[x].keys.schwartzSort!(k => cast()costs[x][k]) //**
              .release;
   foreach (immutable x; demand.byKey)
       g[x] = costs.keys.schwartzSort!(k=> cast()costs[k][x]).release;
   while (g.length) {
       int[K] d, s;
       foreach (immutable x; demand.byKey)
           d[x] = g[x].length > 1 ?
                  costs[g[x][1]][x] - costs[g[x][0]][x] :
                  costs[g[x][0]][x];
       foreach (immutable x; supply.byKey)
           s[x] = g[x].length > 1 ?
                  costs[x][g[x][1]] - costs[x][g[x][0]] :
                  costs[x][g[x][0]];
       auto f = d.keys.minPos!((a,b) => d[a] > d[b])[0];
       auto t = s.keys.minPos!((a,b) => s[a] > s[b])[0];
       if (d[f] > s[t]) {
           t = f;
           f = g[f][0];
       } else {
           f = t;
           t = g[t][0];
       }
       immutable v = min(supply[f], demand[t]);
       res[f][t] += v;
       demand[t] -= v;
       if (demand[t] == 0) {
           foreach (immutable k, immutable n; supply)
               if (n != 0)
                   g[k] = g[k].remove!(c => c == t);
           g.remove(t);
           demand.remove(t);
       }
       supply[f] -= v;
       if (supply[f] == 0) {
           foreach (immutable k, immutable n; demand)
               if (n != 0)
                   g[k] = g[k].remove!(c => c == f);
           g.remove(f);
           supply.remove(f);
       }
   }
   writefln("%-(\t%s%)", cols);
   auto cost = 0;
   foreach (immutable c; costs.keys.sort().release) {
       write(c, '\t');
       foreach (immutable n; cols) {
           if (n in res[c]) {
               immutable y = res[c][n];
               if (y != 0) {
                   y.write;
                   cost += y * costs[c][n];
               }
           }
           '\t'.write;
       }
       writeln;
   }
   writeln("\nTotal Cost = ", cost);

}</lang>

Output:
	A	B	C	D	E
X	30		20		10	
Y		20		30		
Z					50	
W			50			

Total Cost = 3100

Go

Translation of: Kotlin

<lang go>package main

import (

   "fmt"
   "math"

)

var supply = []int{50, 60, 50, 50} var demand = []int{30, 20, 70, 30, 60}

var costs = make([][]int, 4)

var nRows = len(supply) var nCols = len(demand)

var rowDone = make([]bool, nRows) var colDone = make([]bool, nCols) var results = make([][]int, nRows)

func init() {

   costs[0] = []int{16, 16, 13, 22, 17}
   costs[1] = []int{14, 14, 13, 19, 15}
   costs[2] = []int{19, 19, 20, 23, 50}
   costs[3] = []int{50, 12, 50, 15, 11}
   for i := 0; i < len(results); i++ {
       results[i] = make([]int, nCols)
   }

}

func nextCell() []int {

   res1 := maxPenalty(nRows, nCols, true)
   res2 := maxPenalty(nCols, nRows, false)
   switch {
   case res1[3] == res2[3]:
       if res1[2] < res2[2] {
           return res1
       } else {
           return res2
       }
   case res1[3] > res2[3]:
       return res2
   default:
       return res1
   }

}

func diff(j, l int, isRow bool) []int {

   min1 := math.MaxInt32
   min2 := min1
   minP := -1
   for i := 0; i < l; i++ {
       var done bool
       if isRow {
           done = colDone[i]
       } else {
           done = rowDone[i]
       }
       if done {
           continue
       }
       var c int
       if isRow {
           c = costs[j][i]
       } else {
           c = costs[i][j]
       }
       if c < min1 {
           min2, min1, minP = min1, c, i
       } else if c < min2 {
           min2 = c
       }
   }
   return []int{min2 - min1, min1, minP}

}

func maxPenalty(len1, len2 int, isRow bool) []int {

   md := math.MinInt32
   pc, pm, mc := -1, -1, -1
   for i := 0; i < len1; i++ {
       var done bool
       if isRow {
           done = rowDone[i]
       } else {
           done = colDone[i]
       }
       if done {
           continue
       }
       res := diff(i, len2, isRow)
       if res[0] > md {
           md = res[0]  // max diff
           pm = i       // pos of max diff
           mc = res[1]  // min cost
           pc = res[2]  // pos of min cost
       }
   }
   if isRow {
       return []int{pm, pc, mc, md}
   }
   return []int{pc, pm, mc, md}

}

func main() {

   supplyLeft := 0
   for i := 0; i < len(supply); i++ {
       supplyLeft += supply[i]
   }
   totalCost := 0
   for supplyLeft > 0 {
       cell := nextCell()
       r, c := cell[0], cell[1]
       q := demand[c]
       if q > supply[r] {
           q = supply[r]
       }
       demand[c] -= q
       if demand[c] == 0 {
           colDone[c] = true
       }
       supply[r] -= q
       if supply[r] == 0 {
           rowDone[r] = true
       }
       results[r][c] = q
       supplyLeft -= q
       totalCost += q * costs[r][c]
   }
   fmt.Println("    A   B   C   D   E")
   for i, result := range results {
       fmt.Printf("%c", 'W' + i)
       for _, item := range result {
           fmt.Printf("  %2d", item)
       }
       fmt.Println()
   }
   fmt.Println("\nTotal cost =", totalCost)

}</lang>

Output:
    A   B   C   D   E
W   0   0  50   0   0
X  30   0  20   0  10
Y   0  20   0  30   0
Z   0   0   0   0  50

Total cost = 3100

If the program is changed as follows to accomodate the second Ruby example: <lang go>package main

import (

   "fmt"
   "math"

)

var supply = []int{461, 277, 356, 488, 393} var demand = []int{278, 60, 461, 116, 1060}

var costs = make([][]int, nRows)

var nRows = len(supply) var nCols = len(demand)

var rowDone = make([]bool, nRows) var colDone = make([]bool, nCols) var results = make([][]int, nRows)

func init() {

   costs[0] = []int{46, 74, 9, 28, 99}
   costs[1] = []int{12, 75, 6, 36, 48}
   costs[2] = []int{35, 199, 4, 5, 71}
   costs[3] = []int{61, 81, 44, 88, 9}
   costs[4] = []int{85, 60, 14, 25, 79}
   for i := 0; i < len(results); i++ {
       results[i] = make([]int, nCols)
   }

}

// etc

func main() {

   // etc
   fmt.Println("     A    B    C    D    E")
   for i, result := range results {
       fmt.Printf("%c", 'V'+i)
       for _, item := range result {
           fmt.Printf("  %3d", item)
       }
       fmt.Println()
   }
   fmt.Println("\nTotal cost =", totalCost)

}</lang>

then the output, which agrees with the C and Phix output but not with the Ruby output itself, is:

     A    B    C    D    E
V    0    0  461    0    0
W  277    0    0    0    0
X    1    0    0    0  355
Y    0    0    0    0  488
Z    0   60    0  116  217

Total cost = 60748

J

Implementation:

<lang J>vam=:1 :0

 exceeding=. 0 <. -&(+/)
 D=. x,y exceeding x NB. x: demands
 S=. y,x exceeding y NB. y: sources
 C=. (m,.0),0        NB. m: costs
 B=. 1+>./,C         NB. bigger than biggest cost
 mincost=. <./@-.&0  NB. smallest non-zero cost
 penalty=. |@(B * 2 -/@{. /:~ -. 0:)"1 - mincost"1
 R=. C*0
 while. 0 < +/D,S do.
   pS=. penalty C
   pD=. penalty |:C
   if. pS >&(>./) pD do.
     row=. (i. >./) pS
     col=. (i. mincost) row { C
   else.
     col=. (i. >./) pD
     row=. (i. mincost) col {"1 C
   end.
   n=. (row{S) <. col{D
   S=. (n-~row{S) row} S
   D=. (n-~col{D) col} D
   C=. C * S *&*/ D
   R=. n (<row,col)} R
 end.
 _1 _1 }. R

)</lang>

Note that for our penalty we are using the difference between the two smallest relevant costs multiplied by 1 larger than the highest represented cost and we subtract from that multiple the smallest relevant cost. This gives us the tiebreaker mechanism currently specified for this task.

Task example:

<lang J>demand=: 30 20 70 30 60 src=: 50 60 50 50 cost=: 16 16 13 22 17,14 14 13 19 15,19 19 20 23 50,:50 12 50 15 11

  demand cost vam src
0  0 50  0  0

30 0 20 0 10

0 20  0 30  0
0  0  0  0 50</lang>

Java

Works with: Java version 8

<lang java>import java.util.Arrays; import static java.util.Arrays.stream; import java.util.concurrent.*;

public class VogelsApproximationMethod {

   final static int[] demand = {30, 20, 70, 30, 60};
   final static int[] supply = {50, 60, 50, 50};
   final static int[][] costs = {{16, 16, 13, 22, 17}, {14, 14, 13, 19, 15},
   {19, 19, 20, 23, 50}, {50, 12, 50, 15, 11}};
   final static int nRows = supply.length;
   final static int nCols = demand.length;
   static boolean[] rowDone = new boolean[nRows];
   static boolean[] colDone = new boolean[nCols];
   static int[][] result = new int[nRows][nCols];
   static ExecutorService es = Executors.newFixedThreadPool(2);
   public static void main(String[] args) throws Exception {
       int supplyLeft = stream(supply).sum();
       int totalCost = 0;
       while (supplyLeft > 0) {
           int[] cell = nextCell();
           int r = cell[0];
           int c = cell[1];
           int quantity = Math.min(demand[c], supply[r]);
           demand[c] -= quantity;
           if (demand[c] == 0)
               colDone[c] = true;
           supply[r] -= quantity;
           if (supply[r] == 0)
               rowDone[r] = true;
           result[r][c] = quantity;
           supplyLeft -= quantity;
           totalCost += quantity * costs[r][c];
       }
       stream(result).forEach(a -> System.out.println(Arrays.toString(a)));
       System.out.println("Total cost: " + totalCost);
       es.shutdown();
   }
   static int[] nextCell() throws Exception {
       Future<int[]> f1 = es.submit(() -> maxPenalty(nRows, nCols, true));
       Future<int[]> f2 = es.submit(() -> maxPenalty(nCols, nRows, false));
       int[] res1 = f1.get();
       int[] res2 = f2.get();
       if (res1[3] == res2[3])
           return res1[2] < res2[2] ? res1 : res2;
       return (res1[3] > res2[3]) ? res2 : res1;
   }
   static int[] diff(int j, int len, boolean isRow) {
       int min1 = Integer.MAX_VALUE, min2 = Integer.MAX_VALUE;
       int minP = -1;
       for (int i = 0; i < len; i++) {
           if (isRow ? colDone[i] : rowDone[i])
               continue;
           int c = isRow ? costs[j][i] : costs[i][j];
           if (c < min1) {
               min2 = min1;
               min1 = c;
               minP = i;
           } else if (c < min2)
               min2 = c;
       }
       return new int[]{min2 - min1, min1, minP};
   }
   static int[] maxPenalty(int len1, int len2, boolean isRow) {
       int md = Integer.MIN_VALUE;
       int pc = -1, pm = -1, mc = -1;
       for (int i = 0; i < len1; i++) {
           if (isRow ? rowDone[i] : colDone[i])
               continue;
           int[] res = diff(i, len2, isRow);
           if (res[0] > md) {
               md = res[0];  // max diff
               pm = i;       // pos of max diff
               mc = res[1];  // min cost
               pc = res[2];  // pos of min cost
           }
       }
       return isRow ? new int[]{pm, pc, mc, md} : new int[]{pc, pm, mc, md};
   }

}</lang>

[0, 0, 50, 0, 0]
[30, 0, 20, 0, 10]
[0, 20, 0, 30, 0]
[0, 0, 0, 0, 50]
Total cost: 3100

Julia

This solution is designed to scale well to large numbers of suppliers and customers. The opportunity cost matrix is sorted only once, and penalties are recalculated only when the relevant resources are exhausted. The solution is stored in a sparse matrix, because the number of components to a solution is less than s+c (suppliers + customers) but the size of the matrix is s*c.

This solution does not impose the requirement that the problem be balanced. vogel will iterate until either supply or demand is exhausted and provide a low-cost result even when the problem is unbalanced, whether this result is a good solution is left for the user to decide. The function isbalanced can be used to test whether a given problem is balanced.

Types

The immutable type TProblem stores the problem's parameters. It includes permutation matrices that allow the rows and columns of the total opportunity cost matrix to be sorted as needed.

Resource stores the currently available quantity of a given supply or demand as well as its penalty, cost, and some meta-data. isavailable indicates whether any of the given resource remains. isless is designed to make the currently most usable resource appear as a maximum compared to other resources. <lang Julia> immutable TProblem{T<:Integer,U<:String}

   sd::Array{Array{T,1},1}
   toc::Array{T,2}
   labels::Array{Array{U,1},1}
   tsort::Array{Array{T,2}, 1}

end

function TProblem{T<:Integer,U<:String}(s::Array{T,1},

                                       d::Array{T,1},
                                       toc::Array{T,2},
                                       slab::Array{U,1},
                                       dlab::Array{U,1})
   scnt = length(s)
   dcnt = length(d)
   size(toc) = (scnt,dcnt) || error("Supply, Demand, TOC Size Mismatch")
   length(slab) == scnt || error("Supply Label Size Labels")
   length(dlab) == dcnt || error("Demand Label Size Labels")
   0 <= minimum(s) || error("Negative Supply Value")
   0 <= minimum(d) || error("Negative Demand Value")
   sd = Array{T,1}[]
   push!(sd, s)
   push!(sd, d)
   labels = Array{U,1}[]
   push!(labels, slab)
   push!(labels, dlab)
   tsort = Array{T,2}[]
   push!(tsort, mapslices(sortperm, toc, 2))
   push!(tsort, mapslices(sortperm, toc, 1))
   TProblem(sd, toc, labels, tsort)

end isbalanced(tp::TProblem) = sum(tp.sd[1]) == sum(tp.sd[2])

type Resource{T<:Integer}

   dim::T
   i::T
   quant::T
   l::T
   m::T
   p::T
   q::T

end function Resource{T<:Integer}(dim::T, i::T, quant::T)

   zed = zero(T)
   Resource(dim, i, quant, zed, zed, zed, zed)

end

isavailable(r::Resource) = 0 < r.quant Base.isless(a::Resource, b::Resource) = a.p < b.p || (a.p == b.p && b.q < a.q) </lang>

Functions

penalize! updates the penalty, cost and some meta-data of lists of supplies and demands. It short-circuits to avoid recalculating these values when the relevant resources remain available. Sorting is provided by the permutation matrices in TProblem.

vogel implements Vogel's approximation method on a TProblem. It is somewhat straightforward, given the types and penalize!. <lang Julia> function penalize!{T<:Integer,U<:String}(sd::Array{Array{Resource{T},1},1},

                                        tp::TProblem{T,U})
   avail = BitArray{1}[]
   for dim in 2:-1:1
       push!(avail, bitpack(map(isavailable, sd[dim])))
   end
   for dim in 1:2, r in sd[dim]
       if r.quant == 0
           r.l = r.m = r.p = r.q = 0
           continue
       end
       r.l == 0 || !avail[dim][r.l] || !avail[dim][r.m] || continue
       rsort = filter(x->avail[dim][x], vec(slicedim(tp.tsort[dim],dim,r.i)))
       rcost = vec(slicedim(tp.toc, dim, r.i))[rsort]
       if length(rsort) == 1
           r.l = r.m = rsort[1]
           r.p = r.q = rcost[1]
       else
           r.l, r.m = rsort[1:2]
           r.p = rcost[2] - rcost[1]
           r.q = rcost[1]
       end
   end
   nothing

end

function vogel{T<:Integer,U<:String}(tp::TProblem{T,U})

   sdcnt = collect(size(tp.toc))
   sol = spzeros(T, sdcnt[1], sdcnt[2])
   sd = Array{Resource{T},1}[]
   for dim in 1:2
       push!(sd, [Resource(dim, i, tp.sd[dim][i]) for i in 1:sdcnt[dim]])
   end
   while any(map(isavailable, sd[1])) && any(map(isavailable, sd[2]))
       penalize!(sd, tp)
       a = maximum([sd[1], sd[2]])
       b = sd[rem1(a.dim+1,2)][a.l]
       if a.dim == 2 # swap to make a supply and b demand
           a, b = b, a
       end
       expend = min(a.quant, b.quant)        
       sol[a.i, b.i] = expend
       a.quant -= expend
       b.quant -= expend
   end
   return sol

end </lang>

Main <lang Julia>using Printf

sup = [50, 60, 50, 50] slab = ["W", "X", "Y", "Z"] dem = [30, 20, 70, 30, 60] dlab = ["A", "B", "C", "D", "E"] c = [16 16 13 22 17;

    14 14 13 19 15;
    19 19 20 23 50;
    50 12 50 15 11]

tp = TProblem(sup, dem, c, slab, dlab) sol = vogel(tp) cost = sum(tp.toc .* sol)

println("The solution is:") print(" ") for s in tp.labels[2]

   print(@sprintf "%4s" s)

end println() for i in 1:size(tp.toc)[1]

   print(@sprintf "    %4s" tp.labels[1][i])
   for j in 1:size(tp.toc)[2]
       print(@sprintf "%4d" sol[i,j])
   end

println() end println("The total cost is: ", cost) </lang>

Output:
The solution is:
           A   B   C   D   E
       W   0   0  50   0   0
       X  10  20  20   0  10
       Y  20   0   0  30   0
       Z   0   0   0   0  50
The total cost is:  3100

Kotlin

Translation of: Java

<lang scala>// version 1.1.3

val supply = intArrayOf(50, 60, 50, 50) val demand = intArrayOf(30, 20, 70, 30, 60)

val costs = arrayOf(

   intArrayOf(16, 16, 13, 22, 17),
   intArrayOf(14, 14, 13, 19, 15),
   intArrayOf(19, 19, 20, 23, 50),
   intArrayOf(50, 12, 50, 15, 11)

)

val nRows = supply.size val nCols = demand.size

val rowDone = BooleanArray(nRows) val colDone = BooleanArray(nCols) val results = Array(nRows) { IntArray(nCols) }

fun nextCell(): IntArray {

   val res1 = maxPenalty(nRows, nCols, true)
   val res2 = maxPenalty(nCols, nRows, false)
   if (res1[3] == res2[3]) 
       return if (res1[2] < res2[2]) res1 else res2
   return if (res1[3] > res2[3]) res2 else res1

}

fun diff(j: Int, len: Int, isRow: Boolean): IntArray {

   var min1 = Int.MAX_VALUE
   var min2 = min1
   var minP = -1
   for (i in 0 until len) {
       val done = if (isRow) colDone[i] else rowDone[i]
       if (done) continue
       val c = if (isRow) costs[j][i] else costs[i][j]
       if (c < min1) {
           min2 = min1
           min1 = c
           minP = i
       }
       else if (c < min2) min2 = c
   }
   return intArrayOf(min2 - min1, min1, minP)

}

fun maxPenalty(len1: Int, len2: Int, isRow: Boolean): IntArray {

   var md = Int.MIN_VALUE
   var pc = -1
   var pm = -1
   var mc = -1
   for (i in 0 until len1) {
       val done = if (isRow) rowDone[i] else colDone[i]
       if (done) continue
       val res = diff(i, len2, isRow)
       if (res[0] > md) {
           md = res[0]  // max diff
           pm = i       // pos of max diff
           mc = res[1]  // min cost
           pc = res[2]  // pos of min cost
       }
   }
   return if (isRow) intArrayOf(pm, pc, mc, md) else
                     intArrayOf(pc, pm, mc, md)

}

fun main(args: Array<String>) {

   var supplyLeft = supply.sum()
   var totalCost = 0
   while (supplyLeft > 0) {
       val cell = nextCell()
       val r = cell[0]
       val c = cell[1]
       val q = minOf(demand[c], supply[r])
       demand[c] -= q
       if (demand[c] == 0) colDone[c] = true
       supply[r] -= q
       if (supply[r] == 0) rowDone[r] = true
       results[r][c] = q
       supplyLeft -= q
       totalCost += q * costs[r][c]
   }
   println("    A   B   C   D   E")
   for ((i, result) in results.withIndex()) {
       print(('W'.toInt() + i).toChar())
       for (item in result) print("  %2d".format(item))
       println()
   }
   println("\nTotal Cost = $totalCost")

}</lang>

Output:
    A   B   C   D   E
W   0   0  50   0   0
X  30   0  20   0  10
Y   0  20   0  30   0
Z   0   0   0   0  50

Total Cost = 3100

Lua

Translation of: Kotlin

<lang lua>function initArray(n,v)

   local tbl = {}
   for i=1,n do
       table.insert(tbl,v)
   end
   return tbl

end

function initArray2(m,n,v)

   local tbl = {}
   for i=1,m do
       table.insert(tbl,initArray(n,v))
   end
   return tbl

end

supply = {50, 60, 50, 50} demand = {30, 20, 70, 30, 60} costs = {

   {16, 16, 13, 22, 17},
   {14, 14, 13, 19, 15},
   {19, 19, 20, 23, 50},
   {50, 12, 50, 15, 11}

}

nRows = table.getn(supply) nCols = table.getn(demand)

rowDone = initArray(nRows, false) colDone = initArray(nCols, false) results = initArray2(nRows, nCols, 0)

function diff(j,le,isRow)

   local min1 = 100000000
   local min2 = min1
   local minP = -1
   for i=1,le do
       local done = false
       if isRow then
           done = colDone[i]
       else
           done = rowDone[i]
       end
       if not done then
           local c = 0
           if isRow then
               c = costs[j][i]
           else
               c = costs[i][j]
           end
           if c < min1 then
               min2 = min1
               min1 = c
               minP = i
           elseif c < min2 then
               min2 = c
           end
       end
   end
   return {min2 - min1, min1, minP}

end

function maxPenalty(len1,len2,isRow)

   local md = -100000000
   local pc = -1
   local pm = -1
   local mc = -1
   for i=1,len1 do
       local done = false
       if isRow then
           done = rowDone[i]
       else
           done = colDone[i]
       end
       if not done then
           local res = diff(i, len2, isRow)
           if res[1] > md then
               md = res[1] -- max diff
               pm = i      -- pos of max diff
               mc = res[2] -- min cost
               pc = res[3] -- pos of min cost
           end
       end
   end
   if isRow then
       return {pm, pc, mc, md}
   else
       return {pc, pm, mc, md}
   end

end

function nextCell()

   local res1 = maxPenalty(nRows, nCols, true)
   local res2 = maxPenalty(nCols, nRows, false)
   if res1[4] == res2[4] then
       if res1[3] < res2[3] then
           return res1
       else
           return res2
       end
   else
       if res1[4] > res2[4] then
           return res2
       else
           return res1
       end
   end

end

function main()

   local supplyLeft = 0
   for i,v in pairs(supply) do
       supplyLeft = supplyLeft + v
   end
   local totalCost = 0
   while supplyLeft > 0 do
       local cell = nextCell()
       local r = cell[1]
       local c = cell[2]
       local q = math.min(demand[c], supply[r])
       demand[c] = demand[c] - q
       if demand[c] == 0 then
           colDone[c] = true
       end
       supply[r] = supply[r] - q
       if supply[r] == 0 then
           rowDone[r] = true
       end
       results[r][c] = q
       supplyLeft = supplyLeft - q
       totalCost = totalCost + q * costs[r][c]
   end
   print("    A   B   C   D   E")
   local labels = {'W','X','Y','Z'}
   for i,r in pairs(results) do
       io.write(labels[i])
       for j,c in pairs(r) do
           io.write(string.format("  %2d", c))
       end
       print()
   end
   print("Total Cost = " .. totalCost)

end

main()</lang>

Output:
    A   B   C   D   E
W   0   0  50   0   0
X  30   0  20   0  10
Y   0  20   0  30   0
Z   0   0   0   0  50
Total Cost = 3100

Nim

Translation of: Kotlin

<lang Nim>import math, sequtils, strutils

var

 supply = [50, 60, 50, 50]
 demand = [30, 20, 70, 30, 60]

let

 costs = [[16, 16, 13, 22, 17],
          [14, 14, 13, 19, 15],
          [19, 19, 20, 23, 50],
          [50, 12, 50, 15, 11]]
 nRows = supply.len
 nCols = demand.len

var

 rowDone = newSeq[bool](nRows)
 colDone = newSeq[bool](nCols)
 results = newSeqWith(nRows, newSeq[int](nCols))


proc diff(j, len: int; isRow: bool): array[3, int] =

 var min1, min2 = int.high
 var minP = -1
 for i in 0..<len:
   let done = if isRow: colDone[i] else: rowDone[i]
   if done: continue
   let c = if isRow: costs[j][i] else: costs[i][j]
   if c < min1:
     min2 = min1
     min1 = c
     minP = i
   elif c < min2:
     min2 = c
 result = [min2 - min1, min1, minP]


proc maxPenalty(len1, len2: int; isRow: bool): array[4, int] =

 var md = int.low
 var pc, pm, mc = -1
 for i in 0..<len1:
   let done = if isRow: rowDone[i] else: colDone[i]
   if done: continue
   let res = diff(i, len2, isRow)
   if res[0] > md:
     md = res[0]  # max diff
     pm = i       # pos of max diff
     mc = res[1]  # min cost
     pc = res[2]  # pos of min cost
 result = if isRow: [pm, pc, mc, md] else: [pc, pm, mc, md]


proc nextCell(): array[4, int] =

 let res1 = maxPenalty(nRows, nCols, true)
 let res2 = maxPenalty(nCols, nRows, false)
 if res1[3] == res2[3]:
   return if res1[2] < res2[2]: res1 else: res2
 result = if res1[3] > res2[3]: res2 else: res1


when isMainModule:

 var supplyLeft = sum(supply)
 var totalCost = 0
 while supplyLeft > 0:
   let cell = nextCell()
   let r = cell[0]
   let c = cell[1]
   let q = min(demand[c], supply[r])
   dec demand[c], q
   if demand[c] == 0: colDone[c] = true
   dec supply[r], q
   if supply[r] == 0: rowDone[r] = true
   results[r][c] = q
   dec supplyLeft, q
   inc totalCost, q * costs[r][c]
 echo "    A   B   C   D   E"
 for i, result in results:
   stdout.write chr(i + ord('W'))
   for item in result:
     stdout.write "  ", ($item).align(2)
   echo()
 echo "\nTotal cost = ", totalCost</lang>
Output:
    A   B   C   D   E
W   0   0  50   0   0
X  30   0  20   0  10
Y   0  20   0  30   0
Z   0   0   0   0  50

Total cost = 3100

Perl

<lang perl>#!/usr/bin/perl

use strict; # https://rosettacode.org/wiki/Vogel%27s_approximation_method use warnings; use List::AllUtils qw( max_by nsort_by min );

my $data = <<END; A=30 B=20 C=70 D=30 E=60 W=50 X=60 Y=50 Z=50 AW=16 BW=16 CW=13 DW=22 EW=17 AX=14 BX=14 CX=13 DX=19 EX=15 AY=19 BY=19 CY=20 DY=23 EY=50 AZ=50 BZ=12 CZ=50 DZ=15 EZ=11 END my $table = sprintf +('%4s' x 6 . "\n") x 5,

 map {my $t = $_; map "$_$t", , 'A' .. 'E' }  , 'W' .. 'Z';

my ($cost, %assign) = (0); while( $data =~ /\b\w=\d/ )

 {
 my @penalty;
 for ( $data =~ /\b(\w)=\d/g )
   {
   my @all = map /(\d+)/, nsort_by { /\d+/ && $& }
     grep { my ($t, $c) = /(.)(.)=/; $data =~ /\b$c=\d/ and $data =~ /\b$t=\d/ }
     $data =~ /$_\w=\d+|\w$_=\d+/g;
   push @penalty, [ $_, ($all[1] // 0) - $all[0] ];
   }
 my $rc = (max_by { $_->[1] } nsort_by
   { my $x = $_->[0]; $data =~ /(?:$x\w|\w$x)=(\d+)/ && $1 } @penalty)->[0];
 my @lowest = nsort_by { /\d+/ && $& }
   grep { my ($t, $c) = /(.)(.)=/; $data =~ /\b$c=\d/ and $data =~ /\b$t=\d/ }
   $data =~ /$rc\w=\d+|\w$rc=\d+/g;
 my ($t, $c) = $lowest[0] =~ /(.)(.)/;
 my $allocate = min $data =~ /\b[$t$c]=(\d+)/g;
 $table =~ s/$t$c/ sprintf "%2d", $allocate/e;
 $cost += $data =~ /$t$c=(\d+)/ && $1 * $allocate;
 $data =~ s/\b$_=\K\d+/ $& - $allocate ||  /e for $t, $c;
 }

print "cost $cost\n\n", $table =~ s/[A-Z]{2}/--/gr;</lang>

Output:
cost 3100

       A   B   C   D   E
   W  --  --  50  --  --
   X  30  --  20  --  10
   Y  --  20  --  30  --
   Z  --  --  --  --  50

Phix

See Transportation_problem#Phix for optimal results.

Translation of: YaBasic
Translation of: Go
with javascript_semantics
sequence supply = {50,60,50,50},
         demand = {30,20,70,30,60},
         costs = {{16,16,13,22,17},
                  {14,14,13,19,15},
                  {19,19,20,23,50},
                  {50,12,50,15,11}}
 
sequence row_done = repeat(false,length(supply)),
         col_done = repeat(false,length(demand))
 
function diff(integer j, leng, bool is_row)
integer min1 = #3FFFFFFF, min2 = min1, min_p = -1
    for i=1 to leng do
        if not iff(is_row?col_done:row_done)[i] then
            integer c = iff(is_row?costs[j,i]:costs[i,j])
            if c<min1 then
                min2 = min1
                min1 = c
                min_p = i
            elsif c<min2 then
                min2 = c
            end if
        end if
    end for
    return {min2-min1,min1,min_p,j}
end function
 
function max_penalty(integer len1, len2, bool is_row)
integer pc = -1, pm = -1, mc = -1, md = -#3FFFFFFF
    for i=1 to len1 do
        if not iff(is_row?row_done:col_done)[i] then
            sequence res2 = diff(i, len2, is_row)
            if res2[1]>md then
                {md,mc,pc,pm} = res2
            end if
        end if
    end for
    return {md,mc}&iff(is_row?{pm,pc}:{pc,pm})
end function
 
integer supply_left = sum(supply),
        total_cost = 0
 
sequence results = repeat(repeat(0,length(demand)),length(supply))
 
while supply_left>0 do
    sequence cell = min(max_penalty(length(supply), length(demand), true),
                        max_penalty(length(demand), length(supply), false))
    integer {{},{},r,c} = cell,
            q = min(demand[c], supply[r]) 
    demand[c] -= q
    col_done[c] = (demand[c]==0)
    supply[r] -= q
    row_done[r] = (supply[r]==0)
    results[r, c] = q
    supply_left -= q
    total_cost += q * costs[r, c]
end while
 
printf(1,"     A   B   C   D   E\n")
for i=1 to length(supply) do
    printf(1,"%c ",'Z'-length(supply)+i)
    for j=1 to length(demand) do
        printf(1,"%4d",results[i,j])
    end for
    printf(1,"\n")
end for
printf(1,"\nTotal cost = %d\n", total_cost)
Output:
     A   B   C   D   E
W    0   0  50   0   0
X   30   0  20   0  10
Y    0  20   0  30   0
Z    0   0   0   0  50

Total cost = 3100

Using the sample from Ruby:

sequence supply = {461, 277, 356, 488,   393},
         demand = {278, 60, 461, 116, 1060},
         costs  = {{46, 74,  9, 28, 99},
                   {12, 75,  6, 36, 48},
                   {35, 199, 4,  5, 71},
                   {61, 81, 44, 88,  9},
                   {85, 60, 14, 25, 79}}
Output:

Note this agrees with C and Go but not Ruby

     A   B   C   D   E
V    0   0 461   0   0
W  277   0   0   0   0
X    1   0   0   0 355
Y    0   0   0   0 488
Z    0  60   0 116 217

Total cost = 60748

Python

Translation of: Ruby

<lang python>from collections import defaultdict

costs = {'W': {'A': 16, 'B': 16, 'C': 13, 'D': 22, 'E': 17},

         'X': {'A': 14, 'B': 14, 'C': 13, 'D': 19, 'E': 15},
         'Y': {'A': 19, 'B': 19, 'C': 20, 'D': 23, 'E': 50},
         'Z': {'A': 50, 'B': 12, 'C': 50, 'D': 15, 'E': 11}}

demand = {'A': 30, 'B': 20, 'C': 70, 'D': 30, 'E': 60} cols = sorted(demand.iterkeys()) supply = {'W': 50, 'X': 60, 'Y': 50, 'Z': 50} res = dict((k, defaultdict(int)) for k in costs) g = {} for x in supply:

   g[x] = sorted(costs[x].iterkeys(), key=lambda g: costs[x][g])

for x in demand:

   g[x] = sorted(costs.iterkeys(), key=lambda g: costs[g][x])

while g:

   d = {}
   for x in demand:
       d[x] = (costs[g[x][1]][x] - costs[g[x][0]][x]) if len(g[x]) > 1 else costs[g[x][0]][x]
   s = {}
   for x in supply:
       s[x] = (costs[x][g[x][1]] - costs[x][g[x][0]]) if len(g[x]) > 1 else costs[x][g[x][0]]
   f = max(d, key=lambda n: d[n])
   t = max(s, key=lambda n: s[n])
   t, f = (f, g[f][0]) if d[f] > s[t] else (g[t][0], t)
   v = min(supply[f], demand[t])
   res[f][t] += v
   demand[t] -= v
   if demand[t] == 0:
       for k, n in supply.iteritems():
           if n != 0:
               g[k].remove(t)
       del g[t]
       del demand[t]
   supply[f] -= v
   if supply[f] == 0:
       for k, n in demand.iteritems():
           if n != 0:
               g[k].remove(f)
       del g[f]
       del supply[f]

for n in cols:

   print "\t", n,

print cost = 0 for g in sorted(costs):

   print g, "\t",
   for n in cols:
       y = res[g][n]
       if y != 0:
           print y,
       cost += y * costs[g][n]
       print "\t",
   print

print "\n\nTotal Cost = ", cost</lang>

Output:
    A   B   C   D   E
W           50          
X   30      20      10  
Y       20      30      
Z                   50  


Total Cost =  3100

Racket

Losley:

Translation of: Ruby

Strangely, due to the sub-deterministic nature of the hash tables, resources were allocated differently to the #Ruby version; but somehow at the same total cost!

<lang racket>#lang racket (define-values (1st 2nd 3rd) (values first second third))

(define-syntax-rule (?: x t f) (if (zero? x) f t))

(define (hash-ref2

        hsh# key-1 key-2
        #:fail-2 (fail-2 (λ () (error 'hash-ref2 "key-2:~a is not found in hash" key-2)))
        #:fail-1 (fail-1 (λ () (error 'hash-ref2 "key-1:~a is not found in hash" key-1))))
 (hash-ref (hash-ref hsh# key-1 fail-1) key-2 fail-2))

(define (VAM costs all-supply all-demand)

 (define (reduce-g/x g/x x#-- x x-v y y-v)
   (for/fold ((rv (?: x-v g/x (hash-remove g/x x))))
     (#:when (zero? y-v) ((k n) (in-hash x#--)) #:unless (zero? n))
     (hash-update rv k (curry remove y))))
 
 (define (cheapest-candidate/tie-break candidates)
   (define cand-max3 (3rd (argmax 3rd candidates)))
   (argmin 2nd (for/list ((cand candidates) #:when (= (3rd cand) cand-max3)) cand)))
 
 (let vam-loop
   ((res (hash))
    (supply all-supply)
    (g/supply
     (for/hash ((x (in-hash-keys all-supply)))
       (define costs#x (hash-ref costs x))
       (define key-fn (λ (g) (hash-ref costs#x g)))
       (values x (sort (hash-keys costs#x) < #:key key-fn #:cache-keys? #t))))
    (demand all-demand)
    (g/demand
     (for/hash ((x (in-hash-keys all-demand)))
       (define key-fn (λ (g) (hash-ref2 costs g x)))
       (values x (sort (hash-keys costs) < #:key key-fn #:cache-keys? #t)))))
   (cond
     [(and (hash-empty? supply) (hash-empty? demand)) res]
     [(or (hash-empty? supply) (hash-empty? demand)) (error 'VAM "Unbalanced supply / demand")]
     [else
      (define D
        (let ((candidates
               (for/list ((x (in-hash-keys demand)))
                 (match-define (hash-table ((== x) (and g#x (list g#x.0 _ ...))) _ ...) g/demand)
                 (define z (hash-ref2 costs g#x.0 x))
                 (match g#x
                   [(list _ g#x.1 _ ...) (list x z (- (hash-ref2 costs g#x.1 x) z))]
                   [(list _) (list x z z)]))))
          (cheapest-candidate/tie-break candidates)))
      
      (define S
        (let ((candidates
               (for/list ((x (in-hash-keys supply)))
                 (match-define (hash-table ((== x) (and g#x (list g#x.0 _ ...))) _ ...) g/supply)
                 (define z (hash-ref2 costs x g#x.0))
                 (match g#x
                   [(list _ g#x.1 _ ...) (list x z (- (hash-ref2 costs x g#x.1) z))]
                   [(list _) (list x z z)]))))
          (cheapest-candidate/tie-break candidates)))
      
      (define-values (d s)
        (let ((t>f? (if (= (3rd D) (3rd S)) (> (2nd S) (2nd D)) (> (3rd D) (3rd S)))))
          (if t>f? (values (1st D) (1st (hash-ref g/demand (1st D))))
              (values (1st (hash-ref g/supply (1st S))) (1st S)))))
      
      (define v (min (hash-ref supply s) (hash-ref demand d)))
      
      (define d-v (- (hash-ref demand d) v))
      (define s-v (- (hash-ref supply s) v))
      
      (define demand-- (?: d-v (hash-set demand d d-v) (hash-remove demand d)))
      (define supply-- (?: s-v (hash-set supply s s-v) (hash-remove supply s)))
      
      (vam-loop
       (hash-update res s (λ (h) (hash-update h d (λ (x) (+ v x)) 0)) hash)
       supply-- (reduce-g/x g/supply supply-- s s-v d d-v)
       demand-- (reduce-g/x g/demand demand-- d d-v s s-v))])))

(define (vam-solution-cost costs demand?cols solution)

 (match demand?cols
   [(? list? demand-cols)
    (for*/sum ((g (in-hash-keys costs)) (n (in-list demand-cols)))
      (* (hash-ref2 solution g n #:fail-2 0) (hash-ref2 costs g n)))]
   [(hash-table (ks _) ...) (vam-solution-cost costs (sort ks symbol<? solution))]))

(define (describe-VAM-solution costs demand sltn)

 (define demand-cols (sort (hash-keys demand) symbol<?))
 (string-join
  (map
   (curryr string-join "\t")
   `(,(map ~a (cons "" demand-cols))
     ,@(for/list ((g (in-hash-keys costs)))
         (cons (~a g) (for/list ((c demand-cols)) (~a (hash-ref2 sltn g c #:fail-2 "-")))))
     ()
     ("Total Cost:" ,(~a (vam-solution-cost costs demand-cols sltn)))))
  "\n"))
--------------------------------------------------------------------------------------------------

(let ((COSTS (hash 'W (hash 'A 16 'B 16 'C 13 'D 22 'E 17)

                  'X (hash 'A 14 'B 14 'C 13 'D 19 'E 15)
                  'Y (hash 'A 19 'B 19 'C 20 'D 23 'E 50)
                  'Z (hash 'A 50 'B 12 'C 50 'D 15 'E 11)))      
     (DEMAND (hash 'A 30 'B 20 'C 70 'D 30 'E 60))
     (SUPPLY (hash 'W 50 'X 60 'Y 50 'Z 50)))  
 (displayln (describe-VAM-solution COSTS DEMAND (VAM COSTS SUPPLY DEMAND))))</lang>
Output:
	A	B	C	D	E
W	-	-	50	-	-
X	10	20	20	-	10
Y	20	-	-	30	-
Z	-	-	-	-	50

Total Cost:	3100

Raku

(formerly Perl 6)

Works with: Rakudo version 2019.03.1
Translation of: Sidef

<lang perl6>my %costs =

   :W{:16A, :16B, :13C, :22D, :17E},
   :X{:14A, :14B, :13C, :19D, :15E},
   :Y{:19A, :19B, :20C, :23D, :50E},
   :Z{:50A, :12B, :50C, :15D, :11E};

my %demand = :30A, :20B, :70C, :30D, :60E; my %supply = :50W, :60X, :50Y, :50Z;

my @cols = %demand.keys.sort;

my %res; my %g = (|%supply.keys.map: -> $x { $x => [%costs{$x}.sort(*.value)».key]}),

  (|%demand.keys.map: -> $x { $x => [%costs.keys.sort({%costs{$_}{$x}})]});

while (+%g) {

   my @d = %demand.keys.map: -> $x
     {[$x, my $z = %costs{%g{$x}[0]}{$x},%g{$x}[1] ?? %costs{%g{$x}[1]}{$x} - $z !! $z]}
   my @s = %supply.keys.map: -> $x
     {[$x, my $z = %costs{$x}{%g{$x}[0]},%g{$x}[1] ?? %costs{$x}{%g{$x}[1]} - $z !! $z]}
   @d = |@d.grep({ (.[2] == max @d».[2]) }).&min: :by(*.[1]);
   @s = |@s.grep({ (.[2] == max @s».[2]) }).&min: :by(*.[1]);
   my ($t, $f) = @d[2] == @s[2] ?? (@s[1],@d[1]) !! (@d[2],@s[2]);
   my ($d, $s) = $t > $f ?? (@d[0],%g{@d[0]}[0]) !! (%g{@s[0]}[0], @s[0]);
   my $v = %supply{$s} min %demand{$d};
   %res{$s}{$d} += $v;
   %demand{$d} -= $v;
   if (%demand{$d} == 0) {
       %supply.grep( *.value != 0 )».key.map: -> $v
         { %g{$v}.splice((%g{$v}.first: * eq $d, :k),1) };
       %g{$d}:delete;
       %demand{$d}:delete;
   }
   %supply{$s} -= $v;
   if (%supply{$s} == 0) {
       %demand.grep( *.value != 0 )».key.map: -> $v
         { %g{$v}.splice((%g{$v}.first: * eq $s, :k),1) };
       %g{$s}:delete;
       %supply{$s}:delete;
   }

}

say join "\t", flat , @cols; my $total; for %costs.keys.sort -> $g {

   print "$g\t";
   for @cols -> $col {
       print %res{$g}{$col} // '-', "\t";
       $total += (%res{$g}{$col} // 0) * %costs{$g}{$col};
   }
   print "\n";

} say "\nTotal cost: $total";</lang>

Output:
	A	B	C	D	E
W	-	-	50	-	-	
X	30	-	20	-	10	
Y	-	20	-	30	-	
Z	-	-	-	-	50	

Total cost: 3100

REXX

Translation of: java

Vogel's Approximation

<lang rexx>/* REXX ***************************************************************

  • Solve the Transportation Problem using Vogel's Approximation

Default Input 2 3 # of sources / # of demands 25 35 sources 20 30 10 demands 3 5 7 cost matrix < 3 2 5

  • 20201210 support no input file -courtesy GS
  • Note: correctness of input is not checked
  • 20210102 restored Vogel's Approximation and added Optimization
  • 20210103 eliminated debug code
                                                                                                                                            • /

Signal On Halt Signal On Novalue Signal On Syntax

Parse Arg fid If fid= Then

 fid='input1.txt'

Call init m.=0 Do Forever

 dmax.=0
 dmax=0
 Do r=1 To rr
   dr.r=
   Do c=1 To cc
     If cost.r.c<>'*' Then
       dr.r=dr.r cost.r.c
     End
   dr.r=words(dr.r) dr.r
   dr.r=diff(dr.r)
   If dr.r>dmax Then Do; dmax=dr.r; dmax.0='R'; dmax.1=r; dmax.2=dr.r; End
   End
 Do c=1 To cc
   dc.c=
   Do r=1 To rr
     If cost.r.c<>'*' Then
       dc.c=dc.c cost.r.c
     End
   dc.c=words(dc.c) dc.c
   dc.c=diff(dc.c)
   If dc.c>dmax Then Do; dmax=dc.c; dmax.0='C'; dmax.1=c; dmax.2=dc.c; End
   End
 cmin=999
 Select
   When dmax.0='R' Then Do
     r=dmax.1
     Do c=1 To cc
       If cost.r.c<>'*' &,
          cost.r.c<cmin Then Do
         cmin=cost.r.c
         cx=c
         End
       End
     Call allocate r cx
     End
   When dmax.0='C' Then Do
     c=dmax.1
     Do r=1 To rr
       If cost.r.c<>'*' &,
          cost.r.c<cmin Then Do
         cmin=cost.r.c
         rx=r
         End
       End
     Call allocate rx c
     End
   Otherwise
     Leave
   End
 End

Do r=1 To rr

 Do c=1 To cc
   If cost.r.c<>'*' Then Do
     Call allocate r c
     cost.r.c='*'
     End
   End
 End

Call show_alloc 'Vogels Approximation'

Do r=1 To rr

 Do c=1 To cc
   cost.r.c=word(matrix.r.c,3)   /* restore cost.*.* */
   End
 End

Call steppingstone Exit

/**********************************************************************

  • Subroutines for Vogel's Approximation
                                                                                                                                            • /

init: If lines(fid)=0 Then Do

 Say 'Input file not specified or not found. Using default input instead.'
 fid='Default input'
 in.1=sourceline(4)
 Parse Var in.1 numSources .
 Do i=2 To numSources+3
   in.i=sourceline(i+3)
   End
 End

Else Do

 Do i=1 By 1 while lines(fid)>0
   in.i=linein(fid)
   End
 End

Parse Var in.1 numSources numDestinations . 1 rr cc . source.=0 demand.=0 source_sum=0 Do i=1 To numSources

 Parse Var in.2 source.i in.2
 ss.i=source.i
 source_in.i=source.i
 source_sum=source_sum+source.i
 End

l=linein(fid) demand_sum=0 Do i=1 To numDestinations

 Parse Var in.3 demand.i in.3
 dd.i=demand.i
 demand_in.i=demand.i
 demand_sum=demand_sum+demand.i
 End

Do i=1 To numSources

 j=i+3
 l=in.j
 Do j=1 To numDestinations
   Parse Var l cost.i.j l
   End
 End

Do i=1 To numSources

 ol=format(source.i,3)
 Do j=1 To numDestinations
   ol=ol format(cost.i.j,4)
   End
 End

ol=' ' Do j=1 To numDestinations

 ol=ol format(demand.j,4)
 End

Select

 When source_sum=demand_sum Then Nop  /* balanced */
 When source_sum>demand_sum Then Do   /* unbalanced - add dummy demand */
   Say 'This is an unbalanced case (sources exceed demands). We add a dummy consumer.'
   cc=cc+1
   demand.cc=source_sum-demand_sum
   demand_in.cc=demand.cc
   dd.cc=demand.cc
   Do r=1 To rr
     cost.r.cc=0
     End
   End
 Otherwise /* demand_sum>source_sum */ Do /* unbalanced - add dummy source */
   Say 'This is an unbalanced case (demands exceed sources). We add a dummy source.'
   rr=rr+1
   source.rr=demand_sum-source_sum
   source_in.rr=source.rr
   ss.rr=source.rr
   Do c=1 To cc
     cost.rr.c=0
     End
   End
 End

Say 'Sources / Demands / Cost' ol=' ' Do c=1 To cc

 ol=ol format(demand.c,3)
 End

Say ol

Do r=1 To rr

 ol=format(source.r,4)
 Do c=1 To cc
   ol=ol format(cost.r.c,3)
   matrix.r.c=r c cost.r.c 0
   End
 Say ol
 End

Return

allocate: Procedure Expose m. source. demand. cost. rr cc matrix. Parse Arg r c sh=min(source.r,demand.c) source.r=source.r-sh demand.c=demand.c-sh m.r.c=sh matrix.r.c=subword(matrix.r.c,1,3) sh If source.r=0 Then Do

 Do c=1 To cc
   cost.r.c='*'
   End
 End

If demand.c=0 Then Do

 Do r=1 To rr
   cost.r.c='*'
   End
 End

Return

diff: Procedure Parse Value arg(1) With n list If n<2 Then Return 0 list=wordsort(list) Return word(list,2)-word(list,1)

wordsort: Procedure /**********************************************************************

  • Sort the list of words supplied as argument. Return the sorted list
                                                                                                                                            • /
 Parse Arg wl
 wa.=
 wa.0=0
 Do While wl<>
   Parse Var wl w wl
   Do i=1 To wa.0
     If wa.i>w Then Leave
     End
   If i<=wa.0 Then Do
     Do j=wa.0 To i By -1
       ii=j+1
       wa.ii=wa.j
       End
     End
   wa.i=w
   wa.0=wa.0+1
   End
 swl=
 Do i=1 To wa.0
   swl=swl wa.i
   End
 /* Say swl */
 Return strip(swl)

show_alloc: Procedure Expose matrix. rr cc demand_in. source_in. Parse Arg header If header= Then

 Return

Say Say header total=0 ol=' ' Do c=1 to cc

 ol=ol format(demand_in.c,3)
 End

Say ol as= Do r=1 to rr

 ol=format(source_in.r,4)
 a=word(matrix.r.1,4)
 If a=0.0000000001 Then a=0
 If a>0 Then
   ol=ol format(a,3)
 Else
   ol=ol ' - '
 total=total+word(matrix.r.1,4)*word(matrix.r.1,3)
 Do c=2 To cc
   a=word(matrix.r.c,4)
   If a=0.0000000001 Then a=0
   If a>0 Then
     ol=ol format(a,3)
   Else
     ol=ol ' - '
   total=total+word(matrix.r.c,4)*word(matrix.r.c,3)
   as=as a
   End
 Say ol
 End

Say 'Total costs:' format(total,4,1) Return


/**********************************************************************

  • Subroutines for Optimization
                                                                                                                                            • /

steppingstone: Procedure Expose matrix. cost. rr cc matrix. demand_in.,

                             source_in. ms fid move cnt.

maxReduction=0 move= Call fixDegenerateCase Do r=1 To rr

 Do c=1 To cc
   Parse Var matrix.r.c r c cost qrc
   If qrc=0 Then Do
     path=getclosedpath(r,c)
     If pelems(path)<4 Then Do
       Iterate
       End
     reduction = 0
     lowestQuantity = 1e10
     leavingCandidate = 
     plus=1
     pathx=path
     Do While pathx<>
       Parse Var pathx s '|' pathx
       If plus Then
         reduction=reduction+word(s,3)
       Else Do
         reduction=reduction-word(s,3)
         If word(s,4)<lowestQuantity Then Do
           leavingCandidate = s
           lowestQuantity = word(s,4)
           End
         End
       plus=\plus
       End
     If reduction < maxreduction Then Do
       move=path
       leaving=leavingCandidate
       maxReduction = reduction
       End
     End
   End
 End

if move<> Then Do

 quant=word(leaving,4)
 If quant=0 Then Do
   Call show_alloc 'Optimum'
   Exit
   End
 plus=1
 Do While move<>
   Parse Var move m '|' move
   Parse Var m r c cpu qrc
   Parse Var matrix.r.c vr vc vcost vquant
   If plus Then
     nquant=vquant+quant
   Else
     nquant=vquant-quant
   matrix.r.c = vr vc vcost nquant
   plus=\plus
   End
 move=
 Call steppingStone
 End

Else

 Call show_alloc 'Optimal Solution' fid

Return

getclosedpath: Procedure Expose matrix. cost. rr cc matrix. Parse Arg rd,cd path=rd cd cost.rd.cd word(matrix.rd.cd,4) do r=1 To rr

 Do c=1 To cc
   If word(matrix.r.c,4)>0 Then Do
     path=path'|'r c cost.r.c word(matrix.r.c,4)
     End
   End
 End

path=magic(path) Return stones(path)

magic: Procedure Parse Arg list Do Forever

 list_1=remove_1(list)
 If list_1=list Then Leave
 list=list_1
 End

Return list_1

remove_1: Procedure Parse Arg list cntr.=0 cntc.=0 Do i=1 By 1 While list<>

 parse Var list e.i '|' list
 Parse Var e.i r c .
 cntr.r=cntr.r+1
 cntc.c=cntc.c+1
 End

n=i-1 keep.=1 Do i=1 To n

 Parse Var e.i r c .
 If cntr.r<2 |,
    cntc.c<2 Then Do
   keep.i=0
   End
 End

list=e.1 Do i=2 To n

 If keep.i Then
   list=list'|'e.i
 End

Return list

stones: Procedure Parse Arg lst tstc=lst Do i=1 By 1 While tstc<>

 Parse Var tstc o.i '|' tstc
 end

stones=lst o.0=i-1 prev=o.1 Do i=1 To o.0

 st.i=prev
 k=i//2
 nbrs=getNeighbors(prev,lst)
 Parse Var nbrs n.1 '|' n.2
 If k=0 Then
   prev=n.2
 Else
   prev=n.1
 End

stones=st.1 Do i=2 To o.0

 stones=stones'|'st.i
 End

Return stones

getNeighbors: Procedure Expose o. parse Arg s, lst Do i=1 To 4

 Parse Var lst o.i '|' lst
 End

nbrs.= sr=word(s,1) sc=word(s,2) Do i=1 To o.0

 If o.i<>s Then Do
   or=word(o.i,1)
   oc=word(o.i,2)
   If or=sr & nbrs.0= Then
     nbrs.0 = o.i
   else if oc=sc & nbrs.1= Then
     nbrs.1 = o.i
   If nbrs.0<> & nbrs.1<> Then
     Leave
   End
 End

return nbrs.0'|'nbrs.1

m1: Procedure Parse Arg z Return z-1

pelems: Procedure Call Trace 'O' Parse Arg p n=0 Do While p<>

 Parse Var p x '|' p
 If x<> Then n=n+1
 End

Return n

fixDegenerateCase: Procedure Expose matrix. rr cc ms Call matrixtolist If (rr+cc-1)<>ms Then Do

 Do r=1 To rr
   Do c=1 To cc
     If word(matrix.r.c,4)=0 Then Do
       matrix.r.c=subword(matrix.r.c,1,3) 1.e-10
       Return
       End
     End
   End
 End

Return

matrixtolist: Procedure Expose matrix. rr cc ms ms=0 list= Do r=1 To rr

 Do c=1 To cc
   If word(matrix.r.c,4)>0 Then Do
     list=list'|'matrix.r.c
     ms=ms+1
     End
   End
 End

Return strip(list,,'|')

Novalue:

 Say 'Novalue raised in line' sigl
 Say sourceline(sigl)
 Say 'Variable' condition('D')
 Signal lookaround

Syntax:

 Say 'Syntax raised in line' sigl
 Say sourceline(sigl)
 Say 'rc='rc '('errortext(rc)')'

halt: lookaround:

 If fore() Then Do
   Say 'You can look around now.'
   Trace ?R
   Nop
   End
 Exit 12</lang>
Output:
F:\>regina tpv vv.txt
Sources / Demands / Cost
      30  20  70  30  60
  50  16  16  13  22  17
  60  14  14  13  19  15
  50  19  19  20  23  50
  50  50  12  50  15  11

Vogel's Approximation
      30  20  70  30  60
  50  -   -   50  -   -
  60  -   -   20  -   40
  50  30  20  -   -   -
  50  -   -   -   30  20
Total costs: 3130.0

Optimum
      30  20  70  30  60
  50  -   -   50  -   -
  60  30  -   20  -   10
  50  -   20  -   30  -
  50  -   -   -   -   50
Total costs: 3100.0

Low Cost Algorithm

<lang rexx>/* REXX ***************************************************************

  • Solve the Transportation Problem using the Least Cost Method

Default Input 2 3 # of sources / # of demands 25 35 sources 20 30 10 demands 3 5 7 cost matrix 3 2 5

  • 20201228 corresponds to NWC above
  • Note: correctness of input is not checked
  • 20210102 add optimization
  • 20210103 remove debug code
                                                                                                                                            • /

Signal On Halt Signal On Novalue Signal On Syntax

Parse Arg fid If fid= Then

 fid='input1.txt'

Call init Do r=1 To rr

 Do c=1 To cc
   matrix.r.c=r c cost.r.c 0
   End
 End

Do Until source_sum=0

 mincost=1e10
 Do r=1 To rr
   If source.r>0 Then Do
     Do c=1 To cc
       If demand.c>0 Then Do
         cost=word(matrix.r.c,3)
         If cost>0 & cost<mincost |,
           source_sum=source.r |,
           demand_sum=demand.c Then Do
           tgt=r c cost
           mincost=cost
           End
         End
       End
     End
   End
 Parse Var tgt tr tc .
 a=min(source.tr,demand.tc)
 matrix.tr.tc=subword(matrix.tr.tc,1,3) word(matrix.tr.tc,4)+a
 source.tr=source.tr-a
 demand.tc=demand.tc-a
 source_sum=source_sum-a
 demand_sum=demand_sum-a
 End

Call show_alloc 'Low Cost Algorithm' Call steppingstone Exit

/**********************************************************************

  • Subroutines for Low Cost Algorithm
                                                                                                                                            • /

init: If lines(fid)=0 Then Do

 Say 'Input file not specified or not found. Using default input instead.'
 fid='Default input'
 in.1=sourceline(4)
 Parse Var in.1 numSources .
 Do i=2 To numSources+3
   in.i=sourceline(i+3)
   End
 End

Else Do

 Do i=1 By 1 while lines(fid)>0
   in.i=linein(fid)
   End
 End

Parse Var in.1 numSources numDestinations . 1 rr cc . source_sum=0 Do i=1 To numSources

 Parse Var in.2 source.i in.2
 ss.i=source.i
 source_sum=source_sum+source.i
 source_in.i=source.i
 End

demand_sum=0 Do i=1 To numDestinations

 Parse Var in.3 demand.i in.3
 dd.i=demand.i
 demand_in.i=demand.i
 demand_sum=demand_sum+demand.i
 End

Do i=1 To numSources

 j=i+3
 l=in.j
 Do j=1 To numDestinations
   Parse Var l cost.i.j l
   End
 End

Do i=1 To numSources

 ol=format(source.i,3)
 Do j=1 To numDestinations
   ol=ol format(cost.i.j,4)
   End
 End

Select

 When source_sum=demand_sum Then Nop  /* balanced */
 When source_sum>demand_sum Then Do   /* unbalanced - add dummy demand */
   Say 'This is an unbalanced case (sources exceed demands). We add a dummy consumer.'
   cc=cc+1
   demand.cc=source_sum-demand_sum
   demand_in.cc=demand.cc
   dd.cc=demand.cc
   Do r=1 To rr
     cost.r.cc=0
     End
   End
 Otherwise /* demand_sum>source_sum */ Do /* unbalanced - add dummy source */
   Say 'This is an unbalanced case (demands exceed sources). We add a dummy source.'
   rr=rr+1
   source.rr=demand_sum-source_sum
   ss.rr=source.rr
   source_in.rr=source.rr
   Do c=1 To cc
     cost.rr.c=0
     End
   End
 End

Say 'Sources / Demands / Cost' ol=' ' Do c=1 To cc

 ol=ol format(demand.c,3)
 End

Say ol Do r=1 To rr

 ol=format(source.r,4)
 Do c=1 To cc
   ol=ol format(cost.r.c,3)
   End
 Say ol
 End

Return

show_alloc: Procedure Expose matrix. rr cc demand_in. source_in. Parse Arg header If header= Then

 Return

Say Say header total=0 ol=' ' Do c=1 to cc

 ol=ol format(demand_in.c,3)
 End

Say ol as= Do r=1 to rr

 ol=format(source_in.r,4)
 a=word(matrix.r.1,4)
 If a=0.0000000001 Then a=0
 If a>0 Then
   ol=ol format(a,3)
 Else
   ol=ol ' - '
 total=total+word(matrix.r.1,4)*word(matrix.r.1,3)
 Do c=2 To cc
   a=word(matrix.r.c,4)
   If a=0.0000000001 Then a=0
   If a>0 Then
     ol=ol format(a,3)
   Else
     ol=ol ' - '
   total=total+word(matrix.r.c,4)*word(matrix.r.c,3)
   as=as a
   End
 Say ol
 End

Say 'Total costs:' format(total,4,1) Return


/**********************************************************************

  • Subroutines for Optimization
                                                                                                                                            • /

steppingstone: Procedure Expose matrix. cost. rr cc matrix. demand_in.,

                                             source_in. fid move cnt.

maxReduction=0 move= Call fixDegenerateCase Do r=1 To rr

 Do c=1 To cc
   Parse Var matrix.r.c r c cost qrc
   If qrc=0 Then Do
     path=getclosedpath(r,c)
     If pelems(path)<4 then
       Iterate
     reduction = 0
     lowestQuantity = 1e10
     leavingCandidate = 
     plus=1
     pathx=path
     Do While pathx<>
       Parse Var pathx s '|' pathx
       If plus Then
         reduction=reduction+word(s,3)
       Else Do
         reduction=reduction-word(s,3)
         If word(s,4)<lowestQuantity Then Do
           leavingCandidate = s
           lowestQuantity = word(s,4)
           End
         End
       plus=\plus
       End
     If reduction < maxreduction Then Do
       move=path
       leaving=leavingCandidate
       maxReduction = reduction
       End
     End
   End
 End

if move<> Then Do

 quant=word(leaving,4)
 If quant=0 Then Do
   Call show_alloc 'Optimum'
   Exit
   End
 plus=1
 Do While move<>
   Parse Var move m '|' move
   Parse Var m r c cpu qrc
   Parse Var matrix.r.c vr vc vcost vquant
   If plus Then
     nquant=vquant+quant
   Else
     nquant=vquant-quant
   matrix.r.c = vr vc vcost nquant
   plus=\plus
   End
 move=
 Call steppingStone
 End

Else

 Call show_alloc 'Optimal Solution' fid

Return

getclosedpath: Procedure Expose matrix. cost. rr cc Parse Arg rd,cd path=rd cd cost.rd.cd word(matrix.rd.cd,4) do r=1 To rr

 Do c=1 To cc
   If word(matrix.r.c,4)>0 Then Do
     path=path'|'r c cost.r.c word(matrix.r.c,4)
     End
   End
 End

path=magic(path) Return stones(path)

magic: Procedure Parse Arg list Do Forever

 list_1=remove_1(list)
 If list_1=list Then Leave
 list=list_1
 End

Return list_1

remove_1: Procedure Parse Arg list cntr.=0 cntc.=0 Do i=1 By 1 While list<>

 parse Var list e.i '|' list
 Parse Var e.i r c .
 cntr.r=cntr.r+1
 cntc.c=cntc.c+1
 End

n=i-1 keep.=1 Do i=1 To n

 Parse Var e.i r c .
 If cntr.r<2 |,
    cntc.c<2 Then Do
   keep.i=0
   End
 End

list=e.1 Do i=2 To n

 If keep.i Then
   list=list'|'e.i
 End

Return list

stones: Procedure Parse Arg lst stones=lst tstc=lst Do i=1 By 1 While tstc<>

 Parse Var tstc o.i '|' tstc
 End

o.0=i-1 prev=o.1 Do i=1 To o.0

 st.i=prev
 k=i//2
 nbrs=getNeighbors(prev, lst)
 Parse Var nbrs n.1 '|' n.2
 If k=0 Then
   prev=n.2
 Else
   prev=n.1
 End

stones=st.1 Do i=2 To o.0

 stones=stones'|'st.i
 End

Return stones

getNeighbors: Procedure parse Arg s, lst Do i=1 By 1 While lst<>

 Parse Var lst o.i '|' lst
 End

o.0=i-1 nbrs.= sr=word(s,1) sc=word(s,2) Do i=1 To o.0

 If o.i<>s Then Do
   or=word(o.i,1)
   oc=word(o.i,2)
   If or=sr & nbrs.0= Then
     nbrs.0 = o.i
   else if oc=sc & nbrs.1= Then
     nbrs.1 = o.i
   If nbrs.0<> & nbrs.1<> Then
     Leave
   End
 End

return nbrs.0'|'nbrs.1

m1: Procedure Parse Arg z Return z-1

pelems: Procedure Call Trace 'O' Parse Arg p n=0 Do While p<>

 Parse Var p x '|' p
 If x<> Then n=n+1
 End

Return n

fixDegenerateCase: Procedure Expose matrix. rr cc ms ms demand_in. source_in. move cnt. Call matrixtolist If (rr+cc-1)<>ms Then Do

 Do r=1 To rr
   Do c=1 To cc
     If word(matrix.r.c,4)=0 Then Do
       matrix.r.c=subword(matrix.r.c,1,3) 1.e-10
       Return
       End
     End
   End
 End

Return

matrixtolist: Procedure Expose matrix. rr cc ms ms=0 list= Do r=1 To rr

 Do c=1 To cc
   If word(matrix.r.c,4)>0 Then Do
     list=list'|'matrix.r.c
     ms=ms+1
     End
   End
 End

Return strip(list,,'|')

Novalue:

 Say 'Novalue raised in line' sigl
 Say sourceline(sigl)
 Say 'Variable' condition('D')
 Signal lookaround

Syntax:

 Say 'Syntax raised in line' sigl
 Say sourceline(sigl)
 Say 'rc='rc '('errortext(rc)')'

halt: lookaround:

 If fore() Then Do
   Say 'You can look around now.'
   Trace ?R
   Nop
   End
 Exit 12

</lang>

Output:
F:\>rexx tpl vv.txt
Sources / Demands / Cost
      30  20  70  30  60
  50  16  16  13  22  17
  60  14  14  13  19  15
  50  19  19  20  23  50
  50  50  12  50  15  11

Low Cost Algorithm
      30  20  70  30  60
  50  -   -   50  -   -
  60  30  10  20  -   -
  50  -   10  -   30  10
  50  -   -   -   -   50
Total costs: 3400.0

Optimum
      30  20  70  30  60
  50  -   -   50  -   -
  60  30  -   20  -   10
  50  -   20  -   30  -
  50  -   -   -   -   50
Total costs: 3100.0

Ruby

Breaks ties using lowest cost cell.

Task Example

<lang ruby># VAM

  1. Nigel_Galloway
  2. September 1st., 2013

COSTS = {W: {A: 16, B: 16, C: 13, D: 22, E: 17},

         X: {A: 14, B: 14, C: 13, D: 19, E: 15},
         Y: {A: 19, B: 19, C: 20, D: 23, E: 50},
         Z: {A: 50, B: 12, C: 50, D: 15, E: 11}}

demand = {A: 30, B: 20, C: 70, D: 30, E: 60} supply = {W: 50, X: 60, Y: 50, Z: 50} COLS = demand.keys res = {}; COSTS.each_key{|k| res[k] = Hash.new(0)} g = {}; supply.each_key{|x| g[x] = COSTS[x].keys.sort_by{|g| COSTS[x][g]}}

       demand.each_key{|x| g[x] = COSTS.keys.sort_by{|g| COSTS[g][x]}}

until g.empty?

 d = demand.collect{|x,y| [x, z = COSTS[g[x][0]][x], g[x][1] ? COSTS[g[x][1]][x] - z : z]}
 dmax = d.max_by{|n| n[2]}
 d = d.select{|x| x[2] == dmax[2]}.min_by{|n| n[1]}
 s = supply.collect{|x,y| [x, z = COSTS[x][g[x][0]], g[x][1] ? COSTS[x][g[x][1]] - z : z]}
 dmax = s.max_by{|n| n[2]}
 s = s.select{|x| x[2] == dmax[2]}.min_by{|n| n[1]}
 t,f = d[2]==s[2] ? [s[1], d[1]] : [d[2],s[2]] 
 d,s = t > f ? [d[0],g[d[0]][0]] : [g[s[0]][0],s[0]]
 v = [supply[s], demand[d]].min
 res[s][d] += v
 demand[d] -= v
 if demand[d] == 0 then
   supply.reject{|k, n| n == 0}.each_key{|x| g[x].delete(d)}
   g.delete(d)
   demand.delete(d)
 end
 supply[s] -= v
 if supply[s] == 0 then
   demand.reject{|k, n| n == 0}.each_key{|x| g[x].delete(s)}
   g.delete(s)
   supply.delete(s)
 end

end

COLS.each{|n| print "\t", n} puts cost = 0 COSTS.each_key do |g|

 print g, "\t"
 COLS.each do |n|
   y = res[g][n]
   print y if y != 0
   cost += y * COSTS[g][n]
   print "\t"
 end
 puts

end print "\n\nTotal Cost = ", cost</lang>

Output:
        A       B       C       D       E
W                       50
X       30              20              10
Y               20              30
Z                                       50


Total Cost = 3100

Reference Example

Replacing the data in the Task Example with: <lang ruby>COSTS = {S1: {D1: 46, D2: 74, D3: 9, D4: 28, D5: 99},

         S2: {D1: 12, D2:  75, D3:  6, D4: 36, D5: 48},
         S3: {D1: 35, D2: 199, D3:  4, D4:  5, D5: 71},
         S4: {D1: 61, D2:  81, D3: 44, D4: 88, D5:  9},
         S5: {D1: 85, D2:  60, D3: 14, D4: 25, D5: 79}}

demand = {D1: 278, D2: 60, D3: 461, D4: 116, D5: 1060} supply = {S1: 461, S2: 277, S3: 356, S4: 488, S5: 393}</lang> Produces:

        D1      D2      D3      D4      D5
S1      1       60      68              332
S2      277
S3                              116     240
S4                                      488
S5                      393


Total Cost = 68804

Sidef

Translation of: Ruby

<lang ruby>var costs = :(

   W => :(A => 16, B => 16, C => 13, D => 22, E => 17),
   X => :(A => 14, B => 14, C => 13, D => 19, E => 15),
   Y => :(A => 19, B => 19, C => 20, D => 23, E => 50),
   Z => :(A => 50, B => 12, C => 50, D => 15, E => 11)

)

var demand = :(A => 30, B => 20, C => 70, D => 30, E => 60) var supply = :(W => 50, X => 60, Y => 50, Z => 50)

var cols = demand.keys.sort

var (:res, :g) supply.each {|x| g{x} = costs{x}.keys.sort_by{|g| costs{x}{g} }} demand.each {|x| g{x} = costs .keys.sort_by{|g| costs{g}{x} }}

while (g) {

   var d = demand.collect {|x|
       [x, var z = costs{g{x}[0]}{x}, g{x}[1] ? costs{g{x}[1]}{x}-z : z]
   }
   var s = supply.collect {|x|
       [x, var z = costs{x}{g{x}[0]}, g{x}[1] ? costs{x}{g{x}[1]}-z : z]
   }
   d.grep! { .[2] == d.max_by{ .[2] }[2] }.min_by! { .[1] }
   s.grep! { .[2] == s.max_by{ .[2] }[2] }.min_by! { .[1] }
   var (t,f) = (d[2] == s[2] ? ((s[1], d[1])) : ((d[2], s[2])))
       (d,s) = (t > f ? ((d[0], g{d[0]}[0])) : ((g{s[0]}[0],s[0])))
   var v = (supply{s} `min` demand{d})
   res{s}{d} := 0 += v
   demand{d} -= v
   if (demand{d} == 0) {
       supply.grep {|_,n| n != 0 }.each {|x| g{x}.delete(d) }
       g.delete(d)
       demand.delete(d)
   }
   supply{s} -= v
   if (supply{s} == 0) {
       demand.grep {|_,n| n != 0 }.each {|x| g{x}.delete(s) }
       g.delete(s)
       supply.delete(s)
   }

}

say("\t", cols.join("\t"))

var cost = 0 costs.keys.sort.each { |g|

 print(g, "\t")
 cols.each { |n|
   if (defined(var y = res{g}{n})) {
       print(y)
       cost += (y * costs{g}{n})
   }
   print("\t")
 }
 print("\n")

}

say "\n\nTotal Cost = #{cost}"</lang>

Output:
	A	B	C	D	E
W			50			
X	30		20		10	
Y		20		30		
Z					50	


Total Cost = 3100

Tcl

Works with: Tcl version 8.6

<lang tcl>package require Tcl 8.6

  1. A sort that works by sorting by an auxiliary key computed by a lambda term

proc sortByFunction {list lambda} {

   lmap k [lsort -index 1 [lmap k $list {

list $k [uplevel 1 [list apply $lambda $k]]

   }]] {lindex $k 0}

}

  1. A simple way to pick a “best” item from a list

proc minimax {list maxidx minidx} {

   set max -Inf; set min Inf
   foreach t $list {

if {[set m [lindex $t $maxidx]] > $max} { set best $t set max $m set min Inf } elseif {$m == $max && [set m [lindex $t $minidx]] < $min} { set best $t set min $m }

   }
   return $best

}

  1. The approximation engine. Note that this does not change the provided
  2. arguments at all since they are copied on write.

proc VAM {costs demand supply} {

   # Initialise the sorted sequence of pairs and the result dictionary
   foreach x [dict keys $demand] {

dict set g $x [sortByFunction [dict keys $supply] {g { upvar 1 costs costs x x; dict get $costs $g $x }}] dict set row $x 0

   }
   foreach x [dict keys $supply] {

dict set g $x [sortByFunction [dict keys $demand] {g { upvar 1 costs costs x x; dict get $costs $x $g }}] dict set res $x $row

   }
   # While there's work to do...
   while {[dict size $g]} {

# Select "best" demand lassign [minimax [lmap x [dict keys $demand] { if {![llength [set gx [dict get $g $x]]]} continue set z [dict get $costs [lindex $gx 0] $x] if {[llength $gx] > 1} { list $x $z [expr {[dict get $costs [lindex $gx 1] $x] - $z}] } else { list $x $z $z } }] 2 1] d dVal dCost

# Select "best" supply lassign [minimax [lmap x [dict keys $supply] { if {![llength [set gx [dict get $g $x]]]} continue set z [dict get $costs $x [lindex $gx 0]] if {[llength $gx] > 1} { list $x $z [expr {[dict get $costs $x [lindex $gx 1]] - $z}] } else { list $x $z $z } }] 2 1] s sVal sCost

# Compute how much to transfer, and with which "best" if {$sCost == $dCost ? $sVal > $dVal : $sCost < $dCost} { set s [lindex [dict get $g $d] 0] } else { set d [lindex [dict get $g $s] 0] } set v [expr {min([dict get $supply $s], [dict get $demand $d])}]

# Transfer some supply to demand dict update res $s inner {dict incr inner $d $v} dict incr demand $d -$v if {[dict get $demand $d] == 0} { dict for {k n} $supply { if {$n != 0} { # Filter list in dictionary to remove element dict set g $k [lmap x [dict get $g $k] { if {$x eq $d} continue; set x }] } } dict unset g $d dict unset demand $d } dict incr supply $s -$v if {[dict get $supply $s] == 0} { dict for {k n} $demand { if {$n != 0} { dict set g $k [lmap x [dict get $g $k] { if {$x eq $s} continue; set x }] } } dict unset g $s dict unset supply $s }

   }
   return $res

}</lang> Demonstration: <lang tcl>set COSTS {

   W {A 16 B 16 C 13 D 22 E 17}
   X {A 14 B 14 C 13 D 19 E 15}
   Y {A 19 B 19 C 20 D 23 E 50}
   Z {A 50 B 12 C 50 D 15 E 11}

} set DEMAND {A 30 B 20 C 70 D 30 E 60} set SUPPLY {W 50 X 60 Y 50 Z 50}

set RES [VAM $COSTS $DEMAND $SUPPLY]

puts \t[join [dict keys $DEMAND] \t] set cost 0 foreach g [dict keys $SUPPLY] {

   puts $g\t[join [lmap n [dict keys $DEMAND] {

set c [dict get $RES $g $n] incr cost [expr {$c * [dict get $COSTS $g $n]}] expr {$c ? $c : ""}

   }] \t]

} puts "\nTotal Cost = $cost"</lang>

Output:
        A       B       C       D       E
W                       50              
X       10      20      20              10
Y       20                      30      
Z                                       50

Total Cost = 3100

Wren

Translation of: Kotlin
Library: Wren-math
Library: Wren-fmt

<lang ecmascript>import "/math" for Int, Nums import "/fmt" for Fmt

var supply = [50, 60, 50, 50] var demand = [30, 20, 70, 30, 60]

var costs = [

   [16, 16, 13, 22, 17],
   [14, 14, 13, 19, 15],
   [19, 19, 20, 23, 50],
   [50, 12, 50, 15, 11]

]

var nRows = supply.count var nCols = demand.count

var rowDone = List.filled(nRows, false) var colDone = List.filled(nCols, false) var results = List.filled(nRows, null) for (i in 0...nRows) results[i] = List.filled(nCols, 0)

var diff = Fn.new { |j, len, isRow|

   var min1 = Int.maxSafe
   var min2 = min1
   var minP = -1
   for (i in 0...len) {
       var done = isRow ? colDone[i] : rowDone[i]
       if (!done) {
           var c = isRow ? costs[j][i] : costs[i][j]
           if (c < min1) {
               min2 = min1
               min1 = c
               minP = i
           } else if (c < min2) min2 = c
       }
   }
   return [min2 - min1, min1, minP]

}

var maxPenalty = Fn.new { |len1, len2, isRow|

   var md = -Int.maxSafe
   var pc = -1
   var pm = -1
   var mc = -1
   for (i in 0...len1) {
       var done = isRow ? rowDone[i] : colDone[i]
       if (!done) {
           var res = diff.call(i, len2, isRow)
           if (res[0] > md) {
               md = res[0]  // max diff
               pm = i       // pos of max diff
               mc = res[1]  // min cost
               pc = res[2]  // pos of min cost
           }
       }
   }
   return isRow ? [pm, pc, mc, md] : [pc, pm, mc, md]

}

var nextCell = Fn.new {

   var res1 = maxPenalty.call(nRows, nCols, true)
   var res2 = maxPenalty.call(nCols, nRows, false)
   if (res1[3] == res2[3]) return (res1[2] < res2[2]) ? res1 : res2
   return (res1[3] > res2[3]) ? res2 : res1

}

var supplyLeft = Nums.sum(supply) var totalCost = 0 while (supplyLeft > 0) {

   var cell = nextCell.call()
   var r = cell[0]
   var c = cell[1]
   var q = demand[c].min(supply[r])
   demand[c] = demand[c] - q
   if (demand[c] == 0) colDone[c] = true
   supply[r] = supply[r] - q
   if (supply[r] == 0) rowDone[r] = true
   results[r][c] = q
   supplyLeft = supplyLeft - q
   totalCost = totalCost + q*costs[r][c]

}

System.print(" A B C D E") var i = 0 for (result in results) {

   Fmt.write("$c", "W".bytes[0] + i)
   for (item in result) Fmt.write("  $2d", item)
   System.print()
   i = i + 1

} System.print("\nTotal Cost = %(totalCost)")</lang>

Output:
    A   B   C   D   E
W   0   0  50   0   0
X  30   0  20   0  10
Y   0  20   0  30   0
Z   0   0   0   0  50

Total Cost = 3100

Yabasic

Translation of: C

<lang Yabasic> N_ROWS = 4 : N_COLS = 5

dim supply(N_ROWS) dim demand(N_COLS)

restore sup for n = 0 to N_ROWS - 1 read supply(n) next n

restore dem for n = 0 to N_COLS - 1 read demand(n) next n

label sup data 50, 60, 50, 50

label dem data 30, 20, 70, 30, 60

dim costs(N_ROWS, N_COLS)

label cost data 16, 16, 13, 22, 17 data 14, 14, 13, 19, 15 data 19, 19, 20, 23, 50 data 50, 12, 50, 15, 11

restore cost for i = 0 to N_ROWS - 1 for j = 0 to N_COLS - 1 read costs(i, j) next j next i

dim row_done(N_ROWS) dim col_done(N_COLS)

sub diff(j, leng, is_row, res())

   local i, c, min1, min2, min_p, test
   
   min1 = 10e300 : min2 = min1 : min_p = -1
   
   for i = 0 to leng - 1
   	if is_row then
   		test = col_done(i)
   	else
   		test = row_done(i)
   	end if
   	if test continue
   	if is_row then
   		c = costs(j, i)
   	else
   		c = costs(i, j)
   	end if
       if c < min1 then
           min2 = min1
           min1 = c
           min_p = i
       elseif c < min2 then
       	min2 = c
       end if
   next i
   res(0) = min2 - min1
   res(1) = min1
   res(2) = min_p

end sub

sub max_penalty(len1, len2, is_row, res())

   local i, pc, pm, mc, md, res2(3), test
   
   pc = -1 : pm = -1 : mc = -1 : md = -10e300
   
   for i = 0 to len1 - 1
       if is_row then
   		test = row_done(i)
   	else
   		test = col_done(i)
   	end if
       if test continue
      	diff(i, len2, is_row, res2())
       if res2(0) > md then
           md = res2(0)  //* max diff */
           pm = i        //* pos of max diff */
           mc = res2(1)  //* min cost */
           pc = res2(2)  //* pos of min cost */
       end if
   next i

   if is_row then
       res(0) = pm : res(1) = pc
   else
       res(0) = pc : res(1) = pm
   end if
   res(2) = mc : res(3) = md

end sub

sub next_cell(res())

   local i, res1(4), res2(4)
   
   max_penalty(N_ROWS, N_COLS, TRUE, res1())
   max_penalty(N_COLS, N_ROWS, FALSE, res2())

   if res1(3) = res2(3) then
       if res1(2) < res2(2) then
           for i = 0 to 3 : res(i) = res1(i) : next i
       else
           for i = 0 to 3 : res(i) = res2(i) : next i
       end if
       return
   end if
   if res1(3) > res2(3) then
       for i = 0 to 3 : res(i) = res2(i) : next i
   else
       for i = 0 to 3 : res(i) = res1(i) : next i
   end if

end sub

supply_left = 0 : total_cost = 0 : dim cell(4)

dim results(N_ROWS, N_COLS)

for i = 0 to N_ROWS - 1 : supply_left = supply_left + supply(i) : next i

while(supply_left > 0)

   next_cell(cell())
   r = cell(0)
   c = cell(1)
   q = min(demand(c), supply(r)) 
   demand(c) = demand(c) - q
   if not demand(c) col_done(c) = TRUE
   supply(r) = supply(r) - q
   if not supply(r) row_done(r) = TRUE
   results(r, c) = q
   supply_left = supply_left - q
   total_cost = total_cost + q * costs(r, c)

wend

print " A B C D E\n" for i = 0 to N_ROWS - 1

   print chr$(asc("W") + i), " ";
   for j = 0 to N_COLS - 1
   	print results(i, j) using "###";
   next j
   print

next i print "\nTotal cost = ", total_cost</lang>

zkl

Translation of: Python
Translation of: Ruby

<lang zkl>costs:=Dictionary(

  "W",Dictionary("A",16, "B",16, "C",13, "D",22, "E",17),
  "X",Dictionary("A",14, "B",14, "C",13, "D",19, "E",15),
  "Y",Dictionary("A",19, "B",19, "C",20, "D",23, "E",50),
  "Z",Dictionary("A",50, "B",12, "C",50, "D",15, "E",11)).makeReadOnly();

demand:=Dictionary("A",30, "B",20, "C",70, "D",30, "E",60); // gonna be modified supply:=Dictionary("W",50, "X",60, "Y",50, "Z",50); // gonna be modified</lang> <lang zkl>cols:=demand.keys.sort(); res :=vogel(costs,supply,demand); cost:=0; println("\t",cols.concat("\t")); foreach g in (costs.keys.sort()){

  print(g,"\t");
  foreach n in (cols){
     y:=res[g].find(n);
     if(y){ y=y[0]; print(y); cost+=y*costs[g][n]; }
     print("\t");
  }
  println();

} println("\nTotal Cost = ",cost);</lang> <lang zkl>fcn vogel(costs,supply,demand){

  // a Dictionary can be created via a list of (k,v) pairs
  res:= Dictionary(costs.pump(List,fcn([(k,_)]){ return(k,D()) }));
  g  := Dictionary(); // cross index costs and make writable
  supply.pump(Void,'wrap([(k,_)]){ g[k] = 
     costs[k].keys.sort('wrap(a,b){ costs[k][a]<costs[k][b] }).copy() });
  demand.pump(Void,'wrap([(k,_)]){ g[k] = 
     costs.keys.sort('wrap(a,b){ costs[a][k]<costs[b][k] }).copy() });
  while(g){
     d:=Dictionary(demand.pump(List,'wrap([(k,_)]){ return(k,

g[k][0,2].apply('wrap(gk){ costs[gk][k] }).reverse().reduce('-)) }));

     s:=Dictionary(supply.pump(List,'wrap([(k,_)]){ return(k,

g[k][0,2].apply('wrap(gk){ costs[k][gk] }).reverse().reduce('-)) }));

     f:=(0).max(d.values); f=d.filter('wrap([(_,v)]){ v==f })[-1][0];
     t:=(0).max(s.values); t=s.filter('wrap([(_,v)]){ v==t })[-1][0];
     t,f=(if(d[f]>s[t]) T(f,g[f][0]) else T(g[t][0],t));
     v:=supply[f].min(demand[t]);
     res[f].appendV(t,v);  // create t:(v) or append v to t:(...)
     if(0 == (demand[t]-=v)){

supply.pump(Void,'wrap([(k,n)]){ if(n!=0) g[k].remove(t) }); g.del(t); demand.del(t);

     }
     if(0 == (supply[f]-=v)){

demand.pump(Void,'wrap([(k,n)]){ if(n!=0) g[k].remove(f) }); g.del(f); supply.del(f);

     }
  }//while
  res

}</lang>

Output:
	A	B	C	D	E
W			50			
X	10	20	20		10	
Y	20			30		
Z					50	

Total Cost = 3100