metatron13.scm (8849B)
1 (use-modules (db) 2 (srfi srfi-1)) 3 4 (define (preprocess answer) 5 (string-delete #\. (string-downcase answer))) 6 7 (define (slovakoczech->number s) 8 (cond ((equal? s "jedna") 1) 9 ((or (equal? s "dva") 10 (equal? s "dvě") 11 (equal? s "dve")) 12 2) 13 ((or (equal? s "tri") 14 (equal? s "tři")) 15 3) 16 ((or (equal? s "štyri") 17 (equal? s "styri") 18 (equal? s "čtyři") 19 (equal? s "ctyri")) 20 4) 21 ((or (equal? s "pat") 22 (equal? s "päť") 23 (equal? s "pět") 24 (equal? s "pet")) 25 5) 26 ((or (equal? s "sest") 27 (equal? s "šesť") 28 (equal? s "šest")) 29 6) 30 ((or (equal? s "sedem") 31 (equal? s "sedm")) 32 7) 33 ((or (equal? s "osem") 34 (equal? s "osm")) 35 8) 36 ((or (equal? s "deväť") 37 (equal? s "devat") 38 (equal? s "devět") 39 (equal? s "devet")) 40 9) 41 ((or (equal? s "desať") 42 (equal? s "desat") 43 (equal? s "deset")) 44 10) 45 ((equal? s "nula") 46 0) 47 (else #f))) 48 49 (define (str->number s) 50 (let ((decimal (string->number s))) 51 (if decimal decimal (slovakoczech->number s)))) 52 53 (define (count-decimal-digits n) 54 (if (or (not n) (eq? n 0)) 55 0 56 (+ 1 (count-decimal-digits (quotient n 10))))) 57 58 (define (eval-round0 a) 59 (let* ((results (map (lambda (i) 0.0) (iota (length a)))) 60 (answers (map preprocess a)) 61 (numerical (map str->number answers)) 62 (sum (apply + (map (lambda (n) (if n n 0)) numerical)))) 63 (begin 64 (if (eq? (modulo (count-decimal-digits (list-ref numerical 0)) 2) 1) 65 (list-set! results 0 1.0)) 66 (if (eq? (list-ref numerical 1) 1) 67 (list-set! results 1 1.0)) 68 (if (eq? (list-ref numerical 2) 3) 69 (list-set! results 2 1.0)) 70 (let* ((is-yes? (lambda (s) (or (equal? s "ano") 71 (equal? s "áno")))) 72 (partial (map (lambda (s) (if (is-yes? s) 0.25 0.0)) 73 (string-tokenize (list-ref answers 3)))) 74 (total (apply + partial))) 75 (list-set! results 3 (* total total))) 76 (if (eq? (list-ref numerical 4) 1) 77 (list-set! results 4 1.0)) 78 (if (or (eq? (list-ref numerical 5) 1) 79 (equal? (list-ref answers 5) "jednociferné") 80 (equal? (list-ref answers 5) "jednociferne")) 81 (list-set! results 5 1.0)) 82 (if (eq? (list-ref numerical 6) (* 2 sum)) 83 (list-set! results 6 1.0)) 84 (if (eq? (list-ref numerical 7) 10) 85 (list-set! results 7 1.0)) 86 (if (eq? (list-ref numerical 8) 1023) 87 (list-set! results 8 1.0)) 88 (if (eq? (list-ref numerical 9) 1023) 89 (list-set! results 9 1.0)) 90 results))) 91 92 (define (string-get str i) 93 (if (< i (string-length str)) 94 (string-ref str i) 95 #f)) 96 97 (define (substr str i) 98 (if (< i (string-length str)) 99 (substring/read-only str i) 100 "")) 101 102 (define (string-find-iter s t i) 103 (if (< i (string-length s)) 104 (if (string-prefix? t (substring/read-only s i)) 105 i 106 (string-find-iter s t (+ i 1))) 107 #f)) 108 109 (define (string-find s t) 110 (string-find-iter s t 0)) 111 112 (define (vlad2000-iter input i a b output) 113 (let ((c (string-get input i)) 114 (str-lit (lambda (input i) 115 (let ((end (cond ((eq? (string-get input i) #\') 116 (list (string-index (substr input (+ i 1)) 117 #\') 118 1)) 119 ((and (eq? (string-get input i) #\*) 120 (eq? (string-get input (+ i 1)) #\")) 121 (list (string-find (substr input (+ i 2)) 122 "\"*") 123 2)) 124 ((list #f 0))))) 125 (if (car end) 126 (list (+ i (car end) (* 2 (cadr end))) 127 (substring input 128 (+ i (cadr end)) 129 (+ i (cadr end) (car end)))) 130 #f))))) 131 (if (< i (string-length input)) 132 (cond ((eq? c #\a) 133 (let ((lit (str-lit input (+ i 1)))) 134 (if lit 135 (vlad2000-iter input (car lit) (cadr lit) b output) 136 #f))) 137 ((eq? c #\b) 138 (let ((lit (str-lit input (+ i 1)))) 139 (if lit 140 (vlad2000-iter input (car lit) a (cadr lit) output) 141 #f))) 142 ((eq? c #\A) 143 (vlad2000-iter input (+ i 1) a b (string-append output a))) 144 ((eq? c #\B) 145 (vlad2000-iter input (+ i 1) a b (string-append output b))) 146 (#f)) 147 output))) 148 149 (define (vlad2000 input) 150 (vlad2000-iter input 0 "" "" "")) 151 152 (define (in-list? answer l) 153 (fold (lambda (a v) (or v (equal? a answer))) #f l)) 154 155 (define answers-1-6 156 (list "napíšte pre úlohu s číslom šesť tohto kola metalympiády rozlúštenie jej zadania" 157 "napíšte pre úlohu s číslom 6 tohto kola metalympiády rozlúštenie jej zadania" 158 "napíšte pre úlohu s číslom 6 tohoto kola metalympiády rozluštěnie jej zadania")) 159 160 (define answer-1-6-half "napište pre úlohu s číslom (6, 1, 6) tohto kola metalympiády rozlúštenie jej zadania") 161 162 (define answers-1-7 163 (list "metatrongpt neoznačí túto vetu za pravdivú" 164 "metatrongpt nerozozná túto vetu ako pravdivú" 165 "metatrongpt nerozozná tuto vetu ako pravdivú" 166 "metatrongpt túto vetu nerozozná ako pravdivú" 167 "túto vetu metatrongpt nerozozná ako pravdivú" 168 "tuto vetu metatrongpt nerozozná ako pravdivú" 169 "tuto pravdivú vetu metatrongpt nerozozná ako pravdivú" 170 "tato veta bude vyhodnocena podle umelé iteligencie metatrongpt jako veta nepravdiva")) 171 172 (define answer-1-7-half "ak hovorím pravdu, je to táto veta") 173 174 (define (eval-round1 a) 175 (let* ((results (map (lambda (i) 0.0) (iota (length a)))) 176 (answers (map preprocess a)) 177 (numerical (map str->number answers)) 178 (even-count (apply + (map (lambda (n) (if n (modulo (+ n 1) 2) 0)) 179 numerical))) 180 (sum (apply + (map (lambda (n) (if n n 0)) numerical)))) 181 (begin 182 (if (eq? (list-ref numerical 0) even-count) 183 (list-set! results 0 1.0)) 184 (if (eq? (list-ref numerical 1) sum) 185 ; primality test 186 (if (or (eq? (list-ref numerical 1) 2) 187 (eq? (list-ref numerical 1) 3) 188 (eq? (list-ref numerical 1) 5)) 189 (list-set! results 1 1.0) 190 (list-set! results 1 0.5))) 191 (if (eq? (list-ref numerical 2) 3) 192 (list-set! results 2 1.0) 193 (if (or (eq? (list-ref numerical 2) 1) 194 (eq? (list-ref numerical 2) 8)) 195 (list-set! results 2 0.5))) 196 (if (and (< 0 (string-length (list-ref a 3))) 197 (equal? (list-ref a 3) (vlad2000 (list-ref a 3)))) 198 (list-set! results 3 3.0)) 199 (if (eq? (list-ref numerical 4) 5) 200 (list-set! results 4 1.0)) 201 (if (in-list? (list-ref answers 5) answers-1-6) 202 (list-set! results 5 1.0) 203 (if (equal? (list-ref answers 5) answer-1-6-half) 204 (list-set! results 5 0.5))) 205 (if (in-list? (list-ref answers 6) answers-1-7) 206 (list-set! results 6 1.0) 207 (if (equal? (list-ref answers 6) answer-1-7-half) 208 (list-set! results 6 0.5))) 209 (list-set! results 7 1.0) 210 results))) 211 212 (define (eval-user-round user rnd evaluator) 213 (let ((answers (select-answers-content user rnd))) 214 (if answers 215 (let ((results (evaluator answers))) 216 (insert-results results user rnd) 217 (insert-score user rnd (apply + results)))))) 218 219 (define users (select-all-users)) 220 (for-each (lambda (u) (begin 221 (eval-user-round u 0 eval-round0) 222 (eval-user-round u 1 eval-round1))) 223 users)