Merge branch 'master' of git://factorcode.org/git/factor
Joe Groff
commit
d4ee121750
|
|
@ -131,6 +131,7 @@ IN: compiler.cfg.intrinsics
|
|||
{ math.libm:fsqrt [ drop "sqrt" emit-unary-float-function ] }
|
||||
{ math.floats.private:float-min [ drop "fmin" emit-binary-float-function ] }
|
||||
{ math.floats.private:float-max [ drop "fmax" emit-binary-float-function ] }
|
||||
{ math.private:float-mod [ drop "fmod" emit-binary-float-function ] }
|
||||
} enable-intrinsics ;
|
||||
|
||||
: enable-min/max ( -- )
|
||||
|
|
|
|||
|
|
@ -819,3 +819,8 @@ M: tuple-with-read-only-slot clone
|
|||
|
||||
! Don't crash if bad literal inputs are passed to unsafe words
|
||||
[ f ] [ [ { } 1 fixnum+fast ] final-info first literal?>> ] unit-test
|
||||
|
||||
! Converting /i to shift
|
||||
[ t ] [ [ >fixnum dup 0 >= [ 16 /i ] when ] { /i fixnum/i fixnum/i-fast } inlined? ] unit-test
|
||||
[ f ] [ [ >fixnum dup 0 >= [ 16 /i ] when ] { fixnum-shift-fast } inlined? ] unit-test
|
||||
[ f ] [ [ >float dup 0 >= [ 16 /i ] when ] { /i float/f } inlined? ] unit-test
|
||||
|
|
|
|||
|
|
@ -80,6 +80,17 @@ IN: compiler.tree.propagation.transforms
|
|||
] [ f ] if
|
||||
] "custom-inlining" set-word-prop
|
||||
|
||||
{ /i fixnum/i fixnum/i-fast bignum/i } [
|
||||
[
|
||||
in-d>> first2 [ value-info ] bi@ {
|
||||
[ drop class>> integer class<= ]
|
||||
[ drop interval>> 0 [a,a] interval>= ]
|
||||
[ nip literal>> integer? ]
|
||||
[ nip literal>> power-of-2? ]
|
||||
} 2&& [ [ log2 neg shift ] ] [ f ] if
|
||||
] "custom-inlining" set-word-prop
|
||||
] each
|
||||
|
||||
! Integrate this with generic arithmetic optimization instead?
|
||||
: both-inputs? ( #call class -- ? )
|
||||
[ in-d>> first2 ] dip '[ value-info class>> _ class<= ] both? ;
|
||||
|
|
|
|||
|
|
@ -2,8 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: assocs classes.predicate fry generic io.pathnames kernel
|
||||
macros sequences vocabs words words.symbol words.constant
|
||||
lexer parser help.topics help.markup help.vocabs namespaces
|
||||
sorting ;
|
||||
lexer parser help.topics help.markup namespaces sorting ;
|
||||
IN: definitions.icons
|
||||
|
||||
GENERIC: definition-icon ( definition -- path )
|
||||
|
|
@ -38,11 +37,9 @@ ICON: symbol symbol-word
|
|||
ICON: constant constant-word
|
||||
ICON: word normal-word
|
||||
ICON: word-link word-help-article
|
||||
ICON: link help-article
|
||||
ICON: topic help-article
|
||||
ICON: runnable-vocab runnable-vocab
|
||||
ICON: vocab open-vocab
|
||||
ICON: vocab-tag help-article
|
||||
ICON: vocab-author help-article
|
||||
ICON: vocab-link unopen-vocab
|
||||
|
||||
: $definition-icons ( element -- )
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! (c) Joe Groff, see license for details
|
||||
USING: accessors continuations kernel parser words quotations
|
||||
combinators.smart vectors sequences fry ;
|
||||
vectors sequences fry ;
|
||||
IN: literals
|
||||
|
||||
<PRIVATE
|
||||
|
|
@ -19,7 +19,3 @@ PRIVATE>
|
|||
SYNTAX: $ scan-word expand-literal >vector ;
|
||||
SYNTAX: $[ parse-quotation with-datastack >vector ;
|
||||
SYNTAX: ${ \ } [ expand-literals ] parse-literal ;
|
||||
|
||||
SYNTAX: $$
|
||||
scan-word execute( accum -- accum ) dup pop [ >quotation ] keep
|
||||
[ output>sequence ] 2curry call( -- object ) parsed ;
|
||||
|
|
|
|||
|
|
@ -1,7 +1,8 @@
|
|||
IN: math.vectors.simd.tests
|
||||
USING: math math.vectors.simd math.vectors.simd.private
|
||||
math.vectors math.functions math.private kernel.private compiler
|
||||
sequences tools.test compiler.tree.debugger accessors kernel ;
|
||||
sequences tools.test compiler.tree.debugger accessors kernel
|
||||
system ;
|
||||
|
||||
[ float-4{ 0 0 0 0 } ] [ float-4 new ] unit-test
|
||||
|
||||
|
|
@ -349,13 +350,15 @@ sequences tools.test compiler.tree.debugger accessors kernel ;
|
|||
[ { float-8 float } declare v/n ] compile-call
|
||||
] unit-test
|
||||
|
||||
! Test puns
|
||||
[ double-2{ 4 1024 } ] [
|
||||
float-4{ 0 1 0 2 }
|
||||
[ { float-4 } declare dup v+ underlying>> double-2 boa dup v+ ] compile-call
|
||||
] unit-test
|
||||
|
||||
[ 33.0 ] [
|
||||
double-2{ 1 2 } double-2{ 10 20 }
|
||||
[ { double-2 double-2 } declare v+ underlying>> 3.0 float* ] compile-call
|
||||
] unit-test
|
||||
! Test puns; only on x86
|
||||
cpu x86? [
|
||||
[ double-2{ 4 1024 } ] [
|
||||
float-4{ 0 1 0 2 }
|
||||
[ { float-4 } declare dup v+ underlying>> double-2 boa dup v+ ] compile-call
|
||||
] unit-test
|
||||
|
||||
[ 33.0 ] [
|
||||
double-2{ 1 2 } double-2{ 10 20 }
|
||||
[ { double-2 double-2 } declare v+ underlying>> 3.0 float* ] compile-call
|
||||
] unit-test
|
||||
] when
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (c) 2008 Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel math math.functions math.ranges math.order
|
||||
project-euler.common sequences ;
|
||||
project-euler.common sequences layouts ;
|
||||
IN: project-euler.044
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=44
|
||||
|
|
@ -29,20 +29,26 @@ IN: project-euler.044
|
|||
<PRIVATE
|
||||
|
||||
: nth-pentagonal ( n -- seq )
|
||||
dup 3 * 1 - * 2 / ;
|
||||
dup 3 * 1 - * 2 /i ; inline
|
||||
|
||||
: sum-and-diff? ( m n -- ? )
|
||||
[ + ] [ - ] 2bi [ pentagonal? ] bi@ and ;
|
||||
[ + ] [ - ] 2bi [ pentagonal? ] bi@ and ; inline
|
||||
|
||||
: euler044-step ( min m n -- min' )
|
||||
[ nth-pentagonal ] bi@
|
||||
2dup sum-and-diff? [ - abs min ] [ 2drop ] if ; inline
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: euler044 ( -- answer )
|
||||
2500 [1,b] [ nth-pentagonal ] map dup cartesian-product
|
||||
[ first2 sum-and-diff? ] filter [ first2 - abs ] [ min ] map-reduce ;
|
||||
most-positive-fixnum >fixnum
|
||||
2500 [1,b] [
|
||||
dup [1,b] [
|
||||
euler044-step
|
||||
] with each
|
||||
] each ;
|
||||
|
||||
! [ euler044 ] 10 ave-time
|
||||
! 4996 ms ave run time - 87.46 SD (10 trials)
|
||||
|
||||
! TODO: this solution is ugly and not very efficient...find a better algorithm
|
||||
! 289 ms ave run time - 0.27 SD (10 trials)
|
||||
|
||||
SOLUTION: euler044
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (c) 2008 Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel locals make math project-euler.common sequences ;
|
||||
USING: kernel locals math project-euler.common sequences ;
|
||||
IN: project-euler.073
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=73
|
||||
|
|
@ -32,19 +32,19 @@ IN: project-euler.073
|
|||
|
||||
<PRIVATE
|
||||
|
||||
:: (euler073) ( limit lo hi -- )
|
||||
:: (euler073) ( counter limit lo hi -- counter' )
|
||||
[let | m [ lo hi mediant ] |
|
||||
m denominator limit <= [
|
||||
m ,
|
||||
counter 1 +
|
||||
limit lo m (euler073)
|
||||
limit m hi (euler073)
|
||||
] when
|
||||
] [ counter ] if
|
||||
] ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: euler073 ( -- answer )
|
||||
[ 10000 1/3 1/2 (euler073) ] { } make length ;
|
||||
0 10000 1/3 1/2 (euler073) ;
|
||||
|
||||
! [ euler073 ] 10 ave-time
|
||||
! 20506 ms ave run time - 937.07 SD (10 trials)
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
! Copyright (c) 2009 Guillaume Nargeot.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays kernel math math.ranges project-euler.common sequences ;
|
||||
USING: accessors kernel math math.ranges project-euler.common
|
||||
sequences locals ;
|
||||
IN: project-euler.085
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=85
|
||||
|
|
@ -23,28 +24,31 @@ IN: project-euler.085
|
|||
<PRIVATE
|
||||
|
||||
: distance ( m -- n )
|
||||
2000000 - abs ;
|
||||
2000000 - abs ; inline
|
||||
|
||||
: rectangles-count ( a b -- n )
|
||||
2dup [ 1 + ] bi@ * * * 4 / ;
|
||||
2dup [ 1 + ] bi@ * * * 4 /i ; inline
|
||||
|
||||
: unique-products ( a b -- seq )
|
||||
tuck [a,b] [
|
||||
over dupd [a,b] [ 2array ] with map
|
||||
] map concat nip ;
|
||||
:: each-unique-product ( a b quot: ( i j -- ) -- )
|
||||
a b [a,b] [| i |
|
||||
i b [a,b] [| j |
|
||||
i j quot call
|
||||
] each
|
||||
] each ; inline
|
||||
|
||||
: max-by-last ( seq seq -- seq )
|
||||
[ [ last ] bi@ < ] most ;
|
||||
TUPLE: result { area read-only } { distance read-only } ;
|
||||
|
||||
: array2 ( seq -- a b )
|
||||
[ first ] [ last ] bi ;
|
||||
C: <result> result
|
||||
|
||||
: convert ( seq -- seq )
|
||||
array2 [ * ] [ rectangles-count distance ] 2bi 2array ;
|
||||
: min-by-distance ( seq seq -- seq )
|
||||
[ [ distance>> ] bi@ < ] most ; inline
|
||||
|
||||
: compute-result ( i j -- pair )
|
||||
[ * ] [ rectangles-count distance ] 2bi <result> ; inline
|
||||
|
||||
: area-of-nearest ( -- n )
|
||||
1 2000 unique-products
|
||||
[ convert ] [ max-by-last ] map-reduce first ;
|
||||
T{ result f 0 2000000 } 1 2000
|
||||
[ compute-result min-by-distance ] each-unique-product area>> ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,4 @@
|
|||
USING: project-euler.102 tools.test ;
|
||||
IN: project-euler.102.tests
|
||||
|
||||
[ 228 ] [ euler102 ] unit-test
|
||||
|
|
@ -0,0 +1,64 @@
|
|||
! Copyright (c) 2009 Guillaume Nargeot.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays grouping io.encodings.ascii io.files kernel math
|
||||
math.parser sequences splitting project-euler.common ;
|
||||
IN: project-euler.102
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=102
|
||||
|
||||
! DESCRIPTION
|
||||
! -----------
|
||||
|
||||
! Three distinct points are plotted at random on a Cartesian plane, for which
|
||||
! -1000 ≤ x, y ≤ 1000, such that a triangle is formed.
|
||||
|
||||
! Consider the following two triangles:
|
||||
|
||||
! A(-340,495), B(-153,-910), C(835,-947)
|
||||
! X(-175,41), Y(-421,-714), Z(574,-645)
|
||||
|
||||
! It can be verified that triangle ABC contains the origin, whereas triangle
|
||||
! XYZ does not.
|
||||
|
||||
! Using triangles.txt (right click and 'Save Link/Target As...'), a 27K text
|
||||
! file containing the co-ordinates of one thousand "random" triangles, find the
|
||||
! number of triangles for which the interior contains the origin.
|
||||
|
||||
! NOTE: The first two examples in the file represent the triangles in the
|
||||
! example given above.
|
||||
|
||||
|
||||
! SOLUTION
|
||||
! --------
|
||||
|
||||
! A triangle of coordinates (x1, y1) (x2, y2) (x3, y3) contains
|
||||
! the origin when (ab * bc > 0) and (bc * ca > 0) where:
|
||||
! ab = x1 * (y2 - y1) - y1 * (x2 - x1)
|
||||
! bc = x2 * (y3 - y2) - y2 * (x3 - x2)
|
||||
! ca = x3 * (y1 - y3) - y3 * (x1 - x3)
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: source-102 ( -- seq )
|
||||
"resource:extra/project-euler/102/triangles.txt"
|
||||
ascii file-lines [
|
||||
"," split [ string>number ] map 2 group
|
||||
] map ;
|
||||
|
||||
: det ( coord coord -- n )
|
||||
dupd [ [ last ] bi@ - ] [ [ first ] bi@ - ] 2bi 2array
|
||||
[ [ first ] bi@ * ] [ [ last ] bi@ * ] 2bi - ;
|
||||
|
||||
: include-origin? ( coord-seq -- ? )
|
||||
dup first suffix 2 clump [ [ first ] [ last ] bi det ] map
|
||||
2 clump [ product 0 > ] all? ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: euler102 ( -- answer )
|
||||
source-102 [ include-origin? ] count ;
|
||||
|
||||
! [ euler102 ] 100 ave-time
|
||||
! 12 ms ave run time - 0.92 SD (100 trials)
|
||||
|
||||
SOLUTION: euler102
|
||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,4 @@
|
|||
USING: project-euler.112 tools.test ;
|
||||
IN: project-euler.112.tests
|
||||
|
||||
[ 1587000 ] [ euler112 ] unit-test
|
||||
|
|
@ -0,0 +1,52 @@
|
|||
! Copyright (c) 2009 Guillaume Nargeot.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays kernel math project-euler.common sequences sorting ;
|
||||
IN: project-euler.112
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=112
|
||||
|
||||
! DESCRIPTION
|
||||
! -----------
|
||||
|
||||
! Working from left-to-right if no digit is exceeded by the digit to its left
|
||||
! it is called an increasing number; for example, 134468.
|
||||
|
||||
! Similarly if no digit is exceeded by the digit to its right it is called a
|
||||
! decreasing number; for example, 66420.
|
||||
|
||||
! We shall call a positive integer that is neither increasing nor decreasing a
|
||||
! "bouncy" number; for example, 155349.
|
||||
|
||||
! Clearly there cannot be any bouncy numbers below one-hundred, but just over
|
||||
! half of the numbers below one-thousand (525) are bouncy. In fact, the least
|
||||
! number for which the proportion of bouncy numbers first reaches 50% is 538.
|
||||
|
||||
! Surprisingly, bouncy numbers become more and more common and by the time we
|
||||
! reach 21780 the proportion of bouncy numbers is equal to 90%.
|
||||
|
||||
! Find the least number for which the proportion of bouncy numbers is exactly
|
||||
! 99%.
|
||||
|
||||
|
||||
! SOLUTION
|
||||
! --------
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: bouncy? ( n -- ? )
|
||||
number>digits dup natural-sort
|
||||
[ = not ] [ reverse = not ] 2bi and ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: euler112 ( -- answer )
|
||||
0 0 0 [
|
||||
2dup swap 99 * = not
|
||||
] [
|
||||
[ 1 + ] 2dip pick bouncy? [ 1 + ] [ [ 1 + ] dip ] if
|
||||
] do while 2drop ;
|
||||
|
||||
! [ euler112 ] 100 ave-time
|
||||
! 2749 ms ave run time - 33.76 SD (100 trials)
|
||||
|
||||
SOLUTION: euler112
|
||||
|
|
@ -91,7 +91,7 @@ PRIVATE>
|
|||
number>string natural-sort >string "123456789" = ;
|
||||
|
||||
: pentagonal? ( n -- ? )
|
||||
dup 0 > [ 24 * 1 + sqrt 1 + 6 / 1 mod zero? ] [ drop f ] if ;
|
||||
dup 0 > [ 24 * 1 + sqrt 1 + 6 / 1 mod zero? ] [ drop f ] if ; inline
|
||||
|
||||
: penultimate ( seq -- elt )
|
||||
dup length 2 - swap nth ;
|
||||
|
|
|
|||
|
|
@ -19,10 +19,11 @@ USING: definitions io io.files io.pathnames kernel math math.parser
|
|||
project-euler.059 project-euler.063 project-euler.067 project-euler.069
|
||||
project-euler.071 project-euler.073 project-euler.075 project-euler.076
|
||||
project-euler.079 project-euler.085 project-euler.092 project-euler.097
|
||||
project-euler.099 project-euler.100 project-euler.116 project-euler.117
|
||||
project-euler.134 project-euler.148 project-euler.150 project-euler.151
|
||||
project-euler.164 project-euler.169 project-euler.173 project-euler.175
|
||||
project-euler.186 project-euler.190 project-euler.203 project-euler.215 ;
|
||||
project-euler.099 project-euler.100 project-euler.102 project-euler.112
|
||||
project-euler.116 project-euler.117 project-euler.134 project-euler.148
|
||||
project-euler.150 project-euler.151 project-euler.164 project-euler.169
|
||||
project-euler.173 project-euler.175 project-euler.186 project-euler.190
|
||||
project-euler.203 project-euler.215 ;
|
||||
IN: project-euler
|
||||
|
||||
<PRIVATE
|
||||
|
|
|
|||
|
|
@ -20,9 +20,8 @@ struct gc_root : public tagged<T>
|
|||
~gc_root() {
|
||||
#ifdef FACTOR_DEBUG
|
||||
assert(gc_locals.back() == (cell)this);
|
||||
#else
|
||||
gc_locals.pop_back();
|
||||
#endif
|
||||
gc_locals.pop_back();
|
||||
}
|
||||
};
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue