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 (or слог-ключа "") (or остаток-слова ""))
  50.           (concatenate 'string (or слог-слова "") (or остаток-ключа "")))))
  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 сплетник-предложение-safe (предложение ключевое-слово)
  60.   "Безопасная версия для разнородных списков и отсутствия слов. Возвращает список списков."
  61.   (let ((ключевое-слово-str (safe-string ключевое-слово)))
  62.     (mapcan #'(lambda (слово)  ; Используем MAPCAN
  63.                (if (stringp слово)
  64.                    (сплетник-слово слово ключевое-слово-str)
  65.                    (list (format nil "~A ~A" слово ключевое-слово-str))))  ;Для не-строк возвращаем строку
  66.             предложение)))
  67.  
  68. (defun сплетник-предложение (предложение ключевое-слово)
  69.   "Переводит предложение на 'язык сплетника'. Возвращает один плоский список слов."
  70.   (mapcan #'(lambda (слово) (сплетник-слово слово ключевое-слово)) предложение))
  71.  
  72. ;; Examples:
  73. (let ((предложение '("слово" "переводится" "" 123 :символ nil "на" "язык" "сплетника"))
  74.       (ключевое-слово "сплетня"))
  75.   (format t "Исходное предложение: ~A~%" предложение)
  76.   (format t "Ключевое слово: ~A~%" ключевое-слово)
  77.   (format t "Предложение на языке сплетника: ~A~%" (сплетник-предложение-safe предложение ключевое-слово)))
  78.  
  79. (let ((предложение '("мгла" "переводится" "на" "язык" "сплетника"))
  80.       (ключевое-слово "сплетня"))
  81.   (format t "Исходное предложение: ~A~%" предложение)
  82.   (format t "Ключевое слово: ~A~%" ключевое-слово)
  83.   (format t "Предложение на языке сплетника: ~A~%" (сплетник-предложение предложение ключевое-слово)))
  84.  
  85. (let ((предложение '("написать" "программу" "обработки" "текста"))
  86.       (ключевое-слово "сплетня"))
  87.   (format t "Исходное предложение: ~A~%" предложение)
  88.   (format t "Ключевое слово: ~A~%" ключевое-слово)
  89.   (format t "Предложение на языке сплетника: ~A~%" (сплетник-предложение предложение ключевое-слово)))
  90.  
  91. (let ((предложение '("отговорила" "роща" "золотая"))
  92.       (ключевое-слово "кумир"))
  93.   (format t "Исходное предложение: ~A~%" предложение)
  94.   (format t "Ключевое слово: ~A~%" ключевое-слово)
  95.   (format t "Предложение на языке сплетника: ~A~%" (сплетник-предложение предложение ключевое-слово)))
Success #stdin #stdout #stderr 0.02s 9664KB
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
  0x1497c8800000 - 0x1497c8ae4fff
  0x1497c8c15000 - 0x1497c8c39fff
  0x1497c8c3a000 - 0x1497c8dacfff
  0x1497c8dad000 - 0x1497c8df5fff
  0x1497c8df6000 - 0x1497c8df8fff
  0x1497c8df9000 - 0x1497c8dfbfff
  0x1497c8dfc000 - 0x1497c8dfffff
  0x1497c8e00000 - 0x1497c8e02fff
  0x1497c8e03000 - 0x1497c9001fff
  0x1497c9002000 - 0x1497c9002fff
  0x1497c9003000 - 0x1497c9003fff
  0x1497c9080000 - 0x1497c908ffff
  0x1497c9090000 - 0x1497c90c3fff
  0x1497c90c4000 - 0x1497c91fafff
  0x1497c91fb000 - 0x1497c91fbfff
  0x1497c91fc000 - 0x1497c91fefff
  0x1497c91ff000 - 0x1497c91fffff
  0x1497c9200000 - 0x1497c9203fff
  0x1497c9204000 - 0x1497c9403fff
  0x1497c9404000 - 0x1497c9404fff
  0x1497c9405000 - 0x1497c9405fff
  0x1497c94d0000 - 0x1497c94d3fff
  0x1497c94d4000 - 0x1497c94d4fff
  0x1497c94d5000 - 0x1497c94d6fff
  0x1497c94d7000 - 0x1497c94d7fff
  0x1497c94d8000 - 0x1497c94d8fff
  0x1497c94d9000 - 0x1497c94d9fff
  0x1497c94da000 - 0x1497c94e7fff
  0x1497c94e8000 - 0x1497c94f5fff
  0x1497c94f6000 - 0x1497c9502fff
  0x1497c9503000 - 0x1497c9506fff
  0x1497c9507000 - 0x1497c9507fff
  0x1497c9508000 - 0x1497c9508fff
  0x1497c9509000 - 0x1497c950efff
  0x1497c950f000 - 0x1497c9510fff
  0x1497c9511000 - 0x1497c9511fff
  0x1497c9512000 - 0x1497c9512fff
  0x1497c9513000 - 0x1497c9513fff
  0x1497c9514000 - 0x1497c9541fff
  0x1497c9542000 - 0x1497c9550fff
  0x1497c9551000 - 0x1497c95f6fff
  0x1497c95f7000 - 0x1497c968dfff
  0x1497c968e000 - 0x1497c968efff
  0x1497c968f000 - 0x1497c968ffff
  0x1497c9690000 - 0x1497c96a3fff
  0x1497c96a4000 - 0x1497c96cbfff
  0x1497c96cc000 - 0x1497c96d5fff
  0x1497c96d6000 - 0x1497c96d7fff
  0x1497c96d8000 - 0x1497c96ddfff
  0x1497c96de000 - 0x1497c96e0fff
  0x1497c96e3000 - 0x1497c96e3fff
  0x1497c96e4000 - 0x1497c96e4fff
  0x1497c96e5000 - 0x1497c96e5fff
  0x1497c96e6000 - 0x1497c96e6fff
  0x1497c96e7000 - 0x1497c96e7fff
  0x1497c96e8000 - 0x1497c96eefff
  0x1497c96ef000 - 0x1497c96f1fff
  0x1497c96f2000 - 0x1497c96f2fff
  0x1497c96f3000 - 0x1497c9713fff
  0x1497c9714000 - 0x1497c971bfff
  0x1497c971c000 - 0x1497c971cfff
  0x1497c971d000 - 0x1497c971dfff
  0x1497c971e000 - 0x1497c971efff
  0x55bb599b9000 - 0x55bb59aa9fff
  0x55bb59aaa000 - 0x55bb59bb3fff
  0x55bb59bb4000 - 0x55bb59c13fff
  0x55bb59c15000 - 0x55bb59c43fff
  0x55bb59c44000 - 0x55bb59c74fff
  0x55bb59c75000 - 0x55bb59c78fff
  0x55bb59cbb000 - 0x55bb59cdbfff
  0x7ffe66bd7000 - 0x7ffe66bf7fff
  0x7ffe66bfa000 - 0x7ffe66bfdfff
  0x7ffe66bfe000 - 0x7ffe66bfffff
https://ideone.com/dkfJk1
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!