Help language development. Donate to The Perl Foundation

Math::Libgsl::Permutation cpan:FRITH last updated on 2020-10-14

t/01-raw-permutation.rakutest
#!/usr/bin/env perl6

use Test;
use lib 'lib';
use Math::Libgsl::Raw::Permutation :ALL;
use Math::Libgsl::Raw::Matrix :ALL;
use Math::Libgsl::Constants;
use NativeCall;

subtest {
  my $p = gsl_permutation_alloc(10);
  isa-ok $p, gsl_permutation, 'allocate permutation structure';
  lives-ok { gsl_permutation_init($p) }, 'identity permutation structure';
  ok $p.data[9] == 9, 'verify initialization';
  lives-ok { gsl_permutation_free($p) }, 'free permutation structure';
  my $cp = gsl_permutation_calloc(10);
  isa-ok $cp, gsl_permutation, 'allocate, clear, and initialize permutation structure';
  ok $cp.size == 10, 'read permutation structure size';
  ok $cp.data[9] == 9, 'verify initialization';
  my $cd = gsl_permutation_calloc(10);
  ok gsl_permutation_memcpy($cd, $cp) == GSL_SUCCESS, 'copy permutation structure';
  lives-ok { gsl_permutation_free($cp) }, 'free source permutation structure';
  lives-ok { gsl_permutation_free($cd) }, 'free destination permutation structure';
}, 'raw - memory operations';

subtest {
  my $p = gsl_permutation_alloc(10);
  gsl_permutation_init($p);
  ok gsl_permutation_get($p, 2) == 2, 'get element';
  ok gsl_permutation_swap($p, 2, 3) == GSL_SUCCESS, 'swap two elements returns success';
  ok gsl_permutation_get($p, 2) == 3 && gsl_permutation_get($p, 2) == 3, 'two elements swapped';
  gsl_permutation_free($p);
}, 'raw - accessing elements';

subtest {
  my $p = gsl_permutation_alloc(10);
  gsl_permutation_init($p);
  ok gsl_permutation_size($p) == 10, 'permutation size';
  ok $p.data[2] == 2, 'read permutation element';
  ok gsl_permutation_valid($p) == GSL_SUCCESS, 'the permutation is valid';
  gsl_permutation_free($p);
}, 'raw - properties';

subtest {
  my $p = gsl_permutation_alloc(10);
  gsl_permutation_init($p);
  my $orig = $p.data[9];
  lives-ok { gsl_permutation_reverse($p) }, 'reverse the elements returns success';
  ok $p.data[0] == $orig, 'data reversed';
  my $p1 = gsl_permutation_alloc(10);
  gsl_permutation_init($p1);
  gsl_permutation_next($p1);
  my $filename = 't/raw-permutation.dat';
  LEAVE { with $filename.IO { .unlink if .e } }
  ok mgsl_permutation_fwrite($filename, $p1) == GSL_SUCCESS, 'can write data to file';
  ok mgsl_permutation_fread($filename, $p1) == GSL_SUCCESS, 'can read data from file';
  is-deeply $p1.data[^10], (0, 1, 2, 3, 4, 5, 6, 7, 9, 8), 'verify data';
  my $inv = gsl_permutation_calloc(10);
  ok gsl_permutation_inverse($inv, $p1) == GSL_SUCCESS, 'inverse permutation';
  ok $inv.data[9] == 8, 'data inverted';
  my $p2 = gsl_permutation_alloc(10);
  gsl_permutation_init($p2);
  $orig = $p2.data[9];
  ok gsl_permutation_next($p2) == GSL_SUCCESS, 'next permutation returns success';
  ok $p2.data[8] == $orig, 'next permutation data ok';
  ok gsl_permutation_prev($p2) == GSL_SUCCESS, 'previous permutation returns success';
  ok $p2.data[8] == 8, 'previous permutation data ok';
  gsl_permutation_free($p);
  gsl_permutation_free($p1);
  gsl_permutation_free($p2);
}, 'raw - functions';

