assocs: Make map-index-as support seq or assoc exemplars and move map-index, map-index-as to assocs because they need to use new-assoc. Make zip-index-as support assoc exemplars. Fix up docs and tests.

assocs.extras: Remove zip-as and move tests to assocs.
db4
Doug Coleman 2014-11-08 18:14:50 -08:00
parent 1b5711cc42
commit 7cfa9d9518
21 changed files with 86 additions and 65 deletions

View File

@ -87,4 +87,4 @@ SYMBOL: numbers
: block-number ( bb -- n ) numbers get at ;
: number-blocks ( bbs -- )
zip-index >hashtable numbers set ;
H{ } zip-index-as numbers set ;

View File

@ -218,7 +218,7 @@ ERROR: bad-partial-eval quot word ;
\ index [
dup sequence? [
dup length 4 >= [
zip-index >hashtable '[ _ at ]
H{ } zip-index-as '[ _ at ]
] [ drop f ] if
] [ drop f ] if
] 1 define-partial-eval

View File

@ -1,4 +1,4 @@
USING: game.input math math.order kernel macros fry sequences quotations
USING: assocs game.input math math.order kernel macros fry sequences quotations
arrays windows.directx.xinput combinators accessors windows.types
game.input.dinput sequences.private namespaces classes.struct
windows.errors windows.com.syntax alien.strings ;

View File

@ -1,6 +1,6 @@
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays fry hashtables io kernel macros make
USING: accessors arrays assocs fry hashtables io kernel macros make
math.parser multiline namespaces present sequences
sequences.generalizations splitting strings vocabs.parser ;
IN: interpolate

View File

@ -1,5 +1,5 @@
! (c)2010 Joe Groff bsd license
USING: help.markup help.syntax kernel math quotations sequences
USING: assocs help.markup help.syntax kernel math quotations sequences
sequences.private ;
IN: sequences.unrolled

View File

@ -5,15 +5,8 @@ generalizations sequences.generalizations hashtables kernel
locals locals.backend macros make math parser sequences ;
IN: shuffle
<PRIVATE
: >index-assoc ( sequence -- assoc )
zip-index >hashtable ;
PRIVATE>
MACRO: shuffle-effect ( effect -- )
[ out>> ] [ in>> >index-assoc ] bi
[ out>> ] [ in>> H{ } zip-index-as ] bi
[
[ nip assoc-size , \ narray , ]
[ [ at \ swap \ nth [ ] 3sequence ] curry map , \ cleave , ] 2bi

View File

@ -530,7 +530,7 @@ HELP: zip
HELP: zip-as
{ $values
{ "keys" sequence } { "values" sequence } { "exemplar" sequence }
{ "obj" "a sequence of key/value pairs of type " { $snippet "exemplar" } } }
{ "assoc" "a sequence of key/value pairs of type " { $snippet "exemplar" } } }
{ $description "Combines two sequences pairwise into a single sequence of key/value pairs of type " { $snippet "exemplar" } "." }
{ $notes "Exemplar must be a sequence type; hashtables will not work yet." }
{ $examples
@ -568,4 +568,24 @@ HELP: zip-index-as
}
{ $description "Zip a sequence with its index and return an associative list of type " { $snippet "exemplar" } " where the input sequence is the keys and the indices are the values." } ;
HELP: map-index
{ $values
{ "seq" sequence } { "quot" { $quotation ( ... elt index -- ... newelt ) } } { "newseq" sequence } }
{ $description "Calls the quotation with the element of the sequence and its index on the stack, with the index on the top of the stack. Collects the outputs of the quotation and outputs them in a sequence of the same type as the input sequence." }
{ $examples { $example "USING: arrays assocs prettyprint ;"
"{ 10 20 30 } [ 2array ] map-index ."
"{ { 10 0 } { 20 1 } { 30 2 } }"
} } ;
HELP: map-index-as
{ $values
{ "seq" sequence } { "quot" { $quotation ( ... elt index -- ... newelt ) } } { "exemplar" sequence } { "obj" object } }
{ $description "Calls the quotation with the element of the sequence and its index on the stack, with the index on the top of the stack. Collects the outputs of the quotation and outputs them in a sequence of the same type as the " { $snippet "exemplar" } "." }
{ $examples { $example "USING: arrays assocs prettyprint ;"
"{ 10 20 30 } [ 2array ] V{ } map-index-as ."
"V{ { 10 0 } { 20 1 } { 30 2 } }"
} } ;
{ map-index map-index-as } related-words
{ unzip zip zip-as zip-index zip-index-as } related-words

View File

