; == 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 and == ; ^^^^^^^^^^^^^ ^^^^^^^^^^^^^^^^^^^ ( 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 =========