subtest {
  my $p = gsl_permutation_alloc(5);
  gsl_permutation_init($p);
  gsl_permutation_next($p);
  my $c;
  $c = CArray[num64].new: 100e0, 101e0, 102e0, 103e0, 104e0;
  ok gsl_permute($p.data, $c, 1, 5) == GSL_SUCCESS, 'gsl_permute returns success';
  is-deeply $c.list, (100e0, 101e0, 102e0, 104e0, 103e0), 'input data permutated';
  $c = CArray[num64].new: 100e0, 101e0, 102e0, 103e0, 104e0;
  ok gsl_permute_inverse($p.data, $c, 1, 5) == GSL_SUCCESS, 'gsl_permute_inverse returns success';
  is-deeply $c.list, (100e0, 101e0, 102e0, 104e0, 103e0), 'input data inverted';
  my $z = CArray[num64].new: 100e0, 1e0, 101e0, 1e0, 102e0, 1e0, 103e0, 1e0, 104e0, 1e0;
  ok gsl_permute_complex($p.data, $z, 1, 5) == GSL_SUCCESS, 'gsl_permute_complex returns success';
  is-deeply $z.list, (100e0, 1e0, 101e0, 1e0, 102e0, 1e0, 104e0, 1e0, 103e0, 1e0), 'complex data permutated';
  $c = CArray[num64].new: 100e0, 101e0, 102e0, 103e0, 104e0;
  ok gsl_permute_complex_inverse($p.data, $z, 1, 5) == GSL_SUCCESS, 'gsl_permute_complex_inverse returns success';
  is-deeply $z.list, (100e0, 1e0, 101e0, 1e0, 102e0, 1e0, 103e0, 1e0, 104e0, 1e0), 'complex data permutated';
  my $zf = CArray[num32].new: 100e0, 1e0, 101e0, 1e0, 102e0, 1e0, 103e0, 1e0, 104e0, 1e0;
  ok gsl_permute_complex_float($p.data, $zf, 1, 5) == GSL_SUCCESS, 'gsl_permute_complex_float returns success';
  is-deeply $zf.list, (100e0, 1e0, 101e0, 1e0, 102e0, 1e0, 104e0, 1e0, 103e0, 1e0), 'complex float data permutated';
  $c = CArray[num64].new: 100e0, 101e0, 102e0, 103e0, 104e0;
  ok gsl_permute_complex_float_inverse($p.data, $zf, 1, 5) == GSL_SUCCESS, 'gsl_permute_complex_float_inverse returns success';
  is-deeply $zf.list, (100e0, 1e0, 101e0, 1e0, 102e0, 1e0, 103e0, 1e0, 104e0, 1e0), 'complex float data permutated';
  my gsl_vector $v = gsl_vector_alloc(5);
  gsl_vector_set($v, $_, $_.Num) for ^5;
  gsl_permute_vector($p, $v);
  is-deeply (gather take gsl_vector_get($v, $_) for ^5), (0e0, 1e0, 2e0, 4e0, 3e0), 'vector permutation';
  gsl_permute_vector_inverse($p, $v);
  is-deeply (gather take gsl_vector_get($v, $_) for ^5), (0e0, 1e0, 2e0, 3e0, 4e0), 'inverse vector permutation';
  my gsl_matrix $m = gsl_matrix_alloc(5, 5);
  for ^5 -> $r {
    for ^5 -> $c {
      gsl_matrix_set($m, $r, $c, $c + $r * 10e0);
    }
  }
  gsl_permute_matrix($p, $m);
  is-deeply (gather for ^5 -> $r { for ^5 -> $c { take gsl_matrix_get($m, $r, $c) } }),
    (0, 1, 2, 4, 3, 10, 11, 12, 14, 13, 20, 21, 22, 24, 23, 30, 31, 32, 34, 33, 40, 41, 42, 44, 43)ยป.Num,
    'matrix permutation';
  $c = CArray[num64].new: 100e0, 101e0, 102e0, 104e0, 103e0;
  my $p1 = gsl_permutation_alloc(5);
  gsl_permutation_init($p1);
  gsl_permutation_next($p1);
  my $p2 = gsl_permutation_alloc(5);
  gsl_permutation_init($p2);
  gsl_permutation_next($p2);
  gsl_permutation_next($p2);
  my $res = gsl_permutation_alloc(5);
  ok gsl_permutation_mul($res, $p1, $p2) == GSL_SUCCESS, 'gsl_permutation_mul returns success';
  gsl_permute($res.data, $c, 1, 5);
  is-deeply $c.list, (100e0, 101e0, 104e0, 103e0, 102e0), 'permutation & multiplication data';
  gsl_permutation_free($p);
  gsl_permutation_free($p1);
  gsl_permutation_free($p2);
}, 'raw - applying';

subtest {
  my $plin = gsl_permutation_alloc(5);
  gsl_permutation_init($plin);
  my $pcan = gsl_permutation_alloc(5);
  ok gsl_permutation_linear_to_canonical($pcan, $plin) == GSL_SUCCESS, 'linear to canonical returns success';
  is-deeply $plin.data[^5], $pcan.data[^5].reverse, 'linear to canonical';
  ok gsl_permutation_canonical_cycles($pcan) == 5, 'count canonical cycles';
  ok gsl_permutation_linear_cycles($plin) == 5, 'count linear cycles';
  ok gsl_permutation_canonical_to_linear($plin, $pcan) == GSL_SUCCESS, 'canonical to linear returns success';
  is-deeply $plin.data[^5], $pcan.data[^5].reverse, 'canonical to linear';
  gsl_permutation_free($plin);
  gsl_permutation_free($pcan);
}, 'raw - cyclic';

done-testing;