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.   (format nil "~{~A~^ ~}" 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 9528KB
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
  0x150ad1800000 - 0x150ad1ae4fff
  0x150ad1c15000 - 0x150ad1c39fff
  0x150ad1c3a000 - 0x150ad1dacfff
  0x150ad1dad000 - 0x150ad1df5fff
  0x150ad1df6000 - 0x150ad1df8fff
  0x150ad1df9000 - 0x150ad1dfbfff
  0x150ad1dfc000 - 0x150ad1dfffff
  0x150ad1e00000 - 0x150ad1e02fff
  0x150ad1e03000 - 0x150ad2001fff
  0x150ad2002000 - 0x150ad2002fff
  0x150ad2003000 - 0x150ad2003fff
  0x150ad2080000 - 0x150ad208ffff
  0x150ad2090000 - 0x150ad20c3fff
  0x150ad20c4000 - 0x150ad21fafff
  0x150ad21fb000 - 0x150ad21fbfff
  0x150ad21fc000 - 0x150ad21fefff
  0x150ad21ff000 - 0x150ad21fffff
  0x150ad2200000 - 0x150ad2203fff
  0x150ad2204000 - 0x150ad2403fff
  0x150ad2404000 - 0x150ad2404fff
  0x150ad2405000 - 0x150ad2405fff
  0x150ad247b000 - 0x150ad247efff
  0x150ad247f000 - 0x150ad247ffff
  0x150ad2480000 - 0x150ad2481fff
  0x150ad2482000 - 0x150ad2482fff
  0x150ad2483000 - 0x150ad2483fff
  0x150ad2484000 - 0x150ad2484fff
  0x150ad2485000 - 0x150ad2492fff
  0x150ad2493000 - 0x150ad24a0fff
  0x150ad24a1000 - 0x150ad24adfff
  0x150ad24ae000 - 0x150ad24b1fff
  0x150ad24b2000 - 0x150ad24b2fff
  0x150ad24b3000 - 0x150ad24b3fff
  0x150ad24b4000 - 0x150ad24b9fff
  0x150ad24ba000 - 0x150ad24bbfff
  0x150ad24bc000 - 0x150ad24bcfff
  0x150ad24bd000 - 0x150ad24bdfff
  0x150ad24be000 - 0x150ad24befff
  0x150ad24bf000 - 0x150ad24ecfff
  0x150ad24ed000 - 0x150ad24fbfff
  0x150ad24fc000 - 0x150ad25a1fff
  0x150ad25a2000 - 0x150ad2638fff
  0x150ad2639000 - 0x150ad2639fff
  0x150ad263a000 - 0x150ad263afff
  0x150ad263b000 - 0x150ad264efff
  0x150ad264f000 - 0x150ad2676fff
  0x150ad2677000 - 0x150ad2680fff
  0x150ad2681000 - 0x150ad2682fff
  0x150ad2683000 - 0x150ad2688fff
  0x150ad2689000 - 0x150ad268bfff
  0x150ad268e000 - 0x150ad268efff
  0x150ad268f000 - 0x150ad268ffff
  0x150ad2690000 - 0x150ad2690fff
  0x150ad2691000 - 0x150ad2691fff
  0x150ad2692000 - 0x150ad2692fff
  0x150ad2693000 - 0x150ad2699fff
  0x150ad269a000 - 0x150ad269cfff
  0x150ad269d000 - 0x150ad269dfff
  0x150ad269e000 - 0x150ad26befff
  0x150ad26bf000 - 0x150ad26c6fff
  0x150ad26c7000 - 0x150ad26c7fff
  0x150ad26c8000 - 0x150ad26c8fff
  0x150ad26c9000 - 0x150ad26c9fff
  0x55a191ed5000 - 0x55a191fc5fff
  0x55a191fc6000 - 0x55a1920cffff
  0x55a1920d0000 - 0x55a19212ffff
  0x55a192131000 - 0x55a19215ffff
  0x55a192160000 - 0x55a192190fff
  0x55a192191000 - 0x55a192194fff
  0x55a192697000 - 0x55a1926b7fff
  0x7ffe9f245000 - 0x7ffe9f265fff
  0x7ffe9f28f000 - 0x7ffe9f292fff
  0x7ffe9f293000 - 0x7ffe9f294fff
https://ideone.com/bN0h1X
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!