ユメ先輩チェッカー

test.scm

(load "ysc.scm")
(define yume '((hair . light-blue)(oppai . 105)(futomomo . 60)
  (style . long)(personality . tennen)(zuzushii . #t)
  (baka . #t)(caring . #t)(school . abydos)(role . kaichou)))
(define hiyori '((hair . light-blue)(oppai . 88)(futomomo . 58)
  (style . long)(personality . tennen)(school . arius)))
(define hosino '((hair . light-blue)(oppai . 75)(futomomo . 50)
  (style . short)(school . abydos)))
(display "ユメ: ")(display (ysc yume))(newline)
(display "ヒヨリ: ")(display (ysc hiyori))(newline)
(display "ホシノ: ")(display (ysc hosino))(newline)

ysc.scm

;; YSC: Yume Senpai Checker
;; Checkers as data, combined via monoid (+, 0)
(define (ysc d)
  (define (g k) (cond ((assq k d) => cdr) (else #f)))
  (define (eq k . v) (memq (g k) v))
  (define (ge k n) (let ((x (g k))) (and x (>= x n))))
  ;; (weight predicate) pairs
  (define cs
    `((20 ,(eq 'hair 'light-blue 'aqua))
      (15 ,(ge 'oppai 90))  (10 ,(ge 'oppai 100))
      (10 ,(ge 'futomomo 55)) (5 ,(eq 'style 'long))
      (10 ,(eq 'personality 'tennen))
      (10 ,(g 'zuzushii)) (5 ,(g 'baka)) (5 ,(g 'caring))
      (5 ,(eq 'school 'abydos)) (5 ,(eq 'role 'kaichou))))
  ;; mconcat: sum weighted scores
  (define score
    (apply + (map (lambda (c) (if (cadr c) (car c) 0)) cs)))
  (cond ((>= score 80) "うへ...ユメ先輩!")
        ((>= score 60) "ユメ先輩...?")
        ((>= score 40) "似た何か")
        (else "違います")))