Merge git://projects.elasticdog.com/git/factor

db4
Doug Coleman 2008-01-14 10:12:05 -10:00
commit 04b4832454
10 changed files with 127 additions and 55 deletions

View File

@ -1,5 +1,4 @@
USING: definitions help help.markup help.syntax io io.files USING: definitions help help.markup help.syntax io io.files editors words ;
editors words ;
IN: editors.vim IN: editors.vim
ARTICLE: { "vim" "vim" } "Vim support" ARTICLE: { "vim" "vim" } "Vim support"

View File

@ -26,10 +26,8 @@ TUPLE: positive-even-expected n ;
dup even? [ -1 shift >r 1+ r> (factor-2s) ] when ; dup even? [ -1 shift >r 1+ r> (factor-2s) ] when ;
: factor-2s ( n -- r s ) : factor-2s ( n -- r s )
#! factor an even number into s * 2 ^ r #! factor an integer into s * 2^r
dup even? over 0 > and [ 0 swap (factor-2s) ;
positive-even-expected construct-boa throw
] unless 0 swap (factor-2s) ;
:: (miller-rabin) | n prime?! | :: (miller-rabin) | n prime?! |
n 1- factor-2s s set r set n 1- factor-2s s set r set

View File

@ -1,20 +1,23 @@
USING: help.markup help.syntax ; USING: help.markup help.syntax math sequences ;
IN: math.primes.factors IN: math.primes.factors
{ factors count-factors unique-factors } related-words { factors group-factors unique-factors } related-words
HELP: factors HELP: factors
{ $values { "n" "a positive integer" } { "seq" "a sequence" } } { $values { "n" "a positive integer" } { "seq" sequence } }
{ $description { "Factorize an integer and return an ordered list of factors, possibly repeated." } } ; { $description { "Return an ordered list of a number's prime factors, possibly repeated." } }
{ $examples { $example "300 factors ." "{ 2 2 3 5 5 }" } } ;
HELP: count-factors HELP: group-factors
{ $values { "n" "a positive integer" } { "seq" "a sequence" } } { $values { "n" "a positive integer" } { "seq" sequence } }
{ $description { "Return a sequence of pairs representing each factor in the number and its corresponding power." } } ; { $description { "Return a sequence of pairs representing each prime factor in the number and its corresponding power (multiplicity)." } }
{ $examples { $example "300 group-factors ." "{ { 2 2 } { 3 1 } { 5 2 } }" } } ;
HELP: unique-factors HELP: unique-factors
{ $values { "n" "a positive integer" } { "seq" "a sequence" } } { $values { "n" "a positive integer" } { "seq" sequence } }
{ $description { "Return an ordered list of unique prime factors." } } ; { $description { "Return an ordered list of a number's unique prime factors." } }
{ $examples { $example "300 unique-factors ." "{ 2 3 5 }" } } ;
HELP: totient HELP: totient
{ $values { "n" "a positive integer" } { "t" "an integer" } } { $values { "n" "a positive integer" } { "t" integer } }
{ $description { "Return the number of integers between 1 and " { $snippet "n-1" } " relatively prime to " { $snippet "n" } "." } } ; { $description { "Return the number of integers between 1 and " { $snippet "n-1" } " that are relatively prime to " { $snippet "n" } "." } } ;

View File

@ -1,6 +1,6 @@
USING: math.primes.factors tools.test ; USING: math.primes.factors tools.test ;
{ { 999983 999983 1000003 } } [ 999969000187000867 factors ] unit-test { { 999983 999983 1000003 } } [ 999969000187000867 factors ] unit-test
{ { { 999983 2 } { 1000003 1 } } } [ 999969000187000867 count-factors ] unit-test { { { 999983 2 } { 1000003 1 } } } [ 999969000187000867 group-factors ] unit-test
{ { 999983 1000003 } } [ 999969000187000867 unique-factors ] unit-test { { 999983 1000003 } } [ 999969000187000867 unique-factors ] unit-test
{ 999967000236000612 } [ 999969000187000867 totient ] unit-test { 999967000236000612 } [ 999969000187000867 totient ] unit-test

