fork(1) download
  1. (defun гласная? (char)
  2. "Проверяет, является ли символ гласной буквой."
  3. (member char '(#\а #\у #\о #\ы #\и #\э #\я #\ю #\ё #\е) :test #'char-equal))
  4.  
  5. (defun согласная? (char)
  6. "Проверяет, является ли символ согласной буквой."
  7. (and (graphic-char-p char)
  8. (not (гласная? char))))
  9.  
  10. (defun дели-слово (слово)
  11. "Преобразует слово в список его букв."
  12. (coerce (string слово) 'list))
  13.  
  14. (defun дели-слово-рекурсия (начало конец)
  15. "Делит слово на две части (рекурсивно)."
  16. (cond
  17. ((null конец) (list начало nil)) ; Список букв закончился
  18. ((гласная? (first конец)) (list (append начало (list (first конец))) (rest конец))) ; Если гласная, то это конец слога
  19. ((согласная? (first конец)) ; Если первый символ - согласная
  20. (if (null (rest конец)) ; Если это последний символ, тоже завершаем слог
  21. (list (append начало (list (first конец))) nil)
  22. (дели-слово-рекурсия (append начало (list (first конец))) (rest конец))))
  23. (t (list начало конец)))) ; Символ не гласная и не согласная
  24.  
  25. (defun раздели-слово (слово)
  26. "Основная функция разделения слова."
  27. (let ((буквы (дели-слово слово)))
  28. (дели-слово-рекурсия '() буквы)))
  29.  
  30. (defun первый-слог (слово)
  31. "Возвращает первый слог слова."
  32. (let ((результат (раздели-слово слово)))
  33. (when (first результат)
  34. (coerce (first результат) 'string))))
  35.  
  36. (defun остаток-слова (слово)
  37. "Возвращает часть слова, идущую после первого слога."
  38. (let ((результат (раздели-слово слово)))
  39. (if (second результат)
  40. (coerce (second результат) 'string)
  41. "")))
  42.  
  43. (defun сплетник-слово (слово ключевое-слово)
  44. "Возвращает слово и ключевое слово."
  45. (list слово ключевое-слово))
  46.  
  47. (defun safe-string (arg)
  48. "Преобразует символ или число в строку, или возвращает строку без изменений."
  49. (cond ((stringp arg) arg)
  50. ((symbolp arg) (symbol-name arg))
  51. ((numberp arg) (write-to-string arg))
  52. (t "")))
  53.  
  54. (defun сплетник-предложение-safe (предложение ключевое-слово)
  55. "Безопасная версия для разнородных списков и отсутствия слов."
  56. (let ((ключевое-слово-str (safe-string ключевое-слово)))
  57. (mapcar #'(lambda (слово)
  58. (if (stringp слово)
  59. (сплетник-слово слово ключевое-слово-str)
  60. (list (safe-string слово) ключевое-слово-str))) ; Обрабатываем все как строки
  61. предложение)))
  62.  
  63. (defun сплетник-предложение (предложение ключевое-слово)
  64. "Переводит предложение на 'язык сплетника'."
  65. (mapcar #'(lambda (слово) (сплетник-слово слово ключевое-слово)) предложение))
  66.  
  67. ;; Examples:
  68. (let ((предложение '("слово" "переводится" "" 123 :символ nil "на" "язык" "сплетника"))
  69. (ключевое-слово "сплетня"))
  70. (format t "Исходное предложение: ~A~%" предложение)
  71. (format t "Ключевое слово: ~A~%" ключевое-слово)
  72. (format t "Предложение на языке сплетника: ~A~%" (сплетник-предложение-safe предложение ключевое-слово)))
  73.  
  74. (let ((предложение '("мгла" "переводится" "на" "язык" "сплетника"))
  75. (ключевое-слово "сплетня"))
  76. (format t "Исходное предложение: ~A~%" предложение)
  77. (format t "Ключевое слово: ~A~%" ключевое-слово)
  78. (format t "Предложение на языке сплетника: ~A~%" (сплетник-предложение предложение ключевое-слово)))
  79.  
  80. (let ((предложение '("надкусить" "ломтик" "колбасы"))
  81. (ключевое-слово "сплетня"))
  82. (format t "Исходное предложение: ~A~%" предложение)
  83. (format t "Ключевое слово: ~A~%" ключевое-слово)
  84. (format t "Предложение на языке сплетника: ~A~%" (сплетник-предложение предложение ключевое-слово)))
  85.  
  86. (let ((предложение '("написать" "программу" "обработки" "текста"))
  87. (ключевое-слово "сплетня"))
  88. (format t "Исходное предложение: ~A~%" предложение)
  89. (format t "Ключевое слово: ~A~%" ключевое-слово)
  90. (format t "Предложение на языке сплетника: ~A~%" (сплетник-предложение предложение ключевое-слово)))
  91.  
  92. (let ((предложение '("отговорила" "роща" "золотая"))
  93. (ключевое-слово "кумир"))
  94. (format t "Исходное предложение: ~A~%" предложение)
  95. (format t "Ключевое слово: ~A~%" ключевое-слово)
  96. (format t "Предложение на языке сплетника: ~A~%" (сплетник-предложение предложение ключевое-слово)))
Success #stdin #stdout #stderr 0.02s 9640KB
stdin
Standard input is empty
stdout
Исходное предложение: (слово переводится  123 СИМВОЛ NIL на язык сплетника)
Ключевое слово: сплетня
Предложение на языке сплетника: 
((слово сплетня) (переводится сплетня) ( сплетня) (123 сплетня)
 (СИМВОЛ сплетня) (NIL сплетня) (на сплетня) (язык сплетня)
 (сплетника сплетня))
Исходное предложение: (мгла переводится на язык сплетника)
Ключевое слово: сплетня
Предложение на языке сплетника: 
((мгла сплетня) (переводится сплетня) (на сплетня) (язык сплетня)
 (сплетника сплетня))
Исходное предложение: (надкусить ломтик колбасы)
Ключевое слово: сплетня
Предложение на языке сплетника: ((надкусить сплетня) (ломтик сплетня) (колбасы сплетня))
Исходное предложение: (написать программу обработки текста)
Ключевое слово: сплетня
Предложение на языке сплетника: ((написать сплетня) (программу сплетня) (обработки сплетня) (текста сплетня))
Исходное предложение: (отговорила роща золотая)
Ключевое слово: кумир
Предложение на языке сплетника: ((отговорила кумир) (роща кумир) (золотая кумир))
stderr
Warning: reserving address range 0x80000c0000...0x1fffffffffff that contains memory mappings. clisp might crash later!
Memory dump:
  0x8000000000 - 0x80000bffff
  0x15464c000000 - 0x15464c2e4fff
  0x15464c415000 - 0x15464c439fff
  0x15464c43a000 - 0x15464c5acfff
  0x15464c5ad000 - 0x15464c5f5fff
  0x15464c5f6000 - 0x15464c5f8fff
  0x15464c5f9000 - 0x15464c5fbfff
  0x15464c5fc000 - 0x15464c5fffff
  0x15464c600000 - 0x15464c602fff
  0x15464c603000 - 0x15464c801fff
  0x15464c802000 - 0x15464c802fff
  0x15464c803000 - 0x15464c803fff
  0x15464c880000 - 0x15464c88ffff
  0x15464c890000 - 0x15464c8c3fff
  0x15464c8c4000 - 0x15464c9fafff
  0x15464c9fb000 - 0x15464c9fbfff
  0x15464c9fc000 - 0x15464c9fefff
  0x15464c9ff000 - 0x15464c9fffff
  0x15464ca00000 - 0x15464ca03fff
  0x15464ca04000 - 0x15464cc03fff
  0x15464cc04000 - 0x15464cc04fff
  0x15464cc05000 - 0x15464cc05fff
  0x15464cc07000 - 0x15464cc0afff
  0x15464cc0b000 - 0x15464cc0bfff
  0x15464cc0c000 - 0x15464cc0dfff
  0x15464cc0e000 - 0x15464cc0efff
  0x15464cc0f000 - 0x15464cc0ffff
  0x15464cc10000 - 0x15464cc10fff
  0x15464cc11000 - 0x15464cc1efff
  0x15464cc1f000 - 0x15464cc2cfff
  0x15464cc2d000 - 0x15464cc39fff
  0x15464cc3a000 - 0x15464cc3dfff
  0x15464cc3e000 - 0x15464cc3efff
  0x15464cc3f000 - 0x15464cc3ffff
  0x15464cc40000 - 0x15464cc45fff
  0x15464cc46000 - 0x15464cc47fff
  0x15464cc48000 - 0x15464cc48fff
  0x15464cc49000 - 0x15464cc49fff
  0x15464cc4a000 - 0x15464cc4afff
  0x15464cc4b000 - 0x15464cc78fff
  0x15464cc79000 - 0x15464cc87fff
  0x15464cc88000 - 0x15464cd2dfff
  0x15464cd2e000 - 0x15464cdc4fff
  0x15464cdc5000 - 0x15464cdc5fff
  0x15464cdc6000 - 0x15464cdc6fff
  0x15464cdc7000 - 0x15464cddafff
  0x15464cddb000 - 0x15464ce02fff
  0x15464ce03000 - 0x15464ce0cfff
  0x15464ce0d000 - 0x15464ce0efff
  0x15464ce0f000 - 0x15464ce14fff
  0x15464ce15000 - 0x15464ce17fff
  0x15464ce1a000 - 0x15464ce1afff
  0x15464ce1b000 - 0x15464ce1bfff
  0x15464ce1c000 - 0x15464ce1cfff
  0x15464ce1d000 - 0x15464ce1dfff
  0x15464ce1e000 - 0x15464ce1efff
  0x15464ce1f000 - 0x15464ce25fff
  0x15464ce26000 - 0x15464ce28fff
  0x15464ce29000 - 0x15464ce29fff
  0x15464ce2a000 - 0x15464ce4afff
  0x15464ce4b000 - 0x15464ce52fff
  0x15464ce53000 - 0x15464ce53fff
  0x15464ce54000 - 0x15464ce54fff
  0x15464ce55000 - 0x15464ce55fff
  0x55ceee807000 - 0x55ceee8f7fff
  0x55ceee8f8000 - 0x55ceeea01fff
  0x55ceeea02000 - 0x55ceeea61fff
  0x55ceeea63000 - 0x55ceeea91fff
  0x55ceeea92000 - 0x55ceeeac2fff
  0x55ceeeac3000 - 0x55ceeeac6fff
  0x55ceef2d2000 - 0x55ceef2f2fff
  0x7ffe51eb0000 - 0x7ffe51ed0fff
  0x7ffe51f9c000 - 0x7ffe51f9ffff
  0x7ffe51fa0000 - 0x7ffe51fa1fff