Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
map & fold explorations
;; letrec practice
;; fold
;; map
;; filter
;; mapcat
(define (fold fold-f acc l)
(letrec
((FOLD (lambda (acc l)
(cond
((null? l) acc)
(else
(FOLD (fold-f acc (car l))
(cdr l)))))))
(FOLD acc l)))
(define map
(lambda (map-f l)
(letrec
((MAP (lambda (l)
(cond
((null? l) '())
(else
(cons (map-f (car l))
(MAP (cdr l))))))))
(MAP l))))
(define filter
(lambda (filter-f l)
(letrec
((FILTER (lambda (l)
(cond
((null? l) '())
((filter-f (car l))
(cons (car l)
(FILTER (cdr l))))
(else
(FILTER (cdr l)))))))
(FILTER l))))
;; not a fan of this style. it's hard to reason about.
(define mapcat
(lambda (map-f l)
(letrec
((CONCAT (lambda (list-1 list-2)
(cond
((null? list-1) list-2)
(else
(cons (car list-1)
(CONCAT (cdr list-1) list-2))))))
(FOLD (lambda (fold-f acc l)
(cond
((null? l) acc)
(else
(FOLD fold-f
(fold-f acc (car l))
(cdr l))))))
(MAP (lambda (l)
(cond
((null? l) '())
(else
(cons (map-f (car l))
(MAP (cdr l)))))))
(MAPCAT (lambda (l)
(FOLD (lambda (acc e)
(CONCAT acc (MAP e)))
'()
l))))
(MAPCAT l))))
(mapcat add1 '((1 2 3) (4 5 6)))
(define identity
(lambda (x) x))
(define concat
(lambda (l1 l2)
(concat-helper l1 l2 identity)))
(define concat-helper
(lambda (l1 l2 acc-f)
(cond
((null? l1) (acc-f l2))
(else
(concat-helper (cdr l1)
l2
(lambda (cont)
(acc-f (cons (car l1) cont))))))))
(concat '(1 2 3) '(4 5 6))
require 'benchmark'
$data = Array.new(1000) { rand(1000) }
def select(f, l)
if l.empty?
[]
elsif f.(l.first)
select(f, l[1..-1]).unshift(l.first)
else
select(f, l[1..-1])
end
end
def select_with_cps(f, l, cont)
if l.empty?
cont
elsif f.(l.first)
select_with_cps f, l[1..-1], ->(acc) { cont.( acc.unshift(l.first) ) }
else
select_with_cps f, l[1..-1], cont
end
end
#select ->(n) { n.odd? }, $data.dup
#(select_with_cps ->(n) { n.odd? }, $data.dup, ->(x) { x }).([])
TIMES = 100_000
def benchmark(msg, &block)
block.call
time = Benchmark.realtime { block.call }
puts "#{msg} RESULT: #{time}"
end
# approx 49 seconds on my laptop
benchmark("select") do
TIMES.times do
select ->(n) { n.odd? }, $data.dup
end
end
cont = select_with_cps ->(n) { n.odd? }, $data.dup, ->(x) { x }
# about 17 seconds on my laptop
benchmark("CPS") do
TIMES.times do
cont.([])
end
end
# about 8 seconds avg
benchmark("native") do
TIMES.times do
$data.select(&:odd?)
end
end
# about 13 seconds average
benchmark("iterative") do
TIMES.times do
result = []
for n in $data
if n.odd?
result << n
end
end
result
end
end
;; Write `filter` 3 different ways.
;; helpers
(define greater-than-two (lambda (n) (> n 2)))
(define fold (lambda (fun acc l) (cond ((null? l) acc) (else (fold fun (fun acc (car l)) (cdr l))))))
(define identity (lambda (x) x))
;; V1 - consing on to the recursion
(define filter
(lambda (fun l)
(cond
((null? l) '())
((fun (car l))
(cons (car l)
(filter fun (cdr l))))
(else
(filter fun (cdr l))))))
;; (filter greater-than-two '(1 2 3 4 5))
;; => (3 4 5)
;; V2 - acc with reverse
(define acc-filter
(lambda (fun acc l)
(cond
((null? l) (reverse acc))
((fun (car l))
(acc-filter fun
(cons (car l) acc)
(cdr l)))
(else
(acc-filter fun acc (cdr l))))))
;; (acc-filter greater-than-two '() '(1 2 3 4 5))
;; => (3 4 5)
;; V3 - filter w/ fold
(define fold-filter
(lambda (filter-f l)
(reverse
(fold
(lambda (acc e)
(cond
((filter-f e)
(cons e acc))
(else
acc)))
'()
l))))
;; (fold-filter greater-than-two '(1 2 3 4 5))
;; => (3 4 5)
;; V4 - w/ CPS
(define cps-filter
(lambda (filter-f l acc-f)
(cond
((null? l) (acc-f '()))
(else
(cps-filter filter-f
(cdr l)
(lambda (acc)
(cond
((filter-f (car l))
(acc-f (cons (car l) acc)))
(else
(acc-f acc)))))))))
(cps-filter greater-than-two '(1 2 3 4 5) identity)
;; Write `fold` 3 different ways
;; helpers
(define identity
(lambda (x) x))
(define cons-em!
(lambda (acc e)
(cons e acc)))
;; V1: "standard fold". acc style.
(define fold
(lambda (fun acc l)
(cond
((null? l) acc)
(else
(fold fun
(fun acc (car l))
(cdr l))))))
; (fold + 0 '(1 2 3))
;; notice the acc nature. the results will be reversed
;; (fold (lambda (acc e) (cons e acc))
;; '()
;; '(1 2 3))
;; => (3 2 1)
;; V2: summing with apply-onto-recursion.
;; notice how _not_ generic it is. not folding here.
(define sum
(lambda (lon)
(cond
((null? lon) 0)
(else
(+ (car lon)
(sum (cdr lon)))))))
;; V3: a cps fold.
(define cps-fold
(lambda (reducer-f seed l collector-f)
(cond
((null? l) (collector-f seed))
(else
(cps-fold reducer-f
seed
(cdr l)
(lambda (previous)
(collector-f (reducer-f previous (car l)))))))))
;; (cps-fold + 0 '(1 2 3) identity)
;; => 6
;;
;; notice that CPS returns results in order
;; (cps-fold cons-em! '() '(1 2 3) identity)
;; => (1 2 3)
;; Write `map` 3 different ways
; a simple mapper (aka a function you'd pass to map)
(define add-one
(lambda (n)
(add1 n)))
; an easy cps finalizer
(define identity
(lambda (x) x))
;; MAP V1: consing on to the recursion
(define map
(lambda (l fun)
(cond
((null? l) '())
(else
(cons (fun (car l))
(map (cdr l) fun))))))
;; MAP V2: accumulate & reverse
(define map-with-acc
(lambda (l fun)
(map-with-acc-helper '() l fun)))
(define map-with-acc-helper
(lambda (acc l fun)
(cond
((null? l) (reverse acc))
(else
(map-with-acc-helper
(cons (fun (car l)) acc)
(cdr l)
fun)))))
;; MAP V3: with CPS
(define map-with-col
(lambda (l fun col)
(cond
((null? l) (col '()))
(else
(map-with-col (cdr l)
fun
(lambda (acc)
(col (cons (fun (car l)) acc))))))))
;(map '(1 2 3) add-one)
;(map-with-acc '(1 2 3) add-one)
;(map-with-col '(1 2 3) add-one identity)
(define identity
(lambda (x) x))
(define concat
(lambda (l1 l2)
(concat-helper l1 l2 identity)))
(define concat-helper
(lambda (l1 l2 acc-f)
(cond
((null? l1) (acc-f l2))
(else
(concat-helper (cdr l1)
l2
(lambda (cont)
(acc-f (cons (car l1) cont))))))))
;(concat '(1 2 3) '(4 5 6))
(define map
(lambda (map-f l)
(cond
((null? l) '())
(else
(cons (map-f (car l))
(map map-f (cdr l)))))))
(define fold
(lambda (fold-f acc l)
(cond
((null? l) acc)
(else
(fold fold-f
(fold-f acc (car l))
(cdr l))))))
(define mapcat
(lambda (map-f lol)
(fold (lambda (acc l)
(concat acc (map map-f l)))
'()
lol)))
(mapcat add1 '((1 2 3) (4 5 6)))
# mapcat in Elixir using CPS
defmodule My do
defp map_with_cps(_, [], acc_f), do: acc_f
defp map_with_cps(map_f, [h|t], acc_f) do
map_with_cps(
map_f,
t,
fn (acc) -> acc_f.([map_f.(h) | acc]) end
)
end
# mapcat without concat/merge, using CPS
def mapcat(map_f, lol) do
List.foldl(
lol,
&(&1),
fn (l, acc) -> map_with_cps(map_f, l, acc) end
).([])
end
end
[2, 3, 4, 5, 6, 7] = My.mapcat &(&1 + 1), [[1, 2, 3], [4, 5, 6]]
;; tl;dr fold is a fucking workhorse.
;; I wanted to write mapcat without using or writing my own concat or merge.
;; My first attempts failed, so I thought I'd try to use CPS.
;; mapcat works on lists of lists, and I soon realized that I wanted to
;; "replay" the continuation for each subsequent head of the list.
;; I also realized that I wanted to "seed" the very first run with a particular value.
;; I failed until I realized that what I wanted to do was fold.
;; I'd seed with the core-func of the continuation (identity), and keep folding the
;; the continuation-result until I got to the end of the list.
;; I need to spend time with this. I wrote it, but I'm not super comfortable with it yet.
(define identity (lambda (x) x))
(define fold
(lambda (reducer acc l)
(cond
((null? l) acc)
(else
(fold reducer
(reducer acc (car l))
(cdr l))))))
(define -map-with-cps
(lambda (map-f l acc-f)
(cond
((null? l) acc-f) ;; returning the continuation to be fold'd instead of applying it to the empty list
(else
(-map-with-cps map-f
(cdr l)
(lambda (acc)
(acc-f (cons (map-f (car l)) acc))))))))
(define mapcat
(lambda (map-f lol)
((fold
(lambda (acc l)
(-map-with-cps map-f l acc))
identity
lol)
'())))
(mapcat add1 '((1 2 3) (4 5 6) (7 8 9)))
;; this is more map than fold. look at the structure.
;; i am repeating `(fun acc (car l))`,
(define mapfold
(lambda (acc l fun)
(cond
((null? l) '())
(else
(cons (fun acc (car l))
(mapfold (fun acc (car l))
(cdr l)
fun))))))
(define sum-of-prefixes
(lambda (lon)
(mapfold 0 lon (lambda (acc n) (+ acc n)))))
; (sum-of-prefixes '(1 1 1 1 1))
;; trying more from the fold side of things...
(define fold
(lambda (fold-f acc l)
(cond
((null? l) acc)
(else
(fold fold-f
(fold-f acc (car l))
(cdr l))))))
;; I don't really have a mapfold like above, because it's just calling fold.
;; The onus is on the reducer, in this case.
;; I don't like that the reducer has to ask (null? acc) each time.
(define sum-of-prefixes
(lambda (tup)
(reverse
(fold (lambda (acc n)
(cond
((null? acc) (cons n '()))
(else
(cons (+ n (car acc)) acc))))
'()
tup))))
(sum-of-prefixes '(1 2 3 4 5))
(define mk-eq
(lambda (x)
(lambda (y)
(eq? x y))))
(define filter
(lambda (filter-f l)
(letrec ((FILTER (lambda (l)
(cond
((null? l) '())
((filter-f (car l))
(FILTER (cdr l)))
(else
(cons (car l)
(FILTER (cdr l))))))))
(FILTER l))))
(define multirember
(lambda (a lat)
(filter (mk-eq a) lat)))
(multirember 'c '(a c d c))
;; notes fold takes a binary function
(define identity
(lambda (x) x))
;; polya: solve something easier first.
(define adder
(lambda (l)
(adder-helper 0 l identity)))
(define adder-helper
(lambda (final l cont-f)
(cond
((null? l) (cont-f final))
(else
(adder-helper final
(cdr l)
(lambda (acc)
(cont-f (+ acc (car l)))))))))
(define fold-right
(lambda (fold-f acc l)
(fold-right-helper fold-f acc l identity)))
(define fold-right-helper
(lambda (fold-f terminating-value l cont-f)
(cond
((null? l) (cont-f terminating-value))
(else
(fold-right-helper fold-f
terminating-value
(cdr l)
(lambda (acc)
(cont-f (fold-f acc (car l)))))))))
(fold-right (lambda (acc e)
(begin
(display e)
(display "\n"))
(+ acc e))
0
'(1 2 3))
;; CPS sets up collections to be folded from the right; you pass in the resulting matryoshka doll function the terminating
;; value (eg 0, or '() etc) and it essentially right folds its way back to the the first element and finally the
;; core-func
;; using fold to define map & filter.
(define fold
(lambda (fold-f acc l)
(cond
((null? l) acc)
(else
(fold fold-f
(fold-f acc (car l))
(cdr l))))))
(define map
(lambda (map-f l)
(reverse
(fold (lambda (acc e)
(cons (map-f e) acc))
'()
l))))
(define filter
(lambda (filter-f l)
(reverse
(fold (lambda (acc e)
(cond
((filter-f e)
(cons e acc))
(else acc)))
'()
l))))
; (map add1 '(1 2 3))
; (filter (lambda (n) (> n 3)) '(1 2 3 4 5))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.