Your task today is very simple. Write a ‘remove’ procedure. It takes two arguments: a value, and a well formed list, and it should remove the left-most occurence of the value in the list (as determine by eqv?).
Rewrite the above procedure so that it shares as much of a tail as possible with the original procedure. In particular, if the element does not appear in the list, then the returned list should be eqv? to the argument list.
Rewrite your one of your versions of this procedure as a right fold
Essential to the idea of functional programming, is the idea that the output of a function is solely determined by the inputs. In practice, this means that functions should have no side effects. This poses an obvious problem for people who like to do “printf” debugging, so today we’re going to solve that problem.
So, we need to return some additional state for logging, that’s okay, our logger procedures will just return a second value.
(define (incr x)
(values (1+ x) "I'ma increment your value."))
(define (double x)
(values (* x 2)
"I'ma doublin' your value."))
Before, we could write new functions through composition like
(define 2x+1 (compose incr double))
but now we can’t do that. Write a join-loggers
function that
composes two logging functions. Like so
(define 2x+1 (join-loggers incr double)) (2x+1 5) ;; returns 11 and "I'ma doublin' your value.I'ma increment your value."
When writing higher order functions, it is useful to be able to have a “do nothing” option. In scheme, we can write
(define (identity x) x)
Write an identity-logger
logging function, that can be composed with
normal loggers using join-loggers
. Note that all three of the
following should return equal? values
(double 5)
((join-loggers identity-logger double) 5)
((join-loggers double identity-logger) 5)
;; all return 10 and "I'ma doublin' your value."
Some Scheme functions like +
, append
, and compose
take zero or
more arguments. Extend join-loggers
in a similar way.
We can’t easily use normal procedures with join-loggers
, write a
lift
function that turns a normal procedure of one argument into a
logging procedure.
(define (square x) (* x x))
((join-loggers incr (lift square) double) 10)
;; returns 401 and "I'ma doublin' your value.I'ma increment your value."
Write a procedure emit
, of one argument, which returns a logger that
logs that argument. Like so
((join-loggers incr (emit "mmm, pickles.") double) 2)
;; returns 5 and "I'ma doublin' your value.mmm, pickles.I'ma increment your value."
(define (remove a list)
(if (null? list)
'()
(if (eqv? a (car list))
(cdr list)
(cons (car list)
(remove a (cdr list))))))
(define (remove* a list)
;; list -> (values shared? list)
(define (rm list)
(cond ((null? list)
(values #t '()))
((eqv? a (car list))
(values #f (cdr list)))
(else
(call-with-values
(lambda ()
(rm (cdr list)))
(lambda (shared? rest)
(if shared?
(values #t list)
(values #f (cons (car list) rest))))))))
(call-with-values
(lambda () (rm list))
(lambda (_ lst) lst)))
(define (remove** a list)
(define (accum head pair)
(let ((full-tail (car pair))
(removed-tail (cdr pair)))
(if (eqv? a head)
(cons (cons head full-tail)
full-tail)
(cons (cons head full-tail)
(cons head removed-tail)))))
(cdr (fold-right accum (cons '() '()) list)))
HARD MODE. sharing and right folds
(define (remove*** a list)
(define (accum h t)
(let ((elem (car h))
(share? (car t))
(tail (cdr t)))
(cond ((eqv? elem a)
(cons #f (cdr h)))
(share?
(cons #t h))
(else
(cons #f (cons elem tail))))))
(cdr (fold-right accum (cons #t '())
(non-empty-tails list)
;(but-last (tails list))
)))
(define (non-empty-tails l)
(pair-fold-right cons '() l))
If you counter that a pair fold is cheating then
(define (non-empty-tails* l)
(reverse* (tails* l)))
(define (reverse* ls)
(cdr (fold-right (lambda (x y) (cons (cdar y)
(cons (caar y) (cdr y))))
(cons ls '())
ls)))
(define (tails* ls)
(cdr (fold-right (lambda (x y)
(cons (cdar y)
(cons (car y)
(cdr y))))
(cons ls '())
ls)))
I expect with proper application of fusion laws, and careful definitions, you can get a hideous thing that does one right fold, but I’m not going to attempt to calculate it.
(define (join-loggers* g f)
(lambda (x)
(call-with-values
(lambda () (f x))
(lambda (v s)
(call-with-values
(lambda () (g v))
(lambda (v* t)
(values v* (string-append s t))))))))
(define (identity-logger x)
(values x ""))
(define (join-loggers . args)
(fold-right join-loggers* identity-logger args))
(define (lift f)
(lambda (x)
(values (f x) "")))
(define (emit s)
(lambda (x)
(values x s)))