View File

@ -6,36 +6,36 @@ IN: math.primes.factors
<PRIVATE <PRIVATE
: (factor) ( n d -- n' ) : (factor) ( n d -- n' )
2dup mod zero? [ [ / ] keep dup , (factor) ] [ drop ] if ; 2dup mod zero? [ [ / ] keep dup , (factor) ] [ drop ] if ;
: (count) ( n d -- n' ) : (count) ( n d -- n' )
[ (factor) ] { } make [ (factor) ] { } make
dup empty? [ drop ] [ [ first ] keep length 2array , ] if ; dup empty? [ drop ] [ [ first ] keep length 2array , ] if ;
: (unique) ( n d -- n' ) : (unique) ( n d -- n' )
[ (factor) ] { } make [ (factor) ] { } make
dup empty? [ drop ] [ first , ] if ; dup empty? [ drop ] [ first , ] if ;
: (factors) ( quot list n -- ) : (factors) ( quot list n -- )
dup 1 > [ swap uncons >r pick call r> swap (factors) ] [ 3drop ] if ; dup 1 > [ swap uncons >r pick call r> swap (factors) ] [ 3drop ] if ;
: (decompose) ( n quot -- seq ) : (decompose) ( n quot -- seq )
[ lprimes rot (factors) ] { } make ; [ lprimes rot (factors) ] { } make ;
PRIVATE> PRIVATE>
: factors ( n -- seq ) : factors ( n -- seq )
[ (factor) ] (decompose) ; foldable [ (factor) ] (decompose) ; foldable
: count-factors ( n -- seq ) : group-factors ( n -- seq )
[ (count) ] (decompose) ; foldable [ (count) ] (decompose) ; foldable
: unique-factors ( n -- seq ) : unique-factors ( n -- seq )
[ (unique) ] (decompose) ; foldable [ (unique) ] (decompose) ; foldable
: totient ( n -- t ) : totient ( n -- t )
dup 2 < [ dup 2 < [
drop 0 drop 0
] [ ] [
[ unique-factors dup 1 [ 1- * ] reduce swap product / ] keep * dup unique-factors dup 1 [ 1- * ] reduce swap product / *
] if ; foldable ] if ; foldable

View File

