Lines Matching defs:bignum
0 # bignum library in pure Tcl [VERSION 7Sep2004]
53 namespace eval ::math::bignum {}
60 set ::math::bignum::atombits 16
61 set ::math::bignum::atombase [expr {1 << $::math::bignum::atombits}]
62 set ::math::bignum::atommask [expr {$::math::bignum::atombase-1}]
68 proc ::math::bignum::max {a b} {
73 proc ::math::bignum::min {a b} {
77 ############################ Basic bignum operations ###########################
79 # Returns a new bignum initialized to the value of 0.
85 # The bignum representation is [list bignum <sign> <atom0> ... <atomN>]
87 # of a number in base 2^$::math::bignum::atombits
92 # create a bignum of <atoms> atoms. For default zero is
97 proc ::math::bignum::zero {{value 0}} {
98 set v [list bignum 0 0]
106 # Get the bignum sign
107 proc ::math::bignum::sign bignum {
108 lindex $bignum 1
111 # Get the number of atoms in the bignum
112 proc ::math::bignum::atoms bignum {
113 expr {[llength $bignum]-2}
116 # Get the i-th atom out of a bignum.
117 # If the bignum is shorter than i atoms, the function
119 proc ::math::bignum::atom {bignum i} {
120 if {[::math::bignum::atoms $bignum] < [expr {$i+1}]} {
123 lindex $bignum [expr {$i+2}]
127 # Set the i-th atom out of a bignum. If the bignum
129 proc ::math::bignum::setatom {bignumvar i atomval} {
130 upvar 1 $bignumvar bignum
131 while {[::math::bignum::atoms $bignum] < [expr {$i+1}]} {
132 lappend bignum 0
134 lset bignum [expr {$i+2}] $atomval
137 # Set the bignum sign
138 proc ::math::bignum::setsign {bignumvar sign} {
139 upvar 1 $bignumvar bignum
140 lset bignum 1 $sign
144 # The normalized bignum is returned
145 proc ::math::bignum::normalize bignumvar {
146 upvar 1 $bignumvar bignum
147 set atoms [expr {[llength $bignum]-2}]
149 while {$atoms && [lindex $bignum $i] == 0} {
150 set bignum [lrange $bignum 0 end-1]
155 set bignum [list bignum 0 0]
157 return $bignum
161 proc ::math::bignum::abs n {
162 ::math::bignum::setsign n 0
168 # Compare by absolute value. Called by ::math::bignum::cmp after the sign check.
174 proc ::math::bignum::abscmp {a b} {
198 proc ::math::bignum::cmp {a b} { ; # same sign case
201 if {[::math::bignum::sign $a] == [::math::bignum::sign $b]} {
202 if {[::math::bignum::sign $a] == 0} {
203 ::math::bignum::abscmp $a $b
205 expr {-([::math::bignum::abscmp $a $b])}
208 if {[::math::bignum::sign $a]} {return -1}
214 proc ::math::bignum::iszero z {
220 proc ::math::bignum::lt {a b} {expr {[::math::bignum::cmp $a $b] < 0}}
221 proc ::math::bignum::le {a b} {expr {[::math::bignum::cmp $a $b] <= 0}}
222 proc ::math::bignum::gt {a b} {expr {[::math::bignum::cmp $a $b] > 0}}
223 proc ::math::bignum::ge {a b} {expr {[::math::bignum::cmp $a $b] >= 0}}
224 proc ::math::bignum::eq {a b} {expr {[::math::bignum::cmp $a $b] == 0}}
225 proc ::math::bignum::ne {a b} {expr {[::math::bignum::cmp $a $b] != 0}}
230 proc ::math::bignum::rawAdd {a b} {
233 set r [::math::bignum::zero [expr {[llength $a]-1}]]
237 set car [expr {$sum >> $::math::bignum::atombits}]
238 set sum [expr {$sum & $::math::bignum::atommask}]
244 ::math::bignum::normalize r
248 proc ::math::bignum::rawSub {a b} {
249 set atoms [::math::bignum::atoms $a]
250 set r [::math::bignum::zero $atoms]
258 incr sub $::math::bignum::atombase
264 ::math::bignum::normalize r
269 proc ::math::bignum::add {a b} {
273 if {[::math::bignum::sign $a] == [::math::bignum::sign $b]} {
274 set r [::math::bignum::rawAdd $a $b]
275 ::math::bignum::setsign r [::math::bignum::sign $a]
278 set cmp [::math::bignum::abscmp $a $b]
280 set s [expr {[::math::bignum::sign $a] == 1}]
282 0 {return [::math::bignum::zero]}
284 set r [::math::bignum::rawSub $a $b]
285 ::math::bignum::setsign r $s
289 set r [::math::bignum::rawSub $b $a]
290 ::math::bignum::setsign r [expr {!$s}]
300 proc ::math::bignum::sub {a b} {
304 if {[::math::bignum::sign $a] != [::math::bignum::sign $b]} {
305 set r [::math::bignum::rawAdd $a $b]
306 ::math::bignum::setsign r [::math::bignum::sign $a]
309 set cmp [::math::bignum::abscmp $a $b]
311 set s [expr {[::math::bignum::sign $a] == 1}]
313 0 {return [::math::bignum::zero]}
315 set r [::math::bignum::rawSub $a $b]
316 ::math::bignum::setsign r $s
320 set r [::math::bignum::rawSub $b $a]
321 ::math::bignum::setsign r [expr {!$s}]
331 set ::math::bignum::karatsubaThreshold 32
335 proc ::math::bignum::mul {a b} {
338 set r [::math::bignum::kmul $a $b]
340 ::math::bignum::setsign r [expr {[::math::bignum::sign $a]^[::math::bignum::sign $b]}]
344 proc ::math::bignum::kmul {a b} {
345 set n [expr {[::math::bignum::max [llength $a] [llength $b]]-2}]
346 set nmin [expr {[::math::bignum::min [llength $a] [llength $b]]-2}]
347 if {$nmin < $::math::bignum::karatsubaThreshold} {return [::math::bignum::bmul $a $b]}
350 set x0 [concat [list bignum 0] [lrange $a 2 [expr {$m+1}]]]
351 set y0 [concat [list bignum 0] [lrange $b 2 [expr {$m+1}]]]
352 set x1 [concat [list bignum 0] [lrange $a [expr {$m+2}] end]]
353 set y1 [concat [list bignum 0] [lrange $b [expr {$m+2}] end]]
363 set p1 [::math::bignum::kmul $x1 $y1]
364 set p2 [::math::bignum::kmul $x0 $y0]
365 set p3 [::math::bignum::kmul [::math::bignum::add $x1 $x0] [::math::bignum::add $y1 $y0]]
367 set p3 [::math::bignum::sub $p3 $p1]
368 set p3 [::math::bignum::sub $p3 $p2]
369 set p1 [::math::bignum::lshiftAtoms $p1 [expr {$m*2}]]
370 set p3 [::math::bignum::lshiftAtoms $p3 $m]
371 set p3 [::math::bignum::add $p3 $p1]
372 set p3 [::math::bignum::add $p3 $p2]
377 proc ::math::bignum::bmul {a b} {
378 set r [::math::bignum::zero [expr {[llength $a]+[llength $b]-3}]]
381 set t [list bignum 0 0]
391 set car [expr {$mul >> $::math::bignum::atombits}]
392 set mul [expr {$mul & $::math::bignum::atommask}]
399 ::math::bignum::normalize r
404 # Left shift 'z' of 'n' atoms. Low-level function used by ::math::bignum::lshift
406 proc ::math::bignum::lshiftAtoms {z n} {
414 # Right shift 'z' of 'n' atoms. Low-level function used by ::math::bignum::lshift
416 proc ::math::bignum::rshiftAtoms {z n} {
420 # Left shift 'z' of 'n' bits. Low-level function used by ::math::bignum::lshift.
421 # 'n' must be <= $::math::bignum::atombits
422 proc ::math::bignum::lshiftBits {z n} {
428 [expr {wide($car)|((wide($t)<<$n)&$::math::bignum::atommask)}]
429 set car [expr {wide($t)>>($::math::bignum::atombits-$n)}]
438 # Right shift 'z' of 'n' bits. Low-level function used by ::math::bignum::rshift.
439 # 'n' must be <= $::math::bignum::atombits
440 proc ::math::bignum::rshiftBits {z n} {
447 [expr {(wide($t)<<($::math::bignum::atombits-$n))&$::math::bignum::atommask}]
449 ::math::bignum::normalize z
453 proc ::math::bignum::lshift {z n} {
455 set atoms [expr {$n / $::math::bignum::atombits}]
456 set bits [expr {$n & ($::math::bignum::atombits-1)}]
457 ::math::bignum::lshiftBits [math::bignum::lshiftAtoms $z $atoms] $bits
461 proc ::math::bignum::rshift {z n} {
463 set atoms [expr {$n / $::math::bignum::atombits}]
464 set bits [expr {$n & ($::math::bignum::atombits-1)}]
470 if { [::math::bignum::sign $z] == 1 } {
479 if { ( $t & ~($::math::bignum::atommask<<($bits)) ) != 0 } {
485 set newz [::math::bignum::rshiftBits [math::bignum::rshiftAtoms $z $atoms] $bits]
487 set newz [::math::bignum::sub $newz 1]
495 proc ::math::bignum::setbit {bignumvar n} {
497 set atom [expr {$n / $::math::bignum::atombits}]
498 set bit [expr {1 << ($n & ($::math::bignum::atombits-1))}]
505 proc ::math::bignum::clearbit {bignumvar n} {
507 set atom [expr {$n / $::math::bignum::atombits}]
510 set mask [expr {$::math::bignum::atommask^(1 << ($n & ($::math::bignum::atombits-1)))}]
512 ::math::bignum::normalize z
516 proc ::math::bignum::testbit {z n} {
517 set atom [expr {$n / $::math::bignum::atombits}]
520 set mask [expr {1 << ($n & ($::math::bignum::atombits-1))}]
525 proc ::math::bignum::bitand {a b} {
534 set r [::math::bignum::zero [expr {[llength $a]-1}]]
539 ::math::bignum::normalize r
543 proc ::math::bignum::bitxor {a b} {
552 set r [::math::bignum::zero [expr {[llength $a]-1}]]
557 ::math::bignum::normalize r
561 proc ::math::bignum::bitor {a b} {
570 set r [::math::bignum::zero [expr {[llength $a]-1}]]
575 ::math::bignum::normalize r
579 proc ::math::bignum::bits z {
580 set atoms [::math::bignum::atoms $z]
581 set bits [expr {($atoms-1)*$::math::bignum::atombits}]
618 proc ::math::bignum::rawDiv {n d} {
619 set bit [expr {[::math::bignum::bits $n]-1}]
620 set r [list bignum 0 0]
621 set q [::math::bignum::zero [expr {[llength $n]-2}]]
623 set b_atom [expr {($bit / $::math::bignum::atombits) + 2}]
624 set b_bit [expr {1 << ($bit & ($::math::bignum::atombits-1))}]
625 set r [::math::bignum::lshiftBits $r 1]
629 if {[::math::bignum::abscmp $r $d] >= 0} {
630 set r [::math::bignum::rawSub $r $d]
635 ::math::bignum::normalize q
639 # Divide by single-atom immediate. Used to speedup bignum -> string conversion.
640 # The procedure returns a two-elements list with the bignum quotient and
642 proc ::math::bignum::rawDivByAtom {n d} {
643 set atoms [::math::bignum::atoms $n]
648 set t [expr {($t << $::math::bignum::atombits)+[lindex $n [expr {$j+2}]]}]
652 ::math::bignum::normalize n
658 # Note that if you want the *modulo* operator you should use ::math::bignum::mod
661 proc ::math::bignum::divqr {n d} {
664 if {[::math::bignum::iszero $d]} {
667 foreach {q r} [::math::bignum::rawDiv $n $d] break
668 ::math::bignum::setsign q [expr {[::math::bignum::sign $n]^[::math::bignum::sign $d]}]
669 ::math::bignum::setsign r [::math::bignum::sign $n]
674 proc ::math::bignum::div {n d} {
675 lindex [::math::bignum::divqr $n $d] 0
679 proc ::math::bignum::rem {n d} {
680 lindex [::math::bignum::divqr $n $d] 1
684 proc ::math::bignum::mod {n m} {
687 set r [lindex [::math::bignum::divqr $n $m] 1]
688 if {[::math::bignum::sign $m] != [::math::bignum::sign $r]} {
689 set r [::math::bignum::add $r $m]
695 proc ::math::bignum::isodd n {
700 proc ::math::bignum::iseven n {
707 proc ::math::bignum::pow {b e} {
710 if {[::math::bignum::iszero $e]} {return [list bignum 0 1]}
712 set sign [expr {[::math::bignum::sign $b] && [::math::bignum::isodd $e]}]
714 ::math::bignum::setsign b 0
716 set r [list bignum 0 1]; # Start with result = 1
717 while {[::math::bignum::abscmp $e [list bignum 0 1]] > 0} { ;# While the exp > 1
718 if {[::math::bignum::isodd $e]} {
719 set r [::math::bignum::mul $r $b]
721 set e [::math::bignum::rshiftBits $e 1] ;# exp = exp / 2
722 set b [::math::bignum::mul $b $b]
724 set r [::math::bignum::mul $r $b]
725 ::math::bignum::setsign r $sign
730 proc ::math::bignum::powm {b e m} {
734 if {[::math::bignum::iszero $e]} {return [list bignum 0 1]}
736 set sign [expr {[::math::bignum::sign $b] && [::math::bignum::isodd $e]}]
738 ::math::bignum::setsign b 0
740 set r [list bignum 0 1]; # Start with result = 1
741 while {[::math::bignum::abscmp $e [list bignum 0 1]] > 0} { ;# While the exp > 1
742 if {[::math::bignum::isodd $e]} {
743 set r [::math::bignum::mod [::math::bignum::mul $r $b] $m]
745 set e [::math::bignum::rshiftBits $e 1] ;# exp = exp / 2
746 set b [::math::bignum::mod [::math::bignum::mul $b $b] $m]
748 set r [::math::bignum::mul $r $b]
749 ::math::bignum::setsign r $sign
750 set r [::math::bignum::mod $r $m]
764 proc ::math::bignum::sqrt n {
768 set i [expr {(([::math::bignum::bits $n]-1)/2)+1}]
771 set r [::math::bignum::zero] ; # guess
772 set x [::math::bignum::zero] ; # guess^2
773 set s [::math::bignum::zero] ; # guess^2 backup
774 set t [::math::bignum::zero] ; # intermediate result
776 ::math::bignum::setbit t $b
777 set x [::math::bignum::rawAdd $s $t]
778 ::math::bignum::clearbit t $b
779 if {[::math::bignum::abscmp $x $n] <= 0} {
781 ::math::bignum::setbit r $i
782 ::math::bignum::setbit t [expr {$b+1}]
784 set t [::math::bignum::rshiftBits $t 1]
792 proc ::math::bignum::rand bits {
793 set atoms [expr {($bits+$::math::bignum::atombits-1)/$::math::bignum::atombits}]
794 set shift [expr {($atoms*$::math::bignum::atombits)-$bits}]
795 set r [list bignum 0]
797 lappend r [expr {int(rand()*(1<<$::math::bignum::atombits))}]
800 set r [::math::bignum::rshiftBits $r $shift]
807 set ::math::bignum::cset "0123456789abcdefghijklmnopqrstuvwxyz"
813 proc ::math::bignum::tostr {z {base 10}} {
814 if {[string length $::math::bignum::cset] < $base} {
817 if {[::math::bignum::iszero $z]} {return 0}
818 set sign [::math::bignum::sign $z]
820 while {![::math::bignum::iszero $z]} {
821 foreach {q r} [::math::bignum::rawDivByAtom $z $base] break
822 append str [string index $::math::bignum::cset $r]
837 # Create a bignum from a string representation in base 'base'.
838 proc ::math::bignum::fromstr {str {base 0}} {
839 set z [::math::bignum::zero]
854 if {[string length $::math::bignum::cset] < $base} {
857 set bigbase [list bignum 0 $base] ; # Build a bignum with the base value
858 set basepow [list bignum 0 1] ; # multiply every digit for a succ. power
862 set digitval [string first [string index $str $i] $::math::bignum::cset]
866 set bigdigitval [list bignum 0 $digitval]
867 set z [::math::bignum::rawAdd $z [::math::bignum::mul $basepow $bigdigitval]]
868 set basepow [::math::bignum::mul $basepow $bigbase]
871 if {![::math::bignum::iszero $z]} {
872 ::math::bignum::setsign z $sign
881 proc ::math::bignum::_treat {num} {
884 # set to the bignum 0
885 return {bignum 0 0}
887 # set to the bignum 1
888 return {bignum 0 1}
894 namespace eval ::math::bignum {
900 package provide math::bignum 3.1.1