Deprecated: The each() function is deprecated. This message will be suppressed on further calls in /home/zhenxiangba/zhenxiangba.com/public_html/phproxy-improved-master/index.php on line 456
Code Snippets: Store, sort and share source code, with tag goodness
[go: Go Back, main page]

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!

Top Tags Alphabetically

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)

« Newer Snippets
Older Snippets »
969 total  XML / RSS feed 

slice function

slice: func [series start len] [copy/part at series start len]

excerpt function

    ;-- 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
        ]
    }

collect function

    ; 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 function

    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
    ]

move function

    ; 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 function

    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
        ]
    ]

chunk function

    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 function

    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 function

    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? and superset? functions

    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
    ]
« Newer Snippets
Older Snippets »
969 total  XML / RSS feed