fork download
  1. ;; Гласные буквы русского языка
  2. (defun vowel-p (char)
  3. (member char '(#\а #\е #\ё #\и #\о #\у #\ы #\э #\ю #\я
  4. #\А #\Е #\Ё #\И #\О #\У #\Ы #\Э #\Ю #\Я)
  5. :test #'char=))
  6.  
  7. ;; Согласные буквы русского языка
  8. (defun consonant-p (char)
  9. (not (vowel-p char)))
  10.  
  11. ;; Функция для проверки наличия "й" после гласной
  12. (defun yot-after-vowel-p (chars index)
  13. (and (< (1+ index) (length chars))
  14. (let ((next-char (elt chars (1+ index))))
  15. (or (char= next-char #\й)
  16. (member next-char '(#\е #\ё #\ю #\я) :test #'char=)))
  17. (vowel-p (elt chars index))))
  18.  
  19. ;; Разбиение слова на слоги по правилам русского языка (рекурсивная версия без SETF)
  20. (defun split-word (word)
  21. (labels ((split-word-recursive (chars syllables current i)
  22. (cond
  23. ((>= i (length chars))
  24. (if current
  25. (reverse (cons (coerce (reverse current) 'string) syllables))
  26. (reverse syllables)))
  27. (t
  28. (let ((ch (elt chars i)))
  29. (cond
  30. ((vowel-p ch)
  31. (if (yot-after-vowel-p chars i)
  32. (let ((next-char (elt chars (1+ i))))
  33. (cond
  34. ((char= next-char #\й)
  35. (let ((new-current (append current (list ch next-char))))
  36. (split-word-recursive chars
  37. (cons (coerce (reverse new-current) 'string) syllables)
  38. nil
  39. (+ i 2))))
  40. ((member next-char '(#\е #\ё #\ю #\я) :test #'char=)
  41. (split-word-recursive chars
  42. (cons (coerce (reverse (cons ch current)) 'string) syllables)
  43. nil
  44. (+ i 1)))
  45. (t
  46. (split-word-recursive chars
  47. (cons (coerce (reverse (cons ch current)) 'string) syllables)
  48. nil
  49. (+ i 1)))))
  50. (split-word-recursive chars
  51. (cons (coerce (reverse (cons ch current)) 'string) syllables)
  52. nil
  53. (+ i 1))))
  54. (t
  55. (split-word-recursive chars
  56. syllables
  57. (cons ch current)
  58. (+ i 1)))))))))
  59. (split-word-recursive (coerce word 'list) nil nil 0)))
  60.  
  61. ;; Разбиение строки на слова (рекурсивная версия без SETF)
  62. (defun split-string (str)
  63. (labels ((split-string-recursive (str current-word words)
  64. (cond
  65. ((null str)
  66. (if current-word
  67. (reverse (cons (coerce (reverse current-word) 'string) words))
  68. (reverse words)))
  69. ((char= (car str) #\Space)
  70. (if current-word
  71. (split-string-recursive (cdr str) nil (cons (coerce (reverse current-word) 'string) words))
  72. (split-string-recursive (cdr str) nil words)))
  73. (t
  74. (split-string-recursive (cdr str) (cons (car str) current-word) words)))))
  75. (split-string-recursive (coerce str 'list) nil nil)))
  76.  
  77. ;; Главная функция с использованием MAPCAR
  78. (defun split-phrase (phrase)
  79. (mapcar #'split-word (split-string phrase)))
  80.  
  81. ;; Тест
  82. (print (split-phrase "написать программу"))
  83. (print (split-phrase "дана фраза на русском языке"))
  84. (print (split-phrase "война, мир, эвакуатор"))
  85. (print (split-phrase "скамейка"))
  86. (print (split-phrase "ванна"))
  87. (print (split-phrase "коллекция"))
  88. (print (split-phrase "чай"))
  89.  
Success #stdin #stdout #stderr 0.01s 9752KB
stdin
Standard input is empty
stdout
(("на" "пи" "са" "ть") ("про" "гра" "мму")) 
(("да" "на") ("фра" "за") ("на") ("ру" "сско" "м") ("я" "зы" "ке")) 
(("йов" "на" ",") ("ми" "р,") ("э" "ва" "ку" "а" "то" "р")) 
(("ска" "йем" "ка")) 
(("ва" "нна")) 
(("ко" "лле" "кци" "я")) 
(("йач")) 
stderr
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