Jump to content

Vogel's approximation method: Difference between revisions

Rename Perl 6 -> Raku, alphabetize, minor clean-up
(Rename Perl 6 -> Raku, alphabetize, minor clean-up)
Line 73:
;Cf.
* [[Transportation_problem|Transportation problem]]
 
 
=={{header|C}}==
Line 966 ⟶ 965:
Total Cost = 3100
</pre>
 
=={{header|Perl 6}}==
{{works with|Rakudo|2019.03.1}}
{{trans|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>
{{out}}
<pre> A B C D E
W - - 50 - -
X 30 - 20 - 10
Y - 20 - 30 -
Z - - - - 50
 
Total cost: 3100</pre>
 
=={{header|Phix}}==
Line 1,333 ⟶ 1,258:
 
Total Cost: 3100</pre>
 
=={{header|Raku}}==
(formerly Perl 6)
{{works with|Rakudo|2019.03.1}}
{{trans|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>
{{out}}
<pre> A B C D E
W - - 50 - -
X 30 - 20 - 10
Y - 20 - 30 -
Z - - - - 50
 
Total cost: 3100</pre>
 
=={{header|Ruby}}==
10,333

edits

Cookies help us deliver our services. By using our services, you agree to our use of cookies.