combinators using case-lambda and more point library procedures

Hello,

Here are bi, bi@, and 2bi defined using case-lambda. Since they're
procedures as opposed to syntax like in my previous note, we can use
utilities like cut with them.

(define bi

(case-lambda

((x f g c)
(c (f x)
(g x)))

((f g c)
(lambda (x)
(bi x f g c)))

((f g)
(lambda (c)
(bi f g c)))

((c)
(lambda (f g)
(bi f g c)))

(()
(lambda (c)
(bi c)))))

(define bi@

(case-lambda

((x y f c)
(c (f x)
(f y)))

((f c)
(lambda (x y)
(bi@ x y f c)))))

(define 2bi

(case-lambda

((x y f g c)
(c (f x y)
(g x y)))

((f g c)
(lambda (x y)
(2bi x y f g c)))

((f g)
(lambda (c)
(2bi f g c)))

((c)
(lambda (f g)
(2bi f g c)))))

Let's bootstrap our point datatype:

(define point (cut vector 'point <> <>))

(define point-x (cut vector-ref <> 1))

(define point-y (cut vector-ref <> 2))

I defined a way to add two points in a previous note. We actually want
similar procedures for -, *, and / as well.

(define (binary-point-op op) (bi@ point-x point-y (cut bi@ <> op) (2bi
point)))

(define point+ (binary-point-op +))
(define point- (binary-point-op -))
(define point* (binary-point-op *))
(define point/ (binary-point-op /))

Now, what about point+n? I.e. add a point and some number by adding
the number component-wise.

(define (point+n a n)
(point (+ (point-x a) n)
(+ (point-y a) n)))

This looks mighty similar to:

(define (point+ a b)
(point (+ (point-x a) (point-x b))
(+ (point-y a) (point-y b))))

Referencing the binary-point-op combinator, this part of it:

(cut bi@ <> op)

is what needs to change. Instead of applying the selector
(point-x or point-y) to both arguments, we only want to apply it to
the "first" argument. So we'll introduce another combinator
(also from stack languages).

(dip x y f c) => (c (f x) y)

I.e. if x and y are on the stack, apply f to x, and leave y on the
stack.

The case-lambda version to allow for currying:

(define dip

(case-lambda

((x y f c)
(c (f x)
y))

((f c)
(lambda (x y)
(dip x y f c)))))

Now we're ready to define point+n and friends:

(define (point-n-op op) (bi@ point-x point-y (cut dip <> op) (2bi
point)))

(define point+n (point-n-op +))
(define point-n (point-n-op -))
(define point*n (point-n-op *))
(define point/n (point-n-op /))

I showed norm in a previous note:

(define norm (bi point-x point-y (bi@ sq (compose sqrt +))))

What about normalize?

(define normalize (bi identity norm point/n))

dot product? There are a couple of ways to approach it. While thinking
about it, I thought I'd need a 'uni' combinator. I.e. whereas:

(bi x f g c) => (c (f x) (g x))

uni is:

(uni x f c) => (c (f x))

I.e. it's just compose. 2uni would be:

(2uni x y f c) => (c (f x y))

By the way the meaning of the numeric prefix on the concatenative
combinators indicates the arity of the procedures they take.

Also, names with a numeric prefix aren't allowed by many
implementations. These examples do work in Chicken. I left the names
the same to help understanding when comparing with the similar
combinators from other stack languages.

OK, back to dot product:

(define dot (2uni point* (bi point-x point-y +)))

or with compose:

(define dot (compose (bi point-x point-y +) point*))

Ed