@ -1,50 +1,50 @@
USING: help.markup help.syntax debugger ; USING: help.markup help.syntax debugger ;
IN: math.statistics IN: math.statistics
HELP: geometric-mean HELP: geometric-mean
{ $values { "seq" "a sequence of numbers" } { "n" "a non-negative real number"} } { $values { "seq" "a sequence of numbers" } { "n" "a non-negative real number"} }
{ $description "Computes the geometric mean of all elements in " { $snippet "seq" } ". The geometric mean measures the central tendency of a data set that minimizes the effects of extreme values." } { $description "Computes the geometric mean of all elements in " { $snippet "seq" } ". The geometric mean measures the central tendency of a data set that minimizes the effects of extreme values." }
{ $examples { $example "USE: math.statistics" "{ 1 2 3 } geometric-mean ." "1.81712059283214" } } { $examples { $example "USE: math.statistics" "{ 1 2 3 } geometric-mean ." "1.81712059283214" } }
{ $errors "Throws a " { $link signal-error. } " (square-root of 0) if the sequence is empty." } ; { $errors "Throws a " { $link signal-error. } " (square-root of 0) if the sequence is empty." } ;
HELP: harmonic-mean HELP: harmonic-mean
{ $values { "seq" "a sequence of numbers" } { "n" "a non-negative real number"} } { $values { "seq" "a sequence of numbers" } { "n" "a non-negative real number"} }
{ $description "Computes the harmonic mean of the elements in " { $snippet "seq" } ". The harmonic mean is appropriate when the average of rates is desired." } { $description "Computes the harmonic mean of the elements in " { $snippet "seq" } ". The harmonic mean is appropriate when the average of rates is desired." }
{ $examples { $example "USE: math.statistics" "{ 1 2 3 } harmonic-mean ." "6/11" } } { $examples { $example "USE: math.statistics" "{ 1 2 3 } harmonic-mean ." "6/11" } }
{ $errors "Throws a " { $link signal-error. } " (divide by zero) if the sequence is empty." } ; { $errors "Throws a " { $link signal-error. } " (divide by zero) if the sequence is empty." } ;
HELP: mean HELP: mean
{ $values { "seq" "a sequence of numbers" } { "n" "a non-negative real number"} } { $values { "seq" "a sequence of numbers" } { "n" "a non-negative real number"} }
{ $description "Computes the arithmetic mean of all elements in " { $snippet "seq" } "." } { $description "Computes the arithmetic mean of all elements in " { $snippet "seq" } "." }
{ $examples { $example "USE: math.statistics" "{ 1 2 3 } mean ." "2" } } { $examples { $example "USE: math.statistics" "{ 1 2 3 } mean ." "2" } }
{ $errors "Throws a " { $link signal-error. } " (divide by zero) if the sequence is empty." } ; { $errors "Throws a " { $link signal-error. } " (divide by zero) if the sequence is empty." } ;
HELP: median HELP: median
{ $values { "seq" "a sequence of numbers" } { "n" "a non-negative real number"} } { $values { "seq" "a sequence of numbers" } { "n" "a non-negative real number"} }
{ $description "Computes the median of " { $snippet "seq" } " by sorting the sequence from lowest value to highest and outputting the middle one. If there is an even number of elements in the sequence, the median is not unique, so the mean of the two middle values is outputted." } { $description "Computes the median of " { $snippet "seq" } " by sorting the sequence from lowest value to highest and outputting the middle one. If there is an even number of elements in the sequence, the median is not unique, so the mean of the two middle values is outputted." }
{ $examples { $examples
{ $example "USE: math.statistics" "{ 1 2 3 } median ." "2" } { $example "USE: math.statistics" "{ 1 2 3 } median ." "2" }
{ $example "USE: math.statistics" "{ 1 2 3 4 } median ." "5/2" } } { $example "USE: math.statistics" "{ 1 2 3 4 } median ." "5/2" } }
{ $errors "Throws a " { $link signal-error. } " (divide by zero) if the sequence is empty." } ; { $errors "Throws a " { $link signal-error. } " (divide by zero) if the sequence is empty." } ;
HELP: range HELP: range
{ $values { "seq" "a sequence of numbers" } { "n" "a non-negative real number"} } { $values { "seq" "a sequence of numbers" } { "n" "a non-negative real number"} }
{ $description "Computes the distance of the maximum and minimum values in " { $snippet "seq" } "." } { $description "Computes the distance of the maximum and minimum values in " { $snippet "seq" } "." }
{ $examples { $examples
{ $example "USE: math.statistics" "{ 1 2 3 } range ." "2" } { $example "USE: math.statistics" "{ 1 2 3 } range ." "2" }
{ $example "USE: math.statistics" "{ 1 2 3 4 } range ." "3" } } ; { $example "USE: math.statistics" "{ 1 2 3 4 } range ." "3" } } ;
HELP: std HELP: std
{ $values { "seq" "a sequence of numbers" } { "x" "a non-negative real number"} } { $values { "seq" "a sequence of numbers" } { "x" "a non-negative real number"} }
{ $description "Computes the standard deviation of " { $snippet "seq" } " by squaring the variance of the sequence. It measures how widely spread the values in a sequence are about the mean." } { $description "Computes the standard deviation of " { $snippet "seq" } " by squaring the variance of the sequence. It measures how widely spread the values in a sequence are about the mean." }
{ $examples { $examples
{ $example "USE: math.statistics" "{ 1 2 3 } std ." "1.0" } { $example "USE: math.statistics" "{ 1 2 3 } std ." "1.0" }
{ $example "USE: math.statistics" "{ 1 2 3 4 } std ." "1.290994448735806" } } ; { $example "USE: math.statistics" "{ 1 2 3 4 } std ." "1.290994448735806" } } ;
HELP: ste HELP: ste
{ $values { "seq" "a sequence of numbers" } { "x" "a non-negative real number"} } { $values { "seq" "a sequence of numbers" } { "x" "a non-negative real number"} }
{ $description "Computes the standard error of the mean for " { $snippet "seq" } ". It's defined as the standard deviation divided by the square root of the length of the sequence, and measures uncertainty associated with the estimate of the mean." } { $description "Computes the standard error of the mean for " { $snippet "seq" } ". It's defined as the standard deviation divided by the square root of the length of the sequence, and measures uncertainty associated with the estimate of the mean." }
{ $examples { $examples
{ $example "USE: math.statistics" "{ -2 2 } ste ." "2.0" } { $example "USE: math.statistics" "{ -2 2 } ste ." "2.0" }
{ $example "USE: math.statistics" "{ -2 2 2 } ste ." "1.333333333333333" } } ; { $example "USE: math.statistics" "{ -2 2 2 } ste ." "1.333333333333333" } } ;
@ -52,7 +52,7 @@ HELP: var
{ $values { "seq" "a sequence of numbers" } { "x" "a non-negative real number"} } { $values { "seq" "a sequence of numbers" } { "x" "a non-negative real number"} }
{ $description "Computes the variance of " { $snippet "seq" } ". It's a measurement of the spread of values in a sequence. The larger the variance, the larger the distance of values from the mean." } { $description "Computes the variance of " { $snippet "seq" } ". It's a measurement of the spread of values in a sequence. The larger the variance, the larger the distance of values from the mean." }
{ $notes "If the number of elements in " { $snippet "seq" } " is 1 or less, it outputs 0." } { $notes "If the number of elements in " { $snippet "seq" } " is 1 or less, it outputs 0." }
{ $examples { $examples
{ $example "USE: math.statistics" "{ 1 } var ." "0" } { $example "USE: math.statistics" "{ 1 } var ." "0" }
{ $example "USE: math.statistics" "{ 1 2 3 } var ." "1" } { $example "USE: math.statistics" "{ 1 2 3 } var ." "1" }
{ $example "USE: math.statistics" "{ 1 2 3 4 } var ." "5/3" } } ; { $example "USE: math.statistics" "{ 1 2 3 4 } var ." "5/3" } } ;

