;; Гласные буквы русского языка (defun vowel-p (char) (member char '(#\а #\е #\ё #\и #\о #\у #\ы #\э #\ю #\я #\А #\Е #\Ё #\И #\О #\У #\Ы #\Э #\Ю #\Я) :test #'char=)) ;; Согласные буквы русского языка (defun consonant-p (char) (not (vowel-p char))) ;; Функция для проверки наличия "й" после гласной (defun yot-after-vowel-p (chars index) (and (< (1+ index) (length chars)) (let ((next-char (elt chars (1+ index)))) (or (char= next-char #\й) (member next-char '(#\е #\ё #\ю #\я) :test #'char=))) (vowel-p (elt chars index)))) ;; Разбиение слова на слоги по правилам русского языка (рекурсивная версия без SETF) (defun split-word (word) (labels ((split-word-recursive (chars syllables current i) (cond ((>= i (length chars)) (if current (reverse (cons (coerce (reverse current) 'string) syllables)) (reverse syllables))) (t (let ((ch (elt chars i))) (cond ((vowel-p ch) (if (yot-after-vowel-p chars i) (let ((next-char (elt chars (1+ i)))) (cond ((char= next-char #\й) (let ((new-current (append current (list ch next-char)))) (split-word-recursive chars (cons (coerce (reverse new-current) 'string) syllables) nil (+ i 2)))) ((member next-char '(#\е #\ё #\ю #\я) :test #'char=) (split-word-recursive chars (cons (coerce (reverse (cons ch current)) 'string) syllables) nil (+ i 1))) (t (split-word-recursive chars (cons (coerce (reverse (cons ch current)) 'string) syllables) nil (+ i 1))))) (split-word-recursive chars (cons (coerce (reverse (cons ch current)) 'string) syllables) nil (+ i 1)))) (t (split-word-recursive chars syllables (cons ch current) (+ i 1))))))))) (split-word-recursive (coerce word 'list) nil nil 0))) ;; Разбиение строки на слова (рекурсивная версия без SETF) (defun split-string (str) (labels ((split-string-recursive (str current-word words) (cond ((null str) (if current-word (reverse (cons (coerce (reverse current-word) 'string) words)) (reverse words))) ((char= (car str) #\Space) (if current-word (split-string-recursive (cdr str) nil (cons (coerce (reverse current-word) 'string) words)) (split-string-recursive (cdr str) nil words))) (t (split-string-recursive (cdr str) (cons (car str) current-word) words))))) (split-string-recursive (coerce str 'list) nil nil))) ;; Главная функция с использованием MAPCAR (defun split-phrase (phrase) (mapcar #'split-word (split-string phrase))) ;; Тест (print (split-phrase "написать программу")) (print (split-phrase "дана фраза на русском языке")) (print (split-phrase "война, мир, эвакуатор")) (print (split-phrase "скамейка")) (print (split-phrase "ванна")) (print (split-phrase "коллекция")) (print (split-phrase "чай"))
Standard input is empty
(("на" "пи" "са" "ть") ("про" "гра" "мму"))
(("да" "на") ("фра" "за") ("на") ("ру" "сско" "м") ("я" "зы" "ке"))
(("йов" "на" ",") ("ми" "р,") ("э" "ва" "ку" "а" "то" "р"))
(("ска" "йем" "ка"))
(("ва" "нна"))
(("ко" "лле" "кци" "я"))
(("йач"))
Warning: reserving address range 0x80000c0000...0x1fffffffffff that contains memory mappings. clisp might crash later! Memory dump: 0x8000000000 - 0x80000bffff 0x15212e400000 - 0x15212e6e4fff 0x15212e800000 - 0x15212e802fff 0x15212e803000 - 0x15212ea01fff 0x15212ea02000 - 0x15212ea02fff 0x15212ea03000 - 0x15212ea03fff 0x15212ea15000 - 0x15212ea39fff 0x15212ea3a000 - 0x15212ebacfff 0x15212ebad000 - 0x15212ebf5fff 0x15212ebf6000 - 0x15212ebf8fff 0x15212ebf9000 - 0x15212ebfbfff 0x15212ebfc000 - 0x15212ebfffff 0x15212ec00000 - 0x15212ec03fff 0x15212ec04000 - 0x15212ee03fff 0x15212ee04000 - 0x15212ee04fff 0x15212ee05000 - 0x15212ee05fff 0x15212ee62000 - 0x15212ee63fff 0x15212ee64000 - 0x15212ee73fff 0x15212ee74000 - 0x15212eea7fff 0x15212eea8000 - 0x15212efdefff 0x15212efdf000 - 0x15212efdffff 0x15212efe0000 - 0x15212efe2fff 0x15212efe3000 - 0x15212efe3fff 0x15212efe4000 - 0x15212efe5fff 0x15212efe6000 - 0x15212efe6fff 0x15212efe7000 - 0x15212efe8fff 0x15212efe9000 - 0x15212efe9fff 0x15212efea000 - 0x15212efeafff 0x15212efeb000 - 0x15212efebfff 0x15212efec000 - 0x15212eff9fff 0x15212effa000 - 0x15212f007fff 0x15212f008000 - 0x15212f014fff 0x15212f015000 - 0x15212f018fff 0x15212f019000 - 0x15212f019fff 0x15212f01a000 - 0x15212f01afff 0x15212f01b000 - 0x15212f020fff 0x15212f021000 - 0x15212f022fff 0x15212f023000 - 0x15212f023fff 0x15212f024000 - 0x15212f024fff 0x15212f025000 - 0x15212f025fff 0x15212f026000 - 0x15212f053fff 0x15212f054000 - 0x15212f062fff 0x15212f063000 - 0x15212f108fff 0x15212f109000 - 0x15212f19ffff 0x15212f1a0000 - 0x15212f1a0fff 0x15212f1a1000 - 0x15212f1a1fff 0x15212f1a2000 - 0x15212f1b5fff 0x15212f1b6000 - 0x15212f1ddfff 0x15212f1de000 - 0x15212f1e7fff 0x15212f1e8000 - 0x15212f1e9fff 0x15212f1ea000 - 0x15212f1effff 0x15212f1f0000 - 0x15212f1f2fff 0x15212f1f5000 - 0x15212f1f5fff 0x15212f1f6000 - 0x15212f1f6fff 0x15212f1f7000 - 0x15212f1f7fff 0x15212f1f8000 - 0x15212f1f8fff 0x15212f1f9000 - 0x15212f1f9fff 0x15212f1fa000 - 0x15212f200fff 0x15212f201000 - 0x15212f203fff 0x15212f204000 - 0x15212f204fff 0x15212f205000 - 0x15212f225fff 0x15212f226000 - 0x15212f22dfff 0x15212f22e000 - 0x15212f22efff 0x15212f22f000 - 0x15212f22ffff 0x15212f230000 - 0x15212f230fff 0x55e9e86e8000 - 0x55e9e87d8fff 0x55e9e87d9000 - 0x55e9e88e2fff 0x55e9e88e3000 - 0x55e9e8942fff 0x55e9e8944000 - 0x55e9e8972fff 0x55e9e8973000 - 0x55e9e89a3fff 0x55e9e89a4000 - 0x55e9e89a7fff 0x55e9e98e2000 - 0x55e9e9902fff 0x7ffe7a4fe000 - 0x7ffe7a51efff 0x7ffe7a5bb000 - 0x7ffe7a5befff 0x7ffe7a5bf000 - 0x7ffe7a5c0fff