steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge http://littledan.onigirihouse.com/factor

db4
Doug Coleman 2008-01-04 19:21:18 -06:00
parent ace3419a8a f66e1b1f66
commit 03b18daa5e
7 changed files with 177 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
extra/project-euler/011/011.factor
View File

@ -1,6 +1,6 @@
! Copyright (c) 2007 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel namespaces project-euler.common sequences ;
USING: kernel namespaces project-euler.common sequences splitting ;
IN: project-euler.011
! http://projecteuler.net/index.php?section=problems&id=11
@ -45,40 +45,40 @@ IN: project-euler.011
: horizontal ( -- matrix )
{
{ 08 02 22 97 38 15 00 40 00 75 04 05 07 78 52 12 50 77 91 08 }
{ 49 49 99 40 17 81 18 57 60 87 17 40 98 43 69 48 04 56 62 00 }
{ 81 49 31 73 55 79 14 29 93 71 40 67 53 88 30 03 49 13 36 65 }
{ 52 70 95 23 04 60 11 42 69 24 68 56 01 32 56 71 37 02 36 91 }
{ 22 31 16 71 51 67 63 89 41 92 36 54 22 40 40 28 66 33 13 80 }
{ 24 47 32 60 99 03 45 02 44 75 33 53 78 36 84 20 35 17 12 50 }
{ 32 98 81 28 64 23 67 10 26 38 40 67 59 54 70 66 18 38 64 70 }
{ 67 26 20 68 02 62 12 20 95 63 94 39 63 08 40 91 66 49 94 21 }
{ 24 55 58 05 66 73 99 26 97 17 78 78 96 83 14 88 34 89 63 72 }
{ 21 36 23 09 75 00 76 44 20 45 35 14 00 61 33 97 34 31 33 95 }
{ 78 17 53 28 22 75 31 67 15 94 03 80 04 62 16 14 09 53 56 92 }
{ 16 39 05 42 96 35 31 47 55 58 88 24 00 17 54 24 36 29 85 57 }
{ 86 56 00 48 35 71 89 07 05 44 44 37 44 60 21 58 51 54 17 58 }
{ 19 80 81 68 05 94 47 69 28 73 92 13 86 52 17 77 04 89 55 40 }
{ 04 52 08 83 97 35 99 16 07 97 57 32 16 26 26 79 33 27 98 66 }
{ 88 36 68 87 57 62 20 72 03 46 33 67 46 55 12 32 63 93 53 69 }
{ 04 42 16 73 38 25 39 11 24 94 72 18 08 46 29 32 40 62 76 36 }
{ 20 69 36 41 72 30 23 88 34 62 99 69 82 67 59 85 74 04 36 16 }
{ 20 73 35 29 78 31 90 01 74 31 49 71 48 86 81 16 23 57 05 54 }
{ 01 70 54 71 83 51 54 69 16 92 33 48 61 43 52 01 89 19 67 48 }
} ;
08 02 22 97 38 15 00 40 00 75 04 05 07 78 52 12 50 77 91 08
49 49 99 40 17 81 18 57 60 87 17 40 98 43 69 48 04 56 62 00
81 49 31 73 55 79 14 29 93 71 40 67 53 88 30 03 49 13 36 65
52 70 95 23 04 60 11 42 69 24 68 56 01 32 56 71 37 02 36 91
22 31 16 71 51 67 63 89 41 92 36 54 22 40 40 28 66 33 13 80
24 47 32 60 99 03 45 02 44 75 33 53 78 36 84 20 35 17 12 50
32 98 81 28 64 23 67 10 26 38 40 67 59 54 70 66 18 38 64 70
67 26 20 68 02 62 12 20 95 63 94 39 63 08 40 91 66 49 94 21
24 55 58 05 66 73 99 26 97 17 78 78 96 83 14 88 34 89 63 72
21 36 23 09 75 00 76 44 20 45 35 14 00 61 33 97 34 31 33 95
78 17 53 28 22 75 31 67 15 94 03 80 04 62 16 14 09 53 56 92
16 39 05 42 96 35 31 47 55 58 88 24 00 17 54 24 36 29 85 57
86 56 00 48 35 71 89 07 05 44 44 37 44 60 21 58 51 54 17 58
19 80 81 68 05 94 47 69 28 73 92 13 86 52 17 77 04 89 55 40
04 52 08 83 97 35 99 16 07 97 57 32 16 26 26 79 33 27 98 66
88 36 68 87 57 62 20 72 03 46 33 67 46 55 12 32 63 93 53 69
04 42 16 73 38 25 39 11 24 94 72 18 08 46 29 32 40 62 76 36
20 69 36 41 72 30 23 88 34 62 99 69 82 67 59 85 74 04 36 16
20 73 35 29 78 31 90 01 74 31 49 71 48 86 81 16 23 57 05 54
01 70 54 71 83 51 54 69 16 92 33 48 61 43 52 01 89 19 67 48
} 20 group ;
: vertical ( -- matrix )
horizontal flip ;
: pad-front ( matrix -- matrix )
[
length [ 0 <repetition> ] each
] keep [ append ] map ;
length [ 0 <repetition> ] map
] keep [ append ] 2map ;
: pad-back ( matrix -- matrix )
<reversed> [
length [ 0 <repetition> ] each
] keep [ <reversed> append ] map ;
length [ 0 <repetition> ] map
] keep [ <reversed> append ] 2map ;
: diagonal/ ( -- matrix )
horizontal reverse pad-front pad-back flip ;
@ -98,9 +98,6 @@ PRIVATE>
[ call 4 max-product , ] each
] { } make supremum ;
! TODO: solution works but doesn't completely compile due to the creation of
! the diagonal matrices, there must be a cleaner way to generate those
! [ euler011 ] 100 ave-time
! 4 ms run / 0 ms GC ave time - 100 trials