View File

@ -24,14 +24,18 @@ IN: project-euler.006
! SOLUTION ! SOLUTION
! -------- ! --------
<PRIVATE
: sum-of-squares ( seq -- n ) : sum-of-squares ( seq -- n )
0 [ sq + ] reduce ; 0 [ sq + ] reduce ;
: square-of-sums ( seq -- n ) : square-of-sum ( seq -- n )
0 [ + ] reduce sq ; sum sq ;
PRIVATE>
: euler006 ( -- answer ) : euler006 ( -- answer )
1 100 [a,b] dup sum-of-squares swap square-of-sums - abs ; 1 100 [a,b] dup sum-of-squares swap square-of-sum - abs ;
! [ euler006 ] 100 ave-time ! [ euler006 ] 100 ave-time
! 0 ms run / 0 ms GC ave time - 100 trials ! 0 ms run / 0 ms GC ave time - 100 trials

View File

@ -0,0 +1,71 @@
! Copyright (c) 2007 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math math.functions math.primes math.ranges sequences ;
IN: project-euler.026
! http://projecteuler.net/index.php?section=problems&id=26
! DESCRIPTION
! -----------
! A unit fraction contains 1 in the numerator. The decimal representation of
! the unit fractions with denominators 2 to 10 are given:
! 1/2 = 0.5
! 1/3 = 0.(3)
! 1/4 = 0.25
! 1/5 = 0.2
! 1/6 = 0.1(6)
! 1/7 = 0.(142857)
! 1/8 = 0.125
! 1/9 = 0.(1)
! 1/10 = 0.1
! Where 0.1(6) means 0.166666..., and has a 1-digit recurring cycle. It can be
! seen that 1/7 has a 6-digit recurring cycle.
! Find the value of d < 1000 for which 1/d contains the longest recurring cycle
! in its decimal fraction part.
! SOLUTION
! --------
<PRIVATE
: source-026 ( -- seq )
1 1000 (a,b) [ prime? ] subset [ 1 swap / ] map ;
: (mult-order) ( n a m -- k )
3dup ^ swap mod 1 = [ 2nip ] [ 1+ (mult-order) ] if ;
PRIVATE>
: coprime? ( m n -- ? )
gcd 1 = nip ;
: recurring-period? ( a/b -- ? )
denominator 10 coprime? ;
! Multiplicative order a.k.a. modulo order
: mult-order ( a n -- k )
swap 1 (mult-order) ;
: period-length ( a/b -- n )
dup recurring-period? [ denominator 10 swap mult-order ] [ drop 0 ] if ;
<PRIVATE
: max-period ( seq -- elt n )
dup [ period-length ] map dup supremum
over index [ swap nth ] curry 2apply ;
PRIVATE>
: euler026 ( -- answer )
source-026 max-period drop denominator ;
! [ euler026 ] 100 ave-time
! 724 ms run / 7 ms GC ave time - 100 trials
MAIN: euler026

