Functional constructs experiments in Red

fun.red

->: make op! :function ; arrow-style lambdas: [x]->[x + 1]

id: ["Identity function, one in, same out" x]->[x]

;--------------------------------------------------------------------------------------

cmp: ["Gets a block! of words! or blcoks! that represent a function! and composes it in the usual way" 
  fs [any-block!]]->[ [x]-> compose/deep/only [take reduce append (reduce fs) [x] ]
]

test1: cmp [[y]->[append copy [] y] [x]->[x * x] :first]

test1 [2] ; => [4]

vec: cmp [:make :vector!]

vec [1 2 3 4 5] ; => make vector! [1 2 3 4 5]

;--------------------------------------------------------------------------------------

fld: ["Quite general fold function"
  rdf [any-function!] "Reducing/accumulating function. Needs to take 2 args, and updates the accumulator"
  ini "Initial value. Gets updated in place."
  elf [any-function!] "Element/take function. This is what defines if we are skipping elements or taking more than one each time."
  ser [series!] "The series! to be folded"
  ]->[
  acc: ini forall ser [acc: rdf acc elf ser] acc
]

;--------------------------------------------------------------------------------------

map: ["Usual map HOF"
  mpf [any-function!]
  ser [series!]
  ]->[ 
  fld :append copy [] cmp [:mpf :first] ser
]

map [x]->[x * x] [1 2 3 4 5] ; => [1 4 9 16 25]

;--------------------------------------------------------------------------------------

sum: ["Shortcut to sum many elements, a example of using fold"
  ser [series!]
  ]->[
  fld :add 0 :first ser
]

sum [1 2 3 4 5] ; => 15

;--------------------------------------------------------------------------------------

fuse: ["Like a reverse map: takes a block! of operations and a single value, and returns a block of applying those funcs to the value" 
  fs [series!]
  input
  ]->[
  collect [foreach f reduce fs compose [keep/only f (input)]]
]

fuse [:id :sqrt [x]->[x * x]] 4.0 ; => [4.0 2.0 16.0]

;--------------------------------------------------------------------------------------

; a more involved example, collects sum, sum of squares, counts and sum of square roots in one pass

float: cmp [:make :float!]

stats-step: [smp]->[vec fuse [[x]->[1.0] :sqrt :float [x]->[float x * x]] smp]

stats: [smp]->[fld :add vec [0.0 0.0 0.0 0.0] :stats-step  smp]

labels: ["count: " "sum of square-roots: " "sum: " "sum of squares: "] 

res: stats [1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0]

foreach v res [prin take labels print v]

; count: 9.0
; sum of square-roots: 19.30600052603572
; sum: 45.0
; sum of squares: 285.0