Racket/Markov

#lang racket

;;;;;
;; Markovkedja av tredje ordningen
;;
;; Tar en textfil eller stdin och bygger statistik över orden i tre gram
;; därefter producerar den en 150 ord lång text baserad på den statistiken
;;
;; Täpp-Anders Sikvall, anders@sikvall.se, 2026-04-07
;;;;;

(require racket/string
         racket/port)

;; ================================================
;; MARKOVKEDJA – TREDJE ORDNINGEN (3-gram) 
;; ================================================

;; Skapar alla n-gram
(define (make-ngrams words n)
  (for/list ([i (in-range 0 (- (length words) (sub1 n)))])
    (take (drop words i) n)))

;; Bygger 3:e ordningens Markovmodell – korrekt indexering
(define (build-markov-3 text)
  (define words (filter non-empty-string? (string-split text)))
  (when (< (length words) 4)
    (error 'build-markov-3 "Texten är för kort för 3-gram (minst 4 ord behövs)."))

  (define transitions (make-hash))

  (for ([i (in-range 0 (- (length words) 3))])
    (let* ([prefix (list (list-ref words i)
                         (list-ref words (+ i 1))
                         (list-ref words (+ i 2)))]
           [next-word (list-ref words (+ i 3))]
           [freq-hash (hash-ref! transitions prefix (λ () (make-hash)))])
      (hash-update! freq-hash next-word add1 0)))

  transitions)

;; Viktad slumpmässig val
(define (weighted-random freq-hash)
  (define options (hash->list freq-hash))
  (define total (apply + (map cdr options)))
  (if (zero? total)
      #f
      (let ([r (random total)])
        (let loop ([lst options] [acc 0])
          (match lst
            ['() #f]
            [(cons (cons word count) rest)
             (if (< r (+ acc count))
                 word
                 (loop rest (+ acc count)))])))))

;; Genererar text
(define (generate-text-3 transitions start-prefix num-words)
  (let loop ([current-prefix start-prefix]
             [result        (vector->list (list->vector start-prefix))]  ; enklare append
             [remaining     (- num-words 3)])
    (if (<= remaining 0)
        (string-join result " ")
        (let* ([freq-hash (hash-ref transitions current-prefix (make-hash))]
               [next-word (weighted-random freq-hash)])
          (if (not next-word)
              (string-join result " ")
              (let ([new-prefix (append (cdr current-prefix) (list next-word))])
                (loop new-prefix
                      (append result (list next-word))
                      (sub1 remaining))))))))

;; ================================================
;; HUVUDPROGRAM
;; ================================================

(define (main)
  (let* ([input-text (port->string (current-input-port))]
         [words      (filter non-empty-string? (string-split input-text))])
    (cond
      [(< (length words) 4)
       (displayln "Fel: Texten är för kort för 3:e ordningens Markovkedja (minst 4 ord behövs).")]
      [else
       (let* ([model        (build-markov-3 input-text)]
              [all-prefixes (hash-keys model)]
              [start-prefix (list-ref all-prefixes (random (length all-prefixes)))])
         (displayln "=== Genererad text med 3:e ordningens Markovkedja (200 ord) ===")
         (displayln (generate-text-3 model start-prefix 200)))])))

(main)