;;; Problem 1-4. Sequences and Higher-order Functions.
(set 1> "1>") (set 1= "1=") ; Hack, hack.
;;; 1-4-a NEW-APPEND and NEW-REVERSE.
;;; (NEW-APPEND s1 s2) appends the sequences S1 and S2 together.
(define NEW-APPEND
(lambda [seq1 seq2]
(if (null seq1)
seq2
(cons (first seq1)
(new-append (rest seq1) seq2)))))
; Tests:
1> (new-append [1 2 3] [4 5 6])
1= [1 2 3 4 5 6]
1> (new-append [] [1])
1= [1]
1> (new-append [1] [])
1= [1]
;;; (NEW-REVERSE s) reverses the sequence S.
(define NEW-REVERSE
(lambda [seq]
(if (null seq)
seq
(append (new-reverse (rest seq))
(list (first seq))))))
; Tests:
1> (new-reverse [])
1= []
1> (new-reverse [1 2 3 4])
1= [4 3 2 1]
;;; 1-4-b The lunatic FRINGE.
;;; (FRINGE s) returns a simple sequence of numbers at the
;;; leaves of S, a sequence of numbers and sequences.
; Version 1:
(define FRINGE
(lambda [seq]
(cond [(null seq) []]
[(number (first seq))
(cons (first seq) (fringe (rest seq)))]
[$true (append (fringe (first seq))
(fringe (rest seq)))])))
; Tests:
1> (fringe [])
1= []
1> (fringe [1 2 3])
1= [1 2 3]
1> (fringe [[[1]]])
1= [1]
1> (fringe [1 [2] [[3]]])
1= [1 2 3]
; Version 2: Generalize FRINGE slightly by decreeing
; that FRINGE of a number is the sequence containing that
; number. This permits the following slightly simpler
; formulation.
(define FRINGE-2
(lambda [x]
(cond [(number x) [x]]
[(null x) []]
[$true (append (fringe-2 (first x))
(fringe-2 (rest x)))])))
; Tests:
1> (fringe-2 10)
1= [10]
1> (fringe-2 [])
1= []
1> (fringe-2 [1 2 3])
1= [1 2 3]
1> (fringe-2 [[[1]]])
1= [1]
1> (fringe-2 [1 [2] [[3]]])
1= [1 2 3]
;;; 1-4-c Objectified arguments.
; Examples from the preamble to 1-4-c:
1> (+ . (rest (rest [1 2 3 4])))
1= 7
1> (let [[x [10 20 30]]] (+ . (rest x)))
1= 50
1> (** 2 3)
1= 8
1> (let [[x [2 3]]] (** . x))
1= 8
1> (let [[x [2 3]]] (** . (reverse x)))
1= 9
(define TEST (lambda args args))
1> (test 1)
1= [1]
1> (test (+ 1 1) (+ 2 2))
1= [2 4]
1> (test . (* 3 3))
1= 9
;;; (HOW-MANY a1 a2 ... an) returns the number or arguments
;;; passed in.
(define HOW-MANY
(lambda args
(if (sequence args)
(length args)
(error "objectified arguments" ↑args))))
; Tests:
1> (how-many)
1= 0
1> (how-many 10 20 30)
1= 3
1> (how-many (+ 2 2))
1= 1
1> (how-many . 1)
*** Error: objectified arguments
Error structure: (error "objectified arguments" ↑args)
Datum 1: 1
;;; 1-4-d Multi-argument version of +.
;;; (+! n1 n2 n3 ...) designates the sum of the numbers
;;; N1, N2, etc. For this version, there must be at least
;;; 2 arguments.
(define +!
(lambda args
(if (= (length args) 2)
(+ . args)
(+ (first args)
(+! . (rest args))))))
; Tests:
1> (+! 2 3)
1= 5
1> (+! 1 2 3 4 5)
1= 15
;;; 1-4-e Multi-argument version of *.
;;; (*! n1 n2 n3 ...) designates the product of the numbers
;;; N1, N2, etc. For this version, there must be at least
;;; 2 arguments.
(define *!
(lambda args
(if (= (length args) 2)
(* . args)
(* (first args)
(*! . (rest args))))))
; Tests:
1> (*! 2 3)
1= 6
1> (*! 1 2 3 4 5)
1= 120
;;; Do multi-argument versions of subtraction and division
;;; make sense? "Sense" could be made out of them (indeed APL
;;; does so), but its a much trickier matter dealing with
;;; non-associative and non-comutative operators.
; Correction: The problem set uses the term "fence-post error"
; in the context of a discussion of the more general class of
; errors that arise when dealing with limiting cases. The term
; normally refers to the subclass of "off by one errors" exemplified
; by the math problem "You have just purchased 100 feet of fencing
; material that you are going to attach to fence posts uniformly
; spaced 10 feet apart. How many fence posts will you going to
; need to build a 100 foot straight fence? [Think quickly.]
; What if you were building a square fence to enclose a yard?
; A triangular fence?"
;;; 1-4-f Multi-argument + and * revisited.
;;; The above definitions of +! and !* blow up if given no
;;; arguments. The natural extensions have (+!) nd (*!) returning
;;; 0 and 1, respectively. Here are the revised definitions:
;;; (+! n1 n2 n3 ...) designates the sum of the numbers
;;; N1, N2, etc. Any number of arguments are permitted.
(define +!
(lambda args
(if (null args)
0
(+ (first args)
(+! . (rest args))))))
; Tests:
1> (+!)
1= 0
1> (+! 100)
1= 100
1> (+! 2 3)
1= 5
1> (+! 1 2 3 4 5)
1= 15
;;; (*! n1 n2 n3 ...) designates the product of the numbers
;;; N1, N2, etc. Any number of arguments are permitted.
(define *!
(lambda args
(if (null args)
1
(* (first args)
(*! . (rest args))))))
; Tests:
1> (*!)
1= 1
1> (*! 66)
1= 66
1> (*! 2 3)
1= 6
1> (*! 1 2 3 4 5)
1= 120
;;; (MAXIMUM! n1 n2 n3 ...) designates the maximum of the numbers
;;; N1, N2, etc. There must be at least one argument.
(define MAXIMUM!
(lambda args
(if (null (rest args))
(first args)
(maximum (first args)
(maximum! . (rest args))))))
(define MAXIMUM
(lambda [n1 n2]
(if (< n1 n2) n2 n1)))
; Tests:
1> (maximum! 1)
1= 1
1> (maximum! 1 2 3)
1= 3
1> (maximum! 3 2 1)
1= 3
; (MAXIMUM!) would make sense if we had a designator for
; negative infinity (something smaller than all numbers).
; This is how APL handles it.
;;; 1-4-g Objectified arguments.
;;; Yes. It is quite simple to define a multi-argument
;;; addition procedure without using objectified arguments.
;;; To crucial capability is to be able to define a
;;; procedure that can *accept* an arbitrary number of
;;; arguments.
(letrec [[sum-sequence
(lambda [seq]
(if (null seq)
0
(+ (first seq)
(sum-sequence (rest seq)))))]]
(define +!
(lambda args
(sum-sequence args))))
; Tests:
1> (+!)
1= 0
1> (+! 100)
1= 100
1> (+! 2 3)
1= 5
1> (+! 1 2 3 4 5)
1= 15
;;; 1-4-h and 1-4-i MAP.
;;; Here is the definition of MAP that 3-Lisp actually uses:
(define map
(letrec
[[map-1-sequence
(lambda [fn seq]
(if (null seq)
seq
(cons (fn (first seq))
(map-1-sequence fn (rest seq)))))]
[map-all-sequences
(lambda [fn seqs]
(if (null (first seqs))
(first seqs)
(cons (fn . (map-1-sequence first seqs))
(map-all-sequences fn (map-1-sequence rest seqs)))))]]
(lambda args
(map-all-sequences (first args) (rest args)))))
; Tests:
1> (map +! [1 2 3])
1= [1 2 3]
1> (map +! [1] [2] [3])
1= [6]
1> (map +! [])
1= []
1> (map +! [1 2 3] [4 5 6] [7 8 9])
1= [12 15 18]
1> (map +!)
*** Error: non-null sequence (or rail) expected
Error structure: (first seqs)
Datum 1: {first closure}
Datum 2: [[]]
;;; It's difficult to ascribe any reasonable behaviour to
;;; (map !+).
;;; 1-4-j SPEAD
;;; ((SPEAD fn) e1 e2 ... en) is roughly the same as
;;; (fn e1 (f2 e2 ... (fn en-1 en)...)). FN must designate
;;; a function of two argument. The resulting function will
;;; accept two or more arguments.
(define SPREAD
(lambda [fn]
(lambda args
(if (= (length args) 2)
(fn . args)
(fn (first args)
((spread fn) . (rest args)))))))
; Tests:
1> ((spread +) 1 2 3)
1= 6
1> ((spread *) 4 5)
1= 20
; ((SPREAD +)) is an error.
;;; (SPREAD fn identity) is an improved version of SPREAD.
(define SPREAD
(lambda [fn identity]
(letrec [[spreader
(lambda args
(if (null args)
identity
(fn (first args)
(spreader . (rest args)))))]]
spreader)))
(define +! (spread + 0))
(define *! (spread * 1))
; Tests:
1> (+!)
1= 0
1> (+! 1 2 3 4 5)
1= 15
1> (*!)
1= 1
1> (*! 1 2 3 4 5)
1= 120
;;; 1-4-k APPEND!
(define NEW-LIST (spread cons []))
(define APPEND! (spread append []))
(define CONSTANT
(lambda [constant-value]
(lambda args constant-value)))
(define NEW-LENGTH
(lambda [seq]
((spread + 0) . (map (constant 1) seq))))
; Tests:
1> (new-list 1 2 3)
1= [1 2 3]
1> (new-list)
1= []
1> (append! [] [] [])
1= []
1> (append! [1 2 3] [4 5 6])
1= [1 2 3 4 5 6]
1> (append!)
1= []
1> ((constant 100) 200)
1= 100
1> (new-length [])
1= 0
1> (new-length [10 20 30])
1= 3
;;; End of solution to 1-4.