Feeds:
Posts
Comments

Archive for November, 2010

Exercise 2.81

If apply-generic is called with two arguments of type scheme-number or of type complex, and no operation is found for these types, than the coercion mechanism comes into play. As a result the type of one of the arguments gets coerced to itself and apply-generic is invoked with exactly the same pair of arguments. The result is an infinite recursive loop.

If, by convention, Mr. Reasoner never installs any coercion procedures from a type to itself than apply-generic will always terminate in a finite number of steps. However, if at some later point apply- generic becomes more elaborate, it might be useful for there to be “identity” coercions.

Here is a modified version of apply-generic that does not try to coerce arguments of the same type:

(define (apply-generic op . args)
  (let ((type-tags (map type-tag args)))
    (let ((proc (get op type-tags)))
      (if proc
          (apply proc (map contents args))
          (if (= (length args) 2)
              (let ((type1 (car type-tags))
                    (type2 (cadr type-tags))
                    (a1 (car args))
                    (a2 (cadr args)))
                (if (eq? type1 type2)
                    (error "No method for these types" (list op type-tags)))
                    (let ((t1->t2 (get-coercion type1 type2))
                          (t2->t1 (get-coercion type2 type1)))
                      (cond (t1->t2 (apply-generic op (t1->t2 a1) a2))
                            (t2->t1 (apply-generic op a1 (t2->t1 a2)))
                            (else (error "No method for these types" 
                                         (list op type-tags)))))
                (error "No method for these types" (list op type-tags))))))))




Exercise 2.82

This new version of apply-generic is capable of applying coercion not only in two argument cases but for any number of arguments. It consecutively scans the arguments and for each one attempts to coerce all other arguments to its type until an acceptable coercion is found or no more coercions are possible. Special precautions are taken to avoid infinite recursive loops as seen in the previous exercise:

