Merge git://projects.elasticdog.com/git/factor
						commit
						04b4832454
					
				| 
						 | 
				
			
			@ -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"
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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" } "." } } ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			@ -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 * ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue