fork download
  1. ;;; Глобальные константы
  2. (defconstant +glasn+ '(#\А #\Е #\Ё #\И #\О #\У #\Ы #\Э #\Ю #\Я #\а #\е #\ё #\и #\о #\у #\ы #\э #\ю #\я)
  3. "Список гласных букв")
  4. (defconstant +sonorn+ '(#\Л #\М #\Н #\Р #\л #\м #\н #\р #\Й #\й)
  5. "Список сонорных согласных букв")
  6.  
  7. ;;; Проверка гласной
  8. (defun glasn (char)
  9. (member char +glasn+ :test #'char-equal))
  10.  
  11. ;;; Проверка сонорного согласного
  12. (defun sonorn (char)
  13. (member char +sonorn+ :test #'char-equal))
  14.  
  15. ;;; Проверка шумного согласного (не гласная и не сонорная)
  16. (defun shumn (char)
  17. (and (characterp char)
  18. (not (glasn char))
  19. (not (sonorn char))))
  20.  
  21. ;;; Разбиение слова на слоги (упрощённый и исправленный вариант)
  22. (defun razbit-na-slogi (word)
  23. (let ((slogi '())
  24. (current-slog '()))
  25. (labels ((add-slog ()
  26. (when current-slog
  27. (push (coerce (nreverse current-slog) 'string) slogi)
  28. (setf current-slog '()))))
  29. (dotimes (i (length word))
  30. (let ((char (char word i)))
  31. (push char current-slog)
  32. (when (glasn char)
  33. (if (<= (length current-slog) 1)
  34. (add-slog)
  35. (let* ((rev-slog (reverse current-slog))
  36. (last1 (nth 0 rev-slog)) ; последний символ (гласная)
  37. (last2 (nth 1 rev-slog))) ; предпоследний символ
  38. (cond
  39. ;; Два шумных подряд - последний переходит в следующий слог
  40. ((and (shumn last1) (shumn last2))
  41. (push last1 rev-slog) ;; возвращаем последний назад
  42. (setf current-slog (list last1))
  43. (add-slog))
  44. ;; Два сонорных подряд, кроме 'й' - последний переходит в следующий слог
  45. ((and (sonorn last1) (sonorn last2) (not (char-equal last1 #\й)))
  46. (push last1 rev-slog)
  47. (setf current-slog (list last1))
  48. (add-slog))
  49. ;; Иначе разделяем здесь
  50. (t (add-slog))))))))
  51. ;; Добавляем последний слог, если остался
  52. (when current-slog
  53. (push (coerce (nreverse current-slog) 'string) slogi))
  54. ;; Возвращаем слоги в правильном порядке
  55. (nreverse slogi))))
Success #stdin #stdout #stderr 0.01s 9500KB
stdin
Standard input is empty
stdout
Standard output is empty
stderr
Warning: reserving address range 0x80000c0000...0x1fffffffffff that contains memory mappings. clisp might crash later!
Memory dump:
  0x8000000000 - 0x80000bffff
  0x14da49e00000 - 0x14da4a0e4fff
  0x14da4a215000 - 0x14da4a239fff
  0x14da4a23a000 - 0x14da4a3acfff
  0x14da4a3ad000 - 0x14da4a3f5fff
  0x14da4a3f6000 - 0x14da4a3f8fff
  0x14da4a3f9000 - 0x14da4a3fbfff
  0x14da4a3fc000 - 0x14da4a3fffff
  0x14da4a400000 - 0x14da4a402fff
  0x14da4a403000 - 0x14da4a601fff
  0x14da4a602000 - 0x14da4a602fff
  0x14da4a603000 - 0x14da4a603fff
  0x14da4a680000 - 0x14da4a68ffff
  0x14da4a690000 - 0x14da4a6c3fff
  0x14da4a6c4000 - 0x14da4a7fafff
  0x14da4a7fb000 - 0x14da4a7fbfff
  0x14da4a7fc000 - 0x14da4a7fefff
  0x14da4a7ff000 - 0x14da4a7fffff
  0x14da4a800000 - 0x14da4a803fff
  0x14da4a804000 - 0x14da4aa03fff
  0x14da4aa04000 - 0x14da4aa04fff
  0x14da4aa05000 - 0x14da4aa05fff
  0x14da4ab1d000 - 0x14da4ab20fff
  0x14da4ab21000 - 0x14da4ab21fff
  0x14da4ab22000 - 0x14da4ab23fff
  0x14da4ab24000 - 0x14da4ab24fff
  0x14da4ab25000 - 0x14da4ab25fff
  0x14da4ab26000 - 0x14da4ab26fff
  0x14da4ab27000 - 0x14da4ab34fff
  0x14da4ab35000 - 0x14da4ab42fff
  0x14da4ab43000 - 0x14da4ab4ffff
  0x14da4ab50000 - 0x14da4ab53fff
  0x14da4ab54000 - 0x14da4ab54fff
  0x14da4ab55000 - 0x14da4ab55fff
  0x14da4ab56000 - 0x14da4ab5bfff
  0x14da4ab5c000 - 0x14da4ab5dfff
  0x14da4ab5e000 - 0x14da4ab5efff
  0x14da4ab5f000 - 0x14da4ab5ffff
  0x14da4ab60000 - 0x14da4ab60fff
  0x14da4ab61000 - 0x14da4ab8efff
  0x14da4ab8f000 - 0x14da4ab9dfff
  0x14da4ab9e000 - 0x14da4ac43fff
  0x14da4ac44000 - 0x14da4acdafff
  0x14da4acdb000 - 0x14da4acdbfff
  0x14da4acdc000 - 0x14da4acdcfff
  0x14da4acdd000 - 0x14da4acf0fff
  0x14da4acf1000 - 0x14da4ad18fff
  0x14da4ad19000 - 0x14da4ad22fff
  0x14da4ad23000 - 0x14da4ad24fff
  0x14da4ad25000 - 0x14da4ad2afff
  0x14da4ad2b000 - 0x14da4ad2dfff
  0x14da4ad30000 - 0x14da4ad30fff
  0x14da4ad31000 - 0x14da4ad31fff
  0x14da4ad32000 - 0x14da4ad32fff
  0x14da4ad33000 - 0x14da4ad33fff
  0x14da4ad34000 - 0x14da4ad34fff
  0x14da4ad35000 - 0x14da4ad3bfff
  0x14da4ad3c000 - 0x14da4ad3efff
  0x14da4ad3f000 - 0x14da4ad3ffff
  0x14da4ad40000 - 0x14da4ad60fff
  0x14da4ad61000 - 0x14da4ad68fff
  0x14da4ad69000 - 0x14da4ad69fff
  0x14da4ad6a000 - 0x14da4ad6afff
  0x14da4ad6b000 - 0x14da4ad6bfff
  0x55c4cf24b000 - 0x55c4cf33bfff
  0x55c4cf33c000 - 0x55c4cf445fff
  0x55c4cf446000 - 0x55c4cf4a5fff
  0x55c4cf4a7000 - 0x55c4cf4d5fff
  0x55c4cf4d6000 - 0x55c4cf506fff
  0x55c4cf507000 - 0x55c4cf50afff
  0x55c4cfad2000 - 0x55c4cfaf2fff
  0x7ffec306f000 - 0x7ffec308ffff
  0x7ffec3178000 - 0x7ffec317bfff
  0x7ffec317c000 - 0x7ffec317dfff