82 lines
2.9 KiB
Perl
82 lines
2.9 KiB
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 = reverse zip scalar reverse($re_wh), scalar reverse($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);
|