summaryrefslogtreecommitdiff
path: root/kelime.lisp
blob: 09610cf9730ea82c68f5ff538317e83a7a58cdcf (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
(in-package :japonca)

(defclass kelime ()
  ((kanji :accessor kanji :initarg :kanji :initform nil)
   (kana :accessor kana :initarg :kana :initform nil)
   (anlam :accessor anlam :initarg :anlam :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)
    (with-slots (kanji kana anlam) kelime
      (if (null kanji)
          (format stream "~a : ~{~a~^, ~}" kana anlam)
          (format stream "~a ~a : ~{~a~^, ~}" kanji kana anlam)))))

(defun kelime-yap (kanji kana anlam)
  (make-instance 'kelime :kanji kanji :kana kana :anlam anlam))

(defmethod kanji= ((kelime kelime) kanji)
  (string= (kanji kelime) kanji))

(defmethod kana= ((kelime kelime) kana)
  (find kana (kana kelime) :test #'string=))

(defmethod anlam= ((kelime kelime) anlam)
  (find anlam (anlam kelime) :test #'string=))

(let* ((son-sayısı 5)
       (son-kelimeler (make-array son-sayısı
                                  :initial-element (make-instance 'kelime)
                                  :element-type 'kelime :fill-pointer 0))
       (i 0))
  (labels ((tarih-ekle (kelime)
             (if (= son-sayısı (fill-pointer son-kelimeler))
                 (setf (aref son-kelimeler i) kelime
                       i (mod (incf i) son-sayısı))
                 (vector-push kelime son-kelimeler))))
    (defun rastgele-kelime (kelimeler &key (test #'identity) (baş 0) son)
      ;; (declare (type number son))
      (let* ((len (length kelimeler))
             (son (if (and (not (null son)) (<= son len))
                      son
                      len))
             (kelime (loop :for kelime := (aref kelimeler (+ baş (random (- son baş))))
                           :while (or (not (funcall test kelime))
                                      (find kelime son-kelimeler :test #'eql))
                           :finally (return kelime))))
        (tarih-ekle kelime)
        kelime)))
  (defun son-rastgele-kelimeler ()
    son-kelimeler)
  (defun son-kelimeler-reset ()
    (setf (fill-pointer son-kelimeler) 0)))

(defun kelime-bul (kelimeler &key kanji)
  (let ((index (position kanji kelimeler :test #'string-equal :key #'kanji)))
    (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)
;; 						:element-type 'kelime :fill-pointer 0)))

;; (defun rastgele-kelime (kelimeler &optional if-fn)
;;   (let ((len (length kelimeler)))
;; 	(if if-fn
;; 		(loop :for kelime = (aref kelimeler (random len))
;; 			  :until (funcall if-fn kelime)
;; 			  :finally (return kelime))
;; 		(aref kelimeler (random len)))))