SystemSuche Loesung

Aus ProgrammingWiki

Archivierte Version vom 2009-05-12T09:13:02+00:00. Aktuelle Version

1. beschränkten Tiefensuchbaum für 15,35,42, 77 bei K=55.

(define hoechstens-maxgewicht?
  (lambda (ls k)
    (<= (apply + ls) k)))

(define gewichte
  (lambda (ls)
    (map car ls)))

(define werte
  (lambda (ls)
    (map cdr ls)))

(define rucksack3a
  (lambda (g-ls k)
    (let
        ((max-s-ls '())
         (mwert 0))
      (letrec
          ((helper
            (lambda (g-ls s-ls)
              (if (null? g-ls)
                  (let
                      ((gesamtgewicht (apply + (gewichte s-ls)))
                       (gesamtwert (apply + (werte s-ls))))
                    (if (and
                         (hoechstens-maxgewicht? (gewichte s-ls) k)
                         (> gesamtwert mwert))
                        (begin
                          (set! max-s-ls (gewichte s-ls))
                          (set! mwert gesamtwert)))
                    (cons max-s-ls mwert))
                  (begin
                    (if (hoechstens-maxgewicht? (gewichte s-ls) k)
                        (helper (cdr g-ls) (cons (car g-ls) s-ls)))
                    (if (hoechstens-maxgewicht? (gewichte s-ls) k)
                        (helper (cdr g-ls) s-ls)))))))
        (helper g-ls '())))))

3. reduzierten Breitensuchbaum für '(15 35 42 77):

;;;  Nondeterminism

;;  amb (which stands for ambiguous)
;;  Inventor: McCarthy; MzScheme implementation: Dorai Sitaram
;;  Source: "Teach yourself Scheme in Fixnum Days"
;;  This is a Chez Scheme implementation.

(define amb-fail '*)

(define initialize-amb-fail
  (lambda ()
    (set! amb-fail
      (lambda ()
        (error "amb" "It fails")))))

(initialize-amb-fail)

(define-syntax amb
  (syntax-rules ()
    ((amb alt ...)
     (let ((+prev-amb-fail amb-fail))
       (call/cc
         (lambda (+sk)
           (call/cc
             (lambda (+fk)
               (set! amb-fail
                     (lambda ()
                       (set! amb-fail +prev-amb-fail)
                       (+fk 'fail)))
               (+sk alt)))
           ...
           (+prev-amb-fail)))))))

(define-syntax bag-of
  (syntax-rules ()
    ((bag-of e)
     (let ((+prev-amb-fail amb-fail)
           (+results '()))
       (if (call/cc
             (lambda (+k)
               (set! amb-fail (lambda () (+k #f)))
               (let ((+v e))
                 (set! +results (cons +v +results))
                 (+k #t))))
           (amb-fail))
       (set! amb-fail +prev-amb-fail)
       (reverse! +results)))))

(define choice
  (lambda (ls)
    (eval
      (cons
        'amb
        (map (lambda (x) (list 'quote x)) ls)))))

(define multichoice
  (lambda (ls n) 
    (if (= n 0)
        '()
        (let ((item (choice ls)))
          (cons item (multichoice (delete item ls) (- n 1)))))))

(define delete
  (lambda (item ls)
    (cond
      ((null? ls) '())
      ((eqv? (car ls) item) (cdr ls))
      (else
        (cons (car ls) (delete item (cdr ls)))))))

(define randomchoice
  (lambda (n)
    (letrec
      ((enumerate
         (lambda (i)
           (if (= i 0)
               '()
               (cons i (enumerate (- i 1)))))))
      (let ((numberlist (enumerate n)))
        (choice numberlist)))))



; ------  examples using nondeterminism  -----

(define number-between
  (lambda (lo hi) 
    (let loop ((i lo)) 
      (if (> i hi) 
          (amb) 
          (amb i (loop (+ i 1)))))))

(define assert 
  (lambda (pred) 
    (if (not pred) (amb))))

(define prime?
  (lambda (n)
    (letrec
      ((helper 
         (lambda (i)
           (cond
             ((> i (ceiling (sqrt n))) #t)
             ((zero? (modulo n i)) #f)
             (else
               (helper (+ i 2)))))))
      (cond
        ((= n 1) #f)
        ((= n 2) #t)
        ((= n 3) #t)
        ((even? n) #f)
        (else
          (helper 3))))))

(define gen-prime
  (lambda (hi)
    (let ((i (number-between 2 hi)))
      (assert (prime? i))
      i)))

; (bag-of (gen-prime 20))

(define all-divider-of 
  (lambda (n)
    (let ((i (number-between 2 (- n 1))))
      (assert (zero? (modulo n i)))
      i)))

; (bag-of (all-divider-of 18))
(initialize-amb-fail)

(define summandenA
  (lambda (ls)
    (list (choice ls) (choice ls))))

(define summandensucheA
  (lambda (ls summe)
    (let ((kandidatenliste (summandenA ls)))
      (if (= (apply + kandidatenliste) summe)
          kandidatenliste
          (choice '())))))

<eval>(summandensucheA '(0 1 2 3 4 5) 6)</eval>

b)siehe c.

(define teilbar_X
  (lambda (ls x)
    (bag-of(let ((kandidatenliste (summandenA ls)))
      (if (integer? (/ (apply + kandidatenliste) x))
          kandidatenliste
          (choice '()))))))

<eval>(teilbar_x '(1 2 3 4 5 6 7 8 9) 6)</eval>