Skip to content

Instantly share code, notes, and snippets.

@ijp
Last active December 23, 2015 01:39
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save ijp/6561748 to your computer and use it in GitHub Desktop.

Taylanub Homework

Day 1 Remove

Write Remove

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?).

Sharing

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.

Fold Right

Rewrite your one of your versions of this procedure as a right fold

Day 2: Functional Logging

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."))

Composition

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."

Identity

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."

less typing

Some Scheme functions like +, append, and compose take zero or more arguments. Extend join-loggers in a similar way.

lifting normal procedures

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."

arbitary logging

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."

My Solutions

Day 1

A

(define (remove a list)
  (if (null? list)
      '()
      (if (eqv? a (car list))
          (cdr list)
          (cons (car list)
                (remove a (cdr list))))))

B

(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)))

C

(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.

Day 2

(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)))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment