Deconvolution/2D+: Difference between revisions
Rename Perl 6 -> Raku, alphabetize, minor clean-up
(Python example) |
Thundergnat (talk | contribs) (Rename Perl 6 -> Raku, alphabetize, minor clean-up) |
||
Line 79:
[6, 4, -26, -10, 26, 12]]]
</pre>
=={{header|C}}==
Line 815 ⟶ 814:
h3 -: g3 deconv3 f3 NB. -: checks for matching structure and data
1</lang>
=={{header|Julia}}==
Line 1,128 ⟶ 1,126:
[ 8 5 8],
[ -2 -6 -4],
],
]</pre>
Line 1,714 ⟶ 1,529:
[[7.0, 4.0, 4.0, -6.0], [9.0, 9.0, 4.0, -4.0], [-3.0, 7.0, -2.0, -3.0]]]
</pre>
=={{header|Raku}}==
(formerly Perl 6)
Works with Rakudo 2018.03.
Translation of Tcl.
<lang perl6># Deconvolution of N dimensional matrices.
sub deconvolve-N ( @g, @f ) {
my @hsize = @g.shape »-« @f.shape »+» 1;
my @toSolve = coords(@g.shape).map:
{ [row(@g, @f, $^coords, @hsize)] };
my @solved = rref( @toSolve );
my @h;
for flat coords(@hsize) Z @solved[*;*-1] -> $_, $v {
@h.AT-POS(|$_) = $v;
}
return @h;
}
# Construct a row for each value in @g to be sent to the simultaneous equation solver
sub row ( @g, @f, @gcoord, $hsize ) {
my @row;
@gcoord = @gcoord[(^@f.shape)]; # clip extraneous values
for coords( $hsize ) -> @hc {
my @fcoord;
for ^@hc -> $i {
my $window = @gcoord[$i] - @hc[$i];
@fcoord.push($window) and next if 0 <= $window < @f.shape[$i];
last;
}
@row.push: @fcoord == @hc ?? @f.AT-POS(|@fcoord) !! 0;
}
@row.push: @g.AT-POS(|@gcoord);
return @row;
}
# Constructs an AoA of coordinates to all elements of N dimensional array
sub coords ( @dim ) {
@[reverse $_ for [X] ([^$_] for reverse @dim)];
}
# Reduced Row Echelon Form simultaneous equation solver
# Can handle over-specified systems (N unknowns in N + M equations)
sub rref (@m) {
return unless @m;
my ($lead, $rows, $cols) = 0, +@m, +@m[0];
# Trim off over specified rows if they exist, for efficiency
if $rows >= $cols {
@m = trim_system(@m);
$rows = +@m;
}
for ^$rows -> $r {
$lead < $cols or return @m;
my $i = $r;
until @m[$i;$lead] {
++$i == $rows or next;
$i = $r;
++$lead == $cols and return @m;
}
@m[$i, $r] = @m[$r, $i] if $r != $i;
my $lv = @m[$r;$lead];
@m[$r] »/=» $lv;
for ^$rows -> $n {
next if $n == $r;
@m[$n] »-=» @m[$r] »*» (@m[$n;$lead] // 0);
}
++$lead;
}
return @m;
# Reduce a system of equations to N equations with N unknowns
sub trim_system ($m) {
my ($vars, @t) = +$m[0]-1;
for ^$vars -> $lead {
for ^$m -> $row {
@t.push: | $m.splice( $row, 1 ) and last if $m[$row;$lead];
}
}
while (+@t < $vars) and +$m { @t.push: $m.splice(0, 1) };
return @t;
}
}
# Pretty printer for N dimensional arrays
# Assumes if first element in level is an array, then all are
sub pretty_print ( @array, $indent = 0 ) {
if @array[0] ~~ Array {
say ' ' x $indent,"[";
pretty_print( $_, $indent + 2 ) for @array;
say ' ' x $indent, "]{$indent??','!!''}";
} else {
say ' ' x $indent, "[{say_it(@array)} ]{$indent??','!!''}";
}
sub say_it ( @array ) { return join ",", @array».fmt("%4s"); }
}
my @f[3;2;3] = (
[
[ -9, 5, -8 ],
[ 3, 5, 1 ],
],
[
[ -1, -7, 2 ],
[ -5, -6, 6 ],
],
[
[ 8, 5, 8 ],
[ -2, -6, -4 ],
]
);
my @g[4;4;6] = (
[
[ 54, 42, 53, -42, 85, -72 ],
[ 45,-170, 94, -36, 48, 73 ],
[ -39, 65,-112, -16, -78, -72 ],
[ 6, -11, -6, 62, 49, 8 ],
],
[
[ -57, 49, -23, 52,-135, 66 ],
[ -23, 127, -58, -5,-118, 64 ],
[ 87, -16, 121, 23, -41, -12 ],
[ -19, 29, 35,-148, -11, 45 ],
],
[
[ -55,-147,-146, -31, 55, 60 ],
[ -88, -45, -28, 46, -26,-144 ],
[ -12,-107, -34, 150, 249, 66 ],
[ 11, -15, -34, 27, -78, -50 ],
],
[
[ 56, 67, 108, 4, 2, -48 ],
[ 58, 67, 89, 32, 32, -8 ],
[ -42, -31,-103, -30, -23, -8 ],
[ 6, 4, -26, -10, 26, 12 ],
]
);
say "# {+@f.shape}D array:";
my @h = deconvolve-N( @g, @f );
say "h =";
pretty_print( @h );
my @h-shaped[2;3;4] = @(deconvolve-N( @g, @f ));
my @ff = deconvolve-N( @g, @h-shaped );
say "\nff =";
pretty_print( @ff );</lang>
Output:
<pre># 3D array:
h =
[
[
[ -6, -8, -5, 9 ],
[ -7, 9, -6, -8 ],
[ 2, -7, 9, 8 ],
],
[
[ 7, 4, 4, -6 ],
[ 9, 9, 4, -4 ],
[ -3, 7, -2, -3 ],
],
]
ff =
[
[
[ -9, 5, -8 ],
[ 3, 5, 1 ],
],
[
[ -1, -7, 2 ],
[ -5, -6, 6 ],
],
[
[ 8, 5, 8 ],
[ -2, -6, -4 ],
],
]</pre>
=={{header|Tcl}}==
| |||