! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays bit-arrays fry kernel kernel.private
layouts locals math math.functions math.order math.private
-multiline sequences sequences.private typed ;
-FROM: math.ranges => [1,b] ;
+math.ranges multiline sequences sequences.private typed ;
IN: bloom-filters
! 100 hashes ought to be enough for anybody.
: #hashes-range ( -- range )
- 100 [1,b] ;
+ 100 [1..b] ;
! { #hashes #bits }
: identity-configuration ( -- 2seq )
: days. ( year month -- )
[ 1 (day-of-week) dup [ " " write ] times ]
- [ (days-in-month) ] 2bi [1,b] [
+ [ (days-in-month) ] 2bi [1..b] [
[ day. ] [ + 7 mod zero? [ nl ] [ bl ] if ] bi
] with each nl ;
GENERIC: year. ( obj -- )
M: integer year.
- dup number>string 64 center. nl 12 [1,b] [
+ dup number>string 64 center. nl 12 [1..b] [
[
[ month-name 20 center. ]
[ days-header. days. nl nl ] bi
M: adler-32 checksum-bytes
drop
[ sum 1 + ]
- [ [ dup length [1,b] <reversed> vdot ] [ length ] bi + ] bi
+ [ [ dup length [1..b] <reversed> vdot ] [ length ] bi + ] bi
[ adler-32-modulus mod ] bi@ 16 shift bitor ;
INSTANCE: adler-32 checksum
: prepare-message-schedule ( seq sha2 -- w-seq )
[ word-size>> <groups> ] [ block-size>> <uint-array> ] bi
[ '[ [ be> ] dip _ set-nth-unsafe ] each-index ]
- [ 16 over length [a,b) over '[ _ prepare-M-256 ] each ] bi ; inline
+ [ 16 over length [a..b) over '[ _ prepare-M-256 ] each ] bi ; inline
:: process-chunk ( M block-size cloned-H sha2 -- )
block-size [
: prepare-sha1-message-schedule ( seq -- w-seq )
4 <groups> 80 <uint-array>
[ '[ [ be> ] dip _ set-nth-unsafe ] each-index ]
- [ 16 80 [a,b) over '[ _ sha1-W ] each ] bi ; inline
+ [ 16 80 [a..b) over '[ _ sha1-W ] each ] bi ; inline
: sha1-f ( B C D n -- f_nbcd )
20 /i
MEMO: static-huffman-tables ( -- obj )
[
- 0 143 [a,b] length [ 8 ] replicate
- 144 255 [a,b] length [ 9 ] replicate append
- 256 279 [a,b] length [ 7 ] replicate append
- 280 287 [a,b] length [ 8 ] replicate append
+ 0 143 [a..b] length [ 8 ] replicate
+ 144 255 [a..b] length [ 9 ] replicate append
+ 256 279 [a..b] length [ 7 ] replicate append
+ 280 287 [a..b] length [ 8 ] replicate append
] append-outputs
- 0 31 [a,b] length [ 5 ] replicate 2array
+ 0 31 [a..b] length [ 5 ] replicate 2array
[ [ length>> <iota> ] [ ] bi get-table ] map ;
CONSTANT: length-table
: gzip-inflate ( bytes -- bytes )
bs:<lsb0-bit-reader>
[ check-gzip-header ] [ inflate-loop ] bi
- inflate-lz77 ;
\ No newline at end of file
+ inflate-lz77 ;
] with-destructors ;
: uncompress ( byte-array -- byte-array' )
- [ length 5 [0,b) [ 2^ * ] with map ] keep
+ [ length 5 [0..b) [ 2^ * ] with map ] keep
'[ _ (uncompress) ] attempt-all ;
USING: accessors calendar calendar.parser classes continuations
db.tester db.tuples db.types kernel math math.intervals math.ranges
namespaces random sequences sorting strings tools.test urls ;
-FROM: math.ranges => [a,b] ;
IN: db.tuples.tests
TUPLE: person the-id the-name the-number the-real
: random-exam ( -- exam )
f
- 6 [ CHAR: a CHAR: z [a,b] random ] replicate >string
+ 6 [ CHAR: a CHAR: z [a..b] random ] replicate >string
100 random
exam boa ;
: each-line ( ... from to quot: ( ... line -- ... ) -- ... )
2over = [ 3drop ] [
- [ [ first ] bi@ [a,b] ] dip each
+ [ [ first ] bi@ [a..b] ] dip each
] if ; inline
: map-lines ( ... from to quot: ( ... line -- ... result ) -- ... results )
: lowest-missing-number ( string-set -- min )
members dup
[ length ] histogram-by
- dup keys length [0,b]
+ dup keys length [0..b]
[ [ of ] keep over [ 10^ < ] [ nip ] if ] with find nip
[ '[ length _ = ] filter natural-sort ] keep ! remove natural-sort here
[
[ sha1-escape-string ] { } map-as ;
M: string sha1-escape-strings ( str -- strs )
- split-lines sha1-escape-strings ;
\ No newline at end of file
+ split-lines sha1-escape-strings ;
[
log-path
[ delete-oldest ]
- [ keep-logs 1 [a,b] [ advance-log ] with each ] bi
+ [ keep-logs 1 [a..b] [ advance-log ] with each ] bi
] bi ;
: (rotate-logs) ( -- )
PRIVATE>
: factorial ( n -- n! )
- dup 1 > [ [1,b] product ] [ drop 1 ] if ;
+ dup 1 > [ [1..b] product ] [ drop 1 ] if ;
: nPk ( n k -- nPk )
- 2dup possible? [ dupd - [a,b) product ] [ 2drop 0 ] if ;
+ 2dup possible? [ dupd - [a..b) product ] [ 2drop 0 ] if ;
: nCk ( n k -- nCk )
twiddle [ nPk ] keep factorial /i ;
-rotd each-combination ; inline
: all-subsets ( seq -- subsets )
- dup length [0,b] [ all-combinations ] with map concat ;
+ dup length [0..b] [ all-combinations ] with map concat ;
<PRIVATE
<PRIVATE ! implementation details of <lower-matrix> and <upper-matrix>
: dimension-range ( matrix -- dim range )
- dimension [ <coordinate-matrix> ] [ first [1,b] ] bi ;
+ dimension [ <coordinate-matrix> ] [ first [1..b] ] bi ;
: upper-matrix-indices ( matrix -- matrix' )
dimension-range <reversed> [ tail-slice* >array ] 2map concat ;
1array
] [
group-factors dup empty? [
- [ first2 [0,b] [ ^ ] with map ] map
+ [ first2 [0..b] [ ^ ] with map ] map
[ product ] product-map natural-sort
] unless
] if ;
0 :> a!
trials <iota> [
drop
- 2 n 2 - [a,b] random a!
+ 2 n 2 - [a..b] random a!
a s n ^mod 1 = [
f
] [
-USING: arrays kernel math math.functions math.order math.vectors
-sequences tools.test ;
-FROM: math.ranges => [a,b] ;
+USING: arrays kernel math math.functions math.order math.ranges
+math.vectors sequences tools.test ;
IN: math.statistics
{ 3 } [ { 1 2 3 4 5 } 1 power-mean ] unit-test
{ 2470 } [ 20 <iota> sum-of-squares ] unit-test
{ 2470 } [ 20 <iota> >array sum-of-squares ] unit-test
-{ 371 } [ 4 10 [a,b] sum-of-squares ] unit-test
-{ 371 } [ 4 10 [a,b] >array sum-of-squares ] unit-test
+{ 371 } [ 4 10 [a..b] sum-of-squares ] unit-test
+{ 371 } [ 4 10 [a..b] >array sum-of-squares ] unit-test
{ 36100 } [ 20 <iota> sum-of-cubes ] unit-test
{ 36100 } [ 20 <iota> >array sum-of-cubes ] unit-test
-{ 2989 } [ 4 10 [a,b] sum-of-cubes ] unit-test
-{ 2989 } [ 4 10 [a,b] >array sum-of-cubes ] unit-test
+{ 2989 } [ 4 10 [a..b] sum-of-cubes ] unit-test
+{ 2989 } [ 4 10 [a..b] >array sum-of-cubes ] unit-test
{ 562666 } [ 20 <iota> sum-of-quads ] unit-test
{ 562666 } [ 20 <iota> >array sum-of-quads ] unit-test
-{ 25235 } [ 4 10 [a,b] sum-of-quads ] unit-test
-{ 25235 } [ 4 10 [a,b] >array sum-of-quads ] unit-test
+{ 25235 } [ 4 10 [a..b] sum-of-quads ] unit-test
+{ 25235 } [ 4 10 [a..b] >array sum-of-quads ] unit-test
{ 0 } [ { 1 } range ] unit-test
{ 89 } [ { 1 2 30 90 } range ] unit-test
combinators.short-circuit fry generalizations grouping kernel
locals math math.functions math.order math.ranges math.vectors
sequences sequences.private sorting ;
-FROM: math.ranges => [a,b] ;
IN: math.statistics
: power-mean ( seq p -- x )
[ demean ] [ sample-std ] bi v/n ;
: dcg ( scores -- dcg )
- dup length 1 + 2 swap [a,b] [ log 2 log /f ] map v/ sum ;
+ dup length 1 + 2 swap [a..b] [ log 2 log /f ] map v/ sum ;
: ndcg ( scores -- ndcg )
[ 0.0 ] [
! XXX
: (simd-vdot) ( a b rep -- n )
[ 2byte>rep-array [ [ first ] bi@ * ] 2keep ] keep
- 1 swap rep-length [a,b) [ '[ _ swap nth-unsafe ] bi@ * + ] 2with each ;
+ 1 swap rep-length [a..b) [ '[ _ swap nth-unsafe ] bi@ * + ] 2with each ;
: (simd-vsqrt) ( a rep -- c ) [ fsqrt ] components-map ;
: (simd-vsad) ( a b rep -- c ) 2byte>rep-array [ - abs ] [ + ] 2map-reduce ;
: (simd-sum) ( a rep -- n ) [ + ] components-reduce ;
[ CHAR: - = ] satisfy hide ,
any-char ,
] seq* [
- first2 [a,b] >string
+ first2 [a..b] >string
] action replace ;
: range-pattern ( pattern -- parser )
r state r2<<
] each
- ! n m - 1 + n [a,b) [
+ ! n m - 1 + n [a..b) [
m 1 - <iota> [
n m - 1 + + >fixnum :> i
i array nth-unsafe
: <sfmt-array> ( sfmt -- uint-array uint-4-array )
state>>
- [ n>> 4 * [1,b] uint >c-array ] [ seed>> ] bi
+ [ n>> 4 * [1..b] uint >c-array ] [ seed>> ] bi
[
[
[ -30 shift ] [ ] bi bitxor
<PRIVATE
: search-range ( i string reverse? -- seq )
- [ drop -1 ] [ length ] if [a,b] ; inline
+ [ drop -1 ] [ length ] if [a..b] ; inline
:: (next-match) ( i string regexp quot: ( i string regexp -- j ) reverse? -- start end ? )
i string regexp quot call dup
} cleave ;
M: immediate retry-sleep-time 2drop 0 ;
-M: random-wait retry-sleep-time nip [ lo>> ] [ hi>> ] bi [a,b] random ;
+M: random-wait retry-sleep-time nip [ lo>> ] [ hi>> ] bi [a..b] random ;
M: exponential-wait retry-sleep-time [ count>> ] [ [ exp>> ^ ] [ nanos>> * ] bi ] bi* ;
: nth* ( n seq -- elt/f ? ) 2dup bounds-check? [ nth t ] [ 2drop f f ] if ;
: compute-selection ( editor -- assoc )
dup gadget-selection? [
- [ selection-start/end [ [ first ] bi@ [a,b] ] [ ] 2bi ]
+ [ selection-start/end [ [ first ] bi@ [a..b] ] [ ] 2bi ]
[ model>> ] bi
'[ [ _ _ ] [ _ start/end-on-line ] bi 2array ] H{ } map>assoc
] [ drop f ] if ;
[ [ loc>> ] [ dim>> ] bi v+ ] visible-line 1 + ;
: each-slice-index ( from to seq quot -- )
- [ [ <slice> ] [ drop [a,b) ] 3bi ] dip 2each ; inline
+ [ [ <slice> ] [ drop [a..b) ] 3bi ] dip 2each ; inline
GENERIC: draw-line ( line index gadget -- )
name-map sort-values keys
[ { [ "first>" tail? ] [ "last>" tail? ] } 1|| ] filter
2 group [
- [ name-map at ] bi@ [ [a,b] ] [ table ?nth ] bi
+ [ name-map at ] bi@ [ [a..b] ] [ table ?nth ] bi
[ swap table ?set-nth ] curry each
] assoc-each table ;
entire-str length :> str-len
0 pos 1 + entire-str <slice> grapheme-class
pos 1 + str-len 1 - min pos!
- pos str-len 1 - [a,b] [
+ pos str-len 1 - [a..b] [
1 + 0 swap entire-str <slice> grapheme-class
dup rot swap grapheme-break?
] find drop nip
pos 0 = [ 0 ] [
str grapheme-class
pos 1 - 0 max pos!
- 0 pos [a,b] [
+ 0 pos [a..b] [
0 swap 1 + str <slice> grapheme-class
dup rot grapheme-break?
] find-last drop ?1+ nip
: v-credit-card ( str -- n )
"- " without
- dup CHAR: 0 CHAR: 9 [a,b] diff empty? [
+ dup CHAR: 0 CHAR: 9 [a..b] diff empty? [
13 v-min-length
16 v-max-length
dup luhn? [ string>number ] [
MACRO: spread* ( n -- quot )
[ [ ] ] [
- [1,b) [ '[ [ [ _ ndip ] curry ] dip compose ] ] map [ ] concat-as
+ [1..b) [ '[ [ [ _ ndip ] curry ] dip compose ] ] map [ ] concat-as
[ call ] compose
] if-zero ;
"Go to the store and buy some more, 99 bottles of beer on the wall." print ;
: 99-bottles ( -- )
- 99 1 [a,b] [ verse ] each last-verse ;
+ 99 [1..b] [ verse ] each last-verse ;
MAIN: 99-bottles
[ (fortran-result>) ]
} cond ;
-: letters ( -- seq ) CHAR: a CHAR: z [a,b] ;
+: letters ( -- seq ) CHAR: a CHAR: z [a..b] ;
: (shuffle-map) ( return parameters -- ret par )
[
drop 1 16 8000 ;
M: noise-generator generate-audio
drop
- 4096 [ -4096 4096 [a,b] random ] short-array{ } replicate-as
+ 4096 [ -4096 4096 [a..b] random ] short-array{ } replicate-as
8192 ;
M: noise-generator dispose
drop ;
[ some-rots do-something 24-from-3 ] [ 4drop ] if-amb ;
: find-impossible-24 ( -- n )
- 10 [1,b] [| a |
- 10 [1,b] [| b |
- 10 [1,b] [| c |
- 10 [1,b] [| d |
+ 10 [1..b] [| a |
+ 10 [1..b] [| b |
+ 10 [1..b] [| c |
+ 10 [1..b] [| d |
a b c d 24-from-4
] count
] map-sum
IN: benchmark.beust1
: count-numbers ( max -- n )
- 1 [a,b] [ number>string all-unique? ] count ; inline
+ 1 [a..b] [ number>string all-unique? ] count ; inline
: beust1-benchmark ( -- )
2000000 count-numbers 229050 assert= ;
! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: binary-search kernel math.primes math.ranges memoize
-prettyprint sequences ;
+USING: binary-search kernel literals math.primes math.ranges
+sequences ;
IN: benchmark.binary-search
-MEMO: primes-under-million ( -- seq ) 1000000 primes-upto ;
-
! Force computation of the primes list before benchmarking the binary search
-primes-under-million drop
+CONSTANT: primes-under-million $[ 1,000,000 primes-upto ]
: binary-search-benchmark ( -- )
- 1 1000000 [a,b] [ primes-under-million sorted-member? ] map
- length 1000000 assert= ;
+ 1,000,000 [1..b] [ primes-under-million sorted-member? ] map
+ length 1,000,000 assert= ;
MAIN: binary-search-benchmark
min-depth max-depth 2 <range> [| depth |
max-depth depth - min-depth + 2^ [
- [1,b] 0 [
+ [1..b] 0 [
dup neg
[ depth bottom-up-tree item-check + ] bi@
] reduce
IN: benchmark.combinatorics
: bench-combinations ( n -- )
- [1,b] dup clone [
+ [1..b] dup clone [
{
[ all-combinations drop ]
[ [ drop ] each-combination ]
<iota> DECIMAL: 1 [ 0 <decimal> DECIMAL: 1 D+ D* ] reduce ; inline
:: calculate-e-decimals ( n -- e )
- n [1,b] DECIMAL: 1
+ n [1..b] DECIMAL: 1
[ D-factorial DECIMAL: 1 swap n D/ D+ ] reduce ;
: e-decimals-benchmark ( -- )
IN: benchmark.hashtables
MEMO: strings ( -- str )
- 0 100 [a,b) 1 [ + ] accumulate* [ number>string ] map ;
+ 100 [0..b) 1 [ + ] accumulate* [ number>string ] map ;
:: add-delete-mix ( hash keys -- )
keys [| k |
: times ( seq quot -- ) [ drop ] prepose each ; inline
:: nested-empty-loop ( n -- )
- 1 n [a,b] [
- 1 n [a,b] [
- 1 n [a,b] [
- 1 n [a,b] [
- 1 n [a,b] [
- 1 n [a,b] [
- 1 n [a,b] [
- 1 n [a,b] [
- 1 n [a,b] [ ] times
+ n [1..b] [
+ n [1..b] [
+ n [1..b] [
+ n [1..b] [
+ n [1..b] [
+ n [1..b] [
+ n [1..b] [
+ n [1..b] [
+ n [1..b] [ ] times
] times
] times
] times
[ [ i ] unless* ] change-nth-unsafe ; inline
: normal-suffixes ( zs -- ss )
- [ length [ f <array> ] [ [1,b) ] bi ] keep pick
+ [ length [ f <array> ] [ [1..b) ] bi ] keep pick
[ (normal-suffixes) ] 2curry each ; inline
:: (partial-suffixes) ( len old elt i -- len old/new old )
T{ gray f 0.06 0.59 } stroke-color set
dup pos>> draw
- 1 4 [a,b] [ axion-white axion-point- ] each
- 1 4 [a,b] [ axion-black axion-point+ ] each
+ 4 [1..b] [ axion-white axion-point- ] each
+ 4 [1..b] [ axion-black axion-point+ ] each
dup vel>> move-by
M: muon collide
dup center >>pos
- 2 32 [a,b] random >>speed
+ 2 32 [a..b] random >>speed
0.0001 0.001 2random >>speed-d
dup collision-theta -0.1 0.1 2random + >>theta
CHAR: \ CHAR: \" take-token* ;
: c-identifier-begin? ( ch -- ? )
- CHAR: a CHAR: z [a,b]
- CHAR: A CHAR: Z [a,b]
+ CHAR: a CHAR: z [a..b]
+ CHAR: A CHAR: Z [a..b]
{ CHAR: _ } 3append member? ;
: c-identifier-ch? ( ch -- ? )
- CHAR: a CHAR: z [a,b]
- CHAR: A CHAR: Z [a,b]
- CHAR: 0 CHAR: 9 [a,b]
+ CHAR: a CHAR: z [a..b]
+ CHAR: A CHAR: Z [a..b]
+ CHAR: 0 CHAR: 9 [a..b]
{ CHAR: _ } 4 nappend member? ;
: (take-c-identifier) ( sequence-parser -- string/f )
SYMBOLS: pawn rook knight bishop queen king ;
-: all-positions ( -- range ) 0 8 [a,b) ;
+: all-positions ( -- range ) 8 [0..b) ;
: black-bishop-positions ( -- range ) 0 6 2 <range> ;
: white-bishop-positions ( -- range ) 1 7 2 <range> ;
"/" split1 [ quot seq parse-value 0 over length 1 - ] dip
string>number <range> swap nths ] }
{ [ CHAR: - over member? ] [
- "-" split1 quot bi@ [a,b] ] }
+ "-" split1 quot bi@ [a..b] ] }
[ quot call 1array ]
} cond ; inline recursive
[ dup 4th-from-end ] dip bitxor suffix! ; inline
: (sched-interval) ( K Nr -- seq )
- [ length ] dip 1 + 4 * [a,b) ; ! over the interval Nk...Nb(Nr + 1)
+ [ length ] dip 1 + 4 * [a..b) ; ! over the interval Nk...Nb(Nr + 1)
: (init-round) ( out -- out temp quot )
[ ]
M: aes-encrypt (expand-key) (expand-enc-key) ;
M: aes-encrypt (first-round) add-first-round-key ;
-M: aes-encrypt (counter) 0 swap (a,b) ;
+M: aes-encrypt (counter) [1..b) ;
M: aes-encrypt (round) aes-round ;
M: aes-encrypt (final-round) [ final-round ] change-state add-final-round-key ;
M: aes-decrypt (first-round) ( aes -- aes' )
add-final-round-key ;
-M: aes-decrypt (counter) ( nrounds -- seq ) 0 swap (a,b) <reversed> ;
+M: aes-decrypt (counter) ( nrounds -- seq ) [1..b) <reversed> ;
M: aes-decrypt (final-round) ( aes -- aes' )
[ [ inv-subword ] map unshift-rows ] change-state
add-first-round-key ;
gadget grid>> grid-dim :> ( rows cols )
COLOR: gray gl-color
cols rows [ size * ] bi@ :> ( w h )
- rows [0,b] [| j |
+ rows [0..b] [| j |
j size * :> y
{ 0 y } { w y } gl-line
- cols [0,b] [| i |
+ cols [0..b] [| i |
i size * :> x
{ x 0 } { x h } gl-line
] each
[ dup array? [ 1array ] unless ] map concat ;
GML: reverse ( array -- reversed ) reverse ;
GML: slice ( array n k -- slice )
- [a,b) swap '[ _ wrap nth ] map ;
+ [a..b) swap '[ _ wrap nth ] map ;
GML:: subarray ( array n k -- slice )
k n k + array subseq ;
GML: sort-number-permutation ( array -- permutation )
[ face-vertex-count>> ]
[ edge-vertex-count>> + dup ]
[ point-vertex-count>> + ] tri
- [a,b) ushort >c-array ;
+ [a..b) ushort >c-array ;
VERTEX-FORMAT: wire-vertex-format
{ "vertex" float-components 3 f }
: leave-not-too-bad ( game -- game )
"YOUR PERFORMANCE COULD HAVE BEEN SOMEWHAT BETTER, BUT" print
"REALLY WASN'T TOO BAD AT ALL." print
- dup population>> 4/5 * floor [0,b] random
+ dup population>> 4/5 * floor [0..b] random
"%d PEOPLE WOULD DEARLY LIKE TO SEE YOU ASSASSINATED\n" printf
"BUT WE ALL HAVE OUR TRIVIAL PROBLEMS" print ;
dup stores>> "YOU NOW HAVE %d BUSHELS IN STORE.\n\n" printf ;
: update-randomness ( game -- game )
- 17 26 [a,b] random >>cost
- 5 [1,b] random >>yield
- 5 [1,b] random >>birth-factor
- 5 [1,b] random >>rat-factor
+ 17 26 [a..b] random >>cost
+ 5 [1..b] random >>yield
+ 5 [1..b] random >>birth-factor
+ 5 [1..b] random >>rat-factor
100 random 15 < >>plague ;
: update-stores ( game -- game )
: named-charref ( str -- newstr )
html5 ?at [
! find the longest matching name
- dup dup length 1 (a,b) [ head html5 at ] with map-find
+ dup dup length 1 (a..b) [ head html5 at ] with map-find
[ swapd tail append ] [ drop "&" prepend ] if*
] unless ;
: read-date-timestamp ( -- timestamp )
timestamp new
- 2 read le> dup 12 [1,b] member? [ bad-tga-timestamp ] unless >>month
- 2 read le> dup 31 [1,b] member? [ bad-tga-timestamp ] unless >>day
+ 2 read le> dup 12 [1..b] member? [ bad-tga-timestamp ] unless >>month
+ 2 read le> dup 31 [1..b] member? [ bad-tga-timestamp ] unless >>day
2 read le> >>year
- 2 read le> dup 23 [0,b] member? [ bad-tga-timestamp ] unless >>hour
- 2 read le> dup 59 [0,b] member? [ bad-tga-timestamp ] unless >>minute
- 2 read le> dup 59 [0,b] member? [ bad-tga-timestamp ] unless >>second ; inline
+ 2 read le> dup 23 [0..b] member? [ bad-tga-timestamp ] unless >>hour
+ 2 read le> dup 59 [0..b] member? [ bad-tga-timestamp ] unless >>minute
+ 2 read le> dup 59 [0..b] member? [ bad-tga-timestamp ] unless >>second ; inline
: read-job-name ( -- string )
41 read ascii decode [ 0 = ] trim ; inline
: moved ( player -- ) nano-count swap last-move<< ;
: speed-range ( -- range )
- max-speed [0,b] ;
+ max-speed [0..b] ;
: change-player-speed ( inc player -- )
[ + 0 max-speed clamp ] change-speed drop ;
sequences words ;
IN: math.derivatives.syntax
-SYNTAX: DERIVATIVE: scan-object dup stack-effect in>> length [1,b]
+SYNTAX: DERIVATIVE: scan-object dup stack-effect in>> length [1..b]
[ drop scan-object ] map ";" expect
"derivative" set-word-prop ;
even? [ "odd degrees of freedom" throw ] unless ;
: (chi2P) ( chi/2 df/2 -- p )
- [1,b) dupd n/v cum-product swap neg e^ [ v*n sum ] keep + ;
+ [1..b) dupd n/v cum-product swap neg e^ [ v*n sum ] keep + ;
PRIVATE>
IN: math.factorials
MEMO: factorial ( n -- n! )
- dup 1 > [ [1,b] product ] [ drop 1 ] if ;
+ dup 1 > [ [1..b] product ] [ drop 1 ] if ;
ALIAS: n! factorial
: factorials ( n -- seq )
- 1 swap [0,b] [ dup 1 > [ * ] [ drop ] if dup ] map nip ;
+ 1 swap [0..b] [ dup 1 > [ * ] [ drop ] if dup ] map nip ;
MEMO: double-factorial ( n -- n!! )
dup [ even? ] [ 0 < ] bi [
{ [ over 1 <= ] [ nip factorial recip ] }
[
2dup < [ t ] [ swap f ] if
- [ (a,b] product ] dip [ recip ] when
+ [ (a..b] product ] dip [ recip ] when
]
} cond ;
{ 0 [ drop 0 ] }
[
dup 0 < [ neg [ + ] keep t ] [ f ] if
- [ dupd + [a,b) product ] dip
+ [ dupd + [a..b) product ] dip
[ recip ] when
]
} case ;
{ 0 [ drop 0 ] }
[
dup 0 < [ neg [ + ] keep t ] [ f ] if
- [ dupd - swap (a,b] product ] dip
+ [ dupd - swap (a..b] product ] dip
[ recip ] when
]
} case ;
: super-factorial ( n -- m )
dup 1 > [
- [1,b] [ factorial ] [ * ] map-reduce
+ [1..b] [ factorial ] [ * ] map-reduce
] [ drop 1 ] if ;
: hyper-factorial ( n -- m )
dup 1 > [
- [1,b] [ dup ^ ] [ * ] map-reduce
+ [1..b] [ dup ^ ] [ * ] map-reduce
] [ drop 1 ] if ;
: alternating-factorial ( n -- m )
dup 1 > [
- [ [1,b] ] keep even? '[
+ [ [1..b] ] keep even? '[
[ factorial ] [ odd? _ = ] bi [ neg ] when
] map-sum
] [ drop 1 ] if ;
: exponential-factorial ( n -- m )
- dup 1 > [ [1,b] 1 [ swap ^ ] reduce ] [ drop 1 ] if ;
+ dup 1 > [ [1..b] 1 [ swap ^ ] reduce ] [ drop 1 ] if ;
<PRIVATE
:: (solovay-strassen) ( n numtrials -- ? )
numtrials <iota> [
drop
- n 1 - [1,b) random :> a
+ n 1 - [1..b) random :> a
a n simple-gcd 1 > [ t ] [
a n jacobi n mod'
a n 1 - 2 /i n ^mod = not
[ order-index-knot-constants ] 2with map ;
: knot-constants ( curve -- knot-constants )
- 2 over order>> [a,b]
+ 2 over order>> [a..b]
[ order-knot-constants ] with map ;
: update-knots ( curve -- curve )
dup length 16 swap 2 range boa zip
[ pdf-page , , ] assoc-each
] { } make
- dup length [1,b] zip [ first2 pdf-object ] map ;
+ dup length [1..b] zip [ first2 pdf-object ] map ;
: objects>pdf ( objects -- str )
[ join-lines "\n" append "%PDF-1.4\n" ]
! ball on the left
X BALL-SIZE + COMPUTER - dup 0 < [
- >integer -10 max 0 [a,b] random
+ >integer -10 max 0 [a..b] random
GADGET swap move-computer-by
] [ drop ] if
! ball on the right
X COMPUTER - dup 0 > [
- >integer 10 min [0,b] random
+ >integer 10 min [0..b] random
GADGET swap move-computer-by
] [ drop ] if ;
: consolidate ( -- seq )
count zero? [ "No mail for account." ] [
- 1 account count>> [a,b] [
+ 1 account count>> [a..b] [
{
[ 0 top drop ]
[ <message> swap >># ]
<PRIVATE
: source-004 ( -- seq )
- 100 999 [a,b] [ 10 divisor? ] reject ;
+ 100 999 [a..b] [ 10 divisor? ] reject ;
: max-palindrome ( seq -- palindrome )
natural-sort [ palindrome? ] find-last nip ;
! --------
: euler005 ( -- answer )
- 20 [1,b] 1 [ lcm ] reduce ;
+ 20 [1..b] 1 [ lcm ] reduce ;
! [ euler005 ] 100 ave-time
! 0 ms ave run time - 0.14 SD (100 trials)
PRIVATE>
: euler006 ( -- answer )
- 100 [1,b] [ sum-of-squares ] [ square-of-sum ] bi - abs ;
+ 100 [1..b] [ sum-of-squares ] [ square-of-sum ] bi - abs ;
! [ euler006 ] 100 ave-time
! 0 ms ave run time - 0.24 SD (100 trials)
[ [ dup 1 > ] [ dup , next-collatz ] while , ] { } make ;
: euler014 ( -- answer )
- 1000000 [1,b] { } [ collatz longer ] reduce first ;
+ 1,000,000 [1..b] { } [ collatz longer ] reduce first ;
! [ euler014 ] time
! 52868 ms run / 483 ms GC time
PRIVATE>
: euler014a ( -- answer )
- 500000 1000000 [a,b] { 1 } [
+ 500000 1000000 [a..b] { 1 } [
dup worth-calculating? [ collatz longer ] [ drop ] if
] reduce first ;
! --------
: euler017 ( -- answer )
- 1000 [1,b] SBUF" " clone [ number>text append! ] reduce [ Letter? ] count ;
+ 1000 [1..b] SBUF" " clone [ number>text append! ] reduce [ Letter? ] count ;
! [ euler017 ] 100 ave-time
! 15 ms ave run time - 1.71 SD (100 trials)
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,b] [ cut swap ] map nip ;
+ } 15 [1..b] [ cut swap ] map nip ;
PRIVATE>
! the day of the week (Sunday is 0).
: euler019 ( -- answer )
- 1901 2000 [a,b] [
- 12 [1,b] [ 1 (day-of-week) ] with map
+ 1901 2000 [a..b] [
+ 12 [1..b] [ 1 (day-of-week) ] with map
] map concat [ 0 = ] count ;
! [ euler019 ] 100 ave-time
{ [ = not ] [ sum-proper-divisors = ] } 2&& ;
: euler021 ( -- answer )
- 10000 [1,b] [ dup amicable? [ drop 0 ] unless ] map-sum ;
+ 10,000 [1..b] [ dup amicable? [ drop 0 ] unless ] map-sum ;
! [ euler021 ] 100 ave-time
! 335 ms ave run time - 18.63 SD (100 trials)
! --------
: euler029 ( -- answer )
- 2 100 [a,b] dup [ ^ ] cartesian-map concat members length ;
+ 2 100 [a..b] dup [ ^ ] cartesian-map concat members length ;
! [ euler029 ] 100 ave-time
! 704 ms ave run time - 28.07 SD (100 trials)
PRIVATE>
: euler032a ( -- answer )
- 50 [1,b] 2000 [1,b]
+ 50 [1..b] 2000 [1..b]
[ mmp ] cartesian-map concat
[ pandigital? ] filter
products members sum ;
<PRIVATE
: source-033 ( -- seq )
- 10 99 [a,b] dup cartesian-product concat [ first2 < ] filter ;
+ 10 99 [a..b] dup cartesian-product concat [ first2 < ] filter ;
: safe? ( ax xb -- ? )
[ 10 /mod ] bi@ [ = ] dip zero? not and nip ;
PRIVATE>
: euler034 ( -- answer )
- 3 2000000 [a,b] [ factorion? ] filter sum ;
+ 3 2000000 [a..b] [ factorion? ] filter sum ;
! [ euler034 ] 10 ave-time
! 5506 ms ave run time - 144.0 SD (10 trials)
PRIVATE>
: euler038 ( -- answer )
- 9123 9876 [a,b] [ concat-product ] map [ pandigital? ] filter supremum ;
+ 9123 9876 [a..b] [ concat-product ] map [ pandigital? ] filter supremum ;
! [ euler038 ] 100 ave-time
! 11 ms ave run time - 1.5 SD (100 trials)
: euler044 ( -- answer )
most-positive-fixnum
- 2500 [1,b] [
- dup [1,b] [
+ 2500 [1..b] [
+ dup [1..b] [
euler044-step
] with each
] each ;
<PRIVATE
: perfect-squares ( n -- seq )
- 2 /i sqrt >integer [1,b] [ sq ] map ;
+ 2 /i sqrt >integer [1..b] [ sq ] map ;
: fits-conjecture? ( n -- ? )
dup perfect-squares [ 2 * - ] with map [ prime? ] any? ;
multiples [ sieve get [ 1 + ] change-nth ] each ;
: prime-tau-upto ( limit -- seq )
- dup initialize-sieve 2 swap [a,b) [
+ dup initialize-sieve 2 swap [a..b) [
dup is-prime? [ increment-counts ] [ drop ] if
] each sieve get ;
! --------
: euler048 ( -- answer )
- 1000 [1,b] [ dup ^ ] map-sum 10 10^ mod ;
+ 1000 [1..b] [ dup ^ ] map-sum 10 10^ mod ;
! [ euler048 ] 100 ave-time
! 276 ms run / 1 ms GC ave time - 100 trials
: replace-positions-with-* ( str positions -- str )
[ *-if-index ] curry map-index ;
: all-positions-combinations ( seq -- combinations )
- dup length [1,b] [ all-combinations ] with map concat ;
+ dup length [1..b] [ all-combinations ] with map concat ;
: families ( stra -- seq )
dup digits-positions values
! --------
: euler053 ( -- answer )
- 23 100 [a,b] [ dup <iota> [ nCk 1000000 > ] with count ] map-sum ;
+ 23 100 [a..b] [ dup <iota> [ nCk 1000000 > ] with count ] map-sum ;
! [ euler053 ] 100 ave-time
! 52 ms ave run time - 4.44 SD (100 trials)
! Through analysis, you only need to check when a and b > 90
: euler056 ( -- answer )
- 90 100 [a,b) dup cartesian-product concat
+ 90 100 [a..b) dup cartesian-product concat
[ first2 ^ number>digits sum ] [ max ] map-reduce ;
! [ euler056 ] 100 ave-time
! (n-2)² + 4(n-1) = odd squares, no need to calculate
: prime-corners ( n -- m )
- 3 [1,b] swap '[ _ [ 1 - * ] keep 2 - sq + prime? ] count ;
+ 3 [1..b] swap '[ _ [ 1 - * ] keep 2 - sq + prime? ] count ;
: total-corners ( n -- m )
1 - 2 * ; foldable
! Round down since we already know that particular value of n is no good.
: euler063 ( -- answer )
- 9 [1,b] [ log [ 10 log dup ] dip - /i ] map-sum ;
+ 9 [1..b] [ log [ 10 log dup ] dip - /i ] map-sum ;
! [ euler063 ] 100 ave-time
! 0 ms ave run time - 0.0 SD (100 trials)
drop drop drop ;
: try-all ( -- n )
- 2 10000 [a,b]
+ 2 10000 [a..b]
[ perfect-square? ] reject
[ find-period ] map
[ odd? ] filter
PRIVATE>
: euler064b ( -- ct )
- 10000 [1,b] [ period odd? ] count ;
+ 10000 [1..b] [ period odd? ] count ;
SOLUTION: euler064b
PRIVATE>
: euler069 ( -- answer )
- 2 1000000 [a,b] [ totient-ratio ] map
+ 2 1000000 [a..b] [ totient-ratio ] map
arg-max 2 + ;
! [ euler069 ] 10 ave-time
! The answer can be found by adding totient(n) for 2 ≤ n ≤ 1e6
: euler072 ( -- answer )
- 2 1000000 [a,b] [ totient ] map-sum ;
+ 2 1000000 [a..b] [ totient ] map-sum ;
! [ euler072 ] 100 ave-time
! 5274 ms ave run time - 102.7 SD (100 trials)
PRIVATE>
: euler074 ( -- answer )
- 1000000 [1,b] [ chain-length 60 = ] count ;
+ 1,000,000 [1..b] [ chain-length 60 = ] count ;
! [ euler074 ] 10 ave-time
! 25134 ms ave run time - 31.96 SD (10 trials)
<PRIVATE
: init ( n -- table )
- [1,b] [ 0 2array 0 ] H{ } map>assoc
+ [1..b] [ 0 2array 0 ] H{ } map>assoc
1 { 0 0 } pick set-at ;
: use ( n i -- n i )
] if ;
:: each-subproblem ( n quot -- )
- n [1,b] [ dup [1,b] quot with each ] each ; inline
+ n [1..b] [ dup [1..b] quot with each ] each ; inline
: (euler076) ( n -- m )
dup init
2dup [ 1 + ] bi@ * * * 4 /i ; inline
:: each-unique-product ( ... a b quot: ( ... i j -- ... ) -- ... )
- a b [a,b] [| i |
- i b [a,b] [| j |
+ a b [a..b] [| i |
+ i b [a..b] [| j |
i j quot call
] each
] each ; inline
dup [ 1 = ] [ 89 = ] bi or [ next-link chain-ending ] unless ;
: lower-endings ( -- seq )
- 567 [1,b] [ chain-ending ] map ;
+ 567 [1..b] [ chain-ending ] map ;
: fast-chain-ending ( seq n -- m )
dup 567 > [ next-link ] when 1 - swap nth ;
PRIVATE>
: euler092 ( -- answer )
- lower-endings 9999999 [1,b] [ fast-chain-ending 89 = ] with count ;
+ lower-endings 9999999 [1..b] [ fast-chain-ending 89 = ] with count ;
! [ euler092 ] 10 ave-time
! 33257 ms ave run time - 624.27 SD (10 trials)
V{ 1 } clone [ [ next ] 2curry times ] keep last 1 - ;
: (euler116) ( length -- permutations )
- 3 [1,b] [ ways ] with map-sum ;
+ 3 [1..b] [ ways ] with map-sum ;
PRIVATE>
unique-factors product ; inline
: rads-upto ( n -- seq )
- [0,b] [ dup rad 2array ] map ;
+ [0..b] [ dup rad 2array ] map ;
: (euler124) ( -- seq )
100000 rads-upto sort-values ;
615949 * 797807 + 20 2^ rem dup 19 2^ - ; inline
: sums-triangle ( -- seq )
- 0 1000 [1,b] [ [ next ] replicate partial-sums ] map nip ; inline
+ 0 1000 [1..b] [ [ next ] replicate partial-sums ] map nip ; inline
:: (euler150) ( m -- n )
sums-triangle :> table
[ swap next-keys [ pick at+ ] with each ] assoc-each ;
: init-table ( -- assoc )
- 9 [1,b] [ 1array 1 ] H{ } map>assoc ;
+ 9 [1..b] [ 1array 1 ] H{ } map>assoc ;
PRIVATE>
<PRIVATE
: laminae ( upper -- n )
- 4 / dup sqrt [1,b] 0 rot [ over /i - - ] curry reduce ;
+ 4 / dup sqrt [1..b] 0 rot [ over /i - - ] curry reduce ;
PRIVATE>
dup sq 300007 * 200003 - * 100003 + 1000000 rem ;
: <generator> ( -- lag )
- 55 [1,b] [ (generator) ] map <circular> ;
+ 55 [1..b] [ (generator) ] map <circular> ;
: next ( lag -- n )
[ [ first dup ] [ 31 swap nth ] bi + 1000000 rem ] keep circular-push ;
PRIVATE>
:: P_m ( m -- P_m )
- m [1,b] [| i | 2 i * m 1 + / i ^ ] PI ;
+ m [1..b] [| i | 2 i * m 1 + / i ^ ] PI ;
: euler190 ( -- answer )
- 2 15 [a,b] [ P_m truncate ] map-sum ;
+ 2 15 [a..b] [ P_m truncate ] map-sum ;
! [ euler150 ] 100 ave-time
! 5 ms ave run time - 1.01 SD (100 trials)
<PRIVATE
: (sum-divisors) ( n -- sum )
- dup sqrt >integer [1,b] [
+ dup sqrt >integer [1..b] [
[ 2dup divisor? [ 2dup / + , ] [ drop ] if ] each
dup perfect-square? [ sqrt >fixnum neg , ] [ drop ] if
] { } make sum ;
: tau* ( m -- n )
factor-2s dup [ 1 + ]
[ perfect-square? -1 0 ? ]
- [ dup sqrt >fixnum [1,b] ] tri* [
+ [ dup sqrt >fixnum [1..b] ] tri* [
dupd divisor? [ [ 2 + ] dip ] when
] each drop * ;
[ multiples ] dip '[ _ [ not ] change-nth ] each ;
: toggle-all-multiples ( doors -- )
- [ number-of-doors [1,b] ] dip '[ _ toggle-multiples ] each ;
+ [ number-of-doors [1..b] ] dip '[ _ toggle-multiples ] each ;
: print-doors ( doors -- )
[
: inc-bulls ( score -- score ) [ 1 + ] change-bulls ;
: inc-cows ( score -- score ) [ 1 + ] change-cows ;
-: random-nums ( -- seq ) 9 [1,b] 4 sample ;
+: random-nums ( -- seq ) 9 [1..b] 4 sample ;
: add-digits ( seq -- n ) 0 [ swap 10 * + ] reduce number>string ;
:: cfrac-estimate ( cfrac terms -- number )
terms cfrac cfrac-a ! top = last a_n
- terms 1 - 1 [a,b] [ :> n
+ terms 1 - 1 [a..b] [ :> n
n cfrac cfrac-b swap / ! top = b_n / top
n cfrac cfrac-a + ! top = top + a_n
] each ;
cents 1 + 0 <array> :> ways
1 ways set-first
coins [| coin |
- coin cents [a,b] [| j |
+ coin cents [a..b] [| j |
j coin - ways nth j ways [ + ] change-nth
] each
] each ways last ;
! Output a random integer 1..5.
: dice5 ( -- x )
- 5 [1,b] random ;
+ 5 [1..b] random ;
! Output a random integer 1..7 using dice5 as randomness source.
: dice7 ( -- x )
! inserting zeros for die rolls that never occur.
: count-outcomes ( #sides rolls -- counts )
histogram
- swap [1,b] [ over [ 0 or ] change-at ] each
+ swap [1..b] [ over [ 0 or ] change-at ] each
sort-keys values ;
! Assumes a fair die [1..n] thrown for sum(counts),
dup [ fizz ] [ buzz ] bi append [ number>string ] [ nip ] if-empty ;
: fizzbuzz-main ( -- )
- 100 [1,b] [ fizzbuzz print ] each ;
+ 100 [1..b] [ fizzbuzz print ] each ;
MAIN: fizzbuzz-main
p ;
: gray-code-main ( -- )
- -1 32 [a,b] [
+ -1 32 [a..b] [
dup [ >bin ] [ gray-encode ] bi
[ >bin ] [ gray-decode ] bi 4array .
] each ;
" ends with " write 4 tail* [ unparse ] map ", " join print
! Maps n => { length n }, and reduces to longest Hailstone sequence.
- 1 100000 [a,b)
+ 100000 [1..b)
[ [ hailstone length ] keep 2array ]
[ [ [ first ] bi@ > ] most ] map-reduce
first2
! mathematically.
:: josephus-k ( n k -- m )
- n [1,b] 0 [ [ k + ] dip mod ] reduce ;
+ n [1..b] 0 [ [ k + ] dip mod ] reduce ;
:: josephus-2 ( n -- m ) ! faster for k=2
n n log2 2^ - 2 * ;
item-no table nth :> prev
item-no 1 + table nth :> curr
item-no items nth :> item
- limit [1,b] [| weight |
+ limit [1..b] [| weight |
weight prev nth
weight item weight>> - dup 0 >=
[ prev nth item value>> + max ]
[ number>string 2 CHAR: space pad-head write " |" write ]
[ 1 - [ " " write ] times ]
[
- dup 12 [a,b]
+ dup 12 [a..b]
[ * number>string 4 CHAR: space pad-head write ] with each
] tri nl ;
: print-table ( -- )
" " write
- 1 12 [a,b] [ number>string 4 CHAR: space pad-head write ] each nl
+ 1 12 [a..b] [ number>string 4 CHAR: space pad-head write ] each nl
" +" write
12 [ "----" write ] times nl
- 1 12 [a,b] [ print-row ] each ;
+ 1 12 [a..b] [ print-row ] each ;
! Note: Assume the players input does not need extra validation.
: make-jumbled-array ( -- sorted jumbled )
- CHAR: 1 CHAR: 9 [a,b] [ 1string ] map dup clone randomize
+ CHAR: 1 CHAR: 9 [a..b] [ 1string ] map dup clone randomize
[ 2dup = ] [ randomize ] while ;
SYMBOL: trials
! should be noted.
:: pascal-coefficients ( n -- seq )
- 1 n [1,b] [
+ 1 n [1..b] [
dupd [ n swap - * ] [ /i ] bi swap
] map nip ;
"Up to %d: %d triples, %d primitives.\n" printf ;
: pyth ( -- )
- 8 [1,b] [ 10^ dup count-triplets pprint-triplet-count ] each ;
+ 8 [1..b] [ 10^ dup count-triplets pprint-triplet-count ] each ;
<PRIVATE
: prefixes ( seq -- prefixes )
- dup length [1,b] [ head ] with map ;
+ dup length [1..b] [ head ] with map ;
PRIVATE>
[ length '[ 0 _ clamp ] bi@ ] keep subseq ;
: all-subseqs ( seq -- seqs )
- dup length [1,b] [ clump ] with map concat ;
+ dup length [1..b] [ clump ] with map concat ;
:: each-subseq ( ... seq quot: ( ... subseq -- ... ) -- ... )
seq length :> len
- len [0,b] [| from |
- from len (a,b] [| to |
+ len [0..b] [| from |
+ from len (a..b] [| to |
from to seq subseq quot call
] each
] each ; inline
] keepdd map-like ; inline
: filter-all-subseqs ( ... seq quot: ( ... subseq -- ... ? ) -- seq )
- [ dup length [1,b] ] dip filter-all-subseqs-range ; inline
+ [ dup length [1..b] ] dip filter-all-subseqs-range ; inline
:: longest-subseq ( seq1 seq2 -- subseq )
seq1 length :> len1
0 :> n!
0 :> end!
len1 1 + [ len2 1 + 0 <array> ] replicate :> table
- len1 [1,b] [| x |
- len2 [1,b] [| y |
+ len1 [1..b] [| x |
+ len2 [1..b] [| y |
x 1 - seq1 nth-unsafe
y 1 - seq2 nth-unsafe = [
y 1 - x 1 - table nth-unsafe nth-unsafe 1 + :> len
[ 1 ] 2dip [ dip * ] curry [ swap ] prepose each ; inline
: insert-nth! ( elt n seq -- )
- [ length ] keep ensure swap pick (a,b]
+ [ length ] keep ensure swap pick (a..b]
over '[ [ 1 + ] keep _ move-unsafe ] each
set-nth-unsafe ;
: prev-page ( book -- ) -1 change-page ;
: strip-tease ( data -- seq )
- first3 2 over length [a,b] [ head 3array ] with with with map ;
+ first3 2 over length [a..b] [ head 3array ] with with with map ;
SYNTAX: STRIP-TEASE:
parse-definition strip-tease append! ;
SELECTOR: to:
SELECTOR: to:do:
-M: object selector-to: swap [a,b] ;
+M: object selector-to: swap [a..b] ;
M:: object selector-to:do: ( to quot from -- nil )
- from to [a,b] [ quot call( i -- result ) drop ] each nil ;
+ from to [a..b] [ quot call( i -- result ) drop ] each nil ;
SELECTOR: value
SELECTOR: value:
:: (bubble-sort!) ( seq quot: ( obj1 obj2 -- <=> ) -- )
seq length 1 - [
- f over [0,b) [| i |
+ f over [0..b) [| i |
i i 1 + [ seq nth-unsafe ] bi@ 2dup quot call +gt+ =
[ i 1 + i [ seq set-nth-unsafe ] bi-curry@ bi* 2drop i t ]
[ 2drop ] if
[ length <iota> ] keep '[ _ remove-nth ] map ;
: transposes ( word -- edits )
- [ length [1,b) ] keep
+ [ length [1..b) ] keep
'[ dup 1 - _ clone [ exchange-unsafe ] keep ] map ;
: replace1 ( i word -- words )
[ length <iota> ] keep '[ _ replace1 ] map concat ;
: inserts ( word -- edits )
- [ length [0,b] ] keep
+ [ length [0..b] ] keep
'[ CHAR: ? over _ insert-nth replace1 ] map concat ;
: edits1 ( word -- edits )
! combined with X
X transpose tensor>array :> X-T
X-T [ mean ] map >tensor :> feat-means
- X shape>> first [0,b) [ drop feat-means ] map stack :> means
+ X shape>> first [0..b) [ drop feat-means ] map stack :> means
! Compute the std for each of the features and repeat it so that it can be
! combined with X
X-T [ std ] map >tensor :> feat-stds
- X shape>> first [0,b) [ drop feat-stds ] map stack :> stds
+ X shape>> first [0..b) [ drop feat-stds ] map stack :> stds
X means t- stds t/ ;
:: compute-cost ( X y params -- cost )
"vocab:tensors/demos/data.csv" utf8 file>csv
[ [ string>number ] map ] map >tensor
"vocab:tensors/demos/target.csv" utf8 file>csv
- [ [ string>number ] map ] map >tensor ;
\ No newline at end of file
+ [ [ string>number ] map ] map >tensor ;
! Construct a tensor with vec { 0 1 2 ... } and reshape to the desired shape
: naturals ( shape -- tensor )
- check-shape [ ] [ product [0,b) >float-array ] bi <tensor> ;
+ check-shape [ ] [ product [0..b) >float-array ] bi <tensor> ;
! Construct a tensor without initializing its values
: (tensor) ( shape -- tensor )
seq [ shape>> last ] map :> last-dims
! Curr tensor and index in tensor
0 0
- last-dims sum [0,b) [
+ last-dims sum [0..b) [
drop :> old-t-ind :> last-dims-i
last-dims-i last-dims nth
old-t-ind -
dup length 5 swap 2 range boa zip
[ pdf-page , pdf-text , ] assoc-each
] { } make
- dup length [1,b] zip [ first2 pdf-object ] map ;
+ dup length [1..b] zip [ first2 pdf-object ] map ;
: objects>pdf ( objects -- str )
[ join-lines "\n" append "%PDF-1.4\n" ]
:: (z-values) ( seq -- Z )
seq length dup 0 <array> :> ( len Z )
len 0 Z set-nth
- seq Z 0 0 len [1,b) [ z-value ] each 4drop
+ seq Z 0 0 len [1..b) [ z-value ] each 4drop
Z ; inline
PRIVATE>
projects / factor.git / commitdiff