Racket/Markov

Från Täpp-Anders
Version från den 7 april 2026 kl. 17.24 av Anders (diskussion | bidrag)
(skillnad) ← Äldre version | Nuvarande version (skillnad) | Nyare version → (skillnad)
Hoppa till navigeringHoppa till sök

Markovkedja av 1:a ordningen

#lang racket

;;;;;
;; Markovkedja av förstaordningen
;;
;; 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 I RACKET – textinläsning → träning → textgenerering
;; ================================================

;; Bygger en första-ordnings Markovkedja (ord → nästa-ord med vikter)
;; Texten splittas på whitespace. Punktuation behålls som del av orden
;; (vill du ha renare hantering kan du utöka med regexp senare).
(define (bygg-markov text)
  (let ([ord-lista (string-split text)])
    (define transitions (make-hash))
    (for ([i (in-range 0 (sub1 (length ord-lista)))])
      (let* ([nuvarande (list-ref ord-lista i)]
             [nästa     (list-ref ord-lista (add1 i))])
        ;; Skapa eller hämta inner-hash för nästa ord
        (let ([nästa-hash (hash-ref! transitions nuvarande (λ () (make-hash)))])
          (hash-update! nästa-hash nästa add1 0))))
    transitions))

;; Väljer nästa ord med korrekt viktning (roulette wheel / weighted random)
(define (viktad-slump nästa-hash)
  (let* ([par   (hash->list nästa-hash)]
         [total (apply + (map cdr par))])
    (if (zero? total)
        #f                                      ; ingen fortsättning finns
        (let ([rand-val (random total)])
          (let loop ([lst par]
                     [acc 0])
            (let* ([pair (car lst)]
                   [key  (car pair)]
                   [cnt  (cdr pair)])
              (if (< rand-val (+ acc cnt))
                  key
                  (loop (cdr lst) (+ acc cnt)))))))))

;; Genererar ny text med angivet antal ord
(define (generera-text transitions start-ord antal-ord)
  (let loop ([nuvarande start-ord]
             [resultat  (list start-ord)]
             [kvar      (sub1 antal-ord)])
    (if (<= kvar 0)
        (string-join (reverse resultat) " ")
        (let* ([nästa-hash (hash-ref transitions nuvarande (make-hash))]
               [nästa      (viktad-slump nästa-hash)])
          (if (not nästa)
              (string-join (reverse resultat) " ")   ; kedjan tog slut
              (loop nästa
                    (cons nästa resultat)
                    (sub1 kvar)))))))

;; ================================================
;; HUVUDPROGRAM – läser från stdin och skriver ut genererad text
;; ================================================

(define (main)
  (let* ([input-text (port->string (current-input-port))]
         [model      (bygg-markov input-text)])
    (cond
      [(hash-empty? model)
       (displayln "Fel: Ingen text inläst! Mata in text via stdin eller fil.")]
      [else
       ;; Välj ett slumpmässigt startord bland alla ord som förekommer
       (let* ([alla-start-ord (hash-keys model)]
              [start-ord      (list-ref alla-start-ord (random (length alla-start-ord)))])
         (displayln "=== Genererad text (100 ord) ===")
         (displayln (generera-text model start-ord 150)))])))

;; Kör programmet direkt när filen exekveras med racket
(main)

Markovkedja av 3:e ordningen

#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 150)))])))

(main)