Never been to DZone Snippets before?

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

« Newer Snippets
Older Snippets »
Showing 21-30 of 38 total

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
    ]

pull function

    pull: func [
        "Remove and return items from a series."
        series [series! none!]
        /part "The number of items to pull; one is the default"
            range [number!]
        /local result
    ] [
        if none? series [return none]
        result: either part [copy/part series range] [pick series 1]
        either part [remove/part series range][remove series]
        result
    ]
    comment {
        b: [1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20]
        pull b
        pull/part b 2
        pull/part at b 3 10
        pull at b 14
    }
« Newer Snippets
Older Snippets »
Showing 21-30 of 38 total