slice function
slice: func [series start len] [copy/part at series start len]
Code Snippets
1036 users tagging and storing useful source code snippets
Snippets is a public source code repository. Easily build up your personal collection of code snippets, categorize them with tags / keywords, and share them with the world (or not, you can keep them private!)
What next?
1. Bookmark us with del.icio.us or Digg Us!
2. Subscribe to this site's RSS feed
3. Browse the site.
4. Post your own code snippets to the site!
REBOL apache array bash bookmarklet canvas cli conversion csharp css database date files form google hello html http image java javascript lighttpd line linux mac math mysql osx perl php prototype python r rails random regex rss ruby rubyonrails series series60 shell sql string text time unix web windows xml
python
Model, View, Controller HOWTO
Profiling Python Code
Read & Write JPEG COM and EXIF medata
ruby
parameterized instance variables
Ruby FPDF PDF_MC_Table port
Form tags
javascript
setClipboard for Firefox
Shallow cloning an array.
Generating a shuffled array.
rails
Form tags
Validations for Non-ActiveRecord Objects
Make Fixtures from ActiveRecord Tables
php
Parse HTML files as PHP
Forward to new page
Enabling Zip compression with PHP
series60
Discover bluetooth devices around you
Getting key press
Image/canvas bliting
html
(un)Check all checkboxes
Alternate row shading on table
Parse HTML files as PHP
REBOL
slice function
excerpt function
collect function
shell
Model, View, Controller HOWTO
Remove all Thumbs.db files
Drop an entire schema
java
unique random array
Alternating Rows
NotFunnyException
rubyonrails
Make Fixtures from ActiveRecord Tables
How to rotate your Rails logs by size, so you ca..
Single-table inheritance and validates_as_unique..
perl
Search module path from name
Getting Documents with LWP
XMLPrettyPrint: simple xml pretty print in perl
REBOL (50)
apache (11)
array (22)
bash (20)
bookmarklet (9)
canvas (11)
cli (13)
conversion (8)
csharp (15)
css (27)
database (11)
date (15)
files (11)
form (11)
google (11)
hello (8)
html (55)
http (9)
image (19)
java (40)
javascript (133)
lighttpd (16)
line (8)
linux (25)
mac (17)
math (28)
mysql (23)
osx (21)
perl (32)
php (64)
prototype (11)
python (167)
r (9)
rails (93)
random (8)
regex (12)
rss (9)
ruby (139)
rubyonrails (33)
series (19)
series60 (58)
shell (40)
sql (30)
string (19)
text (12)
time (12)
unix (23)
web (17)
windows (13)
xml (22)
slice: func [series start len] [copy/part at series start len]
;-- collect-based EXCERPT ----------------------------------
; Could also change EXTRACT to accept a block value for WIDTH
; (renamed to, e.g., SPEC).
; The dialect allows you to use commas in the block, but how they
; are interpreted is not how you might think. Coming after a number,
; they are a valid lexical form, but they denote a decimal! rather
; than being seen as a separator, which means you can't use them too
; flexibly.
excerpt: func [
{Returns the specified items and/or ranges from the series.}
series [series!]
offsets [block!] {Offsets of the items to extract; dialected.}
/only "return sub-block ranges as blocks"
/local
emit-range rules
from* to* index* ; parse vars
][
; always uses ONLY right now; it's a prototype.
collect/only val [
emit-range: func [start end] [
start: to integer! start
if number? end [end: to integer! end - start + 1]
val: either end = 'end [copy at series start][
copy/part at series start end
]
]
rules: [
some [
opt 'from set from* number! 'to set to* number! (
emit-range from* to*
)
| opt 'from set from* number! 'to 'end (emit-range from* 'end)
| 'to set to* number! (emit-range 1 to*)
| set index* number! (val: pick series index*)
| into rules
]
]
parse offsets rules
]
]
comment {
b: [1 2 3 4 5 6 7 8 9 10 11 12 13 14]
excerpt b [1 3 5]
excerpt b [1 3 to 6 8]
excerpt/only b [1, 3 to 6, 8]
excerpt b [1 [5 to 7] 8]
excerpt/only b [1 (from 5 to 7) 8]
excerpt b [(to 2) [4 to 6] 8, 10, from 12 to end]
excerpt/only b [to 2, 4 to 6, 8, 10, (12 to end)]
; Can't use a comma after 'end
excerpt/only b [to 2 to 6 8 10 to end 12 to end]
excerpt/only b [to 2, to 6, 8 [10 to end] 12 to end]
excerpt/only trim {
REBOL is my favorite language
} [
to 5, 10 to 11, 13, 14, 15, 22 to end
]
excerpt/only to binary! {REBOL is my favorite language} [
to 5, 10 to 11, 13, 14, 15, 22 to end
]
}
; What about extending this to work on string values?
collect: func [ ; a.k.a. gather ?
[throw]
{Collects block evaluations.}
'word "Word to collect (as a set-word! in the block)"
block [any-block!] "Block to evaluate"
/into dest [series!] "Where to append results"
/only "Insert series results as series"
;/debug
/local code marker at-marker? marker* mark replace-marker rules
] [
block: copy/deep block
dest: any [dest make block! []]
; "not only" forces the result to logic!, for use with PICK.
; insert+tail pays off here over append.
;code: reduce [pick [insert insert/only] not only 'tail 'dest]
; FIRST BACK allows pass-thru assignment of value. Speed hit though.
;code: reduce ['first 'back pick [insert insert/only] not only 'tail 'dest]
code: compose [first back (pick [insert insert/only] not only) tail dest]
marker: to set-word! word
at-marker?: does [mark/1 = marker]
; We have to use change/part since we want to replace only one
; item (the marker), but our code is more than one item long.
replace-marker: does [change/part mark code 1]
;if debug [probe code probe marker]
marker*: [mark: set-word! (if at-marker? [replace-marker])]
parse block rules: [any [marker* | into rules | skip]]
;if debug [probe block]
do block
head :dest
]
comment {
;collect/debug zz [repeat n 10 [zz: n * 100]]
collect zz []
collect zz [repeat i 10 [if (zz: i) >= 3 [break]]]
collect zz [repeat i 10 [zz: i if i >= 3 [break]]]
collect zz [repeat i 10 [either i <= 3 [zz: i][break]]]
dest: copy []
collect/into zz [repeat n 10 [zz: n * 100]] dest
collect zz [for i 1 10 2 [zz: i * 10]]
collect zz [for x 1 10 1 [zz: x]]
collect zz [foreach [a b] [1 2 3 4] [zz: a + b]]
collect zz [foreach w [a b c d] [zz: w]]
collect zz [repeat e [a b c %.txt] [zz: file? e]]
iota: func [n [integer!]][collect zz [repeat i n [zz: i]]]
iota 10
collect zz [foreach x first system [zz: to-set-word x]]
x: first system
collect zz [forall x [zz: length? x]]
x: first system
collect zz [forskip x 2 [zz: length? x]]
collect zz [forskip x 2 [zz: (length? x) / 0]]
collect/only zz [foreach [a b] [1 2 3 4] [zz: a zz: b zz: reduce [a b a + b]]]
collect/only zz [
foreach [a b] [1 2 3 4] [
zz: a zz: b zz: reduce [a b a + b]
foreach n reduce [a b a + b] [zz: n * 10]
]
]
dest: copy ""
collect/into zz [repeat n 10 [zz: n * 100 zz: " "]] dest
dest: copy []
collect/into zz [
foreach [num blk] [1 [a b c] 2 [d e f] 3 [g h i]] [
zz: num
collect/only/into yy [
zz: blk
foreach word blk [zz: yy: num yy: word]
yy: blk
] dest
]
] dest
}
multi-level-sort: func [
"Returns a copy of the block, sorted on the given items (all ascending)"
block [any-block!]
offsets [any-block!]
/local idx result
][
idx: make block length? block
repeat i length? block [
append idx append/only reduce [i] excerpt block/:i offsets
]
sort/skip/compare idx 2 2
result: make block length? block
foreach [index data] idx [
append/only result block/:index
]
result
]
; Should this return the head of the series? I'm thinking no right now.
; Should /skip be the default op and /to makes it absolute?
move: func [
"Moves the first instance of value, if found, to a new position in the series."
series [series!]
value
/head "Move to the head of the series"
/tail "Move to the tail of the series"
/to "Move to an absolute position in the series"
index [number! logic! pair!] "Can be positive, negative, or zero"
/skip "Move forward or backward from the current position"
offset [number! logic! pair!] "Can be positive, negative, or zero"
/part "Move the given number of items"
range [number! series! pair!]
;/all "move all instances of value" ; ???
/local pos dest sw*
] [
sw*: system/words
either none? pos: find/only series value [none] [
either part [
value: copy/part pos range
remove/part pos range
][
value: first pos
remove pos
]
dest: any [
all [head sw*/head series]
all [tail sw*/tail series]
all [to at series index]
all [skip sw*/skip pos offset]
]
either part [insert dest :value] [insert/only dest :value]
]
]
prepend: func [
{Inserts a value at the head of a series and returns the series head.}
series [series! port!]
value
/only "Prepends a block value as a block"
][
head either only [
insert/only head series :value
] [
insert head series :value
]
]
split: chunk: segment: func [ ; subdivide ?
{See: CLOS pg. 937. Not that mine works the same, but that was
the inspiration.}
series [series!]
size [integer!] "The size of the chunks (last chunk may be shorter)"
/into "split into a set number (size) of chunks (last chunk may be longer than others)."
/local ct cur-piece result
][
ct: either into [size] [round/down divide length? series size]
if into [size: to-integer divide length? series size]
result: copy []
if zero? size [return result]
parse series [
ct [
copy cur-piece size skip (append/only result cur-piece) mark:
]
]
if any [into not zero? remainder length? series size] [
cur-piece: copy mark
either into
[append last result cur-piece]
[append/only result cur-piece]
]
result
]
piece: func [
{Returns one item from a series of fixed size "pieces".}
series [series!]
index [integer!] "Item number, not series offset"
size [integer!] "Size of each piece in the series"
][
; Remember there is no precedence to math ops; just left-to-right.
copy/part at series (index - 1 * size + 1) size
]
group-by: func [
{Returns a block of blocks+sub-blocks with items partitioned by
matching index elements in each sub-block.}
block [any-block!] "A block of blocks"
index [integer!] "Index of sub-block value to compare, for grouping."
/local keys
][
result: copy []
foreach item block [
if not find/skip result item/:index 2 [
append result reduce [item/:index copy []]
]
]
foreach item block [
append/only select result item/:index item
]
result
]
;group-by [[a 1 2] [b 2 3] [a 2 4] [c 2 3] [b 1 5]] 1
;group-by [[a 1 2] [b 2 3] [a 2 4] [c 2 3] [b 1 5] [c 2 4]] 2
;group-by [[a 1 2] [b 2 3] [a 2 4] [c 2 3] [b 1 5] [c 2 4]] 3
subset?: func [
{Returns true if A is a subset of B; false otherwise.}
a [series! bitset!]
b [series! bitset!]
] [
empty? exclude a b
]
superset?: func [
{Returns true if set1 is a superset of set2; false otherwise.}
set1 [series! bitset!]
set2 [series! bitset!]
][
subset? set2 set1
]