PasteRack.org
Paste # 10389
2019-12-17 08:58:13

Fork as a new paste.

Paste viewed 549 times.


Embed:

  1. #lang racket
  2.  
  3. (define (vowel? char)
  4.   (if (regexp-match #rx"[ауоыиэяюёеАУОЫИЭЯЮЁЕ]"
  5.                     (string char))
  6.       #t
  7.       #f))
  8.  
  9. (define (consonant? char)
  10.   (if (regexp-match #rx"[бвгджзйклмнпрстфхцчшщБВГДЖЗЙКЛМНПРСТФХЦЧШЩ]"
  11.                     (string char))
  12.       #t
  13.       #f))
  14.  
  15. (define (delimiter? char)
  16.   (if (regexp-match #rx"[ьъЬЪ]"
  17.                     (string char))
  18.       #t
  19.       #f))
  20.  
  21. (define (sonorous? char)
  22.   (if (regexp-match #rx"[лмнрйЛМНРЙ]"
  23.                     (string char))
  24.       #t
  25.       #f))
  26.  
  27. (define (skip-syllables chars)
  28.   (let loop ([chars chars]
  29.              [syllable null])
  30.     (if (null? chars)
  31.         (cons chars syllable)
  32.         (if (not (consonant? (car chars)))
  33.             (cons chars syllable)
  34.             (loop (cdr chars)
  35.                   (cons (car chars) syllable))))))
  36.  
  37. (define (word->syllables word)
  38.   (reverse
  39.    (map
  40.     (compose list->string reverse)
  41.     (let loop ([chars (string->list word)]
  42.                [syllables null])
  43.       (let* ([chars-syl (skip-syllables chars)]
  44.              [chars (car chars-syl)]
  45.              [syllable (cdr chars-syl)])
  46.         (match chars
  47.                [`(,x ,y . ,z) #:when (and (delimiter? x)
  48.                                           (vowel? y)
  49.                                           (list? z))
  50.                 (loop (cdr chars)
  51.                       (cons (append (cons x syllable)
  52.                                     (car syllables))
  53.                             (cdr syllables)))]
  54.                [`(,x ,y ,z . ,w) #:when (and (vowel? x)
  55.                                              (sonorous? y)
  56.                                              (consonant? z)
  57.                                              (list? w))
  58.                 (loop (cddr chars)
  59.                       (cons `(,y ,x . ,syllable)
  60.                             syllables))]
  61.                [`(,x ,y ,z . ,w) #:when (and (vowel? x)
  62.                                              (consonant? y)
  63.                                              (delimiter? z)
  64.                                              (list? w))
  65.                 (loop (cdddr chars)
  66.                       (cons `(,z ,y ,x . ,syllable)
  67.                             syllables))]
  68.                [(cons x y) #:when (and (vowel? x)
  69.                                        (list? y))
  70.                 (loop (cdr chars)
  71.                       (cons (cons x syllable)
  72.                             syllables))]
  73.                [null
  74.                 (if (not (pair? syllables))
  75.                     null
  76.                     (cons (append syllable
  77.                                   (car syllables))
  78.                           (cdr syllables)))]
  79.                [_
  80.                 syllables]))))))
  81.  
  82. (define (sentence->syllables sentence)
  83.   (map
  84.     word->syllables
  85.     (string-split sentence)))
  86.  
  87. (sentence->syllables "Католическая философия в том смысле в котором я буду применять этот термин это философское направление господствовавшее в европейской мысли со времен Августина до эпохи возрождения")

=>

'(("Ка" "то" "ли" "че" "ска" "я")

  ("фи" "ло" "со" "фи" "я")

  ()

  ("том")

  ("смы" "сле")

  ()

  ("ко" "то" "ром")

  ("я")

  ("бу" "ду")

  ("при" "ме" "нять")

  ("э" "тот")

  ("тер" "мин")

  ("э" "то")

  ("фи" "ло" "со" "фско" "е")

  ("на" "пра" "вле" "ни" "е")

  ("го" "спо" "дство" "ва" "вше" "е")

  ()

  ("е" "вро" "пей" "ской")

  ("мы" "сли")

  ("со")

  ("вре" "мен")

  ("А" "вгу" "сти" "на")

  ("до")

  ("э" "по" "хи")

  ("во" "зро" "жде" "ни" "я"))