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 конец)
  18.      (list (reverse (append начало накопленный-слог)) nil))  ; Список букв закончился
  19.     ((гласная? (first конец))
  20.      (list (reverse (cons (first конец) накопленный-слог)) (rest конец))) ; Если гласная, то это конец слога
  21.     ((согласная? (first конец))     ; Если первый символ - согласная
  22.      (if (null (rest конец))   ; Если это последний символ, тоже завершаем слог
  23.          (list (reverse (cons (first конец) накопленный-слог)) nil)
  24.          (дели-слово-рекурсия начало (rest конец) (cons (first конец) накопленный-слог))))
  25.     (t (list начало конец))))  ; Символ не гласная и не согласная
  26.  
  27. (defun раздели-слово (слово)
  28.   "Основная функция разделения слова."
  29.   (let ((буквы (дели-слово слово)))
  30.     (дели-слово-рекурсия '() буквы '())))
  31.  
  32. (defun первый-слог (слово)
  33.   "Возвращает первый слог слова."
  34.   (let ((результат (раздели-слово слово)))
  35.     (when (first результат)
  36.       (coerce (first результат) 'string))))
  37.  
  38. (defun остаток-слова (слово)
  39.   "Возвращает часть слова, идущую после первого слога."
  40.   (let ((результат (раздели-слово слово)))
  41.     (if (second результат)
  42.       (coerce (second результат) 'string)
  43.       "")))
  44.  
  45. (defun сплетник-слово (слово ключевое-слово)
  46.   "Переводит одно слово на 'язык сплетника'. Возвращает список из двух слов."
  47.   (let ((слог-слова (первый-слог слово))
  48.         (слог-ключа (первый-слог ключевое-слово))
  49.         (остаток-слова (остаток-слова слово))
  50.         (остаток-ключа (остаток-слова ключевое-слово)))
  51.     (list (concatenate 'string (if слог-ключа слог-ключа "") (if остаток-слова остаток-слова ""))
  52.           (concatenate 'string (if слог-слова слог-слова "") (if остаток-ключа остаток-ключа "")))))
  53.  
  54. (defun safe-string (arg)
  55.   "Преобразует символ или число в строку, или возвращает строку без изменений."
  56.   (typecase arg
  57.     (string arg)
  58.     (symbol (symbol-name arg))
  59.     (number (write-to-string arg))
  60.     (t "")))
  61.  
  62. (defun сплетник-предложение-safe (предложение ключевое-слово)
  63.   "Безопасная версия для разнородных списков и отсутствия слов. Возвращает список списков."
  64.   (let ((ключевое-слово-str (safe-string ключевое-слово)))
  65.     (mapcan #'(lambda (слово)  ; Используем MAPCAN
  66.                (if (stringp слово)
  67.                    (сплетник-слово слово ключевое-слово-str)
  68.                    (list (format nil "~A ~A" слово ключевое-слово-str))))  ;Для не-строк возвращаем строку
  69.             предложение)))
  70.  
  71. (defun сплетник-предложение (предложение ключевое-слово)
  72.   "Переводит предложение на 'язык сплетника'. Возвращает один плоский список слов."
  73.   (mapcan #'(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~%" (сплетник-предложение предложение ключевое-слово)))
  87.  
  88. (let ((предложение '("написать" "программу" "обработки" "текста"))
  89.       (ключевое-слово "сплетня"))
  90.   (format t "Исходное предложение: ~A~%" предложение)
  91.   (format t "Ключевое слово: ~A~%" ключевое-слово)
  92.   (format t "Предложение на языке сплетника: ~A~%" (сплетник-предложение предложение ключевое-слово)))
  93.  
  94. (let ((предложение '("отговорила" "роща" "золотая"))
  95.       (ключевое-слово "кумир"))
  96.   (format t "Исходное предложение: ~A~%" предложение)
  97.   (format t "Ключевое слово: ~A~%" ключевое-слово)
  98.   (format t "Предложение на языке сплетника: ~A~%" (сплетник-предложение предложение ключевое-слово)))
Success #stdin #stdout #stderr 0.02s 9592KB
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
  0x14753bc00000 - 0x14753bee4fff
  0x14753c015000 - 0x14753c039fff
  0x14753c03a000 - 0x14753c1acfff
  0x14753c1ad000 - 0x14753c1f5fff
  0x14753c1f6000 - 0x14753c1f8fff
  0x14753c1f9000 - 0x14753c1fbfff
  0x14753c1fc000 - 0x14753c1fffff
  0x14753c200000 - 0x14753c202fff
  0x14753c203000 - 0x14753c401fff
  0x14753c402000 - 0x14753c402fff
  0x14753c403000 - 0x14753c403fff
  0x14753c480000 - 0x14753c48ffff
  0x14753c490000 - 0x14753c4c3fff
  0x14753c4c4000 - 0x14753c5fafff
  0x14753c5fb000 - 0x14753c5fbfff
  0x14753c5fc000 - 0x14753c5fefff
  0x14753c5ff000 - 0x14753c5fffff
  0x14753c600000 - 0x14753c603fff
  0x14753c604000 - 0x14753c803fff
  0x14753c804000 - 0x14753c804fff
  0x14753c805000 - 0x14753c805fff
  0x14753c8a6000 - 0x14753c8a9fff
  0x14753c8aa000 - 0x14753c8aafff
  0x14753c8ab000 - 0x14753c8acfff
  0x14753c8ad000 - 0x14753c8adfff
  0x14753c8ae000 - 0x14753c8aefff
  0x14753c8af000 - 0x14753c8affff
  0x14753c8b0000 - 0x14753c8bdfff
  0x14753c8be000 - 0x14753c8cbfff
  0x14753c8cc000 - 0x14753c8d8fff
  0x14753c8d9000 - 0x14753c8dcfff
  0x14753c8dd000 - 0x14753c8ddfff
  0x14753c8de000 - 0x14753c8defff
  0x14753c8df000 - 0x14753c8e4fff
  0x14753c8e5000 - 0x14753c8e6fff
  0x14753c8e7000 - 0x14753c8e7fff
  0x14753c8e8000 - 0x14753c8e8fff
  0x14753c8e9000 - 0x14753c8e9fff
  0x14753c8ea000 - 0x14753c917fff
  0x14753c918000 - 0x14753c926fff
  0x14753c927000 - 0x14753c9ccfff
  0x14753c9cd000 - 0x14753ca63fff
  0x14753ca64000 - 0x14753ca64fff
  0x14753ca65000 - 0x14753ca65fff
  0x14753ca66000 - 0x14753ca79fff
  0x14753ca7a000 - 0x14753caa1fff
  0x14753caa2000 - 0x14753caabfff
  0x14753caac000 - 0x14753caadfff
  0x14753caae000 - 0x14753cab3fff
  0x14753cab4000 - 0x14753cab6fff
  0x14753cab9000 - 0x14753cab9fff
  0x14753caba000 - 0x14753cabafff
  0x14753cabb000 - 0x14753cabbfff
  0x14753cabc000 - 0x14753cabcfff
  0x14753cabd000 - 0x14753cabdfff
  0x14753cabe000 - 0x14753cac4fff
  0x14753cac5000 - 0x14753cac7fff
  0x14753cac8000 - 0x14753cac8fff
  0x14753cac9000 - 0x14753cae9fff
  0x14753caea000 - 0x14753caf1fff
  0x14753caf2000 - 0x14753caf2fff
  0x14753caf3000 - 0x14753caf3fff
  0x14753caf4000 - 0x14753caf4fff
  0x55f8b6279000 - 0x55f8b6369fff
  0x55f8b636a000 - 0x55f8b6473fff
  0x55f8b6474000 - 0x55f8b64d3fff
  0x55f8b64d5000 - 0x55f8b6503fff
  0x55f8b6504000 - 0x55f8b6534fff
  0x55f8b6535000 - 0x55f8b6538fff
  0x55f8b7e94000 - 0x55f8b7eb4fff
  0x7ffd42241000 - 0x7ffd42261fff
  0x7ffd42396000 - 0x7ffd42399fff
  0x7ffd4239a000 - 0x7ffd4239bfff
https://ideone.com/wW3C0O
language:
Common Lisp (clisp 2.49.92)
created:
4 hours 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!