summaryrefslogtreecommitdiff
path: root/examples/speech/pt-fixed_answer.lali
blob: 0002672d2b9aea0b47b019fb79edf88e63158f2e (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
(set '_ '_)

(set 'reply '((sim    +2)
              (mais   +1)
              (okay   +0)
              (menos  -1)
              (nao    -2)))

(set 'question '((+8   "sim todo"          +3)   ;; todo este + talvez outro grupo
                 (+7   "sim muito"         +2)   ;; todo este + talvez um de outro
                 (+6   "todo"              +1)   ;; todo deste
                 (+5   "muito"             +0)   ;; muito deste
                 (+4   "algo"               _)   ;; assim
                 (+3   "pouco"             -0)   ;; pouco deste
                 (+2   "nao (outro)"       -1)   ;; nada deste + talvez outro grupo
                 (+1   "nao (outro) pouco" -2)   ;; nada deste + talvez um de outro
                 (+0   "nada"              -3))) ;; nenhum

(defun assoc (el lst)
  (fill
   ((dif el (car (car lst))) (car lst))
   ((algo lst) '(f f))
   (f (assoc el (cdr lst)))))

(defun without (el lst)
  (fill
   ((dif el (car lst)) f)
   ((algo (car lst)) t)
   (f (without el (cdr lst)))))

;; vv begin of training options vv

(defun train-ups-and-downs ()
  (random +8))

(defun train-ups ()
  (+ +4 (random +4)))

(defun train-downs ()
  (random +4))

(defun train-middle ()
  (+ +2 (random +4)))

(defun train-inner ()
  (+ +3 (random +2)))

;; ^^ end of training options ^^

(defun get-answer-score (the-reply)
  (fill
   ((without f the-reply)
    (prog
       (princ "\n~\n>> desconheço")
       (newline)
       f))
   (f (eval (cons + the-reply)))))

(defun main ()
  (progs
   f
   ;; vv change training (just) below here vv
   (set 'target-question (train-ups-and-downs))
   (set 'it-quest (assoc target-question question))
   (princ (car (cdr it-quest)))
   (princ "\b?")
   (newline)
   (newline)

   (set 'target-answer +4)
   (princ "resposta:")

   (set 'question-score target-question)
   (set 'my-reply (readl))
   (differ my-reply '(f))
   (set 'answer-score (get-answer-score
                       (map
                        (lambda (word)
                          (car (cdr (assoc word reply))))
                        my-reply)))
   (fill
    ((dif target-answer
          (+ question-score answer-score))
     'correct)
    (f 'wrong))))

(defun loop ()
  (set 'res (main))
  (fill
   ((dif res 'correct) (loop))
   ((dif res 'wrong) (prog (princ ">> errado") (newline)))
   (f f)))

(loop)