; == CSI 3125, Fall 2001, Homework 3 ==
; ==   solved by Stan Szpakowicz   ==


; ======== Problem 1 ========

( define ( mirror L )
  ( if ( list? L )
    ( mirror_ L )
    'cannot-flip-non-lists
) )

( define ( mirror_ L )
   ( cond
      ( ( not ( list? L ) ) L )
      ( ( null? L ) L )
      ( else ( append
                ( mirror_ ( cdr L ) )
                ( list ( mirror_ ( car L ) ) )
)  )  )      )

; == test cases ==

; (mirror '((a b) (c (d e))))
; (mirror '(ten and 0.5 (less (three minus ((three quarters) plus 5))) gives 13.25))

; -- error checking
; (mirror 'nonlist)
; (mirror 192)



; ======== Problem 2 ========

( define ( combine-pairs F L )
  ( if ( even-length-list? L )
    ( combine-pairs_ F L )
    'not-an-even-length-list
) )

( define ( even-length-list? L )
  ( if ( list? L )
    ( even? ( length L ) )
    #f
) )

( define ( combine-pairs_ F L )
  ( if
    ( null? L )
    ()
    ( cons
       ( F ( car L ) ( cadr L ) )
       ( combine-pairs_ F ( cddr L ) )
) ) )

; == test cases ==

; (combine-pairs + '(1 2 3 4 5 6))
; (combine-pairs string '(#\a #\b #\c #\d))
; (combine-pairs list '(a b c d e f))
; (combine-pairs (lambda (x y) (list y x)) '(a b c d e f))

; -- error checking
; (combine-pairs + '(1 2 3 4 5))
; (combine-pairs string #\a)



; ======== Problem 3 ========

; ==== the main function ====

( define ( interpret )
  ( analyze ( read-tokens ) )
)


; ==== a simple tokenizer ====

( define ( read-tokens )
  ( read-tokens-aux ( read ) )
)

( define ( read-tokens-aux last-token )
  ( if
    ( eq? '$ last-token )
    ()
    ( cons
      last-token
      ( read-tokens-aux ( read ) )
) ) )


; ==== the top-level "switch" ====

( define ( analyze exprl )
  ( cond
    ( ( null? exprl )
      'no-expression )
    ( ( eq? '[ ( car exprl ) )
      ( if ( correct-matrix-expr? exprl )
        ( print-list ( calculate-matrix exprl ) )
        'wrong-matrix-expression
    ) )
    ( ( number? ( car exprl ) )
      ( if ( correct-scalar-expr? exprl )
        ( print-list ( list ( calculate-scalar exprl ) ) )
        'wrong-scalar-expression
    ) )
    ( else
      'wrong-expression
    )
) )


; ==== data checking, scalar expressions ====

( define ( correct-scalar-expr? exprl )
; exprl is not empty
  ( if ( null? ( cdr exprl ) )
    ( number? ( car exprl ) )
    ( if ( and ( number? ( car exprl ) )
               ( operator? ( cadr exprl ) ) )
      ( correct-scalar-expr? ( cddr exprl ) )
      #f
) ) )

( define ( operator? x )
  ( or ( eq? x '+ ) ( eq? x '- ) )
)

; ==== data checking, matrix expressions ====
; == (incomplete -- see scan-matrix) ==

( define ( correct-matrix-expr? exprl )
  ( let ( ( length-exprl ( length exprl ) )
        )
    ( cond
      ( ( = 9 length-exprl )
        ( null? ( scan-matrix exprl ) ) )
      ( ( < 9 length-exprl )
        ( correct-matrix-expr-tail? ( scan-matrix exprl ) ) )
      ( else
        #f )
) ) )

; == a stub (to be completed, maybe :>) ==

( define ( scan-matrix exprl )
  ( get-others exprl )
; -- get-others is defined at the bottom
)

( define ( correct-matrix-expr-tail? exprl )
  ( if ( operator? ( car exprl ) )
    ( correct-matrix-expr? ( cdr exprl ) )
    #f
) )


; == printing (inspired by "do-for-all") ==

( define ( print-list lst )
  ( if ( null? lst )
    ( newline )
    ( let ( ( dummy1 ( display ( car lst ) ) )
            ( dummy2 ( display #\space ) )
          )
          ( print-list ( cdr lst ) )
) ) )


; ==== scalar expressions ====
; == direct calculation with left-associativity ==

; -- (a parser with embedded calculations would
; --  automatically take care of associativity :>)

; == cut into <scalar_expr> and <operator> <scalar> ==
;             ^^^^^^^^^^^^^     ^^^^^^^^^^^^^^^^^^^

( define ( without-last-two lst )
  ( if ( null? ( cddr lst ) )
    ()
    ( cons ( car lst )
           ( without-last-two ( cdr lst ) )
) ) )

( define ( last-two lst )
  ( if ( null? ( cddr lst ) )
    lst
      ; the last operator and the last operand
    ( last-two ( cdr lst ) )
) )

; == the calculation, a clean version ==

; ( define ( calculate-scalar exprl )
;   ( if ( null? ( cdr exprl ) )
;     ( car exprl )
;     ( if ( eq? '+ ( car ( last-two exprl ) ) )
;          ( + ( calculate-scalar ( without-last-two exprl ) )
;              ( cadr ( last-two exprl ) )
;          )
;          ( - ( calculate-scalar ( without-last-two exprl ) )
;              ( cadr ( last-two exprl ) )
;          )
; ) ) )

; == an efficient version, with "let" ==

( define ( calculate-scalar exprl )
  ( if ( null? ( cdr exprl ) )
    ( car exprl )   ; one number
    ( let ( ( front ( without-last-two exprl ) )
            ( back ( last-two exprl ) )
          )
          ( if ( eq? '+ ( car back ) )
                      ; the rightmost operator
               ( + ( calculate-scalar front )
                   ( cadr back )
               )
               ( - ( calculate-scalar front )
                   ( cadr back )
               )
          )
    )
) )

; ==== simplify the matrix, then calculate by parts ====

( define ( calculate-matrix exprl )
  ( calculate-parts ( simplify-matrix exprl ) ) 
)


; ==== matrix expressions ====
; ==== calculate by parts ====
; -- insert the matrix delimiters

( define ( calculate-parts matrixl )
  ( list
    '[
    ( calculate-scalar ( extract-element-expr matrixl 1 ) )
    '/
    ( calculate-scalar ( extract-element-expr matrixl 2 ) )
    '&
    ( calculate-scalar ( extract-element-expr matrixl 3 ) )
    '/
    ( calculate-scalar ( extract-element-expr matrixl 4 ) )
    ']
) )

; ==== extract one "thread" ====

( define ( extract-element-expr matrixl n )
  ( if ( null? ( cdr matrixl ) )
    ( list ( nth ( car matrixl ) n ) )
    ( cons ( nth ( car matrixl ) n )
           ( cons ( cadr matrixl )  ; the operator
                  ( extract-element-expr ( cddr matrixl ) n )
    )      )
) )

; ==== extract one of four ====

( define ( nth eleml n )
  ( if ( = 1 n )
    ( car eleml )
    ( nth ( cdr eleml ) ( - n 1 ) )
) )

; ==== convert a matrix expression into simpler lists ====
; -- skip the delimiters
; -- a parser would do it more cleanly (:<)

; -- these test data:
; [ 2.2 / 3 & -5.2 / 1 ] - [ 3.1 / 1 & 6.4 / 9 ] + [ 1 / 1 & 2 / 2 ] $
; -- give this result:
; ( ( 2.2 3 -5.2 1 ) - ( 3.1 1 6.4 9 ) + ( 1 1 2 2 ) )

( define ( simplify-matrix exprl )
  ( if ( null? exprl )
    ()
    ( cons ( get-first exprl )
           ( let ( ( tail ( get-others exprl ) ) )
                 ( if ( null? tail )
                      ()
                      ( cons ( car tail )
                             ( simplify-matrix ( cdr tail ) )
                 )    )
    )      )
) )

; == get the first matrix, skipping all delimiters ==
; -- for clarity, defined in small steps

( define ( get-first exprl )
  ( cons ( cadr exprl ) ( get-first-2 ( cddr exprl ) ) )
) 

( define ( get-first-2 exprl )
  ( cons ( cadr exprl ) ( get-first-3 ( cddr exprl ) ) )
) 

( define ( get-first-3 exprl )
  ( cons ( cadr exprl ) ( get-first-4 ( cddr exprl ) ) )
) 

( define ( get-first-4 exprl )
  ( list ( cadr exprl ) )
)

; -- this is defined _only_ for clarity

( define ( get-others exprl )
  ( cdddr ( cdddr ( cdddr exprl ) ) )
)


; == test cases ==

; ( interpret )
; 3.25 + 4 - 2.5 + 7.1 $
; ( interpret )
; [ 2.2 / 3 & -5.2 / 1 ] - [ 3.1 / 1 & 6.4 / 9 ] + [ 1 / 1 & 2 / 2 ] $

; -- error checking

; ( interpret )
; $

; ( interpret )
; a b c $

; ( interpret )
; 3.25 + 4 - a + 7.1 $
; ( interpret )
; 3.25 + 4  2.5 + 7.1 $

; ( interpret )
; [ 2.2 / 3 & -5.2 ] - [ 3.1 / 1 & 6.4 / 9 ] $

; ( interpret )
; [ 2.2 / 3 & -5.2 / 1 ] * [ 3.1 / 1 & 6.4 / 9 ] $

; ( interpret )
; [ 2.2 / 3 & -5.2 / 1 ] * [ 3.1 / 1 / 0 & 6.4 / 9 ] $


; ========= The End =========