(define (apply-generic op . args)
  (define (coercion-good? coerced-args)
    (let ((type-tags (map type-tag args))
          (coerced-type-tags (map type-tag coerced-args)))
      (and (not (equal? type-tags coerced-type-tags))
           (get op coerced-type-tags))))
  (define (coerce-argument to-type arg)
    (if (eq? to-type (type-tag arg))
        arg
        (let ((coerce-proc (get-coercion (type-tag arg) to-type)))
          (if coerce-proc 
              (coerce-proc arg)
              'failed))))
  (define (coerce-arguments to-type args)
    (if (null? args)
        '()
        (let ((coerced-arg (coerce-argument to-type (car args)))
              (coerced-args (coerce-arguments to-type (cdr args)))) 
          (if (or (eq? coerced-arg 'failed) (eq? coerced-args 'failed))
              'failed
              (cons coerced-arg coerced-args)))))
  (define (search rest)
    (if (null? rest) 
        #f
        (let ((coerced-args (coerce-arguments (type-tag (car rest)) args)))
          (if (and (not (eq? coerced-args 'failed))
                   (coercion-good? coerced-args))
              coerced-args
              (search (cdr rest))))))
  
  (let ((type-tags (map type-tag args)))
    (let ((proc (get op type-tags)))
      (if proc 
          (apply proc (map contents args))
          (let ((coerced-args (search args)))
            (if coerced-args 
                (apply apply-generic (cons op coerced-args))
                (error "No method for these types" (list op type-tags))))))))

To understand why this coercion strategy is still not general enough consider a situation where we try to apply some operation to two arguments of types a and b. Let the operation be defined only for arguments of type c. Since c is not among the initial argument types, no attempt will be made to coerce a to c and b to c.




Exercise 2.83

For types integer, rational, and real we register a raise operation in the operation table and define a generic raise that delegates its job to apply-generic:

(define (raise-integer x)
  (make-rational x 1))

(define (raise-rational x)
  (make-real (/ (* 1.0 (numer x)) (* 1.0 (denom x)))))

(define (raise-real x)
  (make-from-real-imag x 0))

(put 'raise '(integer) raise-integer)
(put 'raise '(rational) raise-rational)
(put 'raise '(real) raise-real)

(define (raise x) (apply-generic 'raise x))




Exercise 2.84

A new unary generic operation height is defined such that for any two types a and b (height a) is greater than (height b) if a is located above b in the tower of types. This allows apply-generic to check the height of its arguments and if necessary raise the lower one or both of them (if their heights are the same) until a matching operation is found or raising is no longer possible:

(put 'height '(integer)  (lambda (x) 0))
(put 'height '(rational) (lambda (x) 1))
(put 'height '(real)     (lambda (x) 2))
(put 'height '(complex)  (lambda (x) 3))

(define (height x) (apply-generic 'height x))

(define (apply-generic op . args)
  (let* ((type-tags (map type-tag args))
         (proc (get op type-tags)))
    (if proc
        (apply proc (map contents args))
        (if (= (length args) 2)
            (let* ((a1 (car args))
                   (a2 (cadr args))
                   (h1 (height a1))
                   (h2 (height a2)))
              (cond ((< h1 h2) (apply-generic (raise a1) a2))
                    ((> h1 h2) (apply-generic a1 (raise a2)))
                    (else (apply-generic (raise a1) (raise a2)))))
            (error "No method for these types -- APPLY-GENERIC" (op type-tags))))))




Exercise 2.85

There is some ambiguity in this exercise. On the one hand the authors suggest using the type tower from exercise 2.83 (integer -> rational -> real -> complex), and on the other, they talk about projecting reals directly onto integers, entirely forgetting about rational numbers.

I have decided not to skip rational numbers. To implement the projecting from reals to rationals I am using the rationalize and inexact->exact procedures provided by the Scheme system:

(define (project-complex x)
  (make-real (real-part x)))

(define (project-real x)
  (let ((scheme-rat (rationalize (inexact->exact x) 0.00001)))
    (make-rational (numerator x) (denominator x))))

(define (project-rational x)
  (make-integer (numer x)))

(put 'project '(complex) project-complex)
(put 'project '(real) project-real)
(put 'project '(rational) project-rational)

(define (project x) (apply-generic 'project x))

And here is the definition of the drop procedure:

(define (drop x)
  (if (and (get 'project (list (type-tag x)))
           (equ? (raise (project x)) x))
      (drop (project x))
      x))

The final part of the exercise is also a bit fishy. If apply-generic would actually apply drop to its result, then imagine what would happen if we execute the generic raise operation. The argument would first be raised and then immediately dropped down again. This would even cause an infinite recursive loop when apply-generic tries to coerce its arguments.

Probably the best that can be done is to leave apply-generic alone and instead choose whether to use drop when defining new generic operations. For example add, sub, mul, and div could have been defined as:

(define (add x y) (drop (apply-generic 'add x y)))
(define (sub x y) (drop (apply-generic 'sub x y)))
(define (mul x y) (drop (apply-generic 'mul x y)))
(define (div x y) (drop (apply-generic 'div x y)))




Exercise 2.86

To introduce the required changes to the system we need to redefine the internal procedures in the complex packages to use the generic add, sub, mul, and div operations instead of their built-in equivalents +, , *, and /. Furthermore, we have to define new generic operations for sine, cosine, arctan, square-root, and square:

(define (sine x)        (apply-generic 'sine x))
(define (cosine x)      (apply-generic 'cosine x))
(define (arctan x y)    (apply-generic 'arctan x y))
(define (square-root x) (apply-generic 'square-root x))
(define (square x)      (apply-generic 'square x))

Next we have to add implementations for these new operations in the Scheme-number and rational-number packages:

;;internal to the scheme number package
(put 'sine        '(scheme-number)      (lambda (x) (tag (sin x))))
(put 'cosine      '(scheme-number)      (lambda (x) (tag (cos x))))
(put 'arctan      '(scheme-number scheme-number) (lambda (x y) (tag (atan x y))))
(put 'square-root '(scheme-number)      (lambda (x) (tag (sqrt x))))
(put 'square      '(scheme-number)      (lambda (x) (tag (* x x))))

;;internal to the rational number package
(define (to-scheme-number x)
    (make-scheme-number (/ (* 1.0 (numer x) (denom x)))))

(put 'sine        '(rational) (lambda (x) (sine (to-scheme-number x))))
(put 'cosine      '(rational) (lambda (x) (cosine (to-scheme-number x))))
(put 'arctan      '(rational rational) 
     (lambda (x y) (arctan (to-scheme-number x) (to-scheme-number y))))
(put 'square-root '(rational) (lambda (x) (square-root (to-scheme-number x))))
(put 'square      '(rational) (lambda (x) (square (to-scheme-number x))))

Finally, we have to modify the polar and rectangular packages to use the new generic operations instead of their built-in counterparts.

Read Full Post »

XSLT 1.0 Sudoku Solver

Taking a dry academic course on XML and its derivatives is, not surprisingly, just plain old boring. But you still can create a little bit of fun for yourself.

A few days ago, while the lecturer was diligently enumerating the endless features of the different version of XSLT in front of the sleepy audience, a bright idea suddenly struck my mind. Why not implement a little Sudoku solver in this language?

During the next few days the picture of exactly what I wanted implemented started to take shape. It should be something simple, that would run in a regular browser without the need for any external XSLT processors. Clearly the only version of the language that could achieve this is XSLT 1.0. In a day or two I had a working “prototype” that relied on nothing more than named templates, conditionals and a little bit of “magic” XPath string manipulations. After gaining confidence that everything seemed to work as expected, a final transformation, to a “user-friendly” HTML output was added:

The algorithm implemented is just a brute-force backtracking search with some amount of pruning. The main challenge was to come up with the appropriate data-structures for representing the intermediate stages of the computation and to encode them as strings – particularly annoying was the fact that strings in XPath are indexed starting from one, which made the “index arithmetic” clumsier than it needed to be.

The performance varies according to how “tough” a puzzle is – the number of recursive calls required to reach a solution. Since the search does not employ any special heuristics, such as the “least constrained variable first”, the program’s measure of “tough” is not necessary the same as a human solver would perceive. Exceptionally nasty cases, with tens of millions of recursive calls, might take as much as tens of seconds. Most puzzles, however, are solved in pretty reasonable time.

The code of this small project can be downloaded from here.

Read Full Post »