(load "prekode3a.scm")


;;en liten abstraksjonsbarriere for å gjøre koden litt lettere å lese
(define fall-back 10000);;forenkling for nå

(define (word-root tree)
  (car(cdr tree)))

(define (pair-root tree)
  (car(cdr(cdr tree))))

(define (left branch)
  (car branch))

(define (right branch)
  (cadr branch))

(define (word-pair node)
  (car(cdr(cdr node))))

(define (word-pair-freq node)
  (car(cdr(cdr(cdr node)))))

(define (deeper-than-root? branch)
  (if (string=? (car(word-pair branch)) "root")
      #f
      #t))

(define (make-lm) ;; lager et tree som egentlig er to forskjellige binærtrær, podet sammen på toppen. et for par, og et for ord. Hodet består av et label '*head* og en peker til hver rot. ('*word-root* og '*pair-root*)
  (list
   '*head*
   (list '*word-root* '() (cons "root" "word") 0) ;;roten består av et label, en peker til subtreet, et cons-par(redundant) og et tall (redundant)
   (list '*pair-root* '() (cons "root" "pair") 0))) ;;samme som over

(define tree (make-lm))

;;sjekker om to noder har identiske cons-par ved å sjekke (car node1) mot (car node2) og (cdr node1) mode (cdr node2)
(define (node=? n1 n2)
  (if (or(null? n1)(null? n2))
      '()
      (if (and (string=? (car(word-pair n1))(car(word-pair n2)))
               (string=? (cdr(word-pair n1))(cdr(word-pair n2))))
          #t
          #f)))
;;sjekker om n1 er mindre enn node2
(define (node<? n1 n2)
  (if (or (null? n1)(null? n2))
      '()
      (cond ((string=? (car(word-pair n1))(car(word-pair n2)))
             (string<? (cdr(word-pair n1))(cdr(word-pair n2))))
            (else (string<? (car(word-pair n1))(car(word-pair n2)))))))

;;wrapper-funksjon for å finne frekvensen til et bigram
(define (lm-lookup-bigram btree w1 w2)
  (if (not(null? (lm-lookup (list '() '() (cons w1 w2) 0) (right(pair-root btree)))))
      (word-pair-freq (lm-lookup (list '() '() (cons w1 w2) 0) (right(pair-root btree))))
      (/ 1 fall-back)))

;;wrapper for å finne ordfrekvens
(define (lm-lookup-word btree w1)
  (if (not(null? (lm-lookup (list '() '() (cons w1 "") 0) (right(word-root btree)))))
      (word-pair-freq (lm-lookup (list '() '() (cons w1 "") 0) (right(word-root btree))))))


;;leter i treet, starter på node branch, og leter etter node
(define (lm-lookup node branch)
  (if (or (null? node)(null? branch)(and (not(deeper-than-root? branch))(null? (cadr branch))))
      '()
      (if (node=? node branch)
          branch
          (if (and(node<? node branch)(deeper-than-root? branch))
              (lm-lookup node (car branch))
              (lm-lookup node (cadr branch))))))

;;Denne metoden er ansvarlig for å bygge binærtreet fra topp og ned
(define (lm-record-bigram w1 w2 tree)
  (define (func node branch)

    (define (insert node branch)
      (if (and (string=? (car(word-pair branch)) "root")(null? (cadr branch))) ;; sjekker om branch er root(og bare root)
          (set-car! (cdr branch) node) ;;hvis branch er root, setter vi inn noden med en gang
          (if (and(node<? node branch)(deeper-than-root? branch))
              (if (null? (left branch))
                  (set-car! branch node)
                  (insert node (left branch)))
              (if (null? (right branch))
                  (set-car! (cdr branch) node)
                  (insert node (right branch))))))


    (let ((record (lm-lookup node branch)))
      (if (not (null? record))
          (set-car! (cdr(cdr(cdr record))) (+ (word-pair-freq record) 1)) ;;increasing freq by one
          (insert node branch))))

  (func (list '() '() (cons w1 w2) 1)(pair-root tree)) ;;legger til ordparet
  (func (list '() '() (cons w1 "") 1)(word-root tree)));; legger til enkeltordet w1 i egen del av binærtreet


;;Signaturen er litt anderledes enn oppgaven for letter å kombinere filer i en og samme språkmodell
(define (lm-train! tree table)
  (define (table-rec table)
    (define (list-rec wlist)
      (if (string=? (car wlist)"</s>")
          '()
          (begin (lm-record-bigram (car wlist) (cadr wlist) tree) (list-rec (cdr wlist)))))
    (if (null? table)
        '()
        (list-rec (car table)))
    (if (null? (cdr table))
        '()
        (table-rec (cdr table))))
  (table-rec table))

;;estimate
(define (lm-estimate! lm)
  (define (recur branch)
    (set-car! (cdr(cdr(cdr branch))) (/    ;;deler frekvensene til w1 på frekvensen til w2, og lagrer resultatet der ordparets frekvens lå.
                                      (word-pair-freq branch)
                                      (lm-lookup-word lm (car(word-pair branch)))))
    (if (not(null? (left branch)))
        (recur (left branch))
        '())
    (if (not(null? (right branch)))
        (recur (right branch))
        '()))

  (recur (right (pair-root lm)))) ;;sender med første element i par-treet

(define (lm-score-table lm table) ;;tar inn en korpusfil, og sender setninger til lm-score
  (if (null? table)
      '()
      (lm-score lm (car table)))
  (if (null? (cdr table))
      '()
      (lm-score-table lm (cdr table))))

;;finner sannsynligheten for hver setning i en korpusfil ved å sende en og en setning til lm-score
(define (lm-table-score lm table)
  (if (null? table)
      '()
      (cons
       (lm-score lm (car table))
       (lm-table-score lm (cdr table)))))

;;finner total sannsynlighet til en setning
(define (lm-score lm s)
  (define (recur wlist)
    (if (string=? (car wlist) "</s>")
        1
        (*
         (lm-lookup-bigram lm (car wlist) (cadr wlist))
         (recur (cdr wlist)))))
  (recur s))

(define test (read-corpus "test.txt"))
(define wsj (read-corpus "wsj.txt"))

(lm-train! tree test)

(lm-estimate! tree)

(lm-table-score tree test)
test
;;2d
;;Trent med kun test.txt virker som at metoden synes at setning #19 er mest sannsynlig: "<s>" "Fundamentally" "illegal," "unfair" "evidence" "was" "dismissed" "by" "it," "as" "the" "case" "was" "approached" "by" "the" "court." "</s>")

;;2e
;;(define 2e-tre (make-lm))
;;(lm-train! 2e-tre test)
;;(lm-train! 2e-tre wsj)
;;(lm-estimate! 2e-tre)
;;(lm-table-score 2e-tre test)

;; trent med både test.txt og wsj.txt synes metoden at setning #14 er mest sannsynlig: "<s>" "It" "dismissed" "fundamentally" "illegal," "unfair" "evidence," "as" "the" "case" "was" "approached" "by" "the" "court." "</s>")