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
editors words ;
USING: definitions help help.markup help.syntax io io.files editors words ;
IN: editors.vim
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 ;
: factor-2s ( n -- r s )
#! factor an even number into s * 2 ^ r
dup even? over 0 > and [
positive-even-expected construct-boa throw
] unless 0 swap (factor-2s) ;
#! factor an integer into s * 2^r
0 swap (factor-2s) ;
:: (miller-rabin) | n prime?! |
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
{ factors count-factors unique-factors } related-words
{ factors group-factors unique-factors } related-words
HELP: factors
{ $values { "n" "a positive integer" } { "seq" "a sequence" } }
{ $description { "Factorize an integer and return an ordered list of factors, possibly repeated." } } ;
{ $values { "n" "a positive integer" } { "seq" sequence } }
{ $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
{ $values { "n" "a positive integer" } { "seq" "a sequence" } }
{ $description { "Return a sequence of pairs representing each factor in the number and its corresponding power." } } ;
HELP: group-factors
{ $values { "n" "a positive integer" } { "seq" sequence } }
{ $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
{ $values { "n" "a positive integer" } { "seq" "a sequence" } }
{ $description { "Return an ordered list of unique prime factors." } } ;
{ $values { "n" "a positive integer" } { "seq" sequence } }
{ $description { "Return an ordered list of a number's unique prime factors." } }
{ $examples { $example "300 unique-factors ." "{ 2 3 5 }" } } ;
HELP: totient
{ $values { "n" "a positive integer" } { "t" "an integer" } }
{ $description { "Return the number of integers between 1 and " { $snippet "n-1" } " relatively prime to " { $snippet "n" } "." } } ;
{ $values { "n" "a positive integer" } { "t" integer } }
{ $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 ;
{ { 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
{ 999967000236000612 } [ 999969000187000867 totient ] unit-test

View File

@ -27,7 +27,7 @@ PRIVATE>
: factors ( n -- seq )
[ (factor) ] (decompose) ; foldable
: count-factors ( n -- seq )
: group-factors ( n -- seq )
[ (count) ] (decompose) ; foldable
: unique-factors ( n -- seq )
@ -37,5 +37,5 @@ PRIVATE>
dup 2 < [
drop 0
] [
[ unique-factors dup 1 [ 1- * ] reduce swap product / ] keep *
dup unique-factors dup 1 [ 1- * ] reduce swap product / *
] if ; foldable

View File

@ -24,14 +24,18 @@ IN: project-euler.006
! SOLUTION
! --------
<PRIVATE
: sum-of-squares ( seq -- n )
0 [ sq + ] reduce ;
: square-of-sums ( seq -- n )
0 [ + ] reduce sq ;
: square-of-sum ( seq -- n )
sum sq ;
PRIVATE>
: 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
! 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 )
[ 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 )
rot 1 tail -rot ;
@ -88,11 +85,11 @@ PRIVATE>
! The divisor function, counts the number of divisors
: 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
: tau* ( m -- n )
reduce-2s [ perfect-square? -1 0 ? ] keep
factor-2s [ 1+ ] dip [ perfect-square? -1 0 ? ] keep
dup sqrt >fixnum [1,b] [
dupd mod zero? [ >r 2 + r> ] when
dupd mod zero? [ [ 2 + ] dip ] when
] 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.017 project-euler.018 project-euler.019 project-euler.020
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.173 project-euler.175 ;
project-euler.025 project-euler.026 project-euler.067 project-euler.134
project-euler.169 project-euler.173 project-euler.175 ;
IN: project-euler
<PRIVATE