nasin-musi-telo/majuna/2020-11-24.rkt

#lang racket/base

(require srfi/26)
(require racket/list)
(require racket/function)
(require racket/string)

(random-seed 10)

(define nimi-ale (read (open-input-file "nimi-ale.lisp")))

;; nimi li ken ijo li ken pali li ken ale.
(define nimi-ijo
  (filter-map (lambda (sona-nimi)
                ;; sona-nimi li kulupu. ijo nanpa wan li nimi. ijo
                ;; nanpa tu en ijo nanpa mute li nimi pi nasin nimi
                ;; (adjective, noun, ijo ante)
                (and (findf (lambda (nasin-nimi)
                              (findf
                                (cut eq? <> nasin-nimi)
                                '(adjective noun verb)))
                            (cdr sona-nimi))
                     ;; nimi ni li ken nasa lili tawa lipu
                     ;; TODO: tenpo kama o lukin sin e ni
                     (not (findf
                            (cut eq? <> (car sona-nimi))
                            '(meli mije unpa ijo pu mi sina ona ni)))
                     (symbol->string (car sona-nimi))))
              nimi-ale))

;; lipu ale la nanpa pi mute lili o suli. mute li kama lon tenpo mute lon
;; lipu wan la jan li sona e suli ona. ni li ken wawa e nasin.
;; nasin ni li kute e kulupu nimi:
;;   (list "a" "b" "c" "d")
;; li pana e kulupu pi tu nimi nanpa:
;;   (list '("a" . 1) '("b" 1/2) '("c" 1/3))
;; nanpa li toki e ni: nimi seme li kama lon tenpo mute?
(define (nanpa-ken kulupu)
  (for/list ([nimi (shuffle kulupu)]
             [nanpa (in-naturals 1)])
    (cons nimi (/ (expt nanpa 6/5)))))

;; nasin ni li kute e kulupu pi tu nimi nanpa (sama nasin nanpa-ken) li
;; pana e kulupu sama.
;;
;; ona li nasa lili e nanpa. tan ni la sike musi ante la nimi ante lili li
;; ken lon tenpo mute. ona li nasa pi lili taso; nimi suli tan kulupu nanpa
;; wan li ken awen suli lon kulupu nanpa tu.
(define (o-nasa-e-kulupu-ken kulupu)
  (map (lambda (tu) (cons (car tu) (* (/ (random 51) 50) (cdr tu)))) kulupu))

;; o alasa e nimi wan tan kulupu pi ken nimi
;; ona li kute e kulupu (sama nasin nanpa-ken) li pana e nimi wan taso.
(define (o-alasa kulupu-ken)
  ;; ijo nanpa x
  (define (ijo-nanpa kulupu-ken nanpa ijo)
    (cond
      [(null? kulupu-ken) ijo]
      [(< nanpa (cdar kulupu-ken)) (caar kulupu-ken)]
      [else (ijo-nanpa (cdr kulupu-ken)
                       (- nanpa (cdar kulupu-ken))
                       (caar kulupu-ken))]))

  (ijo-nanpa kulupu-ken (* (random) (apply + (map cdr kulupu-ken))) #f))

;; nasin ni li kute e kulupu nimi:
;;   (list 'a 'b 'a 'a 'a 'c 'c)
;; li pana e kulupu pi tu nanpa nimi li toki e ni: mute seme la
;; nimi li lon kulupu?
;;   (list '(4 . a) '(2 . c) '(1 . b))
(define (o-nanpa-e-kulupu l)
  (map (lambda (kulupu) (cons (length kulupu) (car kulupu)))
       (sort (group-by identity l) > #:key length)))

;; tenpo mute la sike sin o nasa ala tawa sike ante. sike nanpa wan en
;; sike nanpa tu o ante suli ala. tenpo ona o sama lili.
(define (suli-pi-sike-sin suli-pi-sike-ante)
  (let
    ([nanpa-ken
       (for/list
         ([nanpa (in-range 2 9)])
         (cons
           nanpa
           (* (/ nanpa)
              ;; nanpa ale li kama tan kulupu pi nanpa lili.
              ;; nanpa tu en nanpa tu li kama e nanpa tu tu.
              ;; nanpa tu en nanpa luka li kama e nanpa luka luka.
              ;;
              ;; nasin 'gcd' li toki e ni: kulupu pi nanpa nanpa wan en kulupu
              ;; pi nanpa nanpa tu la nanpa seme li lon kulupu tu? ijo mute li
              ;; lon kulupu tu la nanpa ni li pona tawa sike ante li sike lon
              ;; tenpo pi sama lili. nasin ni li mute e ken ona tan ni.
              (+ 9 (apply + (map (cut gcd <> nanpa) suli-pi-sike-ante))))))])
    (o-alasa nanpa-ken)))

(define (pali-lili nimi-ken)
  (string-join
    (car
      (shuffle
        (list
          (list (o-alasa nimi-ken))
          (list (o-alasa nimi-ken)
                "li"
                (o-alasa nimi-ken))
          (list (o-alasa nimi-ken)
                "li"
                (o-alasa nimi-ken)
                "e"
                (o-alasa nimi-ken)))))
  " "))

(define (sike-sin nimi-ken sike-ante)
  (let ([suli (suli-pi-sike-sin (map length sike-ante))]
        [nimi-ken (o-nasa-e-kulupu-ken nimi-ken)])
    (for/list ([nimi (in-range suli)])
      ;; TODO: ken la o ante e ni
      (pali-lili nimi-ken))))

(define (sike-mute nimi-ken mute)
  (if (= mute 0)
      '()
      (let ([sike-ante (sike-mute nimi-ken (- mute 1))])
        (cons (sike-sin nimi-ken sike-ante)
              sike-ante))))

(define toki-lawa
  #<<PINI
\documentclass{article}

\usepackage[T1]{fontenc}
\usepackage[utf8]{inputenc}
\usepackage[margin=1in]{geometry}
\usepackage{fourier}
\usepackage{nanpa}

\pagenumbering{gobble}

\setcounter{secnumdepth}{0}
\newcounter{nasin}
\newcounter{sike}

\begin{document}

PINI
)

(define toki-noka
  #<<PINI
\end{document}
PINI
)

(define (sitelen-sike sike)
  (string-append
    "\\begin{minipage}[t][10\\baselineskip]{0.30\\linewidth}\n"
    "\\begin{center}\n"
    "\\stepcounter{sike}\\textbf{sike nanpa \\nanpasuli{sike}}\n\n"
    (string-join sike "\n\n")
    "\\end{center}\\end{minipage}\\hfill\n"))

(define (lipu-wan)
  (string-append
    "\\newpage{}\\begin{center}\n"
    "\\stepcounter{nasin}\n"
    "\\setcounter{sike}{0}\n"
    "\\section{\\Huge nanpa \\nanpasuli{nasin}}\n"
    "\\vspace*{\\fill}"
    (string-join
      (let ([nanpa-ken (nanpa-ken nimi-ijo)])
        (map (cut apply string-append <>)
             (list
               (map sitelen-sike (sike-mute nanpa-ken 1))
               (map sitelen-sike (sike-mute nanpa-ken 3))
               (map sitelen-sike (sike-mute nanpa-ken 3)))))
      "\n")
    "\n"
    "\\vspace*{\\fill}"
    "\\end{center}"))

;; (for-each (lambda (x) (newline) (for-each displayln x)) (sike-mute (nanpa-ken nimi-ijo) 5))

(displayln toki-lawa)
(for ([i (in-range 500)])
  (displayln (lipu-wan)))
(displayln toki-noka)