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

This commit is contained in:
2025-03-04 21:36:34 +03:00
parent 20ba3d08cc
commit 5faa1b4c9d
4 changed files with 68 additions and 33 deletions

View File

@@ -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)
(altgrup :accessor altgrup :initarg :altgrup :initform nil)))
(tür :accessor tür :initarg :tür :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)

View File

@@ -96,8 +96,8 @@
(boşluk-geç okur)
(anlam-oku okur)))))
(defmethod kelime-oku ((okur okur))
(let (kanji kana anlam grup altgrup)
(defmethod kelime-oku ((okur okur) sıra)
(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 #\; #\,)))
(cond ((or (string= grup "fiil")
(string= grup "sıfat"))
(setf tür (sonraki-öbek okur '(#\Newline #\Space #\; #\,)))
(cond ((or (string= tür "fiil")
(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)
(kelimeler okur)))))
(otherwise (vector-push-extend (kelime-oku okur sıra)
(kelimeler okur))
(incf sıra))))
(kelimeler okur))
(defmacro okurla ((isim dosya-ismi) &body beden)

View File

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

View File

@@ -4,8 +4,7 @@
(defparameter *kelimeler* nil)
(defparameter *kelimeler-dosyası*
(format nil "/home/~a/projects/japonca/kelime/kelimeler.txt"
(uiop:hostname)))
(asdf:system-relative-pathname :japonca "kelime/kelimeler.txt"))
(defun kelimeleri-yükle (&optional (dosya *kelimeler-dosyası*))
(setf *kelimeler*
@@ -26,7 +25,7 @@
(when *soru-sayısı*
(format t "~a. " *soru-sayısı*)))
(defmethod kelime-soru ((kelime kelime) (tip (eql :okunuş)) )
(defmethod kelime-soru ((kelime kelime) (tip (eql :okunuş)))
(block soru
(let (cevap sonuç)
(format t "~a nasıl okunur ? " (kanji kelime))
@@ -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)
(when (null *kelimeler*)
(kelimeleri-yükle))
(format t "Tanımlı kelimeler: ~d~%" (fill-pointer *kelimeler*))
(defmethod alıştırma :before ((tip (eql :okunuş)) &key (baş 0) son sırayla (kelimeler *kelimeler*) &allow-other-keys)
(when (null kelimeler)
(setf kelimeler (kelimeleri-yükle)))
(format t "Tanımlı kelimeler: ~d~%" (fill-pointer kelimeler))
(when (not son)
(setf son (length *kelimeler*)))
(format t "Aralık: ~d-~d, ~d kelime~%" baş (- son 1) (- son baş)))
(setf son (length kelimeler)))
(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))
(loop :for *soru-sayısı* :from 1
: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))))))
(if (not sırayla)
(loop :for *soru-sayısı* :from 1
: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))))
(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