@ -213,6 +213,23 @@ unit-test
{ { 1 f } { f 2 } } sift-values
] unit-test
! map-index, map-index-as
{
{ 11 23 35 }
} [ { 11 22 33 } [ + ] map-index ] unit-test
{
V{ 11 23 35 }
} [ { 11 22 33 } [ + ] V{ } map-index-as ] unit-test
{
B{ 11 23 35 }
} [ { 11 22 33 } [ + ] B{ } map-index-as ] unit-test
{
BV{ 11 23 35 }
} [ { 11 22 33 } [ + ] BV{ } map-index-as ] unit-test
! zip, zip-as
{
{ { 1 4 } { 2 5 } { 3 6 } }
@ -234,6 +251,17 @@ unit-test
V{ { 1 4 } { 2 5 } { 3 6 } }
} [ BV{ 1 2 3 } BV{ 4 5 6 } V{ } zip-as ] unit-test
{ { { 1 3 } { 2 4 } }
} [ { 1 2 } { 3 4 } { } zip-as ] unit-test
{
V{ { 1 3 } { 2 4 } }
} [ { 1 2 } { 3 4 } V{ } zip-as ] unit-test
{
H{ { 1 3 } { 2 4 } }
} [ { 1 2 } { 3 4 } H{ } zip-as ] unit-test
! zip-index, zip-index-as
{
{ { 11 0 } { 22 1 } { 33 2 } }

View File

@ -198,11 +198,28 @@ M: assoc value-at* swap [ = nip ] curry assoc-find nip ;
: push-at ( value key assoc -- )
[ ?push ] change-at ;
: zip-as ( keys values exemplar -- obj )
[ [ 2array ] ] dip 2map-as ; inline
: zip-as ( keys values exemplar -- assoc )
dup sequence? [
[ 2array ] swap 2map-as
] [
[ 2dup min-length ] dip new-assoc
[ [ set-at ] with-assoc 2each ] keep
] if ; inline
: zip ( keys values -- alist )
{ } zip-as ; inline
: zip ( keys values -- alist )
{ } zip-as ; inline
: map-index-as ( ... seq quot: ( ... elt index -- ... newelt ) exemplar -- ... obj )
dup sequence? [
[ dup length iota ] 2dip 2map-as
] [
[ dup length iota ] 2dip [ over length ] dip new-assoc
! Need to do 2array/first2 here because of quot's stack effect
[ [ [ first2 swap ] dip set-at ] curry compose 2each ] keep
] if ; inline
: map-index ( ... seq quot: ( ... elt index -- ... newelt ) -- ... newseq )
{ } map-index-as ; inline
: zip-index-as ( values exemplar -- obj )
[ [ 2array ] ] dip map-index-as ; inline

View File

@ -1,4 +1,4 @@
USING: arrays generic.single help.markup help.syntax kernel
USING: assocs arrays generic.single help.markup help.syntax kernel
layouts math math.order quotations sequences.private vectors ;
IN: sequences
@ -365,25 +365,6 @@ HELP: each-index
"{ 10 0 }\n{ 20 1 }\n{ 30 2 }"
} } ;
HELP: map-index
{ $values
{ "seq" sequence } { "quot" { $quotation ( ... elt index -- ... newelt ) } } { "newseq" sequence } }
{ $description "Calls the quotation with the element of the sequence and its index on the stack, with the index on the top of the stack. Collects the outputs of the quotation and outputs them in a sequence of the same type as the input sequence." }
{ $examples { $example "USING: arrays sequences prettyprint ;"
"{ 10 20 30 } [ 2array ] map-index ."
"{ { 10 0 } { 20 1 } { 30 2 } }"
} } ;
HELP: map-index-as
{ $values
{ "seq" sequence } { "quot" { $quotation ( ... elt index -- ... newelt ) } } { "exemplar" sequence } { "newseq" sequence } }
{ $description "Calls the quotation with the element of the sequence and its index on the stack, with the index on the top of the stack. Collects the outputs of the quotation and outputs them in a sequence of the same type as the " { $snippet "exemplar" } " sequence." }
{ $examples { $example "USING: arrays sequences prettyprint ;"
"{ 10 20 30 } [ 2array ] V{ } map-index-as ."
"V{ { 10 0 } { 20 1 } { 30 2 } }"
} } ;
{ map-index map-index-as } related-words
HELP: change-nth
{ $values { "i" "a non-negative integer" } { "seq" "a mutable sequence" } { "quot" { $quotation ( ..a elt -- ..b newelt ) } } }
{ $description "Applies the quotation to the " { $snippet "i" } "th element of the sequence, storing the result back into the sequence." }

View File