View File

@ -34,9 +34,6 @@ IN: project-euler.common
: propagate ( bottom top -- newtop ) : propagate ( bottom top -- newtop )
[ over 1 tail rot first2 max rot + ] map nip ; [ over 1 tail rot first2 max rot + ] map nip ;
: reduce-2s ( n -- r s )
dup even? [ factor-2s >r 1+ r> ] [ 1 swap ] if ;
: shift-3rd ( seq obj obj -- seq obj obj ) : shift-3rd ( seq obj obj -- seq obj obj )
rot 1 tail -rot ; rot 1 tail -rot ;
@ -88,11 +85,11 @@ PRIVATE>
! The divisor function, counts the number of divisors ! The divisor function, counts the number of divisors
: tau ( m -- n ) : tau ( m -- n )
count-factors flip second 1 [ 1+ * ] reduce ; group-factors flip second 1 [ 1+ * ] reduce ;
! Optimized brute-force, is often faster than prime factorization ! Optimized brute-force, is often faster than prime factorization
: tau* ( m -- n ) : tau* ( m -- n )
reduce-2s [ perfect-square? -1 0 ? ] keep factor-2s [ 1+ ] dip [ perfect-square? -1 0 ? ] keep
dup sqrt >fixnum [1,b] [ dup sqrt >fixnum [1,b] [
dupd mod zero? [ >r 2 + r> ] when dupd mod zero? [ [ 2 + ] dip ] when
] each drop * ; ] each drop * ;

View File

@ -8,8 +8,8 @@ USING: definitions io io.files kernel math.parser sequences vocabs
project-euler.013 project-euler.014 project-euler.015 project-euler.016 project-euler.013 project-euler.014 project-euler.015 project-euler.016
project-euler.017 project-euler.018 project-euler.019 project-euler.020 project-euler.017 project-euler.018 project-euler.019 project-euler.020
project-euler.021 project-euler.022 project-euler.023 project-euler.024 project-euler.021 project-euler.022 project-euler.023 project-euler.024
project-euler.025 project-euler.067 project-euler.134 project-euler.169 project-euler.025 project-euler.026 project-euler.067 project-euler.134
project-euler.173 project-euler.175 ; project-euler.169 project-euler.173 project-euler.175 ;
IN: project-euler IN: project-euler
<PRIVATE <PRIVATE