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.     (t (list начало конец))))  ; Символ не гласная и не согласная.  Упрощенная логика
  20.  
  21. (defun раздели-слово (слово)
  22.   "Основная функция разделения слова."
  23.   (let ((буквы (раздели-слово-безопасно слово)))
  24.     (дели-слово-рекурсия '() буквы)))
  25.  
  26. (defun раздели-слово-безопасно (слово)
  27.   (if (stringp слово)
  28.       (coerce слово 'list)
  29.       '()))
  30.  
  31.  
  32.  
  33. (defun первый-слог (слово)
  34.   "Возвращает первый слог слова."
  35.   (let ((результат (раздели-слово слово)))
  36.     (when (first результат)
  37.       (coerce (first результат) 'string))))
  38.  
  39. (defun остаток-слова (слово)
  40.   "Возвращает часть слова, идущую после первого слога."
  41.   (let ((результат (раздели-слово слово)))
  42.     (if (second результат)
  43.       (coerce (second результат) 'string)
  44.       "")))
  45.  
  46. (defun сплетник-слово (слово ключевое-слово)
  47.   "Переводит одно слово на 'язык сплетника'."
  48.   (let ((слог-слова (первый-слог слово))
  49.         (слог-ключа (первый-слог ключевое-слово))
  50.         (остаток-слова (остаток-слова слово))
  51.         (остаток-ключа (остаток-слова ключевое-слово)))
  52.     (list (concatenate 'string слог-ключа остаток-слова)
  53.           (concatenate 'string слог-слова остаток-ключа))))
  54.  
  55. (defun safe-string (arg)
  56.   "Преобразует символ или число в строку, или возвращает строку без изменений."
  57.   (cond ((stringp arg) arg)
  58.         ((symbolp arg) (symbol-name arg))
  59.         ((numberp arg) (write-to-string arg))
  60.         (t "")))
  61.  
  62. (defun сплетник-предложение-safe (предложение ключевое-слово)
  63.   "Безопасная версия для разнородных списков и отсутствия слов."
  64.   (let ((ключевое-слово-str (safe-string ключевое-слово)))
  65.     (mapcar #'(lambda (слово)
  66.                 (if (stringp слово) ; Проверяем, что слово - строка
  67.                     (сплетник-слово слово ключевое-слово-str)
  68.                     (safe-string слово))) ; Если не строка, просто преобразуем в строку
  69.             предложение)))
  70.  
  71. (defun сплетник-предложение (предложение ключевое-слово)
  72.   "Переводит предложение на 'язык сплетника'."
  73.   (mapcar #'(lambda (слово) (сплетник-слово слово ключевое-слово)) предложение))
  74.  
  75. ;; Examples:
  76. (let ((предложение '("слово" "переводится" "" "123" ":символ" nil "на" "язык" "сплетника"))
  77.       (ключевое-слово "сплетня"))
  78.   (format t "Исходное предложение: ~A~%" предложение)
  79.   (format t "Ключевое слово: ~A~%" ключевое-слово)
  80.   (format t "Предложение на языке сплетника: ~A~%" (сплетник-предложение-safe предложение ключевое-слово)))
  81.  
  82. (let ((предложение '("мгла" "переводится" "на" "язык" "сплетника"))
  83.       (ключевое-слово "сплетня"))
  84.   (format t "Исходное предложение: ~A~%" предложение)
  85.   (format t "Ключевое слово: ~A~%" ключевое-слово)
  86.   (format t "Предложение на языке сплетника: ~A~%" (сплетник-предложение-safe предложение ключевое-слово)))
  87.  
  88. (let ((предложение '("надкусить" "ломтик" "колбасы"))
  89.       (ключевое-слово "сплетня"))
  90.   (format t "Исходное предложение: ~A~%" предложение)
  91.   (format t "Ключевое слово: ~A~%" ключевое-слово)
  92.   (format t "Предложение на языке сплетника: ~A~%" (сплетник-предложение-safe предложение ключевое-слово)))
  93.  
  94. (let ((предложение '("написать" "программу" "обработки" "текста"))
  95.       (ключевое-слово "сплетня"))
  96.   (format t "Исходное предложение: ~A~%" предложение)
  97.   (format t "Ключевое слово: ~A~%" ключевое-слово)
  98.   (format t "Предложение на языке сплетника: ~A~%" (сплетник-предложение-safe предложение ключевое-слово)))
  99.  
  100. (let ((предложение '("отговорила" "роща" "золотая"))
  101.       (ключевое-слово "кумир"))
  102.   (format t "Исходное предложение: ~A~%" предложение)
  103.   (format t "Ключевое слово: ~A~%" ключевое-слово)
  104.   (format t "Предложение на языке сплетника: ~A~%" (сплетник-предложение-safe предложение ключевое-слово)))
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
  0x149747600000 - 0x1497478e4fff
  0x149747a15000 - 0x149747a39fff
  0x149747a3a000 - 0x149747bacfff
  0x149747bad000 - 0x149747bf5fff
  0x149747bf6000 - 0x149747bf8fff
  0x149747bf9000 - 0x149747bfbfff
  0x149747bfc000 - 0x149747bfffff
  0x149747c00000 - 0x149747c02fff
  0x149747c03000 - 0x149747e01fff
  0x149747e02000 - 0x149747e02fff
  0x149747e03000 - 0x149747e03fff
  0x149747e80000 - 0x149747e8ffff
  0x149747e90000 - 0x149747ec3fff
  0x149747ec4000 - 0x149747ffafff
  0x149747ffb000 - 0x149747ffbfff
  0x149747ffc000 - 0x149747ffefff
  0x149747fff000 - 0x149747ffffff
  0x149748000000 - 0x149748003fff
  0x149748004000 - 0x149748203fff
  0x149748204000 - 0x149748204fff
  0x149748205000 - 0x149748205fff
  0x149748280000 - 0x149748283fff
  0x149748284000 - 0x149748284fff
  0x149748285000 - 0x149748286fff
  0x149748287000 - 0x149748287fff
  0x149748288000 - 0x149748288fff
  0x149748289000 - 0x149748289fff
  0x14974828a000 - 0x149748297fff
  0x149748298000 - 0x1497482a5fff
  0x1497482a6000 - 0x1497482b2fff
  0x1497482b3000 - 0x1497482b6fff
  0x1497482b7000 - 0x1497482b7fff
  0x1497482b8000 - 0x1497482b8fff
  0x1497482b9000 - 0x1497482befff
  0x1497482bf000 - 0x1497482c0fff
  0x1497482c1000 - 0x1497482c1fff
  0x1497482c2000 - 0x1497482c2fff
  0x1497482c3000 - 0x1497482c3fff
  0x1497482c4000 - 0x1497482f1fff
  0x1497482f2000 - 0x149748300fff
  0x149748301000 - 0x1497483a6fff
  0x1497483a7000 - 0x14974843dfff
  0x14974843e000 - 0x14974843efff
  0x14974843f000 - 0x14974843ffff
  0x149748440000 - 0x149748453fff
  0x149748454000 - 0x14974847bfff
  0x14974847c000 - 0x149748485fff
  0x149748486000 - 0x149748487fff
  0x149748488000 - 0x14974848dfff
  0x14974848e000 - 0x149748490fff
  0x149748493000 - 0x149748493fff
  0x149748494000 - 0x149748494fff
  0x149748495000 - 0x149748495fff
  0x149748496000 - 0x149748496fff
  0x149748497000 - 0x149748497fff
  0x149748498000 - 0x14974849efff
  0x14974849f000 - 0x1497484a1fff
  0x1497484a2000 - 0x1497484a2fff
  0x1497484a3000 - 0x1497484c3fff
  0x1497484c4000 - 0x1497484cbfff
  0x1497484cc000 - 0x1497484ccfff
  0x1497484cd000 - 0x1497484cdfff
  0x1497484ce000 - 0x1497484cefff
  0x55e291603000 - 0x55e2916f3fff
  0x55e2916f4000 - 0x55e2917fdfff
  0x55e2917fe000 - 0x55e29185dfff
  0x55e29185f000 - 0x55e29188dfff
  0x55e29188e000 - 0x55e2918befff
  0x55e2918bf000 - 0x55e2918c2fff
  0x55e29236d000 - 0x55e29238dfff
  0x7fffcfdc1000 - 0x7fffcfde1fff
  0x7fffcfdee000 - 0x7fffcfdf1fff
  0x7fffcfdf2000 - 0x7fffcfdf3fff
https://ideone.com/41VthQ
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!