투명 필름문제 Scheme 답

문제는 http://codingdojo.metaschool.org/4893 에 있습니다.

해당하는 스킴 코드를 짜봤습니다.

입력부분은 그냥 panel을 리스트로 구성해서 넘겼고..
출력은 일단 리스트로 만들었으니 나중에 따로 출력부만 만들면 될 것 같습니다.

;; 점 표시..
(define (make-point x y)
  (list x y))

(define (get-x point)
  (car point))

(define (get-y point)
  (cadr point))

;; 라인 표시.
(define (make-line p1 p2)
  (if (< (get-x p1) (get-x p2))
      (list p1 p2)
      (list p2 p1)))

(define (get-left line)
  (car line))

(define (get-right line)
  (cadr line))

;; 패널 표시
(define (make-panel line transp)
  (list line transp))

(define (get-line panel)
  (car panel))

(define (get-transp panel)
  (cadr panel))



;; 예제 패널에서 x축 데이터만 가져오기
(define (get-x-from-panel panel)
  (let ((line-list (map (lambda (p) (get-line p)) panel)))
    (let ((left-point (map (lambda (l) (get-left l)) line-list))
          (right-point (map (lambda (l) (get-right l)) line-list)))
      (let ((left-x-point (map (lambda (p) (get-x p)) left-point))
            (right-x-point (map (lambda (p) (get-x p)) right-point)))
        (quicksort (union-set left-x-point right-x-point))))))

;; 0.0 부터 시작해서 각 x점마다 중간점을 이용해서 해당 점이 개별 패널이 들어있는지 찾기
(define (get-middle p1 p2)
  (/ (+ p1 p2) 2))



;; 특정 점이 패널에 속했는지 여부 알기..
(define (in-width x line)
  (let ((left-point (get-left line))
        (right-point (get-right line)))
    (let ((left-x (get-x left-point))
          (right-x (get-x right-point)))
      (and (<= left-x x)
           (>= right-x x)))))

;; 특정 점이 속하는 패널 값 가져오기
(define (get-transp-list x panel-list)
  (map (lambda (panel)
         (if (in-width x (get-line panel))
             (get-transp panel)
             0.0)) panel-list))

;; 리스트 값중 0.0이면 무시하고 나머지 값을 모두 곱하기
(define (product-transp transp-list)
  (if (null? transp-list)
      1
      (if (= 0 (car transp-list))
          (* 1 (product-transp (cdr transp-list)))
          (* 1 (car transp-list)
             (product-transp (cdr transp-list))))))

(define (quicksort lst)
  (if (null? lst)
      '()
      (let ((middle (car lst)))
        (if (< (length lst) 1)
            lst
            (append
             (quicksort (lessor_list lst middle))
             (cons middle (quicksort (larger_list lst middle))))))))

(define (length lst)
  (if (null? lst)
      0
      (+ 1 (length (cdr lst)))))

(define (nth n lst)
  (if (null? lst)
      '()
      (if (= n 0)
          (car lst)
          (nth (- n 1) (cdr lst)))))

(define (lessor_list lst value)
  (if (null? lst)
      '()
      (let ((item (car lst)))
        (cond ((< item value) (cons item (lessor_list (cdr lst) value)))
              (else
               (lessor_list (cdr lst) value))))))

(define (larger_list lst value)
  (if (null? lst)
      '()
      (let ((item (car lst)))
        (cond ((> item value) (cons item (larger_list (cdr lst) value)))
              (else
               (larger_list (cdr lst) value))))))


;; X축에 대해 sorted list에 넣기
(define (element-of-set? x set)
  (cond ((null? set) #f)
        ((< x (car set)) #f)
        ((= x (car set)) #t)
        (else
         (element-of-set? x (cdr set)))))
      
(define (adjoin-set x set)
  (if (null? set)
      (list x)
      (let ((first-item (car set)))
        (cond ((< x first-item) (cons x set))
              ((= x first-item) set)
              (else
               (adjoin-set x (cdr set)))))))

(define (union-set set1 set2)
  (cond ((and (null? set1) (null? set2)) '())
        ((null? set1) set2)
        ((null? set2) set1)
        (else
         (let ((item1 (car set1)) (item2 (car set2)))
           (cond ((= item1 item2) (cons item1 (union-set (cdr set1) (cdr set2))))
                 ((< item1 item2) (cons item1 (union-set (cdr set1) set2)))
                 (else (cons item2 (union-set set1 (cdr set2)))))))))

;; 예제 패널..
(define exam-panel
  (list
   (make-panel (make-line (make-point 2.0  2.0) (make-point  9.0  2.0))  0.9 )
   (make-panel (make-line (make-point 13.5  2.0) (make-point  4.0  8.5))  0.7 )
   (make-panel (make-line (make-point 17.0  10.0)  (make-point 7.0  8.5))  0.8 )))

;; 실제 투명값 구하는 부분..
(define (get-transp-in-panel panel)
  (let ((x-list (get-x-from-panel panel)))
    (let ((all-x-list (cons 0.0 x-list)))
      (define (i-g-t-i-p xlist)
        (if (< (length xlist) 2)
            (list (cons (car xlist) (cons 'inf (list 1.0))))
            (let ((left (car xlist))
                  (right (cadr xlist)))
              (cons (cons left (cons right (list (product-transp (get-transp-list (get-middle left right) panel)))))
                    (i-g-t-i-p (cdr xlist))))))
      (i-g-t-i-p all-x-list))))