BuK-Kreativaufgabe05 G2

(define newlength 0)
;help procedures
(define list-correct?
  (lambda (liste res)
    (display res)
    (newline)
;    (if (not (= (length res) newlength)) 
;        (and 
;           (set! newlength (length res)) 
;           (display  (length res))
;           (newline)
;           )
;        #f)
    
    (if (= 0 (length res))
     #f
     (equal? (expand-listA liste res "")(expand-listB liste res ""))
    )
    ))
  
(define expand-listA
  (lambda (liste res in)     
    (if (not (= 0 (length  res)))
        (and 
          (set! in (string-append in (car (list-ref liste ( - (car res) 1)))))
          (expand-listA liste (cdr res) in))
        in 
    )))

(define expand-listB
  (lambda (liste res in)     
    (if (not (= 0 (length  res)))
        (and 
          (set! in (string-append in (cdr (list-ref liste (- (car res) 1)))))
          (expand-listB liste (cdr res) in))
        in
    )))

(define pcp
  (lambda (liste2 res todo-list)
    (define liste liste2)
    
    (if (not (= 0 (length todo-list))) 
        (set! todo-list (cdr todo-list))
        #f)    
   
    (if (list-correct? liste res) 
        res
        ;expand I-list 
        (and  
        (do ((i 0 (+ i 1))) ((> i (- (length liste) 1)))
           (set! todo-list 
                 (append 
                     todo-list
                    (list (append res (list ( + i 1))))
                 )
           ))
         (pcp liste (list-ref todo-list 0) todo-list)
        )) 
    
    ))

(equal? 
   (pcp  '(("1" . "101")("10" . "00")("011" . "11")) '() '())
   '(1 3 2 3))

(equal? 
   (pcp  '(("01" . "0")("110010" . "0")("1" . "1111")("11" . "01")) '() '())
   '(1 3 2 4 4 3))

;zu lange Ausführung! / nicht effektiv.
;(equal? 
;    (pcp '(("001" . "0")("01" . "011")("01" . "101")("10" . "001")) '() '()) 
;    '(2,4,3,4,4,2,1,2,4,3,4,3,4,4,3,4,4,2,1,4,4,2,1,3,4,1,1,3,4,4,4,2,1,
;       2,1,1,1,3,4,3,4,1,2,1,4,4,2,1,4,1,1,3,4,1,1,3,1,1,3,1,2,1,4,1,1,3))

POSTsches Korrespondenzproblem

Aufgabe

Lösung

Suche