|
in reply to Re: Kronecker Product
in thread Kronecker Product
It doesn't work for the larger example from Wikipedia:
my $X = pdl([1, -4, 7],
[-2, 3, 3]);
my $Y = pdl([8, -9, -6, 5],
[1, -3, -4, 7],
[2, 8, -8, -3],
[1, 2, -5, -1]);
my $XY =pdl([ 8, -9, -6, 5, -32, 36, 24, -20, 56, -63, -42, 35]
+,
[ 1, -3, -4, 7, -4, 12, 16, -28, 7, -21, -28, 49]
+,
[ 2, 8, -8, -3, -8, -32, 32, 12, 14, 56, -56, -21]
+,
[ 1, 2, -5, -1, -4, -8, 20, 4, 7, 14, -35, -7]
+,
[-16, 18, 12, -10, 24, -27, -18, 15, 24, -27, -18, 15]
+,
[ -2, 6, 8, -14, 3, -9, -12, 21, 3, -9, -12, 21]
+,
[ -4, -16, 16, 6, 6, 24, -24, -9, 6, 24, -24, -9]
+,
[ -2, -4, 10, 2, 3, 6, -15, -3, 3, 6, -15, -3]
+);
map{substr$_->[0],$_->[1]||0,1}[\*||{},3],[[]],[ref qr-1,-,-1],[{}],[sub{}^*ARGV,3]
|
Re^3: Kronecker Product
by LanX (Saint) on Jun 21, 2022 at 11:34 UTC
|
that's because he hardcoded $x->[0] and $x->[1]
here a generic version
use v5.12;
use warnings;
use Data::Dump qw/pp dd/;
my $X =
[
[1, -4, 7],
[-2, 3, 3]
];
my $Y =
[
[8, -9, -6, 5],
[1, -3, -4, 7],
[2, 8, -8, -3],
[1, 2, -5, -1]
];
pp $X;
pp $Y;
my $X_Y;
for my $x ( @$X ) {
for my $y ( @$Y ) {
push @$X_Y,
[
map {
my $xx = $_;
map { $xx * $_} @$y
} @$x
];
}
}
pp $X_Y;
[[1, -4, 7], [-2, 3, 3]]
[[8, -9, -6, 5], [1, -3, -4, 7], [2, 8, -8, -3], [1, 2, -5, -1]]
[
[8, -9, -6, 5, -32, 36, 24, -20, 56, -63, -42, 35],
[1, -3, -4, 7, -4, 12, 16, -28, 7, -21, -28, 49],
[2, 8, -8, -3, -8, -32, 32, 12, 14, 56, -56, -21],
[1, 2, -5, -1, -4, -8, 20, 4, 7, 14, -35, -7],
[-16, 18, 12, -10, 24, -27, -18, 15, 24, -27, -18, 15],
[-2, 6, 8, -14, 3, -9, -12, 21, 3, -9, -12, 21],
[-4, -16, 16, 6, 6, 24, -24, -9, 6, 24, -24, -9],
[-2, -4, 10, 2, 3, 6, -15, -3, 3, 6, -15, -3],
]
updates
cleaned up code
addded output | [reply]
[d/l]
[select] |
|
|
Nice! Interestingly, for this input, the pure Perl solution if faster than my PDL one. But if you make the matrices larger, e.g. already 3x5 and 4x5 makes PDL the fastest, as it scales the best.
map{substr$_->[0],$_->[1]||0,1}[\*||{},3],[[]],[ref qr-1,-,-1],[{}],[sub{}^*ARGV,3]
| [reply]
[d/l] |
|
|
Just for fun, a solution with nested maps only ... :)
use v5.12;
use warnings;
use Data::Dump qw/pp dd/;
my $X =
[
[1, -4, 7],
[-2, 3, 3]
];
my $Y =
[
[8, -9, -6, 5],
[1, -3, -4, 7],
[2, 8, -8, -3],
[1, 2, -5, -1]
];
pp $X;
pp $Y;
my $X_Y =
[
map {
my $x = $_;
map {
my $y = $_;
[
map {
my $xx = $_;
map { $xx * $_ } @$y
} @$x
]
} @$Y
} @$X
];
pp $X_Y;
[[1, -4, 7], [-2, 3, 3]]
[[8, -9, -6, 5], [1, -3, -4, 7], [2, 8, -8, -3], [1, 2, -5, -1]]
[
[8, -9, -6, 5, -32, 36, 24, -20, 56, -63, -42, 35],
[1, -3, -4, 7, -4, 12, 16, -28, 7, -21, -28, 49],
[2, 8, -8, -3, -8, -32, 32, 12, 14, 56, -56, -21],
[1, 2, -5, -1, -4, -8, 20, 4, 7, 14, -35, -7],
[-16, 18, 12, -10, 24, -27, -18, 15, 24, -27, -18, 15],
[-2, 6, 8, -14, 3, -9, -12, 21, 3, -9, -12, 21],
[-4, -16, 16, 6, 6, 24, -24, -9, 6, 24, -24, -9],
[-2, -4, 10, 2, 3, 6, -15, -3, 3, 6, -15, -3],
]
| [reply]
[d/l]
[select] |
|
|
