Пишем 2000 фактов о себе

[arseniiv]

Топик-стартер даже и не рассчитывал, что найдутся те, кто пройдёт по-честному 

Он вообще надеялся, что ∀x «ты не пройдёшь!».

[Тайльнемер]

Итого финальный вариант преобретает вид:

;; Run in Kawa Scheme
(require 'srfi-1)

(define (letter-facts of-what word)
  (map (lambda (letter i)
         (string-append (number->string (+ i 1)) "-я буква " of-what
                        " — " (string letter) "."))
       (filter char-alphabetic? (string->list word))
       (iota (string-length word))))

(define (num-with-case-form n case-forms)
  (let ((n%100 (modulo n 100))
        (n%10 (modulo n 10)))
    (string-append
      (number->string n)
      " "
      (cond
        ((or (and (>= n%100 11) (<= n%100 19)) (>= n%10 5))
         (caddr case-forms))
        ((= n%10 1)
         (car case-forms))
        (else
         (cadr case-forms))))))

(define (stat-facts of-what word)
  (let ((predicates `((("большая буква" "большие буквы" "больших букв") . ,char-upper-case?)
                      (("маленькая буква" "маленькие буквы" "маленьких букв") . ,char-lower-case?)
                      (("буква вообще" "буквы всего" "букв всего") . ,char-alphabetic?)
                      (("цифра" "цифры" "цифр") . ,char-numeric?)
                      (("пробельный символ" "пробельных символов" "пробельных символов") . ,char-whitespace?)))
        (char-list (string->list word)))
    (map
      (lambda (predicate-info)
        (let ((predicate (cdr predicate-info))
              (name (car predicate-info)))
          (let ((num (length (filter predicate char-list))))
            (string-append "При записи " of-what
                           (if (> num 0)
                               (string-append " используется " (num-with-case-form num name))
                               (string-append " не используется нисколько " (caddr name)))
                           "."))))
      predicates)))

(define (facts of-what word)
  (append (letter-facts of-what word)
          (stat-facts of-what word)))

Напомнило мне мою простыню:

module NumDecl

// Строковые константы:

let lsEmpty     = ""
let lsSep       = " "

let lsMinus     = "минус"

let lfZero      = [|"ь"  ; "ём"  ; "ю"   ; "е"   ; "я"   |]
let lpZero      = ("нол", lfZero)
let lpZeroVar   = ("нул", lfZero)

let lsOne       = "од"
let lpOneFem    = (lsOne, [|"на"  ; "ной" |])
let lsOneFemAcc = "ну"
let lsOneNeu    = "но"
let lsTwoFem    = "е"
let lfSoftEnd   = [|"ь"   ; "ью"  ; "и"   |]

let ltUnits     =
  [|
  (     "", [|""    |]);
  (  lsOne, [|"ин"  ; "ним" ; "ному"; "ном" ; "ного"|]);
  (   "дв", [|"а"   ; "умя" ; "ум"  ; "ух"  |]);
  (   "тр", [|"и"   ; "емя" ; "ём"  ; "ёх"  |]);
  ("четыр", [|"е"   ; "ьмя" ; "ём"  ; "ёх"  |]);
  (  "пят", lfSoftEnd);
  ( "шест", lfSoftEnd);
  (  "сем", lfSoftEnd);
  (  "вос", [|"емь" ; "емью"; "ьми" |]);
  ("девят", lfSoftEnd)
  |]

let lpTen       = (   "десят", lfSoftEnd)
let lpTenDu     = (    "дцат", lfSoftEnd)
let lsTeen      = "на"
let lpFourty    = (   "сорок", [|""    ; "а"   |])
let lpNinety    = ("девяност", [|"о"   ; "а"   |])

let lnHundred   = (       "с", [|"то"  ; "та"  |],         [|"ти"  ; "тами"; "там" ; "тах" ; "от"  |] )
let lnThsnd     = (   "тысяч", [|"а"   ; "ей"  ; "и"   |], [|"и"   ; "ами" ; "ам"  ; "ах"  ; ""    |] )
let lsThsndAcc  = "у"
let lfLionSg    = [|""    ; "ом"  ; "у"   ; "е"   ; "а"   |];
let lfLionPl    = [|"а"   ; "ами" ; "ам"  ; "ах"  ; "ов"  |];
let lnBillion   = ("миллиард", lfLionSg, lfLionPl)
let lnLion      = (  "иллион", lfLionSg, lfLionPl)
let lgLions     = [|"м"; "б"; "тр"; "квадр"; "квинт"; "секст"; "септ"; "окт"; "нон"; "дец"|]

let lhOption    = sprintf "<span class='shaded'>(%s)</span>"
let lhVariant   = sprintf " <span class='shaded'>/ %s</span>"


// Типы:

type Case =
  | Acc = -1
  | Nom =  0
  | Ins =  1
  | Dat =  2
  | Loc =  3
  | Gen =  4

type Gen = Mas | Neu | Fem | All

type Ani = Ina | Ani | All

let Cases = [ Case.Nom; Case.Gen; Case.Dat; Case.Acc; Case.Ins; Case.Loc ]
let Gens  = [ Gen.Mas; Gen.Neu; Gen.Fem ]
let Anis  = [ Ani.Ina; Ani.Ani; ]


// Вспомогательные функции:

let ArrayItem (array : 'a[]) case =
  array.[min (array.Length - 1) (int case)]

let Indecl s case = s

let Empty = Indecl lsEmpty

let ReplaceAcc destCase f = function
  | Case.Acc -> f destCase
  | case -> f case

let FormAcc (b, f) acc = function
  | Case.Acc -> b + acc
  | case -> b + ArrayItem f case

let Form (b, f) =
  FormAcc (b, f) lsEmpty
  |> ReplaceAcc Case.Nom

let Replace f s = function
  | Case.Nom | Case.Acc -> fst f + s
  | case -> Form f case

let (++) f1 f2 case = (f1 case) + (f2 case)

let (+|+) f1 f2 case =
  match (f1 case), (f2 case) with
  | ("", _) | (_, "") -> (f1 case) + (f2 case)
  | (_, _) -> (f1 case) + lsSep + (f2 case)

let Option f case = lhOption (f case)

let Variants vars = Seq.reduce (fun acc item -> acc + (lhVariant item)) vars
let VariantList varlist case = Variants <| List.map (fun v -> v case) varlist

let Unwind varlist case =
  varlist
  |> List.map (fun var -> var case)
  |> Seq.distinct
  |> Variants


// Основные функции:

let NumPlForms numNomAcc num = function
  | Case.Nom | Case.Acc -> numNomAcc, Case.Gen
  | case -> num, case

let NumForms sg pl value case =
  match value / 10 % 10 with
  | 1 -> NumPlForms pl pl case
  | _ ->
    match value % 10 with
    | 1 ->  sg, case
    | 2 ->
      match case with
      | Case.Acc -> sg, Case.Gen
      | _ ->  pl, case
    | 3 | 4 -> NumPlForms sg pl case
    | _ -> NumPlForms pl pl case

let NumFormAcc (b, sg, pl) value acc case =
  (fun (f, case) -> FormAcc (b, f) acc case)
    (NumForms sg pl value case)

let NumForm (b, sg, pl) value =
  NumFormAcc (b, sg, pl) value lsEmpty
  |> ReplaceAcc Case.Nom

let Zero = VariantList [Form lpZero; Form lpZeroVar]

let rec UnitsList value var =
  let (gen, ani) = var
  match value, gen, ani with
  | _, _, Ani.All -> List.concat <| List.map (fun ani -> UnitsList value (gen, ani)) Anis
  | _, Gen.All, _ -> List.concat <| List.map (fun gen -> UnitsList value (gen, ani)) Gens
  | value, gen, Ani.Ani when value < 5 && (value <> 1 || gen = Gen.Mas || gen = Gen.Neu)
    -> UnitsList value (gen, Ani.Ina) |> List.map (fun item -> ReplaceAcc Case.Gen item)
  | 1, Gen.Fem, _ -> [ FormAcc lpOneFem lsOneFemAcc ]
  | 1, Gen.Neu, _ -> [ Replace ltUnits.[value] lsOneNeu ]
  | 2, Gen.Fem, _ -> [ Replace ltUnits.[value] lsTwoFem ]
  | _, _, _ -> [ Form ltUnits.[value] ]

let Units value var =
  Unwind (UnitsList value var)

let Tens = function
  | 0 -> Empty
  | 1 -> Form lpTen
  | 4 -> Form lpFourty
  | 9 -> Form lpNinety
  | x when x > 4 -> Units x (Gen.Mas, Ani.Ina) ++ Replace lpTen lsEmpty
  | x -> Indecl (Units x (Gen.Mas, Ani.Ina) Case.Nom) ++ Form lpTenDu

let Hundreds = function
  | 0 -> Empty
  | 1 -> NumForm lnHundred 1
  | x -> Units x (Gen.Fem, Ani.Ina) ++ NumForm lnHundred x

let TeenBase value =
  match value with
  | 1 -> Units value (Gen.Mas, Ani.Ina) Case.Nom
  | 2 | 3 -> Units value (Gen.Fem, Ani.Ina) Case.Nom
  | _ -> ltUnits.[value] |> fst

let Teens value =
  Indecl (TeenBase value + lsTeen) ++ Form lpTenDu

let GroupName value = function
  | 0 -> Empty
  | 1 -> NumFormAcc lnThsnd value lsThsndAcc
  | 3 -> NumForm lnBillion value
  | group -> Indecl lgLions.[group - 2] ++ NumForm lnLion value

let GroupVar var = function
  | 0 -> var
  | 1 -> Gen.Fem, Ani.Ina
  | _ -> Gen.Mas, Ani.Ina

let GroupValue group value var =
  let modCent = value % 100
  Hundreds (value / 100)
  +|+
  if modCent > 10 && modCent < 20 then
    Teens (modCent - 10)
  else
    Tens (modCent / 10) +|+ Units (value % 10) (GroupVar var group)

let Group group value var =
  (if value = 1 && group > 0 then Option else id)
    (GroupValue group value var)
    +|+
    if value > 0 then GroupName value group else Empty

let rec PositiveNumber group value (gen, ani) =
  let nAni = if value < 5I || value % 10I = 1I then ani else Ani.Ina
  if value > 0I then
    PositiveNumber (group + 1) (value / 1000I) (gen, nAni)
    +|+
    Group group (int (value % 1000I)) (gen, nAni)
  else Empty

let Number value var =
  if value = 0I then Zero
  elif value > 0I then PositiveNumber 0 value var
  else Indecl lsMinus +|+ PositiveNumber 0 -value var

let private Decl f = [for case in Cases -> f case]

let Decline gen ani str =
  System.Collections.Generic.List
    (Decl <| Number (bigint.Parse str) (gen, ani))

[Theo van Pruis]

Первая десятка:
1. Я школота.
2. Я гордый петербуржец.
3. Я начинал учить, наверное, не меньше 50 языков.
4. Выучил из них нормально только 2.
5. Когда-то я написал статью про пиджина в публицистический журнал.
6. Я еврей.
7. Я хочу учиться в Австралию.
8. Со мной нельзя говорить о политике Индонезии, иначе вы никогда не выпутаетесь из дебрей моих мыслей и аргументов.
9. Я хочу, чтоб здесь кто-то выучил индонезийский/малайский.
10. Я встретил здесь старого знакомого через пару дней после прихода на форум.

[Марго]

Theo van Pruis, а зачем Вы сразу рванули на недосягаемую высоту? У нас здесь и попроще анкетка есть: Пишем 20 фактов о себе

[-Dreamer-]

6. Я еврей.

А иврита не знаете. Плохо.

[Вадимий]

3. Я начинал учить, наверное, не меньше 50 языков.

Думаю, что меньше.

[Вадимий]

А иврита не знаете. Плохо.

Придумайте язык людей, которые решают за других людей, что плохо, а что нет. Куче народу он понравится, всяким учителям, демографам, коммунистам, Милонову...

[-Dreamer-]

Придумайте язык людей, которые решают за других людей, что плохо, а что нет. Куче народу он понравится, всяким учителям, демографам, коммунистам, Милонову...

Прошу прощения, но я Вас не спрашивал.

[Вадимий]

«Don't talk to me» тоже не звучало, так что.

[Theo van Pruis]

3. Я начинал учить, наверное, не меньше 50 языков.

Думаю, что меньше.

Очень зависит от определения понятия "начать учить".

[Sudarshana]

   

276. у нас есть собака и кошка
277. моя прабабушка окала
278. я гей
279. я являюсь поклонником давиденко людмилы дмитриевны
280. я всею душой ненавижу россию, первый и нтв
281. из книг достоевского я читал идиота, братьев карамазовых и полпреступления и наказания
282. больше всего понравились карамазовы
283. однако достоевская мораль (что все, что вне христа - дерьмо) мне, мягко говоря, отвратительна
284. я не решил задачу, за которое вадимий получил лучшее решение
285. мое жизненное кредо: just dance be nice
286. я терпим ко всему, кроме насилия
287. мне нравится песня мадонны masterpiece
288. мне нравится песня ники минаж fly
289. мне нравится сирень
290. мне нравится сериал glee
291. я обожаю даррена криса
292. я знаю наизусть "отче наш" по-коптски
293. мне тяжело дается чтение
294. за полтора года я пока прочел всего около 400 страниц моей любимой книги
295. я довольно обидчив
296. я люблю долго выполнять однообразную и тупую работу
297. у меня часты проблемы со сном
298. мне очень понравился фильм the perks of being a wallflower
299. мне ужасно не нравится чехов
300. я люблю темные очки

[Theo van Pruis]

278. я гей

[Sudarshana]

278. я гей

чем вызвано ваше замешательство?

[Theo van Pruis]

Просто не знал сего факта

[Sudarshana]

Просто не знал сего факта

а остальные 299 знали? идите в "битву экстрасенсов"

[Theo van Pruis]

Просто не знал сего факта

а остальные 299 знали? идите в "битву экстрасенсов"

Возможно моё мировоззрение достаточно консервативно (хотя в нетолерантности меня никак нельзя упрекнуть), но этот факт показался мне более значимым, чем большинство других (что совсем не значит, что я даю ему эмоционально окрашенную положительную или отрицательную оценку).

[Sudarshana]

этот факт показался мне более значимым, чем большинство других

ну тут я в основном ерунду пишу, чтобы растянуть количество значимых фактов на 2000

[Joris]

Продолжить что ли...

[Тайльнемер]

Продолжить что ли...

Да

[Joris]

Да

Я уже не помню, что я писал, а чего не писал.

[Гостья_Shaliman]

Сегодня каталась на тюркских фрикослонах.