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