in reply to Kronecker Product

$ perl -le'
my @A = ( [ 1, 2 ], [ 3, 4 ] );
print map "[ @$_ ]\n", @A;
my @B = ( [ 5, 6 ], [ 7, 8 ] );
print map "[ @$_ ]\n", @B;
my @A_B;
for my $x ( @A ) {
    for my $y ( @B ) {
        push @A_B, [ map( $x->[ 0 ] * $_, @$y ), map $x->[ 1 ] * $_, @
+$y ];
        }
    }
print map "[ @$_ ]\n", @A_B;
'
[ 1 2 ]
[ 3 4 ]

[ 5 6 ]
[ 7 8 ]

[ 5 6 10 12 ]
[ 7 8 14 16 ]
[ 15 18 20 24 ]
[ 21 24 28 32 ]

[download]

Replies are listed 'Best First'.
Re^2: Kronecker Product
by choroba (Cardinal) on Jun 21, 2022 at 09:38 UTC
    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]
+);

    [download]

    map{substr$_->[0],$_->[1]||0,1}[\*||{},3],[[]],[ref qr-1,-,-1],[{}],[sub{}^*ARGV,3]
[reply]
[d/l]
[select]
      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;

      [download]

      [[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],
]

      [download]

      Cheers Rolf
      (addicted to the Perl Programming Language :)
      Wikisyntax for the Monastery

      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]

In Section Seekers of Perl Wisdom