首页
学习
活动
专区
圈层
工具
发布
社区首页 >问答首页 >使用通用Lisp和ltk库的语言培训程序

使用通用Lisp和ltk库的语言培训程序
EN

Code Review用户
提问于 2017-03-10 10:16:09
回答 2查看 206关注 0票数 6

其构想如下:

我们提供了两个文件:一个带有英文单词,另一个带有单词,比方说西班牙语。这些文件每一行都有一个单词(可能是一个单词,或word+some解释等等),并根据它们的翻译在文件中排序:例如,第一个文件的第5行包含单词"a stone“,第2行的第5行包含单词"a stone”的翻译。

节目问你以下问题:

  1. 它决定是否用英语说出你的话,并期望得到一个翻译或相反的方式(伪随机各占50% )。
  2. 它伪随机地选择了3个错误答案,再加上正确的答案,给出了这4种可能的选择。
  3. 你从这四个选项中选择一个,它相应地做出反应,跟踪你的赢/全比,赢/输连胜,最长的连胜,在每个问题之后给出正确的答案,并告诉你你的答案是对是错。

有两个入口点可以写入文件的路径。还有一种选择是从两条记忆中的路径中选择一条(根据你想要训练的语言,可以是西班牙语、汉语或其他什么)。

它为我做了它的工作(如果你提供了错误的路径,但这并不可怕,它会为一个错误而发生),但我想知道我应该改进什么,什么是糟糕的风格,什么可能会带来不好的表现,等等。

我还想知道如何制作一个.exe,同时确保每次运行伪随机序列时都会不同(我设法制作了一个.exe,但是每次打开它时,这个序列都是相同的)。如您所见,我将文件的全部内容加载到两个数组中。可以练习吗?我怎样才能更好地处理这件事呢?

代码语言:javascript
复制
(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)
)))
EN

回答 2

Code Review用户

回答已采纳

发布于 2017-03-11 15:41:23

您可能需要解释输入文件的格式和/或提供一些示例。当两个文件中的单词少于四个字时,程序也会中断。

除了@已经说过的话:

  • 使用缩进更好的编辑器,如Vim或Emacs。例如,您可能(嗯,威尔)甚至可以通过计算光标下的单个表单来获得更好的体验。
  • 一致性是关键,所以要么编写tT (IMO搜索大写字母"T“使其更容易)、nilNIL以及一般的符号。
  • #'(lambda ...)是不常见的,因为(lambda ...)本身也是足够的。
  • (eq x NIL)在某种程度上被简化为(not X),因为NIL是单个虚值。

看看ASDF (和其他人的代码--这里有很多很好的例子!)可用于定义和加载项目的依赖项,特别是LTK。大多数人在他们的系统上当然没有C:/sbcl/1.3.12/ltk/ltk.lisp,即使他们把Windows作为他们的操作系统(更不用说硬编码的路径了)。还可以使用defpackage,这样并不是所有的定义都被转储到CL-USER中。

例如training.asd

代码语言:javascript
复制
(asdf:defsystem :training
  :encoding :utf-8
  :depends-on (:ltk)
  :serial T
  :components ((:file "package")
               (:file "training")))

package.lisp

代码语言:javascript
复制
(defpackage :training
  (:use :cl :ltk))

training.lisp中,第一行最后将是:

代码语言:javascript
复制
(in-package :training)

超级简单,帮助您更好地组织您的代码。

因此,例如,REFRESH-DISPLAY被定义为宏,因为RATE和其他变量没有正确公开。不幸的是,这样做是错误的。函数应该接收一个参数,该参数包含所有有关的小部件。对象已经(必然)被使用,因此自定义对象的DEFCLASS就可以了(是的,您可以用一个小部件列表代替,但是让我们选择更正确的选项):

代码语言:javascript
复制
(defclass training ()
  ((rate :accessor rate :initarg :rate)
   (longest-win-streak :accessor longest-win-streak :initarg :longest-win-streak)
   (streak :accessor streak :initarg :streak)))

这不是最终的,但足以将REFRESH-DISPLAYRESET-STANCE转换为函数:

代码语言:javascript
复制
(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))

看看这是怎么回事?在MAIN-DISPLAY中,相关部分如下:

代码语言:javascript
复制
(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)))
  ...)

但是,一旦所有宏都消失了,还有很多工作要做。例如,REFRESH-DISPLAY的最终版本应该更接近于以下内容,因为CONCATENATE加上WRITE-TO-STRING只是为了达到这个目的而不必要地冗长:

代码语言:javascript
复制
(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"))))

如果您喜欢WITH-SLOTS/WITH-ACCESSORS,也可以以重复插槽名称为代价进行合并。

最后,我可能会将大多数全局变量也移到该类中,或者移动到一个单独的“数据模型”类中,该类存储应用程序的非UI状态。

希望这能帮上忙。过度使用全局状态、重复代码以及限制自己不使用库和标准工具都限制了您编写更复杂的应用程序,更不用说当其他人(包括您在一个月内)不得不阅读该代码时,它们会影响理解。

票数 2
EN

Code Review用户

发布于 2017-03-11 08:39:20

Bad

  • 非常糟糕:无缘无故地使用宏。使用函数。
  • 像加载词汇表这样的基本操作是不可读的。
  • 使用可调阵列。要容易得多:读取一个列表,然后将其转换为一个向量。
  • 在每个循环迭代中,由一个元素调整数组是非常低效率的。
  • 使用填充指针和向量推送扩展来模拟可调数组的性能较差。
  • 格式和缩进错误
  • 大量未记录的全局变量
  • 代码中没有文档
  • 混合逻辑和UI代码
  • 硬编码文件名
  • 每个功能都应该是一个理想的功能,可以单独使用和测试。
  • 调用格式来在刚刚创建的字符串上创建字符串是无用的。
  • 代码不是结构化的

我想说:彻底重写是必要的。

示例

您的代码有错误的缩进/格式:

代码语言:javascript
复制
(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))))))))

更好的格式:

代码语言:javascript
复制
(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))))))))

但是密码被破坏了:

  • 它不应该是一个宏
  • 它不应该在每次迭代中调整数组,这是非常昂贵的。
  • 汽车/cdr的东西只是不需要
  • 没有理由计算任何事情
  • 程序中没有使用*FILE-NOT-FOUND*,也没有向程序的其余部分传递丢失的文件的糟糕方法

更好的代码

  • 一个函数
  • 更短
  • 无副作用
  • 文档字符串
  • 更有效率
  • 正确格式化
  • 可测性

示例:

代码语言:javascript
复制
(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)))

理想情况下,检查现有文件和警告的逻辑不应该在这里。留作练习..。

使用

而不是命令式load-up-vector

代码语言:javascript
复制
(load-up-vector *foo-vector* somewhere)

使用类似的东西

代码语言:javascript
复制
(let ((foo-vector (read-lines-from-file somewhere)))
   ...)
票数 3
EN
页面原文内容由Code Review提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接:

https://codereview.stackexchange.com/questions/157412

复制
相关文章

相似问题

领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档