fix load errors from load-all
parent
2ecf3fb568
commit
ef25935366
|
@ -36,17 +36,16 @@ M:: bitmap-node (new-at) ( shift value key hashcode bitmap-node -- node' added-l
|
||||||
new-leaf
|
new-leaf
|
||||||
] [
|
] [
|
||||||
idx nodes nth :> n
|
idx nodes nth :> n
|
||||||
shift radix-bits + value key hashcode n (new-at) :> new-leaf :> n'
|
shift radix-bits + value key hashcode n (new-at) :> new-leaf :> n'
|
||||||
n n' eq? [
|
n n' eq? [
|
||||||
bitmap-node
|
bitmap-node
|
||||||
] [
|
] [
|
||||||
bitmap
|
bitmap
|
||||||
n' idx nodes new-nth
|
n' idx nodes new-nth
|
||||||
shift
|
shift
|
||||||
<bitmap-node>
|
<bitmap-node>
|
||||||
] if
|
] if
|
||||||
new-leaf
|
new-leaf
|
||||||
]
|
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
M:: bitmap-node (pluck-at) ( key hashcode bitmap-node -- node' )
|
M:: bitmap-node (pluck-at) ( key hashcode bitmap-node -- node' )
|
||||||
|
|
|
@ -77,28 +77,34 @@ CONSTANT: homo-sapiens
|
||||||
|
|
||||||
: write-repeat-fasta ( n alu desc id -- )
|
: write-repeat-fasta ( n alu desc id -- )
|
||||||
write-description
|
write-description
|
||||||
0 :> k! :> alu
|
[let
|
||||||
[| len | k len alu make-repeat-fasta k! ] split-lines ; inline
|
0 :> k! :> alu
|
||||||
|
[| len | k len alu make-repeat-fasta k! ] split-lines
|
||||||
|
] ; inline
|
||||||
|
|
||||||
: fasta ( n out -- )
|
: fasta ( n out -- )
|
||||||
homo-sapiens make-cumulative
|
homo-sapiens make-cumulative
|
||||||
IUB make-cumulative
|
IUB make-cumulative
|
||||||
:> homo-sapiens-floats
|
[let
|
||||||
:> homo-sapiens-chars
|
:> homo-sapiens-floats
|
||||||
:> IUB-floats
|
:> homo-sapiens-chars
|
||||||
:> IUB-chars
|
:> IUB-floats
|
||||||
:> out
|
:> IUB-chars
|
||||||
:> n
|
:> out
|
||||||
initial-seed :> seed
|
:> n
|
||||||
|
initial-seed :> seed
|
||||||
|
|
||||||
out ascii [
|
out ascii [
|
||||||
n 2 * ALU "Homo sapiens alu" "ONE" write-repeat-fasta
|
n 2 * ALU "Homo sapiens alu" "ONE" write-repeat-fasta
|
||||||
|
|
||||||
initial-seed
|
initial-seed
|
||||||
n 3 * homo-sapiens-chars homo-sapiens-floats "IUB ambiguity codes" "TWO" write-random-fasta
|
n 3 * homo-sapiens-chars homo-sapiens-floats
|
||||||
n 5 * IUB-chars IUB-floats "Homo sapiens frequency" "THREE" write-random-fasta
|
"IUB ambiguity codes" "TWO" write-random-fasta
|
||||||
drop
|
n 5 * IUB-chars IUB-floats
|
||||||
] with-file-writer ;
|
"Homo sapiens frequency" "THREE" write-random-fasta
|
||||||
|
drop
|
||||||
|
] with-file-writer
|
||||||
|
] ;
|
||||||
|
|
||||||
: run-fasta ( -- ) 2500000 reverse-complement-in fasta ;
|
: run-fasta ( -- ) 2500000 reverse-complement-in fasta ;
|
||||||
|
|
||||||
|
|
|
@ -151,14 +151,16 @@ M: mdb-collection create-collection
|
||||||
[ "$cmd" = ] [ "system" head? ] bi or ;
|
[ "$cmd" = ] [ "system" head? ] bi or ;
|
||||||
|
|
||||||
: check-collection ( collection -- fq-collection )
|
: check-collection ( collection -- fq-collection )
|
||||||
mdb-instance :> instance
|
[let
|
||||||
instance name>> :> instance-name
|
mdb-instance :> instance
|
||||||
dup mdb-collection? [ name>> ] when
|
instance name>> :> instance-name
|
||||||
"." split1 over instance-name =
|
dup mdb-collection? [ name>> ] when
|
||||||
[ nip ] [ drop ] if
|
"." split1 over instance-name =
|
||||||
[ ] [ reserved-namespace? ] bi
|
[ nip ] [ drop ] if
|
||||||
[ instance (ensure-collection) ] unless
|
[ ] [ reserved-namespace? ] bi
|
||||||
[ instance-name ] dip "." glue ;
|
[ instance (ensure-collection) ] unless
|
||||||
|
[ instance-name ] dip "." glue
|
||||||
|
] ;
|
||||||
|
|
||||||
: fix-query-collection ( mdb-query -- mdb-query )
|
: fix-query-collection ( mdb-query -- mdb-query )
|
||||||
[ check-collection ] change-collection ; inline
|
[ check-collection ] change-collection ; inline
|
||||||
|
|
|
@ -105,9 +105,9 @@ USE: tools.walker
|
||||||
! [ dump-to-file ] keep
|
! [ dump-to-file ] keep
|
||||||
write flush ; inline
|
write flush ; inline
|
||||||
|
|
||||||
: build-query-object ( query -- selector )
|
:: build-query-object ( query -- selector )
|
||||||
H{ } clone :> selector
|
H{ } clone :> selector
|
||||||
{ [ orderby>> [ "orderby" selector set-at ] when* ]
|
query { [ orderby>> [ "orderby" selector set-at ] when* ]
|
||||||
[ explain>> [ "$explain" selector set-at ] when* ]
|
[ explain>> [ "$explain" selector set-at ] when* ]
|
||||||
[ hint>> [ "$hint" selector set-at ] when* ]
|
[ hint>> [ "$hint" selector set-at ] when* ]
|
||||||
[ query>> "query" selector set-at ]
|
[ query>> "query" selector set-at ]
|
||||||
|
|
Loading…
Reference in New Issue