use
5.010;
our
$VERSION
=
'0.13'
;
'""'
=> \
&stringify
,
'0+'
=> \
&numify
,
bool
=> \
&boolify
,
'+'
=> \
&add
,
'*'
=> \
&mul
,
'=='
=> \
&eq
,
'!='
=> \
&ne
,
'~'
=> \
&conj
,
'&'
=> \
&and
,
'|'
=> \
&or
,
'^'
=> \
&xor
,
'>>'
=> \
&rsft
,
'<<'
=> \
&lsft
,
'>'
=>
sub
{
$_
[2] ? (
goto
<
) : (
goto
>
) },
'>='
=>
sub
{
$_
[2] ? (
goto
&le
) : (
goto
&ge
) },
'<'
=>
sub
{
$_
[2] ? (
goto
>
) : (
goto
<
) },
'<='
=>
sub
{
$_
[2] ? (
goto
&ge
) : (
goto
&le
) },
'<=>'
=>
sub
{
$_
[2] ? -(
&cmp
(
$_
[0],
$_
[1]) //
return
undef
) :
&cmp
(
$_
[0],
$_
[1]) },
'/'
=>
sub
{
@_
= (
$_
[1],
$_
[0])
if
$_
[2];
goto
&div
},
'-'
=>
sub
{
@_
= (
$_
[1],
$_
[0])
if
$_
[2];
goto
&sub
},
'**'
=>
sub
{
@_
=
$_
[2] ?
@_
[1, 0] :
@_
[0, 1];
goto
&pow
},
'%'
=>
sub
{
@_
=
$_
[2] ?
@_
[1, 0] :
@_
[0, 1];
goto
&mod
},
atan2
=>
sub
{
@_
=
$_
[2] ?
@_
[1, 0] :
@_
[0, 1];
goto
&atan2
},
eq
=>
sub
{
"$_[0]"
eq
"$_[1]"
},
ne
=>
sub
{
"$_[0]"
ne
"$_[1]"
},
cmp
=>
sub
{
$_
[2] ? (
"$_[1]"
cmp
$_
[0]->stringify) : (
$_
[0]->stringify cmp
"$_[1]"
) },
neg
=> \
&neg
,
sin
=> \
&sin
,
cos
=> \
&cos
,
exp
=> \
&exp
,
log
=> \
&log
,
int
=> \
&int
,
abs
=> \
&abs
,
sqrt
=> \
&sqrt
;
{
my
%const
= (
i
=> \
&i
,
);
my
%trig
= (
sin
=>
sub
(_) {
goto
&sin
},
sinh
=> \
&sinh
,
asin
=> \
&asin
,
asinh
=> \
&asinh
,
cos
=>
sub
(_) {
goto
&cos
},
cosh
=> \
&cosh
,
acos
=> \
&acos
,
acosh
=> \
&acosh
,
tan
=> \
&tan
,
tanh
=> \
&tanh
,
atan
=> \
&atan
,
atanh
=> \
&atanh
,
cot
=> \
&cot
,
coth
=> \
&coth
,
acot
=> \
&acot
,
acoth
=> \
&acoth
,
sec
=> \
&sec
,
sech
=> \
&sech
,
asec
=> \
&asec
,
asech
=> \
&asech
,
csc
=> \
&csc
,
csch
=> \
&csch
,
acsc
=> \
&acsc
,
acsch
=> \
&acsch
,
atan2
=>
sub
($$) {
goto
&atan2
},
deg2rad
=> \
°2rad
,
rad2deg
=> \
&rad2deg
,
);
my
%special
= (
exp
=>
sub
(_) {
goto
&exp
},
log
=>
sub
(_) {
goto
&log
},
sqrt
=>
sub
(_) {
goto
&sqrt
},
cbrt
=> \
&cbrt
,
logn
=> \
&logn
,
root
=> \
&root
,
pow
=> \
&pow
,
pown
=> \
&pown
,
gcd
=> \
&gcd
,
invmod
=> \
&invmod
,
powmod
=> \
&powmod
,
);
my
%misc
= (
acmp
=> \
&acmp
,
cplx
=> \
&cplx
,
polar
=> \
&polar
,
abs
=>
sub
(_) {
goto
&abs
},
inv
=> \
&inv
,
sgn
=> \
&sgn
,
conj
=> \
&conj
,
norm
=> \
&norm
,
real
=> \
&real
,
imag
=> \
&imag
,
floor
=> \
&floor
,
ceil
=> \
&ceil
,
round
=> \
&round
,
reals
=> \
&reals
,
);
sub
import
{
shift
;
my
$caller
=
caller
(0);
while
(
@_
) {
my
$name
=
shift
(
@_
);
if
(
$name
eq
':overload'
) {
overload::constant
integer
=>
sub
{ __PACKAGE__->new(
$_
[0], 0) },
float
=>
sub
{ __PACKAGE__->new(
$_
[0], 0) };
foreach
my
$pair
([
'i'
, i()]) {
my
$sub
=
$caller
.
'::'
.
$pair
->[0];
no
strict
'refs'
;
no
warnings
'redefine'
;
my
$value
=
$pair
->[1];
*$sub
=
sub
() {
$value
};
}
}
elsif
(
exists
$const
{
$name
}) {
no
strict
'refs'
;
no
warnings
'redefine'
;
my
$caller_sub
=
$caller
.
'::'
.
$name
;
my
$sub
=
$const
{
$name
};
my
$value
=
$sub
->();
*$caller_sub
=
sub
() {
$value
}
}
elsif
(
exists
(
$trig
{
$name
})
or
exists
(
$special
{
$name
})
or
exists
(
$misc
{
$name
})) {
no
strict
'refs'
;
no
warnings
'redefine'
;
my
$caller_sub
=
$caller
.
'::'
.
$name
;
*$caller_sub
=
$trig
{
$name
} //
$misc
{
$name
} //
$special
{
$name
};
}
elsif
(
$name
eq
':trig'
) {
push
@_
,
keys
(
%trig
);
}
elsif
(
$name
eq
':misc'
) {
push
@_
,
keys
(
%misc
);
}
elsif
(
$name
eq
':special'
) {
push
@_
,
keys
(
%special
);
}
elsif
(
$name
eq
':all'
) {
push
@_
,
keys
(
%const
),
keys
(
%trig
),
keys
(
%special
),
keys
(
%misc
);
}
else
{
die
"unknown import: <<$name>>"
;
}
}
return
;
}
sub
unimport {
overload::remove_constant(
float
=>
''
,
integer
=>
''
,);
}
}
sub
_cartesian {
my
(
$self
) =
@_
;
$self
->{cartesian} //= [
$self
->{a},
$self
->{b}];
}
sub
_polar {
my
(
$self
) =
@_
;
$self
->{polar} //= [CORE::
sqrt
(
$self
->{a} *
$self
->{a} +
$self
->{b} *
$self
->{b}), CORE::
atan2
(
$self
->{b},
$self
->{a})];
}
sub
polar {
my
(
$self
) =
@_
;
@{
$self
->_polar};
}
sub
new {
my
(
$class
,
$x
,
$y
) =
@_
;
bless
{
a
=>
$x
// 0,
b
=>
$y
// 0,
},
$class
;
}
*make
= \
&new
;
sub
cplx {
my
(
$x
,
$y
) =
@_
;
bless
{
a
=>
$x
// 0,
b
=>
$y
// 0,
},
__PACKAGE__;
}
sub
emake {
my
(
$class
,
$r
,
$theta
) =
@_
;
bless
{
a
=> (
$r
// 0) * CORE::
cos
(
$theta
// 0),
b
=> (
$r
// 0) * CORE::
sin
(
$theta
// 0),
},
$class
;
}
sub
cplxe {
my
(
$r
,
$theta
) =
@_
;
bless
{
a
=> (
$r
// 0) * CORE::
cos
(
$theta
// 0),
b
=> (
$r
// 0) * CORE::
sin
(
$theta
// 0),
},
__PACKAGE__;
}
sub
i {
__PACKAGE__->new(0, 1);
}
sub
add {
my
(
$x
,
$y
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
$y
= __PACKAGE__->new(
$y
)
if
ref
(
$y
) ne __PACKAGE__;
__PACKAGE__->new(
$x
->{a} +
$y
->{a},
$x
->{b} +
$y
->{b});
}
sub
sub
{
my
(
$x
,
$y
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
$y
= __PACKAGE__->new(
$y
)
if
ref
(
$y
) ne __PACKAGE__;
__PACKAGE__->new(
$x
->{a} -
$y
->{a},
$x
->{b} -
$y
->{b});
}
sub
mul {
my
(
$x
,
$y
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
$y
= __PACKAGE__->new(
$y
)
if
ref
(
$y
) ne __PACKAGE__;
__PACKAGE__->new(
$x
->{a} *
$y
->{a} -
$x
->{b} *
$y
->{b},
$x
->{a} *
$y
->{b} +
$x
->{b} *
$y
->{a});
}
sub
div {
my
(
$x
,
$y
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
$y
= __PACKAGE__->new(
$y
)
if
ref
(
$y
) ne __PACKAGE__;
my
$d
=
$y
->{a} *
$y
->{a} +
$y
->{b} *
$y
->{b};
if
(
$d
== 0) {
return
$x
->
log
->
sub
(
$y
->
log
)->
exp
;
}
__PACKAGE__->new((
$x
->{a} *
$y
->{a} +
$x
->{b} *
$y
->{b}) /
$d
, (
$x
->{b} *
$y
->{a} -
$x
->{a} *
$y
->{b}) /
$d
);
}
sub
mod {
my
(
$x
,
$y
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
$y
= __PACKAGE__->new(
$y
)
if
ref
(
$y
) ne __PACKAGE__;
$x
->
sub
(
$x
->div(
$y
)->floor->mul(
$y
));
}
sub
inv ($) {
my
(
$x
) =
@_
;
state
$one
= __PACKAGE__->new(1, 0);
$one
->div(
$x
);
}
sub
abs
{
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
CORE::
sqrt
(
$x
->{a} *
$x
->{a} +
$x
->{b} *
$x
->{b});
}
sub
sgn ($) {
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
if
(
$x
->{a} == 0 and
$x
->{b} == 0) {
return
__PACKAGE__->new(0, 0);
}
$x
->div(
$x
->
abs
);
}
sub
neg {
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
__PACKAGE__->new(-
$x
->{a}, -
$x
->{b});
}
sub
conj ($) {
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
__PACKAGE__->new(
$x
->{a}, -
$x
->{b});
}
sub
norm ($) {
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
$x
->{a} *
$x
->{a} +
$x
->{b} *
$x
->{b};
}
sub
and {
my
(
$x
,
$y
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
$y
= __PACKAGE__->new(
$y
)
if
ref
(
$y
) ne __PACKAGE__;
__PACKAGE__->new(
$x
->{a} &
$y
->{a},
$x
->{b} &
$y
->{b});
}
sub
or {
my
(
$x
,
$y
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
$y
= __PACKAGE__->new(
$y
)
if
ref
(
$y
) ne __PACKAGE__;
__PACKAGE__->new(
$x
->{a} |
$y
->{a},
$x
->{b} |
$y
->{b});
}
sub
xor {
my
(
$x
,
$y
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
$y
= __PACKAGE__->new(
$y
)
if
ref
(
$y
) ne __PACKAGE__;
__PACKAGE__->new(
$x
->{a} ^
$y
->{a},
$x
->{b} ^
$y
->{b});
}
sub
lsft {
my
(
$x
,
$y
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
$y
= __PACKAGE__->new(
$y
)
if
ref
(
$y
) ne __PACKAGE__;
if
(
$y
->{b} == 0) {
return
__PACKAGE__->new(
$x
->{a} <<
$y
->{a},
$x
->{b} <<
$y
->{a});
}
state
$two
= __PACKAGE__->new(2, 0);
$x
->mul(
$two
->pow(
$y
))->
int
;
}
sub
rsft {
my
(
$x
,
$y
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
$y
= __PACKAGE__->new(
$y
)
if
ref
(
$y
) ne __PACKAGE__;
if
(
$y
->{b} == 0) {
return
__PACKAGE__->new(
$x
->{a} >>
$y
->{a},
$x
->{b} >>
$y
->{a});
}
state
$two
= __PACKAGE__->new(2, 0);
$x
->div(
$two
->pow(
$y
))->
int
;
}
sub
log
{
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
my
$t
=
$x
->{a} *
$x
->{a} +
$x
->{b} *
$x
->{b};
if
(!
ref
(
$t
) and
$t
== 0) {
return
__PACKAGE__->new(0 +
'-Inf'
, 0);
}
__PACKAGE__->new(CORE::
log
(
$t
) / 2, CORE::
atan2
(
$x
->{b},
$x
->{a}));
}
sub
logn ($$) {
my
(
$x
,
$n
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
$n
= __PACKAGE__->new(
$n
)
if
ref
(
$n
) ne __PACKAGE__;
$x
->
log
->div(
$n
->
log
);
}
sub
exp
{
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
my
$exp
= CORE::
exp
(
$x
->{a});
__PACKAGE__->new(
$exp
* CORE::
cos
(
$x
->{b}),
$exp
* CORE::
sin
(
$x
->{b}));
}
sub
pow ($$) {
my
(
$x
,
$y
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
$y
= __PACKAGE__->new(
$y
)
if
ref
(
$y
) ne __PACKAGE__;
if
(
$x
->{a} == 0 and
$x
->{b} == 0) {
if
(
$y
->{a} < 0) {
return
$x
->inv;
}
if
(
$y
->{a} == 0 and
$y
->{b} == 0) {
return
__PACKAGE__->new(
$x
->{a} + 1,
$x
->{b});
}
return
$x
;
}
$x
->
log
->mul(
$y
)->
exp
;
}
sub
pown ($$) {
my
(
$x
,
$y
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
$y
= CORE::
int
(
$y
);
my
$neg
=
$y
< 0;
$y
= CORE::
int
(CORE::
abs
(
$y
));
if
(
$x
->{a} == 0 and
$x
->{b} == 0) {
if
(
$neg
) {
return
$x
->inv;
}
if
(
$y
== 0) {
return
__PACKAGE__->new(
$x
->{a} + 1,
$x
->{b});
}
return
$x
;
}
my
(
$rx
,
$ry
) = (1, 0);
my
(
$ax
,
$bx
) = (@{
$x
}{
qw(a b)
});
while
(1) {
(
$rx
,
$ry
) = (
$rx
*
$ax
-
$ry
*
$bx
,
$rx
*
$bx
+
$ry
*
$ax
)
if
(
$y
& 1);
(
$y
>>= 1) or
last
;
(
$ax
,
$bx
) = (
$ax
*
$ax
-
$bx
*
$bx
,
$ax
*
$bx
+
$bx
*
$ax
);
}
$neg
? __PACKAGE__->new(
$rx
,
$ry
)->inv : __PACKAGE__->new(
$rx
,
$ry
);
}
sub
gcd ($$) {
my
(
$n
,
$k
) =
@_
;
$n
= __PACKAGE__->new(
$n
)
if
ref
(
$n
) ne __PACKAGE__;
$k
= __PACKAGE__->new(
$k
)
if
ref
(
$k
) ne __PACKAGE__;
my
$norm_n
=
$n
->{a} *
$n
->{a} +
$n
->{b} *
$n
->{b};
my
$norm_k
=
$k
->{a} *
$k
->{a} +
$k
->{b} *
$k
->{b};
if
(
$norm_n
>
$norm_k
) {
(
$n
,
$k
) = (
$k
,
$n
);
}
while
(!(
$k
->{a} == 0 and
$k
->{b} == 0)) {
my
$q
=
$n
->div(
$k
)->round;
my
$r
=
$n
->
sub
(
$q
->mul(
$k
));
(
$n
,
$k
) = (
$k
,
$r
);
}
$n
;
}
sub
invmod ($$) {
my
(
$x
,
$m
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
$m
= __PACKAGE__->new(
$m
)
if
ref
(
$m
) ne __PACKAGE__;
my
$g
=
$x
->gcd(
$m
);
$g
->
abs
== 1 or
return
undef
;
state
$zero
= __PACKAGE__->new(0, 0);
my
$inverse
=
sub
{
my
(
$x
,
$m
,
$k
) =
@_
;
my
(
$u
,
$w
) = (
$k
,
$zero
);
my
(
$q
,
$r
);
my
$c
=
$m
;
while
(!(
$c
->{a} == 0 and
$c
->{b} == 0)) {
$q
=
$x
->div(
$c
)->round;
$r
=
$x
->
sub
(
$q
->mul(
$c
));
(
$x
,
$c
) = (
$c
,
$r
);
(
$u
,
$w
) = (
$w
,
$u
->
sub
(
$q
->mul(
$w
)));
}
return
$u
;
};
state
$one
= __PACKAGE__->new(1, 0);
state
$mone
= __PACKAGE__->new(-1, 0);
state
$i
= __PACKAGE__->new(0, 1);
state
$mi
= __PACKAGE__->new(0, -1);
foreach
my
$k
(
$g
->conj,
$one
,
$mone
,
$i
,
$mi
) {
my
$inv
=
$inverse
->(
$x
,
$m
,
$k
);
my
$t
=
$x
->mul(
$inv
)->mod(
$m
);
if
(
$t
->{a} == 1 and
$t
->{b} == 0) {
return
$inv
->mod(
$m
);
}
}
return
undef
;
}
sub
powmod ($$$) {
my
(
$x
,
$y
,
$m
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
$m
= __PACKAGE__->new(
$m
)
if
ref
(
$m
) ne __PACKAGE__;
$y
= CORE::
int
(
$y
);
my
$neg
=
$y
< 0;
$y
= CORE::
int
(CORE::
abs
(
$y
));
if
(
$x
->{a} == 0 and
$x
->{b} == 0) {
if
(
$neg
) {
return
$x
->invmod(
$m
);
}
if
(
$y
== 0) {
return
__PACKAGE__->new(
$x
->{a} + 1,
$x
->{b})->mod(
$m
);
}
return
$x
->mod(
$m
);
}
$x
=
$x
->invmod(
$m
)
if
$neg
;
$x
//
return
undef
;
my
$r
= __PACKAGE__->new(1, 0);
while
(1) {
$r
=
$r
->mul(
$x
)->mod(
$m
)
if
(
$y
& 1);
(
$y
>>= 1) or
last
;
$x
=
$x
->mul(
$x
)->mod(
$m
);
}
$r
->mod(
$m
);
}
sub
root ($$) {
my
(
$x
,
$y
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
$y
= __PACKAGE__->new(
$y
)
if
ref
(
$y
) ne __PACKAGE__;
$x
->pow(
$y
->inv);
}
sub
sqrt
{
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
my
$r
=
$x
->
log
;
$r
->{a} /= 2;
$r
->{b} /= 2;
$r
->
exp
;
}
sub
cbrt ($) {
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
if
(
$x
->{a} == 0 and
$x
->{b} == 0) {
return
__PACKAGE__->new(0, 0);
}
my
$r
=
$x
->
log
;
$r
->{a} /= 3;
$r
->{b} /= 3;
$r
->
exp
;
}
sub
int
{
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
my
$t1
= CORE::
int
(
$x
->{a});
my
$t2
= CORE::
int
(
$x
->{b});
__PACKAGE__->new(
$t1
,
$t2
);
}
sub
_round ($) {
my
(
$n
) =
@_
;
CORE::
int
((
$n
+
$n
+ ((
$n
< 0) ? -1 : 1)) / 2);
}
sub
round ($) {
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
__PACKAGE__->new(_round(
$x
->{a}), _round(
$x
->{b}));
}
sub
floor ($) {
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
my
$t1
= CORE::
int
(
$x
->{a});
$t1
-= 1
if
(
$x
->{a} !=
$t1
and
$x
->{a} < 0);
my
$t2
= CORE::
int
(
$x
->{b});
$t2
-= 1
if
(
$x
->{b} !=
$t2
and
$x
->{b} < 0);
__PACKAGE__->new(
$t1
,
$t2
);
}
sub
ceil ($) {
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
my
$t
=
$x
->neg->floor;
$t
->{a} = -
$t
->{a};
$t
->{b} = -
$t
->{b};
$t
;
}
sub
sin
{
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
my
$t1
= __PACKAGE__->new(+
$x
->{b}, -
$x
->{a})->
exp
;
my
$t2
= __PACKAGE__->new(-
$x
->{b}, +
$x
->{a})->
exp
;
$t1
->{a} -=
$t2
->{a};
$t1
->{b} -=
$t2
->{b};
$t1
->{a} /= 2;
$t1
->{b} /= 2;
@{
$t1
}{
qw(a b)
} = (-
$t1
->{b},
$t1
->{a});
$t1
;
}
sub
sinh ($) {
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
my
$t1
= __PACKAGE__->new(
$x
->{a} * 2,
$x
->{b} * 2)->
exp
;
$t1
->{a} -= 1;
my
$t2
=
$x
->
exp
;
$t2
->{a} *= 2;
$t2
->{b} *= 2;
$t1
->div(
$t2
);
}
sub
asin ($) {
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
my
$r
= __PACKAGE__->new(1 - (
$x
->{a} *
$x
->{a} -
$x
->{b} *
$x
->{b}), -(
$x
->{a} *
$x
->{b} +
$x
->{b} *
$x
->{a}))->
sqrt
;
$r
->{a} -=
$x
->{b};
$r
->{b} +=
$x
->{a};
$r
=
$r
->
log
;
@{
$r
}{
qw(a b)
} = (
$r
->{b}, -
$r
->{a});
$r
;
}
sub
asinh ($) {
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
my
$r
= __PACKAGE__->new(
$x
->{a} *
$x
->{a} -
$x
->{b} *
$x
->{b} + 1,
$x
->{a} *
$x
->{b} +
$x
->{b} *
$x
->{a})->
sqrt
;
$r
->{a} +=
$x
->{a};
$r
->{b} +=
$x
->{b};
$r
->
log
;
}
sub
cos
{
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
my
$t1
= __PACKAGE__->new(-
$x
->{b}, +
$x
->{a})->
exp
;
my
$t2
= __PACKAGE__->new(+
$x
->{b}, -
$x
->{a})->
exp
;
$t1
->{a} +=
$t2
->{a};
$t1
->{b} +=
$t2
->{b};
$t1
->{a} /= 2;
$t1
->{b} /= 2;
$t1
;
}
sub
cosh ($) {
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
my
$t1
= __PACKAGE__->new(
$x
->{a} * 2,
$x
->{b} * 2)->
exp
;
$t1
->{a} += 1;
my
$t2
=
$x
->
exp
;
$t2
->{a} *= 2;
$t2
->{b} *= 2;
$t1
->div(
$t2
);
}
sub
acos ($) {
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
my
$t1
= __PACKAGE__->new((1 -
$x
->{a}) / 2,
$x
->{b} / -2)->
sqrt
;
my
$t2
= __PACKAGE__->new((1 +
$x
->{a}) / 2,
$x
->{b} / +2)->
sqrt
;
@{
$t1
}{
qw(a b)
} = (-
$t1
->{b},
$t1
->{a});
$t1
->{a} +=
$t2
->{a};
$t1
->{b} +=
$t2
->{b};
my
$r
=
$t1
->
log
;
$r
->{a} *= -2;
$r
->{b} *= -2;
@{
$r
}{
qw(a b)
} = (-
$r
->{b},
$r
->{a});
$r
;
}
sub
acosh ($) {
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
my
$t1
= __PACKAGE__->new(
$x
->{a} - 1,
$x
->{b})->
sqrt
;
my
$t2
= __PACKAGE__->new(
$x
->{a} + 1,
$x
->{b})->
sqrt
;
my
$t3
=
$t1
->mul(
$t2
);
$t3
->{a} +=
$x
->{a};
$t3
->{b} +=
$x
->{b};
$t3
->
log
;
}
sub
tan ($) {
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
my
$r
= __PACKAGE__->new(-2 *
$x
->{b}, 2 *
$x
->{a})->
exp
;
$r
->{a} += 1;
my
$den
=
$r
->{a} *
$r
->{a} +
$r
->{b} *
$r
->{b};
$r
->{a} *= 2;
$r
->{b} *= 2;
if
(!
ref
(
$den
) and
$den
== 0) {
$r
=
$r
->div(
$den
);
}
else
{
$r
->{a} /=
$den
;
$r
->{b} /=
$den
;
}
$r
->{a} -= 1;
@{
$r
}{
qw(a b)
} = (
$r
->{b},
$r
->{a});
$r
;
}
sub
tanh ($) {
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
my
$t1
= __PACKAGE__->new(
$x
->{a} * 2,
$x
->{b} * 2)->
exp
;
my
$t2
= __PACKAGE__->new(
$t1
->{a} - 1,
$t1
->{b});
my
$t3
= __PACKAGE__->new(
$t1
->{a} + 1,
$t1
->{b});
$t2
->div(
$t3
);
}
sub
atan ($) {
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
my
$t1
= __PACKAGE__->new(+
$x
->{b} + 1, -
$x
->{a})->
log
;
my
$t2
= __PACKAGE__->new(-
$x
->{b} + 1, +
$x
->{a})->
log
;
$t1
->{a} -=
$t2
->{a};
$t1
->{b} -=
$t2
->{b};
$t1
->{a} /= 2;
$t1
->{b} /= 2;
@{
$t1
}{
qw(a b)
} = (-
$t1
->{b},
$t1
->{a});
$t1
;
}
sub
atan2
{
my
(
$x
,
$y
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
$y
= __PACKAGE__->new(
$y
)
if
ref
(
$y
) ne __PACKAGE__;
my
$t
= __PACKAGE__->new(
$y
->{a} -
$x
->{b},
$x
->{a} +
$y
->{b});
$t
=
$t
->div(
$x
->mul(
$x
)->add(
$y
->mul(
$y
))->
sqrt
)->
log
;
@{
$t
}{
qw(a b)
} = (
$t
->{b}, -
$t
->{a});
$t
;
}
sub
atanh ($) {
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
my
$t1
= __PACKAGE__->new(1 +
$x
->{a}, +
$x
->{b})->
log
;
my
$t2
= __PACKAGE__->new(1 -
$x
->{a}, -
$x
->{b})->
log
;
$t1
->{a} -=
$t2
->{a};
$t1
->{b} -=
$t2
->{b};
$t1
->{a} /= 2;
$t1
->{b} /= 2;
$t1
;
}
sub
cot ($) {
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
my
$r
= __PACKAGE__->new(-2 *
$x
->{b}, 2 *
$x
->{a})->
exp
;
$r
->{a} -= 1;
my
$den
=
$r
->{a} *
$r
->{a} +
$r
->{b} *
$r
->{b};
$r
->{a} *= 2;
$r
->{b} *= 2;
if
(!
ref
(
$den
) and
$den
== 0) {
$r
=
$r
->div(
$den
);
}
else
{
$r
->{a} /=
$den
;
$r
->{b} /=
$den
;
}
$r
->{a} += 1;
@{
$r
}{
qw(a b)
} = (
$r
->{b},
$r
->{a});
$r
;
}
sub
coth ($) {
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
my
$t1
= __PACKAGE__->new(
$x
->{a} * 2,
$x
->{b} * 2)->
exp
;
my
$t2
= __PACKAGE__->new(
$t1
->{a} + 1,
$t1
->{b});
my
$t3
= __PACKAGE__->new(
$t1
->{a} - 1,
$t1
->{b});
$t2
->div(
$t3
);
}
sub
acot ($) {
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
$x
->inv->atan;
}
sub
acoth ($) {
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
$x
->inv->atanh;
}
sub
sec ($) {
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
my
$t1
= __PACKAGE__->new(+
$x
->{b}, -
$x
->{a})->
exp
;
my
$t2
= __PACKAGE__->new(-
$x
->{b}, +
$x
->{a})->
exp
;
$t1
->{a} +=
$t2
->{a};
$t1
->{b} +=
$t2
->{b};
my
$den
=
$t1
->{a} *
$t1
->{a} +
$t1
->{b} *
$t1
->{b};
$t1
->{a} *= +2;
$t1
->{b} *= -2;
if
(!
ref
(
$den
) and
$den
== 0) {
$t1
=
$t1
->div(
$den
);
}
else
{
$t1
->{a} /=
$den
;
$t1
->{b} /=
$den
;
}
$t1
;
}
sub
sech ($) {
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
my
$t1
=
$x
->
exp
;
my
$t2
= __PACKAGE__->new(
$x
->{a} * 2,
$x
->{b} * 2)->
exp
;
$t1
->{a} *= 2;
$t1
->{b} *= 2;
$t2
->{a} += 1;
$t1
->div(
$t2
);
}
sub
asec ($) {
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
$x
->inv->acos;
}
sub
asech ($) {
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
$x
->inv->acosh;
}
sub
csc ($) {
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
my
$t1
= __PACKAGE__->new(+
$x
->{b}, -
$x
->{a})->
exp
;
my
$t2
= __PACKAGE__->new(-
$x
->{b}, +
$x
->{a})->
exp
;
$t1
->{a} -=
$t2
->{a};
$t1
->{b} -=
$t2
->{b};
my
$den
=
$t1
->{a} *
$t1
->{a} +
$t1
->{b} *
$t1
->{b};
$t1
->{a} *= -2;
$t1
->{b} *= -2;
if
(!
ref
(
$den
) and
$den
== 0) {
$t1
=
$t1
->div(
$den
);
}
else
{
$t1
->{a} /=
$den
;
$t1
->{b} /=
$den
;
}
@{
$t1
}{
qw(a b)
} = (
$t1
->{b},
$t1
->{a});
$t1
;
}
sub
csch ($) {
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
my
$t1
=
$x
->
exp
;
my
$t2
= __PACKAGE__->new(
$x
->{a} * 2,
$x
->{b} * 2)->
exp
;
$t1
->{a} *= 2;
$t1
->{b} *= 2;
$t2
->{a} -= 1;
$t1
->div(
$t2
);
}
sub
acsc ($) {
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
$x
->inv->asin;
}
sub
acsch ($) {
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
$x
->inv->asinh;
}
sub
deg2rad ($) {
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
my
$t
= __PACKAGE__->new(
$x
->{a} / 180,
$x
->{b} / 180);
my
$pi
= CORE::
atan2
(0, -(
$x
->{a} *
$x
->{a} +
$x
->{b} *
$x
->{b}));
if
(!
ref
(
$pi
)) {
$t
->{a} *=
$pi
;
$t
->{b} *=
$pi
;
return
$t
;
}
$t
->mul(
$pi
);
}
sub
rad2deg ($) {
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
my
$r
= __PACKAGE__->new(
$x
->{a} * 180,
$x
->{b} * 180);
my
$t
=
$x
->{a} *
$x
->{a} +
$x
->{b} *
$x
->{b};
if
(
$t
== 0) {
return
$r
;
}
my
$pi
= CORE::
atan2
(0, -
$t
);
if
(!
ref
(
$pi
) and
$pi
!= 0) {
$r
->{a} /=
$pi
;
$r
->{b} /=
$pi
;
return
$r
;
}
$r
->div(
$pi
);
}
sub
real ($) {
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
$x
->{a};
}
sub
imag ($) {
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
$x
->{b};
}
sub
reals ($) {
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
(
$x
->{a},
$x
->{b});
}
sub
eq {
my
(
$x
,
$y
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
$y
= __PACKAGE__->new(
$y
)
if
ref
(
$y
) ne __PACKAGE__;
$x
->{a} ==
$y
->{a}
and
$x
->{b} ==
$y
->{b};
}
sub
ne {
my
(
$x
,
$y
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
$y
= __PACKAGE__->new(
$y
)
if
ref
(
$y
) ne __PACKAGE__;
$x
->{a} !=
$y
->{a}
or
$x
->{b} !=
$y
->{b};
}
sub
cmp {
my
(
$x
,
$y
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
$y
= __PACKAGE__->new(
$y
)
if
ref
(
$y
) ne __PACKAGE__;
((
$x
->{a} <=>
$y
->{a}) //
return
undef
)
or ((
$x
->{b} <=>
$y
->{b}) //
return
undef
);
}
sub
acmp ($$) {
my
(
$x
,
$y
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
$y
= __PACKAGE__->new(
$y
)
if
ref
(
$y
) ne __PACKAGE__;
$x
->
abs
<=>
$y
->
abs
;
}
sub
lt {
my
(
$x
,
$y
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
$y
= __PACKAGE__->new(
$y
)
if
ref
(
$y
) ne __PACKAGE__;
(
$x
->cmp(
$y
) //
return
undef
) < 0;
}
sub
le {
my
(
$x
,
$y
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
$y
= __PACKAGE__->new(
$y
)
if
ref
(
$y
) ne __PACKAGE__;
(
$x
->cmp(
$y
) //
return
undef
) <= 0;
}
sub
gt {
my
(
$x
,
$y
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
$y
= __PACKAGE__->new(
$y
)
if
ref
(
$y
) ne __PACKAGE__;
(
$x
->cmp(
$y
) //
return
undef
) > 0;
}
sub
ge {
my
(
$x
,
$y
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
$y
= __PACKAGE__->new(
$y
)
if
ref
(
$y
) ne __PACKAGE__;
(
$x
->cmp(
$y
) //
return
undef
) >= 0;
}
sub
stringify {
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
"($x->{a} $x->{b})"
;
}
sub
boolify {
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
!!
$x
->{a} or !!
$x
->{b};
}
sub
numify {
my
(
$x
) =
@_
;
$x
= __PACKAGE__->new(
$x
)
if
ref
(
$x
) ne __PACKAGE__;
$x
->{a};
}
1;