36
extra/project-euler/018/018.factor
View File

@ -51,24 +51,24 @@ IN: project-euler.018
<PRIVATE
: pyramid ( -- seq )
{
75
95 64
17 47 82
18 35 87 10
20 04 82 47 65
19 01 23 75 03 34
88 02 77 73 07 63 67
99 65 04 28 06 16 70 92
41 41 26 56 83 40 80 70 33
41 48 72 33 47 32 37 16 94 29
53 71 44 65 25 43 91 52 97 51 14
70 11 33 28 77 73 17 78 39 68 17 57
91 71 52 38 17 14 91 43 58 50 27 29 48
63 66 04 68 89 53 67 30 73 16 69 87 40 31
04 62 98 27 23 09 70 98 73 93 38 53 60 04 23
}
15 [ 1+ cut swap ] map nip ;
{
75
95 64
17 47 82
18 35 87 10
20 04 82 47 65
19 01 23 75 03 34
88 02 77 73 07 63 67
99 65 04 28 06 16 70 92
41 41 26 56 83 40 80 70 33
41 48 72 33 47 32 37 16 94 29
53 71 44 65 25 43 91 52 97 51 14
70 11 33 28 77 73 17 78 39 68 17 57
91 71 52 38 17 14 91 43 58 50 27 29 48
63 66 04 68 89 53 67 30 73 16 69 87 40 31
04 62 98 27 23 09 70 98 73 93 38 53 60 04 23
}
15 [ 1+ cut swap ] map nip ;
PRIVATE>

41
extra/project-euler/169/169.factor Normal file
View File

@ -0,0 +1,41 @@
! Copyright (c) 2007 Samuel Tardieu.
! See http://factorcode.org/license.txt for BSD license.
IN: project-euler.169
USING: combinators kernel math math.functions memoize ;
! http://projecteuler.net/index.php?section=problems&id=169
! DESCRIPTION
! -----------
! Define f(0)=1 and f(n) to be the number of different ways n can be
! expressed as a sum of integer powers of 2 using each power no more
! than twice.
! For example, f(10)=5 since there are five different ways to express 10:
! 1 + 1 + 8
! 1 + 1 + 4 + 4
! 1 + 1 + 2 + 2 + 4
! 2 + 4 + 4
! 2 + 8
! What is f(1025)?
! SOLUTION
! --------
MEMO: fn ( n -- x )
{
{ [ dup 2 < ] [ drop 1 ] }
{ [ dup odd? ] [ 2/ fn ] }
{ [ t ] [ 2/ [ fn ] keep 1- fn + ] }
} cond ;
: euler169 ( -- result )
10 25 ^ fn ;
! [ euler169 ] 100 ave-time
! 0 ms run / 0 ms GC ave time - 100 trials
MAIN: euler169

