<< Previous exercise (2.84) | Index | Next exercise (2.86) >>


 ;; add into rational package 
 (put 'project 'rational 
      (lambda (x) (make-scheme-number (round (/ (numer x) (denom x)))))) 
 ;; add into real package 
 (put 'project 'real 
      (lambda (x)  
        (let ((rat (rationalize  
                     (inexact->exact x) 1/100))) 
            (numerator rat) 
            (denominator rat))))) 
 ;; add into complex package 
 (put 'project 'complex 
      (lambda (x) (make-real (real-part x)))) 
 (define (drop x) 
   (let ((project-proc (get 'project (type-tag x)))) 
     (if project-proc 
       (let ((project-number (project-proc (contents x)))) 
         (if (equ? project-number (raise project-number)) 
           (drop project-number) 
 ;; apply-generic 
 ;; the only change is to apply drop to the (apply proc (map contents args))  
 (drop (apply proc (map contents args))) 

The previous solution did not work for me. Because I define raise in terms of apply-generic, so if I add drop to the result, it will enter an infinite loop. This also fails for equ? function, becuase you can't drop #t or #f.

 ; First, project, the procject package and drop. 
 (define (project arg) 
   (apply-generic 'project arg)) 
 (define (install-project-package) 
   ;; internal procedures 
   (define (complex->real x) 
     (make-real (real-part x))) 
   (define (real->integer x) 
     (round x)) 
   (define (rational->integer x) 
     (round (/ (car x) (cdr x)))) 
   ;; interface with system 
   (put 'project '(complex) 
        (lambda (x) (complex->real x))) 
   (put 'project '(real) 
        (lambda (x) (real->integer x))) 
   (put 'project '(rational) 
        (lambda (x) (rational->integer x))) 
 (define (drop arg) 
   (cond ((eq? (type-tag arg) 'scheme-number) arg) 
         ((equ? arg (raise (project arg))) 
          (drop (project arg))) 
         (else arg))) 
 ;; Here is my complete apply generic function. The change is the If statement 
 ;; after proc. It tests to see if it is a 'raise operation, or an 'equ?  
 ;; operation. If it is, is keeps the result as is, else it "drop"s it.  
  (define (apply-generic op . args) 
    (define (higher-type types) 
      (define (iter x types) 
        (cond ((null? types) x) 
              ((> (level x) (level (car types))) 
               (iter x (cdr types))) 
               (iter (car types) (cdr types))))) 
      (if (null? (cdr types)) (car types) (iter (car types) (cdr types)))) 
    (define (raise-args args level-high-type) 
      (define (iter-raise arg level-high-type) 
        (if (< (level (type-tag arg)) level-high-type) 
            (iter-raise (raise arg) level-high-type) 
      (map (lambda (arg) (iter-raise arg level-high-type)) args)) 
    (define (not-all-same-type? lst) 
      (define (loop lst) 
        (cond ((null? lst) #f) 
              ((eq? #f (car lst)) #t) 
              (else (loop (cdr lst))))) 
      (loop (map (lambda (x) (eq? (car lst) x)) 
                 (cdr lst)))) 
    (let ((type-tags (map type-tag args))) 
      (let ((proc (get op type-tags))) 
        (if proc                  
            (let ((res (apply proc (map contents args)))) 
              (if (or (eq? op 'raise) (eq? op 'equ?)) res (drop res))) 
            (if (not-all-same-type? type-tags) 
                (let ((high-type (higher-type type-tags))) 
                  (let ((raised-args (raise-args args (level high-type)))) 
                    (apply apply-generic (cons op raised-args)))) 
                 "No Method for these types -- APPLY-GENERIC" 
                 (list op type-tags))))))) 

The solution from Rptx looks like if there is a bug in his hierarchy. Hierarchy should be : integer -> rational -> real -> complex.
The solution looks like:

  • integer -> rational
  • integer -> real -> complex
    A complex number cant be dropped to a rational number.

I think there is a bug in meteorgans solution. The line

 (if (equ? project-number (raise project-number))) 

Example: Drop the rational number 7/2.

  • Apply 'project on 7/2 results in '4' "(round (/ 7 2))".
  • Apply 'raise on 4 results in '4/1'. See 'raise from previous ex.:
 (put 'raise 'integer (lambda (x) (make-rational x 1))) 

Applying equ? on '4' and '4/1' returns #t, where '4/1' is definetly not equal to '7/2'. The raised object should be compared to the original object to check if the result of raising the dropped object equals the original. In Scheme:

 (if (equ? (raise project-number) x)) 

Also: integers are ordinary numbers. So... a rational number can only be dropped to an integer if the denom is 1. For example: 7/1 can be dropped. 5/1 can be dropped. 1/3 can't be dropped. So you dont have to calculate the rounded value. Instead, just create an ordinary number with (numer x) and check if its raised value is the same as the original.

 ;;; rational package 
 (put 'project 'rational (lambda (x) (make-integer (numer x)))) 


  • 7/2 => 7, (raise 7) => 7/1, (equ? 7/1 7/2) => #f
  • 7/1 => 7, (raise 7) => 7/1, (equ? 7/1 7/1) => #t