scheme 符号求导程序

SICP 习题：

#lang scheme

( define ( variable? x )
   ( symbol? x ) )

( define ( same-variable? x y )
   ( and ( variable? x )
         ( variable? y )
         ( eq? x y ) ) )

( define ( =number? exp num )
   ( and ( number? exp )
         ( = exp num ) ) )

( define ( addend x )
   ( cadr x ) )

( define ( augend x )
   ( if ( null? ( cdddr x ) )
        ( caddr x )
        ( cons '+ ( cddr x ) ) ) )

( define ( sum? x )
   ( and ( pair? x )
         ( eq? ( car x ) '+ ) ) )

( define ( make-sum x y )
   ( cond
      [ ( =number? x 0 ) y ]
      [ ( =number? y 0 ) x ]
      [ ( and ( number? x )
              ( number? y ) )
        ( + x y ) ]
      [ else
        ( list '+ x y ) ] ) )

( define ( multiplier x )
   ( cadr x ) )

( define ( multiplicand x )
   ( if ( null? ( cdddr x ) )
        ( caddr x )
        ( cons '* ( cddr x ) ) ) )

( define ( product? x )
   ( and ( pair? x )
         ( eq? ( car x ) '* ) ) )

( define ( make-product x y )
   ( cond
      [ ( or ( =number? x 0 )
             ( =number? y 0 ) ) 0 ]
      [ ( =number? x 1 ) y ]
      [ ( =number? y 1 ) x ]
      [ ( and ( number? x )
              ( number? y ) )
        ( * x y ) ]
      [ else
        ( list '* x y ) ] ) )

( define ( exponentiation? exp )
   ( and ( pair? exp )
         ( eq? ( car exp ) '** ) ) )  

( define ( base exp )
   ( cadr exp ) )

( define ( exponent exp )
   ( caddr exp ) )

( define ( make-exponentiation base exp )
   ( cond
      [ ( =number? base 1 ) 1 ]
      [ ( =number? exp 1 ) base ]
      [ ( =number? exp 0 ) 1 ]
      [ else
        ( list '** base exp ) ] ) )

( define ( deriv expr var )
   ( cond
      [ ( number? expr ) 0 ]
      [ ( variable? expr )
        ( if ( same-variable? expr var ) 1 0 ) ]
      [ ( sum? expr )
        ( make-sum ( deriv ( addend expr ) var )
                   ( deriv ( augend expr ) var ) ) ]
      [ ( product? expr )
        ( make-sum ( make-product ( multiplier expr )
                                  ( deriv ( multiplicand expr ) var ) )
                   ( make-product ( deriv ( multiplier expr ) var )
                                  ( multiplicand expr ) ) ) ]
      [ ( exponentiation? expr )
        ( make-product ( make-product ( exponent expr )
                                      ( make-exponentiation ( base expr )
                                                            ( make-sum ( exponent expr ) -1 ) ) )
                       ( deriv ( base expr ) var ) ) ]
      [ else
        ( error "unkown exp" expr ) ] ) )


( deriv '( + 1 x ) 'x )
( deriv '( * ( * x y )
             ( + x 3 ) ) 'x )
( deriv '( * x y ( + x 3 ) ) 'x )