REBOL [
    Title: "Condense Data"
    Date: 18-Feb-2002
    Version: 0.0.1
    File: %condense.r
    Author: "Matthew S. Licholai"
    Rights: "(C)2002 Matthew S. Licholai"
    Usage: {Examples:
        do %get-stock.r
^-^-either exists? %IBM.csv [
^-^-^-stock-data: get-stock/data/retrieve "IBM" (now/date - 50) now/date %IBM.csv
^-^-][
^-^-^-stock-data: get-stock/data/store "IBM" (now/date - 50) now/date %IBM.csv 
^-^-]
^-^-blk:   [1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25]
^-^-blk-r: [1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25]
^-^-blk2:  [1 1 1 1 1 1 1 1 1 1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1 ]
^-^-reverse blk-r
^-^-blk-3: reduce [blk blk blk]
^-^-blk-4: reduce [blk blk2 blk-r blk]
^-^-probe aggregate-10 blk-3
^-^-probe aggregate-5 blk-4

^-^-print length? first stock-data
^-^-answer: aggregate-weeks stock-data
^-^-print length? first answer
^-^-dt: first answer
^-^-answer: next answer
^-^-do %q-plot.r
^-^-view quick-plot [
^-^-^-500x500
^-^-^-x-data [(dt)]
^-^-^-stock [(answer)]
^-^-^-x-axis 7 border
^-^-^-x-grid 7
^-^-^-y-axis 5
^-^-^-y-grid 5
^-^-]
^-^-}
    Purpose: {Provide a series of functions for aggregating data.  Specifically designed for taking daily stock data and condensing it into weekly or monthly data series, but flexible enough for most data aggregation tasks.}
    History: [0.0.1 [18-Feb-2002 "Initial version."]]
    Email: m.s.licholai@ieee.org
    Category: [math file util 3 2]
]

condense: func ["aggregate data by number of items or days"
    data [block!] "data to condense"
    test [function!] "return true when value is the last to condense"
    /test-nr nr-test "vector number to use for testing"
    /combiner comb-fun [function!] "how to aggregate the values"

    /local
    
][  ;see if we have a block of blocks
    blocks: block! = type? first data
    
    data-width: either blocks [length? data][1]

    any [test-nr nr-test: 1] ; default to testing the first block (if more than one)
    
    if not combiner [
        ;;; if we don't have a combiner function specified by the user use a default
        ;      of averaging the values in each vector
        comb-fun: func [temps [block!] /local result sum number ][
            result: copy []
            foreach col temps [
                either all [(not tail? col) (date! = type? first col)][append result last col clear head col][
                    sum: 0.0
                    number: 0.0
                    foreach val col [
                        sum: sum + val
                        number: number + 1.0
                    ]
                    clear head col
                    if (number > 0) [append result (sum / number)]
                ]
            ]
            return result
        ]
    ]
        
    result: copy [] ; where we store the condensed data until done
    temp-blks: copy [] ; temp vectors while we aggregate
    ; create result and temp blocks for each data vector
    loop data-width [append/only result copy [] append/only temp-blks copy []] 
    
    until [
        for i 1 data-width 1 [
            col: pick data i
            val: either blocks [first col][col]
            append (pick temp-blks i) val ;append val to the temp-data vector
        ]
        val: either blocks [first pick data nr-test][pick data nr-test] 
        if test val [
            vals: comb-fun temp-blks
            for i 1 data-width 1 [
                append (pick result i) (pick vals i)
            ]
        ]
        either blocks [for i 1 data-width 1 [poke data i (t: next pick data i)]][t: data: next data]
        tail? t
    ]
    ; add the remaining values at the end
    vals: comb-fun temp-blks
    for i 1 data-width 1 [
        if (val: pick vals i) [append (pick result i) val]
    ]
    if blocks [for i 1 data-width 1 [poke data i (head pick data i)]]; restore the head of each data block
    return either blocks [head result][first result]
]


number-vals: func [number][
    return func [ t-val /reset /local holder][
        holder: []
        append holder 1
        if reset [holder: clear head holder ]
        either ((length? holder) >= number ) [
            holder: clear head holder
            return true
        ][
            return false
        ]
    ]
]

same-week?: func [test-day [date!] /local day last-day result][
    last-day: [1]
    day: test-day/weekday
    result: (day < first last-day)
    last-day: append clear last-day day
    return result
]

same-month?: func [test-day [date!] /local day last-day result][
    last-day: [1]
    day: test-day/day
    result: (day < first last-day)
    last-day: append clear last-day day
    return result
]

;; some concrete implementations

aggregate-10: func [ data ][
    ten-vals: number-vals 10
    ten-vals/reset 1
    return condense data :ten-vals
]

aggregate-5: func [ data ][
    five-vals: number-vals 5
    five-vals/reset 1
    return condense data :five-vals
]

aggregate-weeks: func [data /local ][
    return condense data :same-week? data
]

aggregate-months: func [data /local ][
    return condense data :same-month? data
]

;; tests