@ -578,12 +578,6 @@ PRIVATE>
3bi
] if ; inline
: map-index-as ( ... seq quot: ( ... elt index -- ... newelt ) exemplar -- ... newseq )
[ dup length iota ] 2dip 2map-as ; inline
: map-index ( ... seq quot: ( ... elt index -- ... newelt ) -- ... newseq )
{ } map-index-as ; inline
: reduce-index ( ... seq identity quot: ( ... prev elt index -- ... next ) -- ... result )
swapd each-index ; inline

View File

@ -10,10 +10,6 @@ IN: assocs.extras
{ 1 } [ H{ { "a" H{ { "b" 1 } } } } { "a" "b" } deep-at ] unit-test
{ 4 } [ H{ { 1 H{ { 2 H{ { 3 4 } } } } } } { 1 2 3 } deep-at ] unit-test
{ { { 1 3 } { 2 4 } } } [ { 1 2 } { 3 4 } { } zip-as ] unit-test
{ V{ { 1 3 } { 2 4 } } } [ { 1 2 } { 3 4 } V{ } zip-as ] unit-test
{ H{ { 1 3 } { 2 4 } } } [ { 1 2 } { 3 4 } H{ } zip-as ] unit-test
{ H{ { 2 1 } { 4 3 } } } [ H{ { 1 2 } { 3 4 } } assoc-invert ] unit-test
[ H{ } ] [ { } assoc-merge ] unit-test

View File

@ -14,14 +14,6 @@ IN: assocs.extras
: deep-at ( assoc seq -- value/f )
[ of ] each ; inline
: zip-as ( keys values exemplar -- assoc )
dup sequence? [
[ 2array ] swap 2map-as
] [
[ 2dup min-length ] dip new-assoc
[ [ set-at ] with-assoc 2each ] keep
] if ; inline
: substitute! ( seq assoc -- seq )
substituter map! ;

View File

@ -1,5 +1,5 @@
! (c)2009 Joe Groff bsd license
USING: accessors classes.struct classes.tuple combinators fry
USING: accessors assocs classes.struct classes.tuple combinators fry
functors kernel locals macros math parser quotations sequences
sequences.private slots specialized-arrays words ;
IN: classes.struct.vectored

View File

@ -3,7 +3,7 @@
USING: accessors alien.c-types alien.strings byte-arrays cuda
cuda.contexts cuda.devices cuda.libraries cuda.memory cuda.syntax
destructors io io.encodings.string io.encodings.utf8 kernel locals
math math.parser namespaces sequences strings ;
math math.parser namespaces sequences strings assocs ;
IN: cuda.demos.hello-world
CUDA-LIBRARY: hello cuda32 vocab:cuda/demos/hello-world/hello.ptx

View File

@ -5,7 +5,7 @@ math math.vectors math.matrices assocs arrays hashtables ;
FROM: namespaces => set ;
IN: euler.b-rep
: >index-hash ( seq -- hash ) zip-index >hashtable ; inline
: >index-hash ( seq -- hash ) H{ } zip-index-as ; inline
TUPLE: b-edge < edge sharpness macro ;

View File

@ -1,6 +1,6 @@
! Copyright (C) 2013 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays fry kernel locals math math.matrices
USING: accessors arrays assocs fry kernel locals math math.matrices
math.vectors sequences sequences.private ;
IN: math.matrices.laplace

View File

@ -1,6 +1,6 @@
! Copyright (c) 2012 John Benediktsson
! See http://factorcode.org/license.txt for BSD license.
USING: arrays kernel locals math math.constants math.functions
USING: arrays assocs kernel locals math math.constants math.functions
math.vectors sequences sequences.extras sequences.private ;
IN: math.transforms.fft

View File

@ -1,7 +1,7 @@
! Copyright (c) 2007 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: ascii io.encodings.ascii io.files kernel math project-euler.common
sequences sorting splitting ;
USING: ascii assocs io.encodings.ascii io.files kernel math
project-euler.common sequences sorting splitting ;
IN: project-euler.022
! http://projecteuler.net/index.php?section=problems&id=22

View File

@ -1,6 +1,6 @@
! Copyright (c) 2012 Anonymous
! See http://factorcode.org/license.txt for BSD license.
USING: arrays fry kernel math.matrices sequences ;
USING: arrays assocs fry kernel math.matrices sequences ;
IN: rosetta-code.bitmap
! http://rosettacode.org/wiki/Basic_bitmap_storage

View File

@ -1,6 +1,6 @@
! Copyright (C) 2008 Jeff Bigot
! See http://factorcode.org/license.txt for BSD license.
USING: kernel arrays sequences fry math combinators ;
USING: kernel arrays assocs sequences fry math combinators ;
IN: adsoda.combinators