point free factorial
Name:
Anonymous
2012-11-14 4:47
(define (reduce op id lis)
(if (null? lis)
id
(reduce op (op id (car lis)) (cdr lis))))
(define (flip f)
(lambda (x y) (f y x)))
(define (curry f . args)
(lambda args2
(apply f (append args args2))))
(define (evaluate f x) (f x))
(define (compose . fns)
(let ((rev-fns (reverse fns)))
(lambda args
(reduce (flip evaluate) (apply (car rev-fns) args) (cdr rev-fns)))))
(define (collect . fns)
(lambda args
(map (curry (flip apply) args) fns)))
(define (wrap f . fns)
(compose (curry apply f) (apply collect fns)))
(define (if-fn condition true false)
(lambda args
(if (apply condition args)
(apply true args)
(apply false args))))
(define (constant-fn value)
(lambda args value))
(define (id x) x)
(define factorial-helper
(if-fn (compose (curry = 0) caddr list)
(compose cadr list)
(compose (wrap apply car id) (collect car (wrap * cadr caddr) (compose (curry (flip -) 1) caddr)) list)))
(define factorial (curry factorial-helper factorial-helper 1))
Name:
Anonymous
2012-11-15 2:18
I thought this would turn into a point free programming thread. What has happened to you /prog/?
Name:
Anonymous
2012-11-15 2:59
moar like pointless amirite?
>>2
i blaem REDDIT. &_&
Name:
Anonymous
2012-11-15 7:08
wow, that's a lot of pointy functions for ``point-free'' code.
Name:
Anonymous
2012-11-15 12:11
>>4
OMG OPTIMIZED
!
(define factorial-helper
(if-fn (compose (curry = 0) caddr list)
(compose cadr list)
(compose (curry apply apply) (collect car id) (collect car (compose (curry apply *) (collect cadr caddr)) (compose (curry (flip -) 1) caddr)) list)))
I'll try to get rid of if-fn. Replacing the conditional with a vector of functions should do.
(define factorial-helper
(if-fn (compose (curry = 0) caddr list)
(compose cadr list)
(compose (wrap apply car id) (collect car (wrap * cadr caddr) (compose (curry (flip -) 1) caddr)) list)))
Name:
Anonymous
2012-11-15 12:39
>>5
What about reduce, flip, curry, evaluate, compose, collect, wrap, and constant-fn? if-fn isn't the only function in
>>1 that's pointy.
Name:
Anonymous
2012-11-15 13:50
jesus fucking christ.
Name:
Anonymous
2012-11-15 19:16
point free factorial
(define (curry f . args)
What do you call that thing between f and args? Right in the Culver!
Name:
Anonymous
2012-11-15 20:15
More like........................pointLESS ha ha ha
Name:
Anonymous
2012-11-16 3:15
It wasn't easy, but I got rid of the conditional. I had to add exists? and all?
(define (all? . args)
(cond ((null? args) #t)
((not (car args)) (car args))
((null? (cdr args)) (car args))
(else (apply all? (cdr args)))))
(define (exists? . args)
(cond ((null? args) #f)
((car args) (car args))
((null? (cdr args)) (car args))
(else (apply exists? (cdr args)))))
(define factorial-helper
(compose (curry apply apply)
(collect (compose (curry vector-ref (vector (compose cadr list)
(compose (wrap apply car id)
(collect car
(wrap * cadr caddr)
(compose (curry (flip -) 1) caddr))
list)))
car)
(compose cadr))
(collect (compose unitize caddr) id)
list))
Name:
Anonymous
2012-11-16 3:17
forgot unitize. It maps zero to zero and all other numbers to one.
(define unitize (compose (curry (flip exists?) 1) (curry (flip all?) 0) (curry = 0)))
Name:
Anonymous
2012-11-16 3:24
inlined wrap.
(define factorial-helper
(compose (curry apply apply)
(collect (compose (curry vector-ref (vector (compose cadr list)
(compose (curry apply apply)
(collect car id)
(collect car
(compose (curry apply *)
(collect cadr caddr))
(compose (curry (flip -) 1) caddr))
list)))
car)
(compose cadr))
(collect (compose unitize caddr) id)
list))
Name:
Anonymous
2012-11-17 3:18
collect is now almost point free. At least it can be inlined at this point. Although I had to curry the curry function.
(define (collect . fns)
(compose (curry (flip map) fns) (curry curry (flip apply)) list))
Name:
Anonymous
2012-11-17 4:12
point free collect.
(define collect (compose (curry apply compose) (curry (flip cons) (list (curry curry (flip apply)) list)) (curry curry (flip map)) list))
Name:
Anonymous
2012-11-17 4:34
Ok, final draft. Isn't it beautifu?
(define (reduce op id lis)
(if (null? lis)
id
(reduce op (op id (car lis)) (cdr lis))))
(define (flip f)
(lambda (x y) (f y x)))
(define (curry f . args)
(lambda args2
(apply f (append args args2))))
(define (evaluate f x) (f x))
(define (compose . fns)
(let ((rev-fns (reverse fns)))
(lambda args
(reduce (flip evaluate) (apply (car rev-fns) args) (cdr rev-fns)))))
(define (all? . args)
(cond ((null? args) #t)
((not (car args)) (car args))
((null? (cdr args)) (car args))
(else (apply all? (cdr args)))))
(define (exists? . args)
(cond ((null? args) #f)
((car args) (car args))
((null? (cdr args)) (car args))
(else (apply exists? (cdr args)))))
(define (id x) x)
(define factorial-helper (compose (curry apply apply) ((compose (curry apply
compose) (curry (flip cons) (list (curry curry (flip apply)) list)) (curry
curry (flip map)) list) (compose (curry vector-ref (vector (compose cadr list)
(compose (curry apply apply) ((compose (curry apply compose) (curry (flip
cons) (list (curry curry (flip apply)) list)) (curry curry (flip map)) list)
car id) ((compose (curry apply compose) (curry (flip cons) (list (curry curry
(flip apply)) list)) (curry curry (flip map)) list) car (compose (curry apply
*) ((compose (curry apply compose) (curry (flip cons) (list (curry curry (flip
apply)) list)) (curry curry (flip map)) list) cadr caddr)) (compose (curry
(flip -) 1) caddr)) list))) car) (compose cadr)) ((compose (curry apply
compose) (curry (flip cons) (list (curry curry (flip apply)) list)) (curry
curry (flip map)) list) (compose (curry (flip exists?) 1) (curry (flip all?)
0) (curry = 0) caddr) id) list))
(define factorial (curry factorial-helper factorial-helper 1))
Name:
Anonymous
2012-11-17 8:21
>>15
A+++, would read again. Have considered writing a book on Design Patterns?
Name:
Anonymous
2012-11-17 12:50
>>16
Yes. It would be about managing the challenges that arise when writing factorial programs.
Name:
Anonymous
2012-11-17 13:46
>>15
reduce, flip, curry, evaluate, compose, all?, exists?, and id are all still pointy.
Name:
Anonymous
2012-11-17 13:48
>>18
It's ok if they are standard haskell functions. My only worry is that I curried curry.
Name:
Anonymous
2012-11-17 13:58
POINT MY ANUS
Name:
Anonymous
2012-11-17 14:46
Name:
Anonymous
2012-11-17 14:46
>>21
Why do you even care about doubles? Just curious.
Name:
Anonymous
2012-11-17 14:49
>>22
I am fascinated by numerical patterns. Repeating digits, Mersenne primes, etc.
Name:
Anonymous
2012-11-17 14:56
Name:
Anonymous
2012-11-17 15:08
Name:
Anonymous
2012-11-17 15:19
hgffhgghhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhh
Name:
Anonymous
2012-11-18 1:35
dup :: (a -> a -> b) -> (a -> b)
dup f x = f x x
if' :: Bool -> a -> a -> a
if' x y z = if x then y else z
fact :: Integer -> Integer
fact = dup(dup.(.(.fact.(+(-1))).(*)).(.).(`if'`1).(==0))
Of course, I could have just used product and enumFromTo, but where's the fun in that?
Name:
James Gosling
2013-05-20 8:26
GAWWZMACS FLABBERGASTS MY AUDIENCE
Name:
Anonymous
2013-05-20 14:57
Optimize your higher-order function definitions, Ahmed.
(define (reduce op id lis)
(if (null? lis)
id
(reduce op (op id (car lis)) (cdr lis))))
(define ((flip f) x y)
(f y x))
(define ((curry f . args) . args2)
(apply f (append args args2)))
(define (evaluate f x) (f x))
(define (compose . fns)
(let ((rev-fns (reverse fns)))
(lambda args
(reduce (flip evaluate) (apply (car rev-fns) args) (cdr rev-fns)))))
(define ((collect . fns) . args)
(map (curry (flip apply) args) fns))
(define (wrap f . fns)
(compose (curry apply f) (apply collect fns)))
(define ((if-fn condition true false) . args)
(if (apply condition args)
(apply true args)
(apply false args)))
(define ((constant-fn value) . args)
value)
(define (id x) x)
(define factorial-helper
(if-fn (compose (curry = 0) caddr list)
(compose cadr list)
(compose (wrap apply car id) (collect car (wrap * cadr caddr) (compose (curry (flip -) 1) caddr)) list)))
(define factorial (curry factorial-helper factorial-helper 1))
Name:
Anonymous
2013-05-21 5:16
Name:
Anonymous
2013-05-22 4:55