Imaginary base numbers: Difference between revisions

=={{header|Perl}}==

{{trans|Perl 6}}

{{libheader|ntheory}}

<lang perl>use strict;

use warnings;

use feature 'say';

use Math::Complex;

use List::AllUtils qw(sum mesh);

use ntheory qw<todigitstring fromdigits>;

sub zip {

my($a,$b) = @_;

my($la, $lb) = (length $a, length $b);

my $l = '0' x abs $la - $lb;

$a .= $l if $la < $lb;

$b .= $l if $lb < $la;

(join('', mesh(@{[split('',$a),]}, @{[split('',$b),]})) =~ s/0+$//r) or 0;

}

sub base_i {

my($num,$radix,$precision) = @_;

die unless $radix > -37 and $radix < -1;

return '0' unless $num;

my $value = $num;

my $result = '';

my $place = 0;

my $upper_bound = 1 / (-$radix + 1);

my $lower_bound = $radix * $upper_bound;

$value = $num / $radix ** ++$place until $lower_bound <= $value and $value < $upper_bound;

while (($value or $place > 0) and $place > $precision) {

my $digit = int $radix * $value - $lower_bound;

$value = $radix * $value - $digit;

$result .= '.' unless $place or not index($result, '.');

$result .= $digit == -$radix ? todigitstring($digit-1, -$radix) . '0' : (todigitstring($digit, -$radix) or '0');

$place--;

}

$result

}

sub base_c {

my($num, $radix, $precision) = @_;

die "Base $radix out of range" unless

(-6 <= $radix->Im or $radix->Im <= -2) or (2 <= $radix->Im or $radix->Im <= 6);

my ($re,$im);

defined $num->Im ? ($re, $im) = ($num->Re, $num->Im) : $re = $num;

my ($re_wh, $re_fr) = split /\./, base_i( $re, -1 * int($radix->Im**2), $precision);

my ($im_wh, $im_fr) = split /\./, base_i( ($im/($radix->Im)), -1 * int($radix->Im**2), $precision);

$_ //= '' for $re_fr, $im_fr;

my $whole = join '', reverse split '', zip join('', reverse split '', $re_wh), join('', reverse split '', $im_wh);

my $fraction = zip $im_fr, $re_fr;

$fraction eq 0 ? "$whole" : "$whole.$fraction"

}

sub parse_base {

my($str, $radix) = @_;

return -1 * parse_base( substr($str,1), $radix) if substr($str,0,1) eq '-';

my($whole, $frac) = split /\./, $str;

my $fraction = 0;

my $k = 0;

$fraction = sum map { (fromdigits($_, int $radix->Im**2) || 0) * $radix ** -($k++ +1) } split '', $frac

if $frac;

$k = 0;

$fraction + sum map { (fromdigits($_, int $radix->Im**2) || 0) * $radix ** $k++ } reverse split '', $whole;

}

for (

[ 0*i, 2*i], [1+0*i, 2*i], [5+0*i, 2*i], [ -13+0*i, 2*i],

[ 9*i, 2*i], [ -3*i, 2*i], [7.75-7.5*i, 2*i], [0.25+0*i, 2*i],

[5+5*i, 2*i], [5+5*i, 3*i], [5+5*i, 4*i], [5+5*i, 5*i], [5+5*i, 6*i],

[5+5*i, -2*i], [5+5*i, -3*i], [5+5*i, -4*i], [5+5*i, -5*i], [5+5*i, -6*i]

) {

my($v,$r) = @$_;

my $ibase = base_c($v, $r, -6);

my $rt = cplx parse_base($ibase, $r);

$rt->display_format('format' => '%.2f');

printf "base(%3s): %10s => %9s => %13s\n", $r, $v, $ibase, $rt;

}

say '';

say 'base( 6i): 31432.6219135802-2898.5266203704*i => ' .

base_c(31432.6219135802-2898.5266203704*i, 0+6*i, -3);</lang>

{{out}}

<pre>base( 2i): 0 => 0 => 0

base( 2i): 1 => 1 => 1.00

base( 2i): 5 => 10301 => 5.00-0.00i

base( 2i): -13 => 1030003 => -13.00+0.00i

base( 2i): 9i => 103010.2 => 0.00+9.00i

base( 2i): -3i => 1030.2 => -0.00-3.00i

base( 2i): 7.75-7.5i => 11210.31 => 7.75-7.50i

base( 2i): 0.25 => 1.03 => 0.25-0.00i

base( 2i): 5+5i => 10331.2 => 5.00+5.00i

base( 3i): 5+5i => 25.3 => 5.00+5.00i

base( 4i): 5+5i => 25.c => 5.00+5.00i

base( 5i): 5+5i => 15 => 5.00+5.00i

base( 6i): 5+5i => 15.6 => 5.00+5.00i

base(-2i): 5+5i => 11321.2 => 5.00+5.00i

base(-3i): 5+5i => 1085.6 => 5.00+5.00i

base(-4i): 5+5i => 10f5.4 => 5.00+5.00i

base(-5i): 5+5i => 10o5 => 5.00+5.00i

base(-6i): 5+5i => 5.u => 5.00+5.00i

base( 6i): 31432.6219135802-2898.5266203704*i => perl5.4ever</pre>