Language training program using Common Lisp and the ltk library

Question

The idea is as follows:

We provide program with two files: one with English words and one with words in, let's say, Spanish. The files have one word (it could be a word, or word+some explanation etc) per line and words are ordered in files according to their translation: for example, line 5 of the first file contains the word "a stone" and line 5 of the second file contains the translation of the word "a stone".

The program asks you these questions:

1. It decides whether to give your word in English and expect a translation or the other way around (pseudorandom 50% of each).
2. It pseudorandomly choses 3 false answers, and together with the correct answer, gives these 4 possible options to you.
3. You choose one of the 4 options and it reacts accordingly, keeping track of your win/all ration, win/lose streak, longest win streak, giving correct answers after each question and telling you whether you were right or wrong in your answer.

There are two entry points where you can write a path to files. There is also an option to choose one of two remembered pairs of paths (could be something like Spanish, Chinese or something - according to what language you want to train).

It does its job for me (it would save for one error that happens if you provide the wrong path but it's nothing terrible) but I would like to hear what I should improve on, what is bad style, what may give bad performance, etc.

I would also like to know how I can make an .exe while making sure a pseudorandom sequence will be different each time I run it (I managed to make an .exe, but the sequence was the same each time I turned it on). As you can see, I load the whole content of files into two arrays. Is it ok practice? How can I manage it in a better way?

(defparameter *vocabulary-file* "C:/sbcl/1.3.12/1.txt")
(defparameter *translation-file* "C:/sbcl/1.3.12/1.txt")
(defparameter *wins* 0)
(defparameter *loses* 0)
(defparameter *win-streak* t)
(defparameter *streak-length* 0)
(defparameter *longest-win-streak* 0)
(defparameter *vocabulary* `(,(make-array '(1) :adjustable t) 0))
(defparameter *translation* `(,(make-array '(1) :adjustable t) 0))
(defparameter *question* "QUESTION")
(defparameter *known-practices* '(x y))
(defparameter *FILE-NOT-FOUND* nil)
(setf *random-state* (make-random-state t))
(load "C:/sbcl/1.3.12/ltk/ltk.lisp")
(use-package :ltk)

(defun random-excluding (excluded minimal maximal)
 (let ((rolled (+ minimal (random (+ maximal 1)))))
  (if (member rolled excluded)
   (random-excluding excluded minimal maximal)
   rolled)))
(defmacro refresh-display()
`(progn
  (setf (text rate) (concatenate 'string (write-to-string *wins*) "/" (write-to-string (+ *wins* *loses*))))
  (if *win-streak*
  (progn 
   (setf (text longest-win-streak) (concatenate 'string "Longest win-streak: " (write-to-string *longest-win-streak*)))
   (setf (text streak) (concatenate 'string (write-to-string *streak-length*) "W")))
  (setf (text streak) (concatenate 'string (write-to-string *streak-length*) "L")))))
(defmacro load-up-vector (which from-where)
 `(with-open-file (stream ,from-where :direction :input :if-does-not-exist NIL :external-format :utf-8)
 (if (eq stream NIL) 
  (progn
   (do-msg "FILE NOT FOUND AT PROVIDED LOCATION")
   (setf *FILE-NOT-FOUND* t))
  (let ((line (read-line stream nil nil)))
  (progn 
   (loop 
    :until (eq line nil)
    :do (setf (aref (car ,which) (car (cdr ,which))) line)
        (incf (car (cdr ,which)))
        (adjust-array (car ,which) (list (1+ (car (cdr ,which)))))
        (setf line (read-line stream nil nil)))
    (decf (car(cdr ,which))))))))
(defmacro reset-stance ()
`(progn 
  (setf *vocabulary* (list (make-array '(1) :adjustable t) 0))
  (setf *translation* (list (make-array '(1) :adjustable t) 0))
  (setf *wins* 0)
  (setf *loses* 0)
  (setf *win-streak* t)
  (setf *streak-length* 0)
  (setf *longest-win-streak* 0)
  (refresh-display)))
(defmacro redo-paths()
 `(progn
   (reset-stance)
   (setf (text display) (text known-practices))
   (cond
   ((equalp (text display) "X")
   (progn
    (setf (text vocabulary-path) "C:/sbcl/1.3.12/LangPractice/XX.txt")
    (setf (text translation-path) "C:/sbcl/1.3.12/LangPractice/Xenglish.txt"))
    (setf (text question) "X"))
   ((equalp (text display) "Y")
   (progn
    (setf (text vocabulary-path) "C:/sbcl/1.3.12/LangPractice/YY.txt")
    (setf (text translation-path) "C:/sbcl/1.3.12/LangPractice/Yenglish.txt"))
    (setf (text question) "Y"))
   (t
    (setf (text question) "BLANK")))
   (setf *vocabulary-file* (text vocabulary-path))
   (setf *translation-file* (text translation-path))
   (load-up-vector *vocabulary* *vocabulary-file*)
   (load-up-vector *translation* *translation-file*)
   (if *FILE-NOT-FOUND*
   (setf *FILE-NOT-FOUND* nil)
   (prepare-question))))
(defmacro prepare-question()
 `(let* ((true-answer-index (random (car (cdr *vocabulary*))))
        (which-way (random 2))
        (false-answer-index1 (random-excluding (list true-answer-index) 0 (car (cdr *vocabulary*))))
        (false-answer-index2 (random-excluding (list true-answer-index false-answer-index1) 0 (car (cdr *vocabulary*))))
        (false-answer-index3 (random-excluding (list true-answer-index false-answer-index1 false-answer-index2) 0 (car (cdr *vocabulary*))))
        (where-true (+ 5 (random 9)))
        (where-false1 (random-excluding (list where-true) 5 8))
        (where-false2 (random-excluding (list where-true where-false1) 5 8))
        (where-false3 (random-excluding (list where-true where-false1 where-false2) 5 8)))
  (if (= which-way 0)
   (progn 
    (setf (text true-answer) (format nil "~a" (aref (car *translation*) true-answer-index)))
    (setf (text false-answer1) (format nil "~a" (aref (car *translation*) false-answer-index1)))
    (setf (text false-answer2) (format nil "~a" (aref (car *translation*) false-answer-index2)))
    (setf (text false-answer3) (format nil "~a" (aref (car *translation*) false-answer-index3)))
    (setf (text question) (format nil "~a" (concatenate 'string "AL " (aref (car *vocabulary*) true-answer-index)))))
   (progn
    (setf (text true-answer) (format nil "~a" (aref (car *vocabulary*) true-answer-index)))
    (setf (text false-answer1) (format nil "~a" (aref (car *vocabulary*) false-answer-index1)))
    (setf (text false-answer2) (format nil "~a" (aref (car *vocabulary*) false-answer-index2)))
    (setf (text false-answer3) (format nil "~a" (aref (car *vocabulary*) false-answer-index3)))
    (setf (text question) (format nil "~a" (concatenate 'string "EN " (aref (car *translation*) true-answer-index))))))
   (grid-forget true-answer)
   (grid-forget false-answer1)
   (grid-forget false-answer2)
   (grid-forget false-answer3)
   (grid true-answer where-true 0)
   (grid false-answer1 where-false1 0)
   (grid false-answer2 where-false2 0)
   (grid false-answer3 where-false3 0)))
(defmacro correct()
 `(progn
   (incf *wins*)
   (setf (text display) (format nil "CORRECT!~&~a=~&~a" (subseq (text question) 3) (text true-answer)))
   (if *win-streak*
   (progn 
    (incf *streak-length*)
    (if (> *streak-length* *longest-win-streak*)
    (setf *longest-win-streak* *streak-length*)))
   (progn 
    (setf *win-streak* t)
    (setf *streak-length* 1)))))
(defmacro mistake()
`(progn
  (incf *loses*)
  (setf (text display) (format nil "MISTAKE!~&~a=~&~a" (subseq (text question) 3) (text true-answer)))
  (if *win-streak*
   (progn 
    (setf *win-streak* nil)
    (setf *streak-length* 1))
    (incf *streak-length*))))
(defun main-display ()
 (with-ltk ()
 (let* ((menu (make-instance 'frame))
        (practice (make-instance 'frame))
        (display (make-instance 'label :text "XXX" :master practice))
        (vocabulary-path (make-instance 'entry :text *vocabulary-file* :master menu))
        (translation-path (make-instance 'entry :text *translation-file* :master menu))
        (question (make-instance 'label :text "QUESTION" :master practice))
        (rate (make-instance 'label :text "0/0" :master menu))
        (streak (make-instance 'label :text "0W" :master menu))
        (longest-win-streak (make-instance 'label :text "Longest win-streak: 0" :master menu))
        (true-answer (make-instance 'button :text "" :master practice))
        (false-answer1 (make-instance 'button :text "" :master practice))
        (false-answer2 (make-instance 'button :text "" :master practice))
        (false-answer3 (make-instance 'button :text "" :master practice))
        (known-practices (make-instance 'combobox :values *known-practices* :master menu))
        (refresh-paths (make-instance 'button :text "Refresh paths" :command #'(lambda ()(redo-paths)(prepare-question)) :master menu)))
    (setf (command true-answer) #'(lambda ()(correct)(prepare-question)(refresh-display)))
    (setf (command false-answer1) #'(lambda ()(mistake)(prepare-question)(refresh-display)))
    (setf (command false-answer2) #'(lambda ()(mistake)(prepare-question)(refresh-display)))
    (setf (command false-answer3) #'(lambda ()(mistake)(prepare-question)(refresh-display)))
    (configure false-answer1 :takefocus 0)
    (configure false-answer2 :takefocus 0)
    (configure false-answer3 :takefocus 0)
    (configure true-answer :takefocus 0)
 (grid menu 0 0)
 (grid practice 4 0)
 (grid vocabulary-path 0 0)
 (grid translation-path 1 0)
 (grid refresh-paths 0 1)
 (grid question 4 0)
 (grid longest-win-streak 2 1)
 (grid rate 0 2)
 (grid known-practices 1 1)
 (grid streak 1 2)
 (grid display 3 0)
 (grid true-answer 5 0)
 (grid false-answer1 6 0)
 (grid false-answer2 7 0)
 (grid false-answer3 8 0)
)))

Answer 1

You might want to explain the format of the input files and/or provide some samples. The program also breaks when you have fewer than four words in either file.

---

Apart from what @rainer-joswig has already said:

• Use an editor that indents better, like Vim or Emacs. You might (well, will) even get a nicer experience out of it by being able to evaluate individual forms under your cursor for example.
• Consistency is key, so either write t or T (IMO searching for an uppercase "T" makes it much easier), nil or NIL, and symbols in general.
• #'(lambda ...) is AFAIK uncommon, as (lambda ...) alone is sufficient as well.
• (eq x NIL) is somewhat more succinctly put as (not X) as NIL is the single false value.

---

Take a look at ASDF (and other people's code - there are lots and lots of good examples out there!) can be used to define and load dependencies for a project, in particular LTK. Most people certainly don't have C:/sbcl/1.3.12/ltk/ltk.lisp on their system, even if they had Windows as their operating system (nevermind the hardcoded paths in general). Also use defpackage so that not all definitions are just dumped into CL-USER.

E.g. training.asd:

(asdf:defsystem :training
  :encoding :utf-8
  :depends-on (:ltk)
  :serial T
  :components ((:file "package")
               (:file "training")))

And package.lisp:

(defpackage :training
  (:use :cl :ltk))

In training.lisp finally the first line would be:

(in-package :training)

Super easy and helps you organise your code much better.

---

So REFRESH-DISPLAY for example is defined as a macro because RATE and other variables aren't exposed properly. That's the wrong way to go about that unfortunately. The function should receive a parameter which contains all the widgets in question. Objects are already (necessarily) used, therefore a DEFCLASS for a custom one will be fine (yes, you could get by a list of widgets instead, but let's go for the more correct option instead):

(defclass training ()
  ((rate :accessor rate :initarg :rate)
   (longest-win-streak :accessor longest-win-streak :initarg :longest-win-streak)
   (streak :accessor streak :initarg :streak)))

This is not final, but enough to convert REFRESH-DISPLAY and RESET-STANCE to functions:

(defun refresh-display (training)
  (setf (text (rate training)) (concatenate 'string (write-to-string *wins*) "/" (write-to-string (+ *wins* *loses*))))
  (if *win-streak*
      (progn
        (setf (text (longest-win-streak training)) (concatenate 'string "Longest win-streak: " (write-to-string *longest-win-streak*)))
        (setf (text (streak training)) (concatenate 'string (write-to-string *streak-length*) "W")))
      (setf (text (streak training)) (concatenate 'string (write-to-string *streak-length*) "L"))))

(defun reset-stance (training)
  (setf *vocabulary* (list (make-array '(1) :adjustable t) 0))
  (setf *translation* (list (make-array '(1) :adjustable t) 0))
  (setf *wins* 0)
  (setf *loses* 0)
  (setf *win-streak* t)
  (setf *streak-length* 0)
  (setf *longest-win-streak* 0)
  (refresh-display training))

See where this is going? In MAIN-DISPLAY the relevant parts would be:

(let* (...
       (training (make-instance 'training
                                :rate rate
                                :longest-win-streak longest-win-streak
                                :streak streak)))
  (setf (command refresh-paths) (lambda ()
                                  (redo-paths training)
                                  (prepare-question)))
  ...)

Once all macros are gone there's still a lot to do though. For example, the final version of REFRESH-DISPLAY should be closer to the following, as CONCATENATE plus WRITE-TO-STRING is just needlessly verbose for this purpose:

(defun refresh-display (training)
  (setf (text (rate training)) (format NIL "~A/~A" *wins* (+ *wins* *loses*)))
  (when *win-streak*
    (setf (text (longest-win-streak training)) (format NIL "Longest win-streak: ~A" *longest-win-streak*)))
  (setf (text (streak training)) (format NIL "~A~A" *streak-length* (if *win-streak* "W" "L"))))

If you like WITH-SLOTS/WITH-ACCESSORS could also incorporated at the cost of repeating the slot names.

Finally I'd probably move most of the globals either into that class too, or into a separate "data model" class that stores the non-UI state of the application.

---

Hope that helps. Overuse of global state, duplication of code and restricting yourself to not using libraries and standard tools are all limiting you when writing a more complex application, not to mention that they hurt comprehension when others (including yourself in a month) have to read that code later.

Answer 2

Bad

• Really bad: uses macros for no reason. Use functions.
• basic operations like loading a vocabulary are unreadable.
• uses adjustable arrays. Much easier: read a list and convert it to a vector later.
• adjusting the array by one element in each loop iteration is extremely inefficient
• poorly emulates adjustable arrays with fill pointer and VECTOR-PUSH-EXTEND
• poor formatting and indentation
• lots of undocumented global variables
• no documentation in the code
• mixes logic and UI code
• hardcoded filenames
• each functionality should be ideally a function, which can be used and tested individually
• calling format to create a string, on a string which just has been created, is useless
• code is not structured

I'd say: a total rewrite is necessary.

Example

Your code with wrong indentation/formatting:

(defmacro load-up-vector (which from-where)
 `(with-open-file (stream ,from-where :direction :input :if-does-not-exist NIL :external-format :utf-8)
 (if (eq stream NIL) 
  (progn
   (do-msg "FILE NOT FOUND AT PROVIDED LOCATION")
   (setf *FILE-NOT-FOUND* t))
  (let ((line (read-line stream nil nil)))
  (progn 
   (loop 
    :until (eq line nil)
    :do (setf (aref (car ,which) (car (cdr ,which))) line)
        (incf (car (cdr ,which)))
        (adjust-array (car ,which) (list (1+ (car (cdr ,which)))))
        (setf line (read-line stream nil nil)))
    (decf (car(cdr ,which))))))))

Better formatting:

(defmacro load-up-vector (which from-where)
  `(with-open-file (stream ,from-where
                    :direction :input
                    :if-does-not-exist NIL
                    :external-format :utf-8)
     (if (eq stream NIL) 
         (progn
           (do-msg "FILE NOT FOUND AT PROVIDED LOCATION")
           (setf *FILE-NOT-FOUND* t))
       (let ((line (read-line stream nil nil)))
         (progn 
           (loop 
            :until (eq line nil)
            :do (setf (aref (car ,which) (car (cdr ,which))) line)
            (incf (car (cdr ,which)))
            (adjust-array (car ,which) (list (1+ (car (cdr ,which)))))
            (setf line (read-line stream nil nil)))
           (decf (car(cdr ,which))))))))

But the code is broken:

• it should not be a macro
• it should not adjust the array in each iteration, which is extremely costly
• the car/cdr stuff is just not needed
• there is no reason to count anything
• *FILE-NOT-FOUND* isn't used in the program and a poor way to communicate a missing file to the rest of the program

Better code

• a function
• shorter
• no side effects
• documentation string
• more efficient
• correctly formatted
• testable

Example:

(defun read-lines-from-file (file)
  "Reads a file line by line and returns the lines in a vector.
Returns nil if the file does not exist."
  (if (probe-file file)
      (coerce (with-open-file (stream file :external-format :utf-8)
                (loop for line = (read-line stream nil nil)
                      while line
                      collect line))
              'vector)
    (warn "File ~a not found" file)))

Ideally the logic to check for an existing file and warn should not be here. Left as an exercise...

Usage

Instead of an imperative load-up-vector

(load-up-vector *foo-vector* somewhere)

use something like

(let ((foo-vector (read-lines-from-file somewhere)))
   ...)