fork download
copy 
  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.   (let ((слог-слова (первый-слог слово))
  46.         (слог-ключа (первый-слог ключевое-слово))
  47.         (остаток-слова (остаток-слова слово))
  48.         (остаток-ключа (остаток-слова ключевое-слово)))
  49.     (list (concatenate 'string (if слог-ключа слог-ключа "") остаток-слова)
  50.           (concatenate 'string (if слог-слова слог-слова "") остаток-ключа))))
  51.  
  52. (defun safe-string (arg)
  53.   "Преобразует символ или число в строку, или возвращает строку без изменений."
  54.   (cond ((stringp arg) arg)
  55.         ((symbolp arg) (symbol-name arg))
  56.         ((numberp arg) (write-to-string arg))
  57.         (t "")))
  58.  
  59. (defun string-list-to-string (list)
  60.   "Преобразует список строк в одну строку."
  61.   (apply #'concatenate 'string list))
  62.  
  63. (defun сплетник-предложение-safe (предложение ключевое-слово)
  64.   "Безопасная версия для разнородных списков и отсутствия слов. Возвращает список строк."
  65.   (let ((ключевое-слово-str (safe-string ключевое-слово)))
  66.     (mapcar #'(lambda (слово)
  67.                (if (stringp слово) ; Проверяем, что слово - строка
  68.                    (string-list-to-string (сплетник-слово слово ключевое-слово-str)) ; Объединяем список в строку
  69.                    (format nil "~A ~A" слово ключевое-слово-str))) ; Если не строка, возвращаем строку c пробелом
  70.             предложение)))
  71.  
  72. (defun сплетник-предложение (предложение ключевое-слово)
  73.   "Переводит предложение на 'язык сплетника'.  Возвращает список строк."
  74.   (mapcar #'(lambda (слово) (string-list-to-string (сплетник-слово слово ключевое-слово))) предложение))
  75.  
  76.  
  77. ;; Examples:
  78. (let ((предложение '("слово" "переводится" "" 123 :символ nil "на" "язык" "сплетника"))
  79.       (ключевое-слово "сплетня"))
  80.   (format t "Исходное предложение: ~A~%" предложение)
  81.   (format t "Ключевое слово: ~A~%" ключевое-слово)
  82.   (format t "Предложение на языке сплетника: ~{~A ~}~%" (сплетник-предложение-safe предложение ключевое-слово)))
  83.  
  84. (let ((предложение '("мгла" "переводится" "на" "язык" "сплетника"))
  85.       (ключевое-слово "сплетня"))
  86.   (format t "Исходное предложение: ~A~%" предложение)
  87.   (format t "Ключевое слово: ~A~%" ключевое-слово)
  88.   (format t "Предложение на языке сплетника: ~{~A ~}~%" (сплетник-предложение предложение ключевое-слово)))
  89.  
  90. (let ((предложение '("написать" "программу" "обработки" "текста"))
  91.       (ключевое-слово "сплетня"))
  92.   (format t "Исходное предложение: ~A~%" предложение)
  93.   (format t "Ключевое слово: ~A~%" ключевое-слово)
  94.   (format t "Предложение на языке сплетника: ~{~A ~}~%" (сплетник-предложение предложение ключевое-слово)))
  95.  
  96. (let ((предложение '("отговорила" "роща" "золотая"))
  97.       (ключевое-слово "кумир"))
  98.   (format t "Исходное предложение: ~A~%" предложение)
  99.   (format t "Ключевое слово: ~A~%" ключевое-слово)
  100.   (format t "Предложение на языке сплетника: ~{~A ~}~%" (сплетник-предложение предложение ключевое-слово)))
Success #stdin #stdout #stderr 0.02s 9564KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Исходное предложение: (слово переводится  123 СИМВОЛ NIL на язык сплетника)
Ключевое слово: сплетня
Предложение на языке сплетника: сплевослотня сплереводитсяпетня сплетня 123 сплетня СИМВОЛ сплетня NIL сплетня спленатня сплезыкятня сплетникасплетня 
Исходное предложение: (мгла переводится на язык сплетника)
Ключевое слово: сплетня
Предложение на языке сплетника: сплемглатня сплереводитсяпетня спленатня сплезыкятня сплетникасплетня 
Исходное предложение: (написать программу обработки текста)
Ключевое слово: сплетня
Предложение на языке сплетника: сплеписатьнатня сплеграммупротня сплебработкиотня сплекстатетня 
Исходное предложение: (отговорила роща золотая)
Ключевое слово: кумир
Предложение на языке сплетника: кутговорилаомир кущаромир кулотаязомир
stderr
copy 
Warning: reserving address range 0x80000c0000...0x1fffffffffff that contains memory mappings. clisp might crash later!
Memory dump:
  0x8000000000 - 0x80000bffff
  0x14f9aa200000 - 0x14f9aa4e4fff
  0x14f9aa615000 - 0x14f9aa639fff
  0x14f9aa63a000 - 0x14f9aa7acfff
  0x14f9aa7ad000 - 0x14f9aa7f5fff
  0x14f9aa7f6000 - 0x14f9aa7f8fff
  0x14f9aa7f9000 - 0x14f9aa7fbfff
  0x14f9aa7fc000 - 0x14f9aa7fffff
  0x14f9aa800000 - 0x14f9aa802fff
  0x14f9aa803000 - 0x14f9aaa01fff
  0x14f9aaa02000 - 0x14f9aaa02fff
  0x14f9aaa03000 - 0x14f9aaa03fff
  0x14f9aaa80000 - 0x14f9aaa8ffff
  0x14f9aaa90000 - 0x14f9aaac3fff
  0x14f9aaac4000 - 0x14f9aabfafff
  0x14f9aabfb000 - 0x14f9aabfbfff
  0x14f9aabfc000 - 0x14f9aabfefff
  0x14f9aabff000 - 0x14f9aabfffff
  0x14f9aac00000 - 0x14f9aac03fff
  0x14f9aac04000 - 0x14f9aae03fff
  0x14f9aae04000 - 0x14f9aae04fff
  0x14f9aae05000 - 0x14f9aae05fff
  0x14f9aaf4c000 - 0x14f9aaf4ffff
  0x14f9aaf50000 - 0x14f9aaf50fff
  0x14f9aaf51000 - 0x14f9aaf52fff
  0x14f9aaf53000 - 0x14f9aaf53fff
  0x14f9aaf54000 - 0x14f9aaf54fff
  0x14f9aaf55000 - 0x14f9aaf55fff
  0x14f9aaf56000 - 0x14f9aaf63fff
  0x14f9aaf64000 - 0x14f9aaf71fff
  0x14f9aaf72000 - 0x14f9aaf7efff
  0x14f9aaf7f000 - 0x14f9aaf82fff
  0x14f9aaf83000 - 0x14f9aaf83fff
  0x14f9aaf84000 - 0x14f9aaf84fff
  0x14f9aaf85000 - 0x14f9aaf8afff
  0x14f9aaf8b000 - 0x14f9aaf8cfff
  0x14f9aaf8d000 - 0x14f9aaf8dfff
  0x14f9aaf8e000 - 0x14f9aaf8efff
  0x14f9aaf8f000 - 0x14f9aaf8ffff
  0x14f9aaf90000 - 0x14f9aafbdfff
  0x14f9aafbe000 - 0x14f9aafccfff
  0x14f9aafcd000 - 0x14f9ab072fff
  0x14f9ab073000 - 0x14f9ab109fff
  0x14f9ab10a000 - 0x14f9ab10afff
  0x14f9ab10b000 - 0x14f9ab10bfff
  0x14f9ab10c000 - 0x14f9ab11ffff
  0x14f9ab120000 - 0x14f9ab147fff
  0x14f9ab148000 - 0x14f9ab151fff
  0x14f9ab152000 - 0x14f9ab153fff
  0x14f9ab154000 - 0x14f9ab159fff
  0x14f9ab15a000 - 0x14f9ab15cfff
  0x14f9ab15f000 - 0x14f9ab15ffff
  0x14f9ab160000 - 0x14f9ab160fff
  0x14f9ab161000 - 0x14f9ab161fff
  0x14f9ab162000 - 0x14f9ab162fff
  0x14f9ab163000 - 0x14f9ab163fff
  0x14f9ab164000 - 0x14f9ab16afff
  0x14f9ab16b000 - 0x14f9ab16dfff
  0x14f9ab16e000 - 0x14f9ab16efff
  0x14f9ab16f000 - 0x14f9ab18ffff
  0x14f9ab190000 - 0x14f9ab197fff
  0x14f9ab198000 - 0x14f9ab198fff
  0x14f9ab199000 - 0x14f9ab199fff
  0x14f9ab19a000 - 0x14f9ab19afff
  0x560d79ad9000 - 0x560d79bc9fff
  0x560d79bca000 - 0x560d79cd3fff
  0x560d79cd4000 - 0x560d79d33fff
  0x560d79d35000 - 0x560d79d63fff
  0x560d79d64000 - 0x560d79d94fff
  0x560d79d95000 - 0x560d79d98fff
  0x560d79ec8000 - 0x560d79ee8fff
  0x7ffd85d75000 - 0x7ffd85d95fff
  0x7ffd85dad000 - 0x7ffd85db0fff
  0x7ffd85db1000 - 0x7ffd85db2fff
https://ideone.com/1FWvb1
language:
Common Lisp (clisp 2.49.92)
created:
1 day ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!