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.     (concatenate 'string (if слог-ключа слог-ключа "") остаток-слова)))
  50.  
  51. (defun safe-string (arg)
  52.   "Преобразует символ или число в строку, или возвращает строку без изменений."
  53.   (cond ((stringp arg) arg)
  54.         ((symbolp arg) (symbol-name arg))
  55.         ((numberp arg) (write-to-string arg))
  56.         (t "")))
  57.  
  58. (defun сплетник-предложение-safe (предложение ключевое-слово)
  59.   "Безопасная версия для разнородных списков и отсутствия слов."
  60.   (let ((ключевое-слово-str (safe-string ключевое-слово)))
  61.     (mapcar #'(lambda (слово)
  62.                (if (stringp слово) ; Проверяем, что слово - строка
  63.                    (сплетник-слово слово ключевое-слово-str)
  64.                    (safe-string слово))) ; Если не строка, просто преобразуем в строку
  65.             предложение)))
  66.  
  67. (defun сплетник-предложение (предложение ключевое-слово)
  68.   "Переводит предложение на 'язык сплетника'."
  69.   (mapcar #'(lambda (слово) (сплетник-слово слово ключевое-слово)) предложение))
  70.  
  71. ;; Examples:
  72. (let ((предложение '("слово" "переводится" "" 123 :символ nil "на" "язык" "сплетника"))
  73.       (ключевое-слово "сплетня"))
  74.   (format t "Исходное предложение: ~A~%" предложение)
  75.   (format t "Ключевое слово: ~A~%" ключевое-слово)
  76.   (format t "Предложение на языке сплетника: ~A~%" (сплетник-предложение-safe предложение ключевое-слово)))
  77.  
  78. (let ((предложение '("мгла" "переводится" "на" "язык" "сплетника"))
  79.       (ключевое-слово "сплетня"))
  80.   (format t "Исходное предложение: ~A~%" предложение)
  81.   (format t "Ключевое слово: ~A~%" ключевое-слово)
  82.   (format t "Предложение на языке сплетника: ~A~%" (сплетник-предложение предложение ключевое-слово)))
  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 9652KB
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
  0x14d484a00000 - 0x14d484ce4fff
  0x14d484e15000 - 0x14d484e39fff
  0x14d484e3a000 - 0x14d484facfff
  0x14d484fad000 - 0x14d484ff5fff
  0x14d484ff6000 - 0x14d484ff8fff
  0x14d484ff9000 - 0x14d484ffbfff
  0x14d484ffc000 - 0x14d484ffffff
  0x14d485000000 - 0x14d485002fff
  0x14d485003000 - 0x14d485201fff
  0x14d485202000 - 0x14d485202fff
  0x14d485203000 - 0x14d485203fff
  0x14d485280000 - 0x14d48528ffff
  0x14d485290000 - 0x14d4852c3fff
  0x14d4852c4000 - 0x14d4853fafff
  0x14d4853fb000 - 0x14d4853fbfff
  0x14d4853fc000 - 0x14d4853fefff
  0x14d4853ff000 - 0x14d4853fffff
  0x14d485400000 - 0x14d485403fff
  0x14d485404000 - 0x14d485603fff
  0x14d485604000 - 0x14d485604fff
  0x14d485605000 - 0x14d485605fff
  0x14d485751000 - 0x14d485754fff
  0x14d485755000 - 0x14d485755fff
  0x14d485756000 - 0x14d485757fff
  0x14d485758000 - 0x14d485758fff
  0x14d485759000 - 0x14d485759fff
  0x14d48575a000 - 0x14d48575afff
  0x14d48575b000 - 0x14d485768fff
  0x14d485769000 - 0x14d485776fff
  0x14d485777000 - 0x14d485783fff
  0x14d485784000 - 0x14d485787fff
  0x14d485788000 - 0x14d485788fff
  0x14d485789000 - 0x14d485789fff
  0x14d48578a000 - 0x14d48578ffff
  0x14d485790000 - 0x14d485791fff
  0x14d485792000 - 0x14d485792fff
  0x14d485793000 - 0x14d485793fff
  0x14d485794000 - 0x14d485794fff
  0x14d485795000 - 0x14d4857c2fff
  0x14d4857c3000 - 0x14d4857d1fff
  0x14d4857d2000 - 0x14d485877fff
  0x14d485878000 - 0x14d48590efff
  0x14d48590f000 - 0x14d48590ffff
  0x14d485910000 - 0x14d485910fff
  0x14d485911000 - 0x14d485924fff
  0x14d485925000 - 0x14d48594cfff
  0x14d48594d000 - 0x14d485956fff
  0x14d485957000 - 0x14d485958fff
  0x14d485959000 - 0x14d48595efff
  0x14d48595f000 - 0x14d485961fff
  0x14d485964000 - 0x14d485964fff
  0x14d485965000 - 0x14d485965fff
  0x14d485966000 - 0x14d485966fff
  0x14d485967000 - 0x14d485967fff
  0x14d485968000 - 0x14d485968fff
  0x14d485969000 - 0x14d48596ffff
  0x14d485970000 - 0x14d485972fff
  0x14d485973000 - 0x14d485973fff
  0x14d485974000 - 0x14d485994fff
  0x14d485995000 - 0x14d48599cfff
  0x14d48599d000 - 0x14d48599dfff
  0x14d48599e000 - 0x14d48599efff
  0x14d48599f000 - 0x14d48599ffff
  0x55bdf7c7c000 - 0x55bdf7d6cfff
  0x55bdf7d6d000 - 0x55bdf7e76fff
  0x55bdf7e77000 - 0x55bdf7ed6fff
  0x55bdf7ed8000 - 0x55bdf7f06fff
  0x55bdf7f07000 - 0x55bdf7f37fff
  0x55bdf7f38000 - 0x55bdf7f3bfff
  0x55bdf9755000 - 0x55bdf9775fff
  0x7ffd26a5a000 - 0x7ffd26a7afff
  0x7ffd26af4000 - 0x7ffd26af7fff
  0x7ffd26af8000 - 0x7ffd26af9fff
https://ideone.com/gbT099
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!