rebol [Title: Откриване на дати в низ]

; Вариант 1. Смята се, че низът съдържа дата, ако се състои от точно три части –
; за ден, месец и година – в какъв да е ред. Ако е така, резултатът е стойност-дата.
; В противен случай се дава none.
; num? проверява дали даден низ съдържа число, т.е. дали остава празен след
; премахване на цифрите в него.
; Ако дадено число е ≤ 31, смята се, че е ден в месеца, иначе – година.
; За годината също се смята, че трябва да бъде в определен интервал.
; leap? проверява дали дадена година е високосна.
; nd, nm и ny са броячи на срещнатите дни, месеци и години.
; d, m и y са последните открити ден, месец и година.
string-to-date: func [s] [
  months: [{Jan} 31 {Feb} 28 {Mar} 31 {Apr} 30 {May} 31 {Jun} 30
           {Jul} 31 {Aug} 31 {Sep} 30 {Oct} 31 {Nov} 30 {Dec} 31]
  num?: func [s] [empty? remove-each t copy s [find {0123456789} t]]
  leap?: func [n] [(n // 400 = 0) or ((n // 4 = 0) and (n // 100 > 0))]
  nd: nm: ny: 0
  foreach t parse s { } [       ; за всяка част t (parse s { } разбива низа на части без шпации)
    case [
      num? t [                  ; t съдържа число?
        t: to-integer t
        either t < 32 [nd: 1 + nd  d: t] [ny: 1 + ny  y: t]
      ]
      dm: select months t       ; ако t отговаря на месец, извлича се броят дни в него
        [nm: 1 + nm  m: t]
      return none               ; ако t е друго, не е открита дата
    ]
  ]
  if (nd <> 1) or (nm <> 1) or (ny <> 1) [return none]  ; дата има само ако и трите брояча са 1
  if (y < 1950) or (y > 2030) [return none]             ; допустима ли е годината?
  if (leap? y) and (dm = 28) [dm: 29]                   ; поправка за високосност, ако трябва
  if (d = 0) or (d > dm) [return none]                  ; допустим ли е денят за месеца?
  return to-date rejoin [d {-} m {-} y]                 ; извличане на стойностите, превръщане в низове и сливане в един, образуване на стойност от тип дата
]

; Вариант 2: Дата е последователност от ден, месец и година в какъв да е ред.
; Функцията дава редица, празна или не, от всички открити в низа дати.
; Ако е зададено /ovl, откриват се и дати, които се припокриват по части.
; num?, leap?, d, m, y и уславянията за ден и година са както в другата функция.
; ds е редица от дати и в крайна сметка резултатът.
; c е литерна стойност, показваща вида (ден, месец, година) на последната прочетена част.
; da е редица от най-много три различителя за последните прочетени части на низа, ако те са части от дата.
; Частта от функцията след реда с „remove/part da“ до края на тялото на foreach служи за определяне на изтривания на текущата стъпка участък от da.
dates-in-string: func [s /ovl] [
  months: [{Jan} 31 {Feb} 28 {Mar} 31 {Apr} 30 {May} 31 {Jun} 30
           {Jul} 31 {Aug} 31 {Sep} 30 {Oct} 31 {Nov} 30 {Dec} 31]
  num?: func [s] [empty? remove-each t copy s [find {0123456789} t]]
  leap?: func [n] [(n // 400 = 0) or ((n // 4 = 0) and (n // 100 > 0))]
  ds: copy []  da: copy {}
  foreach t parse s { } [       ; за всяка част t (parse s { } разбива низа на части без шпации)
    c: none
    case [
      num? t [                  ; t съдържа число?
        t: to-integer t
        either t < 32 [         ; t е ден?
          c: #"d"  d: t
        ] [                     ; t е година
          if (1950 <= t) and (t <= 2030) [c: #"y"  y: t]
        ]
      ]
      dm: select months t       ; ако t отговаря на месец, извлича се броят дни в него
        [c: #"m"  m: t]
    ]
    remove/part da              ; изтриване на цялото или на участък от da, чиято дължина се уточнява по-долу
      either c [                ; t е част от дата?
        if p: find da c [remove/part da next p]         ; ако t вече се среща в da, изтрива се дотам включително
        either 3 = length? append da c [                ; събрана е дата?
          if (leap? y) and (dm = 28) [dm: 29]           ; поправка за високосност, ако трябва
          either (0 < d) and (d <= dm) [                ; денят е допустим за месеца?
            append ds to-date rejoin [d {-} m {-} y]    ; извличане на стойностите, превръщане в низове и сливане в един, образуване на стойност от тип дата, добавяне в редицата
            either ovl [1] [3]                          ; ако се допуска припокриване, да се изтрие само първата част, ако не – всички
          ]
          [either da/1 = #"y" [2] [1]]                  ; денят не е допустим; ако da започва с година, да се изтрият тя и следващото (месец), ако не – само първото (месец)
        ]
        [0]                                             ; не е събрана цяла дата, да не се изтриват части
      ]
      [3]                       ; t не е част от дата, да се изтрие всичко
  ]
  ds
]

; Пример за използване: четене и анализ на редове до срещане на празен.
; За всеки ред се извежда списъкът с намерените в него дати.
while [not empty? in-str: input] [
  ; print string-to-date in-str
  print dates-in-string/ovl in-str
]