From 82fd581e9fdd8fdf214bca1fd671e686e0494b10 Mon Sep 17 00:00:00 2001
From: Aaron Schaefer <aaron@elasticdog.com>
Date: Sun, 13 Jan 2008 10:41:35 -0500
Subject: [PATCH 1/6] Fix circular doc errors
---
extra/editors/vim/vim-docs.factor | 4 ++--
extra/math/statistics/statistics-docs.factor | 21 ++++++++++----------
2 files changed, 13 insertions(+), 12 deletions(-)
diff --git a/extra/editors/vim/vim-docs.factor b/extra/editors/vim/vim-docs.factor
index 9f141f524f..020117564d 100644
--- a/extra/editors/vim/vim-docs.factor
+++ b/extra/editors/vim/vim-docs.factor
@@ -1,5 +1,5 @@
-USING: definitions editors.vim 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"
"This module makes the " { $link edit } " word work with Vim by setting the " { $link edit-hook } " global variable to call " { $link vim-location } ". The " { $link vim-path } " variable contains the name of the vim executable. The default " { $link vim-path } " is " { $snippet "\"gvim\"" } "."
diff --git a/extra/math/statistics/statistics-docs.factor b/extra/math/statistics/statistics-docs.factor
index bb92178e6d..4787a85aed 100644
--- a/extra/math/statistics/statistics-docs.factor
+++ b/extra/math/statistics/statistics-docs.factor
@@ -1,49 +1,50 @@
-USING: math.statistics help.markup help.syntax debugger ;
+USING: help.markup help.syntax debugger ;
+IN: math.statistics
HELP: geometric-mean
{ $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." }
-{ $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." } ;
HELP: harmonic-mean
{ $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." }
-{ $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." } ;
HELP: mean
{ $values { "seq" "a sequence of numbers" } { "n" "a non-negative real number"} }
{ $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." } ;
HELP: median
{ $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." }
-{ $examples
+{ $examples
{ $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." } ;
HELP: range
{ $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" } "." }
-{ $examples
+{ $examples
{ $example "USE: math.statistics" "{ 1 2 3 } range ." "2" }
{ $example "USE: math.statistics" "{ 1 2 3 4 } range ." "3" } } ;
HELP: std
{ $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." }
-{ $examples
+{ $examples
{ $example "USE: math.statistics" "{ 1 2 3 } std ." "1.0" }
{ $example "USE: math.statistics" "{ 1 2 3 4 } std ." "1.290994448735806" } } ;
HELP: ste
{ $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." }
- { $examples
+ { $examples
{ $example "USE: math.statistics" "{ -2 2 } ste ." "2.0" }
{ $example "USE: math.statistics" "{ -2 2 2 } ste ." "1.333333333333333" } } ;
@@ -51,7 +52,7 @@ HELP: var
{ $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." }
{ $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 2 3 } var ." "1" }
{ $example "USE: math.statistics" "{ 1 2 3 4 } var ." "5/3" } } ;
From 0d166264c89ff818e1ca42d649c63ab3a40c929a Mon Sep 17 00:00:00 2001
From: Aaron Schaefer <aaron@elasticdog.com>
Date: Sun, 13 Jan 2008 17:28:54 -0500
Subject: [PATCH 2/6] lint on Project Euler solutions
---
extra/project-euler/006/006.factor | 10 +++++++---
1 file changed, 7 insertions(+), 3 deletions(-)
diff --git a/extra/project-euler/006/006.factor b/extra/project-euler/006/006.factor
index 2f09912412..fb4fb954fa 100644
--- a/extra/project-euler/006/006.factor
+++ b/extra/project-euler/006/006.factor
@@ -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
From 12b24af9343719b9c1c1b4c8e2c2c7d40654dbf9 Mon Sep 17 00:00:00 2001
From: Aaron Schaefer <aaron@elasticdog.com>
Date: Mon, 14 Jan 2008 02:38:23 -0500
Subject: [PATCH 3/6] Simplify totient in math.primes.factors
---
extra/math/primes/factors/factors.factor | 30 ++++++++++++------------
1 file changed, 15 insertions(+), 15 deletions(-)
diff --git a/extra/math/primes/factors/factors.factor b/extra/math/primes/factors/factors.factor
index b841d49f7d..66ec748535 100644
--- a/extra/math/primes/factors/factors.factor
+++ b/extra/math/primes/factors/factors.factor
@@ -6,36 +6,36 @@ IN: math.primes.factors
<PRIVATE
: (factor) ( n d -- n' )
- 2dup mod zero? [ [ / ] keep dup , (factor) ] [ drop ] if ;
+ 2dup mod zero? [ [ / ] keep dup , (factor) ] [ drop ] if ;
: (count) ( n d -- n' )
- [ (factor) ] { } make
- dup empty? [ drop ] [ [ first ] keep length 2array , ] if ;
+ [ (factor) ] { } make
+ dup empty? [ drop ] [ [ first ] keep length 2array , ] if ;
: (unique) ( n d -- n' )
- [ (factor) ] { } make
- dup empty? [ drop ] [ first , ] if ;
+ [ (factor) ] { } make
+ dup empty? [ drop ] [ first , ] if ;
: (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 )
- [ lprimes rot (factors) ] { } make ;
+ [ lprimes rot (factors) ] { } make ;
PRIVATE>
: factors ( n -- seq )
- [ (factor) ] (decompose) ; foldable
+ [ (factor) ] (decompose) ; foldable
: count-factors ( n -- seq )
- [ (count) ] (decompose) ; foldable
+ [ (count) ] (decompose) ; foldable
: unique-factors ( n -- seq )
- [ (unique) ] (decompose) ; foldable
+ [ (unique) ] (decompose) ; foldable
: totient ( n -- t )
- dup 2 < [
- drop 0
- ] [
- [ unique-factors dup 1 [ 1- * ] reduce swap product / ] keep *
- ] if ; foldable
+ dup 2 < [
+ drop 0
+ ] [
+ dup unique-factors dup 1 [ 1- * ] reduce swap product / *
+ ] if ; foldable
From 75774188ea7a1db096bcabf6af19b08b4ca5aa03 Mon Sep 17 00:00:00 2001
From: Aaron Schaefer <aaron@elasticdog.com>
Date: Mon, 14 Jan 2008 02:43:31 -0500
Subject: [PATCH 4/6] Solution to Project Euler problem 26
---
extra/project-euler/026/026.factor | 71 ++++++++++++++++++++++++
extra/project-euler/project-euler.factor | 4 +-
2 files changed, 73 insertions(+), 2 deletions(-)
create mode 100644 extra/project-euler/026/026.factor
diff --git a/extra/project-euler/026/026.factor b/extra/project-euler/026/026.factor
new file mode 100644
index 0000000000..d79effed02
--- /dev/null
+++ b/extra/project-euler/026/026.factor
@@ -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
diff --git a/extra/project-euler/project-euler.factor b/extra/project-euler/project-euler.factor
index 038ae3c5b8..6abb056d28 100644
--- a/extra/project-euler/project-euler.factor
+++ b/extra/project-euler/project-euler.factor
@@ -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
From 8bc631f5ed3bbb4f7df8025ec149d6740a2495da Mon Sep 17 00:00:00 2001
From: Aaron Schaefer <aaron@elasticdog.com>
Date: Mon, 14 Jan 2008 11:33:08 -0500
Subject: [PATCH 5/6] Rename count-factors to group-factors and update docs
---
extra/math/primes/factors/factors-docs.factor | 25 +++++++++++--------
.../math/primes/factors/factors-tests.factor | 2 +-
extra/math/primes/factors/factors.factor | 2 +-
extra/project-euler/common/common.factor | 2 +-
4 files changed, 17 insertions(+), 14 deletions(-)
diff --git a/extra/math/primes/factors/factors-docs.factor b/extra/math/primes/factors/factors-docs.factor
index 2238420d32..f5b14b5a5a 100644
--- a/extra/math/primes/factors/factors-docs.factor
+++ b/extra/math/primes/factors/factors-docs.factor
@@ -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" } "." } } ;
diff --git a/extra/math/primes/factors/factors-tests.factor b/extra/math/primes/factors/factors-tests.factor
index 71bdd56a81..70b905f4ab 100644
--- a/extra/math/primes/factors/factors-tests.factor
+++ b/extra/math/primes/factors/factors-tests.factor
@@ -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
diff --git a/extra/math/primes/factors/factors.factor b/extra/math/primes/factors/factors.factor
index 66ec748535..2f70ab24b4 100644
--- a/extra/math/primes/factors/factors.factor
+++ b/extra/math/primes/factors/factors.factor
@@ -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 )
diff --git a/extra/project-euler/common/common.factor b/extra/project-euler/common/common.factor
index 6279606481..67cce7d31a 100644
--- a/extra/project-euler/common/common.factor
+++ b/extra/project-euler/common/common.factor
@@ -88,7 +88,7 @@ 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 )
From 76558babf46a7155506cdc560b84177d851cad45 Mon Sep 17 00:00:00 2001
From: Aaron Schaefer <aaron@elasticdog.com>
Date: Mon, 14 Jan 2008 15:04:21 -0500
Subject: [PATCH 6/6] Generalize factor-2s to eliminate special case exception
---
extra/math/miller-rabin/miller-rabin.factor | 6 ++----
extra/project-euler/common/common.factor | 7 ++-----
2 files changed, 4 insertions(+), 9 deletions(-)
diff --git a/extra/math/miller-rabin/miller-rabin.factor b/extra/math/miller-rabin/miller-rabin.factor
index de5a262268..e2d012ec0a 100644
--- a/extra/math/miller-rabin/miller-rabin.factor
+++ b/extra/math/miller-rabin/miller-rabin.factor
@@ -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
diff --git a/extra/project-euler/common/common.factor b/extra/project-euler/common/common.factor
index 67cce7d31a..2bd2b7ec0b 100644
--- a/extra/project-euler/common/common.factor
+++ b/extra/project-euler/common/common.factor
@@ -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 ;
@@ -92,7 +89,7 @@ PRIVATE>
! 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 * ;