minik refactor ve rastgele sırayla tüm kelimeleri sorma

kelime.lisp

@@ -4,8 +4,9 @@
   ((kanji :accessor kanji :initarg :kanji :initform nil)
    (kana :accessor kana :initarg :kana :initform nil)
    (anlam :accessor anlam :initarg :anlam :initform nil)
-   (grup :accessor grup :initarg :grup :initform nil)
+   (tür :accessor tür :initarg :tür :initform nil)
-   (altgrup :accessor altgrup :initarg :altgrup :initform nil)))
+   (alttür :accessor alttür :initarg :alttür :initform nil)
+   (sıra :accessor sıra :initarg :sıra :initform nil)))
 
 (defmethod print-object ((kelime kelime) stream)
   (print-unreadable-object (kelime stream :type t)
@@ -58,6 +59,22 @@
     (if index
         (values (aref kelimeler index) index))))
 
+(defun kelimeleri-kar (kelimeler)
+  (let ((boy (length kelimeler)))
+    (loop :repeat (* 10 boy)
+          :do (rotatef (aref kelimeler (random boy))
+                       (aref kelimeler (random boy))))))
+
+(defun kelimeleri-sırala (kelimeler)
+  (let ((boy (length kelimeler))
+        (i 0))
+    (loop :while (< i boy)
+          :do (let ((kelime (aref kelimeler i)))
+                (if (= i (sıra kelime))
+                    (incf i)
+                    (rotatef (aref kelimeler i)
+                             (aref kelimeler (sıra kelime))))))))
+
 ;; (defun son-n-kelime-tut (n)
 ;; 	(setf son-kelimeler
 ;; 		  (make-array n :initial-element (make-instance 'kelime)

okur.lisp

@@ -96,8 +96,8 @@
             (boşluk-geç okur)
             (anlam-oku okur)))))
 
-(defmethod kelime-oku ((okur okur))
+(defmethod kelime-oku ((okur okur) sıra)
-  (let (kanji kana anlam grup altgrup)
+  (let (kanji kana anlam tür alttür)
     (setf kanji (kanji-oku okur))
     (boşluk-geç okur)
     (setf kana (kana-oku okur))
@@ -107,28 +107,30 @@
       ;; (yeni-satıra-geç okur)
         (kar-oku okur)
         (boşluk-geç okur)
-        (setf grup (sonraki-öbek okur '(#\Newline #\Space #\; #\,)))
+        (setf tür (sonraki-öbek okur '(#\Newline #\Space #\; #\,)))
-        (cond ((or (string= grup "fiil")
+        (cond ((or (string= tür "fiil")
-                   (string= grup "sıfat"))
+                   (string= tür "sıfat"))
                (boşluk-geç okur)
-               (setf altgrup (sonraki-öbek okur '(#\Newline #\Space #\;))))
+               (setf alttür (sonraki-öbek okur '(#\Newline #\Space #\;))))
               ((char= #\, (kar-bak okur))
                (kar-oku okur)
                (boşluk-geç okur)
-               (push (sonraki-öbek okur '(#\Newline #\Space #\;)) grup))))
+               (setf tür (list tür (sonraki-öbek okur '(#\Newline #\Space #\;)))))))
     (make-instance 'kelime :kanji kanji :kana kana :anlam anlam
-                           :grup grup :altgrup altgrup)))
+                           :tür tür :alttür alttür :sıra sıra)))
 
 (defmethod işle ((okur okur))
   (unless (eq :baş (durum okur))
     (error "Okur zaten işlenmiş"))
-  (loop :until (metin-bitti? okur)
+  (loop :with sıra := 0
+        :until (metin-bitti? okur)
         :do (case (kar-bak okur)
               (#\; (yeni-satıra-geç okur))
               (#\Newline (yeni-satıra-geç okur))
               (#\Space (boşluk-geç okur))
-              (otherwise (vector-push-extend (kelime-oku okur)
+              (otherwise (vector-push-extend (kelime-oku okur sıra)
-                                             (kelimeler okur)))))
+                                             (kelimeler okur))
+               (incf sıra))))
   (kelimeler okur))
 
 (defmacro okurla ((isim dosya-ismi) &body beden)

paket.lisp

@@ -1,2 +1,3 @@
 (defpackage :japonca
-  (:use :common-lisp))
+  (:use :common-lisp)
+  (:export alıştırma kelime-bul))

soru.lisp

@@ -4,8 +4,7 @@
 
 (defparameter *kelimeler* nil)
 (defparameter *kelimeler-dosyası*
-  (format nil "/home/~a/projects/japonca/kelime/kelimeler.txt"
+  (asdf:system-relative-pathname :japonca "kelime/kelimeler.txt"))
-          (uiop:hostname)))
 
 (defun kelimeleri-yükle (&optional (dosya *kelimeler-dosyası*))
   (setf *kelimeler*
@@ -40,25 +39,41 @@
 
 (defgeneric alıştırma (tip &key &allow-other-keys))
 
-(defmethod alıştırma :before ((tip (eql :okunuş)) &key (baş 0) son &allow-other-keys)
+(defmethod alıştırma :before ((tip (eql :okunuş)) &key (baş 0) son sırayla (kelimeler *kelimeler*) &allow-other-keys)
-  (when (null *kelimeler*)
+  (when (null kelimeler)
-    (kelimeleri-yükle))
+    (setf kelimeler (kelimeleri-yükle)))
-  (format t "Tanımlı kelimeler: ~d~%" (fill-pointer *kelimeler*))
+  (format t "Tanımlı kelimeler: ~d~%" (fill-pointer kelimeler))
   (when (not son)
-    (setf son (length *kelimeler*)))
+    (setf son (length kelimeler)))
-  (format t "Aralık: ~d-~d, ~d kelime~%" baş (- son 1) (- son baş)))
+  (when (not sırayla)
+    (format t "Aralık: ~d-~d, ~d kelime~%" baş (- son 1) (- son baş))))
 
-(defmethod alıştırma ((tip (eql :okunuş)) &key (baş 0) son &allow-other-keys)
+(defmethod alıştırma ((tip (eql :okunuş)) &key (baş 0) son sırayla (kelimeler *kelimeler*) &allow-other-keys)
   (let ((yanlış 0) (doğru 0))
+    (if (not sırayla)
         (loop :for *soru-sayısı* :from 1
-          :for cevap := (kelime-soru (rastgele-kelime *kelimeler* :test #'kanji
+              :for cevap := (kelime-soru (rastgele-kelime kelimeler :test #'kanji
                                                                     :baş baş :son son)
                                          :okunuş)
               :do (cond ((eq :çık cevap)
                          (format t "~d/~d~%" doğru (+ doğru yanlış))
                          (loop-finish))
                         ((not cevap) (incf yanlış))
-                    (t (incf doğru))))))
+                        (t (incf doğru))))
+        (progn (kelimeleri-kar kelimeler)
+               (loop :with *soru-sayısı* := 1
+                     :for i :from 0 :below (length kelimeler)
+                     :for cevap := (if (null (kanji (aref kelimeler i)))
+                                       :geç
+                                       (kelime-soru (aref kelimeler i) :okunuş))
+                     :do (cond ((eq :çık cevap)
+                                (format t "~d/~d~%" doğru (+ doğru yanlış))
+                                (loop-finish))
+                               ((not cevap) (incf yanlış))
+                               (t (incf doğru)))
+                         (unless (eq :geç cevap)
+                           (incf *soru-sayısı*)))
+               (kelimeleri-sırala kelimeler)))))
 
 ;; (defmacro soru-tanım (args &body beden)
 ;;   `(block soru