Magic squares/Raku: Difference between revisions

From Rosetta Code
Content added Content deleted
m (→‎{{header|Perl 6}}: Clean up and refactor a bit. Randomize the magic square generation.)
m (→‎{{header|Perl 6}}: Meh. tried to be cute and ended up wrong.)
Line 1: Line 1:
Rather than having multiple examples for different orders of magic square, this will generate a magic square for ''any'' valid n x n grid. Note that it generates a randomized, though correct magic square.
Rather than having multiple examples for different orders of magic square, this will generate a magic square for ''any'' valid n x n grid.

Invoke at the command line and pass in the desired size as a parameter.
Invoke at the command line and pass in the desired size as a parameter.


Line 14: Line 15:
my @sq;
my @sq;
my $i = 1;
my $i = 1;
my $h = $n div 2;
my $q = $n div 4;
gen-sq($n);
gen-sq($n);


say .fmt("%{$i.chars}d", ' ') for @sq;
my @r = ^$n .pick(*);

say $_[@r].fmt("%{$i.chars}d", ' ') for @sq.pick(*);


say "\nThe magic number is ", [+] @sq[0].list;
say "\nThe magic number is ", [+] @sq[0].list;
Line 37: Line 39:
my $y = 0;
my $y = 0;
@sq[$i % $n ?? $y !! $y++][($i-1) % $n] = $i++ for ^$n²;
@sq[$i % $n ?? $y !! $y++][($i-1) % $n] = $i++ for ^$n²;
my $q = $n div 4;
for ^$q -> $r {
for ^$q -> $r {
for $q ..^ $n - $q -> $c {
for $q ..^ $n - $q -> $c {
Line 49: Line 50:


multi sub gen-sq ($n where {$n %% 2 and $n % 4}) { # singly even
multi sub gen-sq ($n where {$n %% 2 and $n % 4}) { # singly even
my $h = $n div 2;
my $q = $n div 4;
gen-sq($h);
gen-sq($h);
$i *= 4;
$i *= 4;
Line 63: Line 62:
(@sq[$r;$c], @sq[$r + $h;$c]) = (@sq[$r + $h;$c], @sq[$r;$c]);
(@sq[$r;$c], @sq[$r + $h;$c]) = (@sq[$r + $h;$c], @sq[$r;$c]);
}
}
}
if $h > 4 {
(@sq[$q;$q], @sq[$q+$h;$q]) = (@sq[$q+$h;$q], @sq[$q;$q]);
if $h > 4 {
for ^$h -> $r {
for ($n - $q + 1) ..^ $n -> $c {
for ($n - $q + 1) ..^ $n -> $c {
(@sq[$r;$c], @sq[$r + $h;$c]) = (@sq[$r + $h;$c], @sq[$r;$c]);
(@sq[$r;$c], @sq[$r + $h;$c]) = (@sq[$r + $h;$c], @sq[$r;$c]);
}
}
}
}
}
}
(@sq[$q;$q], @sq[$q+$h;$q]) = (@sq[$q+$h;$q], @sq[$q;$q]);
}
}
}</lang>
}</lang>

Revision as of 21:59, 18 March 2016

Rather than having multiple examples for different orders of magic square, this will generate a magic square for any valid n x n grid.

Invoke at the command line and pass in the desired size as a parameter.

Works with: Rakudo version 2016-02

See:

<lang perl6>sub MAIN (Int $n where {$n > 0}) {

   my @sq;
   my $i = 1;
   my $h = $n div 2;
   my $q = $n div 4;
   
   gen-sq($n);
   say .fmt("%{$i.chars}d", ' ') for @sq;
   say "\nThe magic number is ", [+] @sq[0].list;


   multi sub gen-sq (2) { # invalid
       note "Sorry, can not generate a 2 x 2 magic square." and exit;
   }
   multi sub gen-sq ($n where {$n % 2}) { # odd
       my $x = $n/2;
       my $y = 0;
       @sq[($i % $n ?? $y-- !! $y++) % $n][($i % $n ?? $x++ !! $x) % $n] = $i++ for ^$n²;
   }
   multi sub gen-sq ($n where {$n %% 4}) { # doubly even
       my $x = 0;
       my $y = 0;
       @sq[$i % $n ?? $y !! $y++][($i-1) % $n] = $i++ for ^$n²;
       for ^$q -> $r {
           for $q ..^ $n - $q -> $c {
               my $ŕ = $n - 1 - $r;
               my $ć = $n - 1 - $c;
               (@sq[$r;$c], @sq[$ŕ;$ć]) = (@sq[$ŕ;$ć], @sq[$r;$c]);
               (@sq[$c;$r], @sq[$ć;$ŕ]) = (@sq[$ć;$ŕ], @sq[$c;$r]);
           }
       }
   }
   multi sub gen-sq ($n where {$n %% 2 and $n % 4}) { # singly even
       gen-sq($h);
       $i *= 4;
       for ^$h -> $r {
           for ^$h -> $c {
               @sq[$r + $h; $c]      = @sq[$r;$c] + $h² * 3;
               @sq[$r; $c + $h]      = @sq[$r;$c] + $h² * 2;
               @sq[$r + $h; $c + $h] = @sq[$r;$c] + $h²;
           }
           for ^$q -> $c {
               next if $c == 0 and $r == ($h-1) div 2;
               (@sq[$r;$c], @sq[$r + $h;$c]) = (@sq[$r + $h;$c], @sq[$r;$c]);
           }
           if $h > 4 {
               for ($n - $q + 1) ..^ $n -> $c {
                       (@sq[$r;$c], @sq[$r + $h;$c]) = (@sq[$r + $h;$c], @sq[$r;$c]);
               }
           }
       }
       (@sq[$q;$q], @sq[$q+$h;$q]) = (@sq[$q+$h;$q], @sq[$q;$q]);
   }

}</lang>