: purge-cache ( cache -- )
dup [ assoc>> ] [ max-age>> ] bi V{ } clone [
'[
- nip dup age>> 1 + [ >>age ] keep
+ dup age>> 1 + [ >>age ] keep
_ < [ drop t ] [ _ dispose-to f ] if
- ] assoc-filter >>assoc drop
+ ] filter-values >>assoc drop
] keep [ last rethrow ] unless-empty ;
objc-methods get >alist
[ first CHAR: . swap member? ] filter
[ first "." split1 nip ] collect-by
- [ nip values members length 1 > ] assoc-filter ;
+ [ values members length 1 > ] filter-values ;
: method-count ( class -- c-direct-array )
0 uint <ref> [ class_copyMethodList (free) ] keep uint deref ;
{ 1 1 1 } [ 1 3 [ ] smart-with times ] unit-test
{ "BCD" } [ 1 "ABC" [ + ] smart-with map ] unit-test
-{ H{ { 1 2 } } } [ 1 H{ { 1 2 } { 3 4 } } [ drop = ] smart-with assoc-filter ] unit-test
+{ H{ { 1 2 } } } [ 1 H{ { 1 2 } { 3 4 } } [ = ] smart-with filter-keys ] unit-test
: test-cleave>sequence ( obj -- seq ) { [ 1 + ] [ sq ] [ 1 - ] } V{ } cleave>sequence ;
\ test-cleave>sequence def>> must-infer
: update-phi ( bb ##phi -- )
[
swap predecessors>>
- '[ drop _ member-eq? ] assoc-filter
+ '[ _ member-eq? ] filter-keys
] change-inputs drop ;
: update-phis ( bb -- )
] each-basic-block ;
: minimize-costs ( costs -- representations )
- [ nip assoc-empty? ] assoc-reject
+ [ assoc-empty? ] reject-values
[ >alist alist-min first ] assoc-map ;
: compute-representations ( cfg -- )
! a i j el
77 eq?
[
- rot drop and
+ nipd and
]
[
! a i j
compiled-crossref get at ;
: dependencies-of ( word dep-type -- assoc )
- [ all-dependencies-of ] dip '[ nip _ dependency>= ] assoc-filter ;
+ [ all-dependencies-of ] dip '[ _ dependency>= ] filter-values ;
: outdated-definition-usages ( set -- assocs )
filter-word-defs [ +definition+ dependencies-of ] map ;
: outdated-conditional-usages ( set -- assocs )
members H{ } clone '[
+conditional+ dependencies-of
- [ drop _ dependencies-satisfied? ] assoc-reject
+ [ _ dependencies-satisfied? ] reject-keys
] map ;
: generic-call-sites-of ( word -- assoc )
concat f like "generic-call-sites" set-word-prop ;
: store-dependencies-of-type ( word assoc symbol prop-name -- )
- [ rot '[ nip _ = ] assoc-filter keys ] dip set-word-prop ;
+ [ rot '[ _ = ] filter-values keys ] dip set-word-prop ;
: store-dependencies ( word assoc -- )
keys "dependencies" set-word-prop ;
M: #alien-node compute-live-values* nip look-at-inputs ;
: filter-mapping ( assoc -- assoc' )
- live-values get '[ drop _ key? ] assoc-filter ;
+ live-values get '[ _ key? ] filter-keys ;
: filter-corresponding ( new old -- old' )
zip filter-mapping values ;
: compute-escaping-allocations ( -- )
allocations get escaping-values get
- '[ drop _ (escaping-value?) ] assoc-filter
+ '[ _ (escaping-value?) ] filter-keys
escaping-allocations set ;
: escaping-allocation? ( value -- ? )
: unbox-tuples ( nodes -- nodes )
allocations get escaping-allocations get
- [ nip key? ] curry assoc-all?
+ [ key? ] curry all-values?
[ [ unbox-tuples* ] map-nodes ] unless ;
[ XZR MOVr ] [
{ 0 1 2 3 } [
tuck -16 * shift 0xffff bitand
- ] with map>alist [ nip 0 = ] assoc-reject
+ ] with map>alist [ 0 = ] reject-values
unclip
overd first2 rot MOVZ
[ first2 rot MOVK ] with each
MEMO: system-hosts ( -- hosts ) hosts-path parse-hosts ;
: host>ips ( host -- ips )
- system-hosts [ member? nip ] with assoc-filter keys ;
+ system-hosts [ member? ] with filter-values keys ;
-: ip>hosts ( ip -- hosts )
- system-hosts at ;
+: ip>hosts ( ip -- hosts ) system-hosts at ;
{ "count*" { "percent-of" "0.99" } }
{ "more?" { "deref?" "0.99" } }
{ "plox" { "?transmute" "0.99" } }
- ! { "?if" { "?if" "0.99" } }
{ "ensure-non-negative" { "assert-non-negative" "0.99" } }
{ "order" { "dispatch-order" "0.99" } }
{ "TEST:" { "DEFINE-TEST-WORD:" "0.99" } }
+ { "assoc-all-key?" { "all-keys?" "0.100" } }
+ { "assoc-all-value?" { "all-values?" "0.100" } }
+ { "assoc-any-key?" { "any-key?" "0.100" } }
+ { "assoc-any-value?" { "any-value?" "0.100" } }
}
: compute-assoc-fixups ( continuation name assoc -- seq )
- swap '[ drop _ = ] assoc-filter [
+ swap '[ _ = ] filter-keys [
drop { }
] [
swap '[
url>user ;
: strip-hash ( hash1 -- hash2 )
- [ drop first CHAR: _ = ] assoc-reject ;
+ [ first CHAR: _ = ] reject-keys ;
-: at-or-k ( key hash -- newkey )
- ?at drop ;
-: value-at-or-k ( key hash -- newkey )
- ?value-at drop ;
+: at-or-k ( key hash -- newkey ) ?at drop ;
+: value-at-or-k ( key hash -- newkey ) ?value-at drop ;
: map-fields-forward ( assoc field-map -- assoc )
[ swapd at-or-k swap ] curry assoc-map ;
: make-specializer ( specs -- quot )
dup length <iota> <reversed>
[ (picker) 2array ] 2map
- [ drop object eq? ] assoc-reject
+ [ object eq? ] reject-keys
[ [ t ] ] [
[ swap specializer-predicate append ] { } assoc>map
[ ] [ swap [ f ] \ if 3array [ ] append-as ] map-reduce
IN: html.templates.chloe.compiler
: chloe-attrs-only ( assoc -- assoc' )
- [ drop chloe-name? ] assoc-filter ;
+ [ chloe-name? ] filter-keys ;
: non-chloe-attrs-only ( assoc -- assoc' )
- [ drop chloe-name? ] assoc-reject ;
+ [ chloe-name? ] reject-keys ;
: chloe-tag? ( tag -- ? )
dup xml? [ body>> ] when
bi* ;
: compile-component-attrs ( tag class -- )
- [ attrs>> [ drop main>> "name" = ] assoc-reject ] dip
+ [ attrs>> [ main>> "name" = ] reject-keys ] dip
[ all-slots swap '[ name>> _ at compile-attr ] each ]
[ [ boa ] [code-with] ]
bi ;
: analysis. ( errors word-histogram message-histogram -- )
nl "==== FREQUENT MESSAGES:" print nl
- "Total: " write dup values sum . nl
+ "Total: " write dup sum-values . nl
[
[ first name>> write bl ]
[ second write ": " write ]
: fp-env-register ( -- register ) (fp-env-registers) first ;
-:: mask> ( bits assoc -- symbols )
- assoc [| k v | bits v mask zero? ] assoc-reject keys ;
+: mask> ( bits assoc -- symbols )
+ [ mask zero? ] with reject-values keys ;
: >mask ( symbols assoc -- bits )
over empty?
[ 2drop 0 ]
[ [ dup 3array ] [ swap ?lookup-method ] 2bi ] with { } map>assoc
sift-values
[ def>> ] assoc-map
- [ nip length 1 = ] assoc-filter
+ [ length 1 = ] filter-values
[ first ] assoc-map % ;
SYMBOL: math-ops
[ drop math-class-max swap method-for-class >boolean ] if ;
: (derived-ops) ( word assoc -- words )
- swap '[ swap first _ eq? nip ] assoc-filter ;
+ swap '[ first _ eq? ] filter-keys ;
: derived-ops ( word -- words )
[ 1array ] [ math-ops get (derived-ops) values ] bi append ;
[ math-ops get (derived-ops) ] [ fast-math-ops get (derived-ops) ] bi
[
[
- drop
[ second integer class<= ]
[ third integer class<= ]
bi and
- ] assoc-filter values
+ ] filter-keys values
] bi@ append ;
: each-derived-op ( word quot -- )
: remove-float-words ( alist -- alist' )
{ distance vsqrt n/v v/n v/ normalize }
- '[ drop _ member? ] assoc-reject ;
+ '[ _ member? ] reject-keys ;
: remove-integer-words ( alist -- alist' )
{ vlshift vrshift v*high v*hs+ }
- '[ drop _ member? ] assoc-reject ;
+ '[ _ member? ] reject-keys ;
: boolean-ops ( -- words )
{ vand vandn vor vxor vnot vcount } ;
: remove-boolean-words ( alist -- alist' )
- boolean-ops '[ drop _ member? ] assoc-reject ;
+ boolean-ops '[ _ member? ] reject-keys ;
: ops-to-check ( elt-class -- alist )
[ vector-words >alist ] dip
] bi
] H{ } make ; inline
-! Checksum all the params but only return the oauth_ params for use in the auth header.
+! Checksum all the params but only return the oauth_ params for
+! use in the auth header.
! See https://github.com/factor/factor/issues/2487
:: sign-params ( url request-method consumer-token request-token params -- oauth-params )
params sort-keys :> params
url request-method params signature-base-string :> sbs
- consumer-token secret>> request-token dup [ secret>> ] when hmac-key :> key
+ consumer-token secret>> request-token dup [ secret>> ] when
+ hmac-key :> key
sbs key sha1 hmac-bytes >base64 >string :> signature
params { "oauth_signature" signature } prefix
- [ drop "oauth_" head? ] assoc-filter ;
+ [ "oauth_" head? ] filter-keys ;
: extract-user-data ( assoc -- assoc' )
[
- drop
{ "oauth_token" "oauth_token_secret" } member? not
- ] assoc-filter ;
+ ] filter-keys ;
: parse-token ( response data -- token )
nip
new-question old-value = [
new-question state table set-at
state nfa transitions>> at
- [ drop tagged-epsilon? ] assoc-filter
+ [ tagged-epsilon? ] filter-keys
[| trans to |
to [
table nfa
_ swap '[ _ get-transitions ] assoc-map
harvest-values
] [
- [ drop tagged-epsilon? ] assoc-filter
+ [ tagged-epsilon? ] filter-keys
] bi H{ } assoc-union-as
] assoc-map
] change-transitions ;
'[ dup _ at = ] swap '[ _ at has-conditions? ] bi or ;
: delete-duplicates ( transitions state-classes -- new-transitions )
- dupd '[ drop _ _ canonical-state? ] assoc-filter ;
+ dupd '[ _ _ canonical-state? ] filter-keys ;
: combine-states ( table -- smaller-table )
dup state-classes
{
[
email>headers sort-keys [
- drop { "Date" "Message-Id" } member? not
- ] assoc-filter
+ { "Date" "Message-Id" } member? not
+ ] filter-keys
]
[ to>> [ extract-email ] map ]
[ from>> extract-email ]
M: word coverage
"coverage" word-prop
- [ drop executed?>> ] assoc-reject values ;
+ [ executed?>> ] reject-keys values ;
GENERIC: coverage. ( object -- )
"Stripping word properties" show
swap '[
[
- [ drop _ member? ] assoc-reject sift-values
+ [ _ member? ] reject-keys sift-values
>alist f like
] change-props drop
] each ;
dup array? [
[
2 group
- [ drop _ in? ] assoc-reject
+ [ _ in? ] reject-keys
concat
] map
] when
: initialize-deprecation-notes ( -- )
[
- get-crossref [ drop deprecated? ] assoc-filter
+ get-crossref [ deprecated? ] filter-keys
values [ members [ check-deprecations ] each ] each
] with-null-writer ;
[ total-time>> ] same? ;
: trim-flat ( root-node -- root-node' )
- dup '[ [ nip _ redundant-flat-node? ] assoc-reject ] change-children ;
+ dup '[ [ _ redundant-flat-node? ] reject-values ] change-children ;
PRIVATE>
: remove-paragraph-styles ( style -- style' )
[
- drop HS{
+ HS{
wrap-margin border-color page-color inset presented
} in?
- ] assoc-reject ;
+ ] reject-keys ;
TUPLE: styled-pane < pane style ;
: process-combining ( data -- hash )
3 swap (process-data)
[ string>number ] assoc-map
- [ nip zero? ] assoc-reject
+ [ zero? ] reject-values
>hashtable ;
! the maximum unicode char in the first 3 planes
! DPI_AWARENESS_CONTEXT experimentally:
! USE: ranges -100 1000 [a..b] [ <alien> IsValidDpiAwarenessContext ] zip-with
-! [ nip 0 > ] assoc-filter keys .
+! [ 0 > ] filter-values keys .
! { -5 -4 -3 -2 -1 17 18 34 273 529 785 }
! -4 <alien> 34 <alien> AreDpiAwarenessContextsEqual . ! t
[ alien>> expired? ] [ t ] if* ;
: delete-values ( value assoc -- )
- [ rot drop = ] with assoc-reject! drop ;
+ [ nipd = ] with assoc-reject! drop ;
PRIVATE>
M: enumerated nth-unsafe dupd seq>> nth-unsafe 2array ; inline
INSTANCE: enumerated immutable-sequence
+
+: any-key? ( ... assoc quot: ( ... key -- ... ? ) -- ... ? )
+ [ drop ] prepose assoc-find 2nip ; inline
+
+: any-value? ( ... assoc quot: ( ... value -- ... ? ) -- ... ? )
+ [ nip ] prepose assoc-find 2nip ; inline
+
+: all-keys? ( ... assoc quot: ( ... key -- ... ? ) -- ... ? )
+ [ not ] compose any-key? not ; inline
+
+: all-values? ( ... assoc quot: ( ... value -- ... ? ) -- ... ? )
+ [ not ] compose any-value? not ; inline
+
+: assoc-reduce ( ... assoc identity quot: ( ... prev key value -- next ) -- ... result )
+ [ >alist ] 2dip [ first2 ] prepose reduce ; inline
+
+: reduce-keys ( ... assoc identity quot: ( ... prev elt -- ... next ) -- ... result )
+ [ drop ] prepose assoc-reduce ; inline
+
+: reduce-values ( ... assoc identity quot: ( ... prev elt -- ... next ) -- ... result )
+ [ nip ] prepose assoc-reduce ; inline
+
+: sum-keys ( assoc -- n ) 0 [ + ] reduce-keys ; inline
+
+: sum-values ( assoc -- n ) 0 [ + ] reduce-values ; inline
+
+: map-keys ( assoc quot: ( key -- key' ) -- assoc )
+ '[ _ dip ] assoc-map ; inline
+
+: map-values ( assoc quot: ( value -- value' ) -- assoc )
+ '[ swap _ dip swap ] assoc-map ; inline
+
+: filter-keys ( assoc quot: ( key -- ? ) -- assoc' )
+ '[ drop @ ] assoc-filter ; inline
+
+: filter-values ( assoc quot: ( value -- ? ) -- assoc' )
+ '[ nip @ ] assoc-filter ; inline
+
+: reject-keys ( assoc quot: ( key -- ? ) -- assoc' )
+ '[ drop @ ] assoc-reject ; inline
+
+: reject-values ( assoc quot: ( value -- ? ) -- assoc' )
+ '[ nip @ ] assoc-reject ; inline
! 2. Convert methods
: split-methods ( assoc class -- first second )
[ [ nip class<= ] curry assoc-reject ]
- [ [ nip class<= ] curry assoc-filter ] 2bi ;
+ [ [ nip class<= ] curry assoc-filter ] 2bi ;
: convert-methods ( assoc class word -- assoc' )
over [ split-methods ] 2dip pick assoc-empty?
[ 3dup swap array-nth ] dip over +empty+ eq?
[ 4drop no-key ] [
[ = ] dip swap
- [ drop rot drop t ]
+ [ roll 2drop t ]
[ probe (key@) ]
if
] if ; inline recursive
[ 3dup swap array-nth ] dip over +empty+ eq?
[ 4drop no-key ] [
[ = ] dip swap
- [ drop rot drop t ]
+ [ roll 2drop t ]
[ probe (key@) ]
if
] if ; inline recursive
GENERIC: update ( search-path-elt -- valid? )
: trim-forgotten ( qualified-vocab -- valid? )
- [ [ nip "forgotten" word-prop ] assoc-reject ] change-words
+ [ [ "forgotten" word-prop ] reject-values ] change-words
words>> assoc-empty? not ;
M: from update trim-forgotten ;
: make-anagram-hash ( strings -- assoc )
[ sort ] collect-by
[ members ] assoc-map
- [ nip length 1 > ] assoc-filter ;
+ [ length 1 > ] filter-values ;
MEMO: dict-words ( -- seq )
"/usr/share/dict/words" ascii file-lines [ >lower ] map ;
: of+ ( assoc key n -- assoc ) '[ 0 or _ + ] change-of ; inline
-: of+* ( assoc key n -- assoc old new ) '[ [ 0 or _ + ] keep swap dup ] change-of ; inline
+: of+* ( assoc key n -- assoc old new )
+ '[ [ 0 or _ + ] keep swap dup ] change-of ; inline
: delete-of ( assoc key -- assoc ) over delete-at ; inline
: substitute! ( seq assoc -- seq )
substituter map! ;
-: assoc-reduce ( ... assoc identity quot: ( ... prev key value -- next ) -- ... result )
- [ >alist ] 2dip [ first2 ] prepose reduce ; inline
-
-: reduce-keys ( ... assoc identity quot: ( ... prev elt -- ... next ) -- ... result )
- [ drop ] prepose assoc-reduce ; inline
-
-: reduce-values ( ... assoc identity quot: ( ... prev elt -- ... next ) -- ... result )
- [ nip ] prepose assoc-reduce ; inline
-
-: sum-keys ( assoc -- n ) 0 [ + ] reduce-keys ; inline
-
-: sum-values ( assoc -- n ) 0 [ + ] reduce-values ; inline
-
-: map-keys ( assoc quot: ( key -- key' ) -- assoc )
- '[ _ dip ] assoc-map ; inline
-
-: map-values ( assoc quot: ( value -- value' ) -- assoc )
- '[ swap _ dip swap ] assoc-map ; inline
-
-: filter-keys ( assoc quot: ( key -- ? ) -- assoc' )
- '[ drop @ ] assoc-filter ; inline
-
-: filter-values ( assoc quot: ( value -- ? ) -- assoc' )
- '[ nip @ ] assoc-filter ; inline
-
-: reject-keys ( assoc quot: ( key -- ? ) -- assoc' )
- '[ drop @ ] assoc-reject ; inline
-
-: reject-values ( assoc quot: ( value -- ? ) -- assoc' )
- '[ nip @ ] assoc-reject ; inline
-
: rekey-new-assoc ( assoc keys -- newassoc )
[ tuck of ] with H{ } map>assoc ; inline
: expand-values-push ( assoc -- sequence )
V{ } expand-values-push-as ; inline
-: assoc-any-key? ( ... assoc quot: ( ... key -- ... ? ) -- ... ? )
- [ drop ] prepose assoc-find 2nip ; inline
-
-: assoc-any-value? ( ... assoc quot: ( ... value -- ... ? ) -- ... ? )
- [ nip ] prepose assoc-find 2nip ; inline
-
-: assoc-all-key? ( ... assoc quot: ( ... key -- ... ? ) -- ... ? )
- [ not ] compose assoc-any-key? not ; inline
-
-: assoc-all-value? ( ... assoc quot: ( ... value -- ... ? ) -- ... ? )
- [ not ] compose assoc-any-value? not ; inline
-
-: any-multi-key? ( assoc -- ? )
- [ sequence? ] assoc-any-key? ;
+: any-multi-key? ( assoc -- ? ) [ sequence? ] any-key? ;
-: any-multi-value? ( assoc -- ? )
- [ sequence? ] assoc-any-value? ;
+: any-multi-value? ( assoc -- ? ) [ sequence? ] any-value? ;
: flatten-keys ( assoc -- assoc' )
dup any-multi-key? [ expand-keys-set-at flatten-keys ] when ;
[
[ clone ] dip
[ drop ] [ holiday-assoc ] 2bi swap
- '[ drop _ same-day? ] assoc-filter values
+ '[ _ same-day? ] filter-keys values
] keep '[ _ swap "holiday" word-prop at ] map ;
HOLIDAY: armistice-day november 11 >>day ;
<PRIVATE
: query-string ( string -- assoc )
- query>assoc [ nip ] assoc-filter [
+ query>assoc sift-values [
[ [ CHAR: \s = ] trim ]
[ dup string? [ 1array ] when ] bi*
] assoc-map ;
! Loop until phi is not divisible by the public key.
dup rsa-primes [ * ] 2keep
[ 1 - ] bi@ *
- dup public-key coprime? [
- rot drop
- ] [
- 2drop modulus-phi
- ] if ;
+ dup public-key coprime? [ nipd ] [ 2drop modulus-phi ] if ;
PRIVATE>
] with-variable ;
: filter-git-remotes ( seq -- seq' )
- [ drop "remote" head? ] assoc-filter ;
+ [ "remote" head? ] filter-keys ;
: github-git-remote? ( hash -- ? )
"url" of [ CHAR: / = ] trim-tail "git@github.com:" head? ;
git-config-path utf8 file-contents string>ini >alist ;
: has-any-git-at-urls? ( git-ini -- ? )
- [ nip github-git-remote? ] assoc-any? ;
+ [ github-git-remote? ] any-value? ;
: has-remote-repo? ( git-ini owner repo -- ? )
- '[ nip _ _ git-remote-matches? ] assoc-filter f like ;
+ '[ _ _ git-remote-matches? ] filter-values f like ;
: write-git-config ( seq -- )
ini>string git-config-path utf8 set-file-contents ;
[ 1array >alt ]
} cond ;
-: canonicalize ( assoc -- assoc' )
- [ nip zero? ] assoc-reject ;
+: canonicalize ( assoc -- assoc' ) [ zero? ] reject-values ;
SYMBOL: terms
{ spin [ swap rot ] }
{ >boolean [ f = not ] }
{ keep [ over [ call ] dip ] }
+ { nipd [ rot drop ] }
}
CONSTANT: trivial-defs
[ keys lint-definitions-keys set-global ] bi ;
: find-duplicates ( -- seq )
- lint-definitions get-global [ nip length 1 > ] assoc-filter ;
+ lint-definitions get-global [ length 1 > ] filter-values ;
GENERIC: lint ( obj -- seq )
: filter-symbols ( alist -- alist )
[
- nip first dup lint-definitions get-global at
+ first dup lint-definitions get-global at
[ first ] bi@ literalize = not
- ] assoc-filter ;
+ ] filter-values ;
M: sequence run-lint ( seq -- seq )
[ lint ] zip-with trim-self
: no-vocab-found ( name -- empty )
{ } 2array ;
-: [is-used?] ( hash-set -- quot )
- '[ nip [ _ in? ] any? ] ; inline
-
: reject-unused-vocabs ( assoc hash-set -- seq )
- [is-used?] assoc-reject keys ;
+ '[ [ _ in? ] any? ] reject-values keys ;
:: print-new-header ( seq -- )
"Use the following header to remove unused imports: " print
: client-streams ( -- assoc ) clients values ;
: username ( -- string ) client username>> ;
: everyone-else ( -- assoc )
- clients [ drop username = ] assoc-reject ;
+ clients [ username = ] reject-keys ;
: everyone-else-streams ( -- assoc ) everyone-else values ;
ERROR: no-such-client username ;
: lex-vocabs ( vocabs -- assoc )
[ [ vocab>literals ] [ nip ] recover ] zip-with ;
-: failed-lexing ( assoc -- assoc' ) [ nip array? ] assoc-reject ;
+: failed-lexing ( assoc -- assoc' ) [ array? ] reject-values ;
: rewrite-file ( path encoding quot: ( str -- str' ) -- )
'[ file-contents @ ] 2keep set-file-contents ; inline
: multi-predicate ( classes -- quot )
dup length <iota> <reversed>
[ picker 2array ] 2map
- [ drop object eq? ] assoc-reject
+ [ object eq? ] reject-keys
[ [ t ] ] [
[ (multi-predicate) ] { } assoc>map
unclip [ swap [ f ] \ if 3array [ ] append-as ] reduce
?github-package-json [
[ "dependencies" of ] [ "devDependencies" of ] bi 2array [
[ over npm-latest-version "version" of 2array ] parallel-assoc-map
- [ nip first2 = not ] assoc-filter
+ [ first2 = not ] filter-values
] map
] transmute ;
: euler061 ( -- n )
4-digit-polygons dup [ 8 = ] filter-keys [
1array 6 find-cycle
- ] with map-find drop values sum ;
+ ] with map-find drop sum-values ;
SOLUTION: euler061
PRIVATE>
: euler164 ( -- answer )
- init-table 19 [ next-table ] times values sum ;
+ init-table 19 [ next-table ] times sum-values ;
! [ euler164 ] 100 ave-time
! 7 ms ave run time - 1.23 SD (100 trials)
] each
] keep ;
-: anagrams ( hash -- seq )
- [ nip length 1 > ] assoc-filter values ;
+: anagrams ( hash -- seq ) [ length 1 > ] filter-values values ;
: deranged-anagrams ( path -- seq )
parse-dict-file anagrams [ derangements ] map concat ;
] keep ;
: unique-abbrev ( seqs -- assoc )
- abbrev [ nip length 1 = ] assoc-filter ;
+ abbrev [ length 1 = ] filter-values ;
IN: sequences.extras
: find-all ( ... seq quot: ( ... elt -- ... ? ) -- ... elts )
- [ <enumerated> ] dip '[ nip @ ] assoc-filter ; inline
+ [ <enumerated> ] dip '[ @ ] filter-values ; inline
:: subseq* ( from to seq -- subseq )
seq length :> len
dup dup _ in? [ <local-reader> ] [ <local> ] if
] H{ } map>assoc
dup
- [ nip local-reader? ] assoc-filter
+ [ local-reader? ] filter-values
[ <local-writer> ] assoc-map
<lexenv> swap >>local-writers swap >>local-readers ;
: base-pointer-groups-decoded ( word -- seq )
word>gc-maps [
second second [ swap 2array ] map-index
- [ nip -1 = ] assoc-reject
+ [ -1 = ] reject-values
] map ;
! byte-array>bit-array
}
: filter-flaky-resources ( seq -- seq' )
- [ drop unparse ignored-resources member? ] assoc-reject ;
+ [ unparse ignored-resources member? ] reject-keys ;
! Allow testing without calling exit
: zealot-help-lint ( exit? -- )
projects / factor.git / commitdiff