[REBOL] A "supercharged" Map function.
From: brett:codeconscious at: 22-Jul-2003 14:25
Hi List,
I was thinking about the way functions collect their arguments from scripts
and then my attention turned to the Map function that many of us have used
or created, and then I thought how nice it would be if Map could apply
functions with multiple arguments. Then I went over-the-top. I wouldn't be
suprised if someone has already got something like this floating around but
anyware here it is. See the examples below for what it does.
; Carl Sassenrath's nargs function.
nargs: func [
{The number of the function arguments}
f [any-function!]
] [-1 + index? any [find first :f refinement! tail first :f]]
map: func [
[catch]
"Map a function to a series (unsets filtered by default)."
mapfunc [any-function! block! none!]
"Function or function body block (use VALUE as argument)."
series [series! none!] "Series to map."
/only "Inserts into result using Only refinement."
/filter filterfunc [any-function! block!]
"Single argument function or body (use VALUE as argument)."
/local num-arg result emit
] [
; Check arguments for none!
if any [none? :mapfunc none? series] [return none]
if block? :mapfunc [
mapfunc: func [value [any-type!]] mapfunc]
if not filter [
filterfunc: [not unset? get/any 'value]]
if block? :filterfunc [
filterfunc: func [value [any-type!]] filterfunc]
num-arg: nargs :mapfunc
result: make type? series length? series
emit: func [value [any-type!]] compose/deep [
if filterfunc get/any 'value [
(pick [insert/only insert] found? only)
tail result get/any 'value
]
]
while [not tail? series] [
emit do compose [mapfunc (copy/part series num-arg)]
series: skip series num-arg
]
result
]
comment [
; Shortcut for specifying mapping function.
map [value] [1 2 3 4]
; Passing functions as the mapping function.
map :add [1 2 3 4]
map func [a b] [a / b] [1 2 3 4]
; Default handling of block results.
map [reduce [value value * 10]] [1 2 3 4]
; Blocks retained.
map/only [reduce [value value * 10]] [1 2 3 4]
; These return none.
map none [1 2 3 4]
map [value] none
map none none
; These return empty blocks.
map [] []
map [] [1 2 3 4]
map [value] []
; Custom filter of function results.
map/filter [value] [1 2 3 4] [value >= 3]
; Default unset! handling.
map [print [value]] [1 2 3 4]
; Default unset! handling overriden.
map/filter [print [value]] [1 2 3 4] [true]
; Flattening a tree.
sample-tree: [1 [2 [] 3 [4 []]] 5 []]
f: func [label subtree] [
append reduce [label] map :f subtree
]
map :f sample-tree
; Converts output from Parse-xml to a tree of element names.
elt: func [name att content] [
reduce [
name
map/filter [
if block? value [map :elt value]
] content [not none? value]
]
]
map :elt first third parse-xml xml
]
Regards,
Brett.
---
Website: http://www.codeconscious.com
Rebsite: http://www.codeconscious.com/index.r