34
extra/project-euler/173/173.factor Normal file
View File

@ -0,0 +1,34 @@
! Copyright (c) 2007 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math math.functions math.ranges sequences ;
IN: project-euler.173
! http://projecteuler.net/index.php?section=problems&id=173
! DESCRIPTION
! -----------
! We shall define a square lamina to be a square outline with a square
! "hole" so that the shape possesses vertical and horizontal
! symmetry. For example, using exactly thirty-two square tiles we can
! form two different square laminae: [see URL for figure]
! With one-hundred tiles, and not necessarily using all of the tiles at
! one time, it is possible to form forty-one different square laminae.
! Using up to one million tiles how many different square laminae can be
! formed?
! SOLUTION
! --------
: laminaes ( upper -- n )
4 / dup sqrt [1,b] 0 rot [ over /mod drop - - ] curry reduce ;
: euler173 ( -- answer )
1000000 laminaes ;
! [ euler173 ] 100 ave-time
! 0 ms run / 0 ms GC ave time - 100 trials
MAIN: euler173

54
extra/project-euler/175/175.factor Normal file
View File

@ -0,0 +1,54 @@
! Copyright (c) 2007 Samuel Tardieu.
! See http://factorcode.org/license.txt for BSD license.
USING: combinators kernel math math.parser math.ranges sequences vectors ;
IN: project-euler.175
! http://projecteuler.net/index.php?section=problems&id=175
! DESCRIPTION
! -----------
! Define f(0)=1 and f(n) to be the number of ways to write n as a sum of
! powers of 2 where no power occurs more than twice.
! For example, f(10)=5 since there are five different ways to express
! 10: 10 = 8+2 = 8+1+1 = 4+4+2 = 4+2+2+1+1 = 4+4+1+1
! It can be shown that for every fraction p/q (p0, q0) there exists at
! least one integer n such that f(n)/f(n-1)=p/q.
! For instance, the smallest n for which f(n)/f(n-1)=13/17 is 241. The
! binary expansion of 241 is 11110001. Reading this binary number from
! the most significant bit to the least significant bit there are 4
! one's, 3 zeroes and 1 one. We shall call the string 4,3,1 the
! Shortened Binary Expansion of 241.
! Find the Shortened Binary Expansion of the smallest n for which
! f(n)/f(n-1)=123456789/987654321.
! Give your answer as comma separated integers, without any whitespaces.
! SOLUTION
! --------
: add-bits ( vec n b -- )
over zero? [
3drop
] [
pick length 1 bitand = [ over pop + ] when swap push
] if ;
: compute ( vec ratio -- )
{
{ [ dup integer? ] [ 1- 0 add-bits ] }
{ [ dup 1 < ] [ 1 over - / dupd compute 1 1 add-bits ] }
{ [ t ] [ [ 1 mod compute ] 2keep >integer 0 add-bits ] }
} cond ;
: euler175 ( -- result )
V{ 1 } clone dup 123456789/987654321 compute [ number>string ] map "," join ;
! [ euler175 ] 100 ave-time
! 0 ms run / 0 ms GC ave time - 100 trials
MAIN: euler175

4
extra/project-euler/project-euler.factor
View File

@ -1,7 +1,7 @@
! Copyright (c) 2007 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: definitions io io.files kernel math.parser sequences vocabs
vocabs.loader project-euler.ave-time project-euler.common
vocabs.loader project-euler.ave-time project-euler.common math
project-euler.001 project-euler.002 project-euler.003 project-euler.004
project-euler.005 project-euler.006 project-euler.007 project-euler.008
project-euler.009 project-euler.010 project-euler.011 project-euler.012
@ -31,7 +31,7 @@ PRIVATE>
: run-project-euler ( -- )
problem-prompt dup problem-solved? [
dup number>euler "project-euler." swap append run
"Answer: " swap number>string append print
"Answer: " swap dup number? [ number>string ] when append print
"Source: " swap solution-path append print
] [
drop "That problem has not been solved yet..." print

3
extra/trees/splay/authors.txt
View File

@ -1 +1,2 @@
Mackenzie Straight, Daniel Ehrenberg
Mackenzie Straight
Daniel Ehrenberg