Skip to content

Instantly share code, notes, and snippets.

@panicz

panicz/srq1.scm

Created August 31, 2018 21:31
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save panicz/a4f33ce686a69a1a19942810413e2b4a to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save panicz/a4f33ce686a69a1a19942810413e2b4a to your computer and use it in GitHub Desktop.
Download ZIP
Quiz solution from Dercz
Raw
srq1.scm
(use-modules (grand scheme))
(define (all-the-same? xs)
(match xs
[(x x) #t]
[(x x . xs*) (all-the-same? `(,x . ,xs*))]
[_ #f]))
(e.g. (all-the-same? '(1 1 1)))
(e.g. (not (all-the-same? '(1 1 2))))
;;; sorry...
(define (first* xs) (if (null? xs) #f (first xs)))
(define (last* xs) (if (null? xs) #f (last xs)))
;;; we will represent possible answer as a list of 10 letters A-E:
(define (anseq? x)
(and (list? x)
(= (length x) 10)
(every (lambda (l) (member? l '(A B C D E))) x)))
(e.g. (anseq? '(A B C D E A B C D E)))
(e.g. (anseq? '(A A E E A C A B A B)))
(e.g. (not (anseq? '(Q B C D E A B C D E))))
(e.g. (not (anseq? '(A B C D))))
;;; fix number of questions ;)
(define (all-questions) (map 1+ (iota 10)))
;;; find out what answer is assigned by anseq for question:
(define (answer question #;wrt anseq) (list-ref anseq (- question 1)))
(e.g. (answer 1 '(B C D A B C A B C A)) ===> B)
(e.g. (answer 3 '(B C D A B C A B C A)) ===> D)
;;; get list of answers for given set of questions:
(define (answers questions #;wrt anseq)
(map (lambda (q) (answer q anseq)) questions))
(e.g. (answers '(1 2) '(A B C D E A B C D E)) ===> (A B))
(e.g. (answers '(3 5 7) '(A B C D E A B C D E)) ===> (C E B))
(define (have-identical-answers? questions #;wrt anseq)
(all-the-same? (answers questions anseq)))
(e.g. (have-identical-answers? '(2 3 4) '(A B B B C A B C D E)))
(e.g. (not (have-identical-answers? '(1 3) '(A B B B C A B C D E))))
(define (all-questions-with-answer ans #;among questions #;wrt anseq)
(filter (lambda (q) (eq? ans (answer q anseq))) questions))
(e.g. (all-questions-with-answer 'A (all-questions) '(A A C D E A C C D E))
===> (1 2 6))
(e.g. (all-questions-with-answer 'B (all-questions) '(A A C D E A C C D E))
===> ())
(e.g. (all-questions-with-answer 'A
(filter even? (all-questions))
'(A A C D E A C C D E))
===> (2 6))
;;; mkay...
(define (sat-q1? anseq)
(let [(first-question-with-answer-A
(first* (all-questions-with-answer 'A (all-questions) anseq)))]
(match `(,(answer 1 anseq) ,first-question-with-answer-A)
[('A 4) #t]
[('B 3) #t]
[('C 2) #t]
[('D 1) #t]
[('E n) (not (member? n '(4 3 2 1)))]
[_ #f])))
(define (sat-q2? anseq)
(match (answer 2 anseq)
['A (have-identical-answers? '(3 4) anseq)]
['B (have-identical-answers? '(4 5) anseq)]
['C (have-identical-answers? '(5 6) anseq)]
['D (have-identical-answers? '(6 7) anseq)]
['E (have-identical-answers? '(7 8) anseq)]))
(define (sat-q3? anseq)
(let* [(next-questions (filter (lambda (q) (> q 3)) (all-questions)))
(first-question-with-answer-A
(first* (all-questions-with-answer 'A next-questions anseq)))]
(match `(,(answer 3 anseq) ,first-question-with-answer-A)
[('A 4) #t]
[('B 5) #t]
[('C 6) #t]
[('D 7) #t]
[('E 8) #t]
[_ #f])))
(define (sat-q4? anseq)
(let* [(even-questions (filter even? (all-questions)))
(first-even-question-with-answer-B
(first* (all-questions-with-answer 'B even-questions anseq)))]
(match `(,(answer 4 anseq) ,first-even-question-with-answer-B)
[('A 2) #t]
[('B 4) #t]
[('C 6) #t]
[('D 8) #t]
[('E 10) #t]
[_ #f])))
(define (sat-q5? anseq)
(let* [(odd-questions (filter odd? (all-questions)))
(odd-questions-with-answer-C
(all-questions-with-answer 'C odd-questions anseq))]
(match `(,(answer 5 anseq) ,odd-questions-with-answer-C)
[('A (1)) #t]
[('B (3)) #t]
[('C (5)) #t]
[('D (7)) #t]
[('E (9)) #t]
[_ #f])))
(define (sat-q6? anseq)
(let* [(questions-with-answer-D
(all-questions-with-answer 'D (all-questions) anseq))
(before (filter (lambda (q) (< q 6)) questions-with-answer-D))
(after (filter (lambda (q) (> q 6)) questions-with-answer-D))]
(match `(,(answer 6 anseq) ,before ,after)
[('A (_ . _) ()) #t]
[('B () (_ . _)) #t]
[('C (_ . _) (_ . _)) #t]
;; D and E are contradictory anyway...
[_ #f])))
(define (sat-q7? anseq)
(let* ([last-question-with-answer-E
(last* (all-questions-with-answer 'E (all-questions) anseq))])
(match `(,(answer 7 anseq) ,last-question-with-answer-E)
[('A 5) #t]
[('B 6) #t]
[('C 7) #t]
[('D 8) #t]
[('E 9) #t]
[_ #f])))
(define (sat-q8? anseq)
(let* ([consonant-answered-questions
(append-map (lambda (ans)
(all-questions-with-answer ans (all-questions) anseq))
'(B C D))])
(match `(,(answer 8 anseq) ,(length consonant-answered-questions))
[('A 7) #t]
[('B 6) #t]
[('C 5) #t]
[('D 4) #t]
[('E 3) #t]
[_ #f])))
(define (sat-q9? anseq)
(let* ([vowel-answered-questions
(append-map (lambda (ans)
(all-questions-with-answer ans (all-questions) anseq))
'(A E))])
(match `(,(answer 9 anseq) ,(length vowel-answered-questions))
[('A 0) #t]
[('B 1) #t]
[('C 2) #t]
[('D 3) #t]
[('E 4) #t]
[_ #f])))
(define (sat-q10? anseq) #t) ;; he_he
(define quiz (list sat-q1? sat-q2? sat-q3? sat-q4? sat-q5?
sat-q6? sat-q7? sat-q8? sat-q9? sat-q10?))
(define (correct-anseq? anseq) (every (lambda (s) (s anseq)) quiz))
(e.g. (correct-anseq? '(C A B B A B E B E D)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (debug quiz anseq)
(zip (all-questions) (map (lambda (s) (s anseq)) quiz)))
(debug quiz '(C A B B A B E B E D))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(let check ([pend (multicombinations '(A B C D E) 10)]
[res '()])
(match pend
[() (begin (pretty-print res) 'BOOM!)]
[(as . pend*) (if (correct-anseq? as)
(begin (pretty-print `(found ,as))
(check pend* `(,as . ,res)))
(check pend* res))]))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment