# ========================================================================
#  JANUS-SR   Janus Speech Recognition Toolkit
#             ------------------------------------------------------------
#  Author  :  Martin Westphal
#  Module  :  coverage.tcl
#  Date    :  22.Oct.97
#
#  Remarks :  This collection of tcl procedure can be used to process
#             a text file and create a vocabulary from it or given
#             a vocabulary calculate the coverage of the text.
#             The main procedure is
#                            readCountText <file>
#             which reads a text file and fills the global array count.
#             There are different procedures to define the vocabulary
#             (see below)
#
#  Global  :  count(<word>)      The count for <word> in the given text.
#
#             vocab(<word>)      Exists and is 1 if <word> is in the 
#                                vocabulary.
#             wordL(<count>)     An alphabetic list of words in the text
#                                that have the same count <count>.
# =======================================================================

# =======================================================================
#  Counting words in the text file
# =======================================================================
# -----------------------------------------------------------------------
#  read a text file and count the words
# -----------------------------------------------------------------------
proc readCountText {file {reset 1}} {
    if {[catch {set FP [open $file r]} msg]} {
	puts stderr "Couldn't open file $file for reading"
	return -1
    }
    if {$reset} { resetCount }
    set wordN 0
    while {[gets $FP line] >= 0} {
	foreach word $line { 
	    countWord $word 
	    incr wordN
	}
    }
    close $FP
    puts "read $wordN words from file $file"
    return $wordN
} 

# -----------------------------------------------------------------------
#  reset count
# -----------------------------------------------------------------------
proc resetCount {} {
    global count
    if [array exists count] {unset count}
}
# -----------------------------------------------------------------------
#  increase the counter for a given word
# -----------------------------------------------------------------------
proc countWord {word} {
    global count
    if [info exists count($word)] { incr count($word)
    } else                        { set count($word) 1 }
}

# -----------------------------------------------------------------------
#  return the number of total words
# -----------------------------------------------------------------------
proc totalWords {} {
    global count
    set totalN 0
    foreach word [array names count] {
	incr totalN $count($word)
    }
    return $totalN
}

# -----------------------------------------------------------------------
#  return the number of different words
# -----------------------------------------------------------------------
proc differentWords {} {
    global count
    return [llength [array names count]]
}

# -----------------------------------------------------------------------
#  return the number of words in the vocabulary
# -----------------------------------------------------------------------
proc totalVocab {} {
    global vocab
    return [llength [array names vocab]]
}

# =======================================================================
#  How to choose the vocabulary:
#  There are different ways to define the vocabulary.
#      1) take the whole dictionary
#      2) take all words with a certain minimal count
#      3) take the most salient words until you reach a certain coverage
#      4) take the n most salient words
#      5) take all (the first n) words of a text
#  First some "sub"-procedures are defined:
#      coverage, sortByCount
# =======================================================================
# -----------------------------------------------------------------------
#  given a vocbulary calculate the coverage
# -----------------------------------------------------------------------
proc coveredWords {} {
    global count vocab
    set cover 0    ;# how many words are covered by the vocabulary
    set known 0    ;# how many vocabulary words in the text 
    foreach word [array names vocab] {
	if {[info exists count($word)]} {
	    incr cover $count($word)
	    incr known
	}
    }
    return "$cover $known"
}

# -----------------------------------------------------------------------
#  write missing words into outfile (tanja@cs.cmu.edu)
# -----------------------------------------------------------------------
proc notCoveredWords { outfile } {
    global count vocab
    set notCover 0
    set fp [open $outfile w]
    foreach word [array names count] {
	if {![info exists vocab($word)]} {
	    incr notCover
	    puts $fp $word
	}
    }
    set total [totalWords]
    set diff [differentWords]
    puts "$notCover words out of $total spoken words ($diff different words) are not covered"
    puts "missing words are written to file $outfile"
    return $notCover
}

proc coverage {} {
    global count vocab
    set total [totalWords]      ;# total words in the text
    set diff  [differentWords]  ;# different words in the text
    set coverKnown [coveredWords]
    set cover [lindex $coverKnown 0]
    set known [lindex $coverKnown 1]

    set miss [expr $diff - $known]
    puts "$diff different words, $known known, $miss missing in the vocabulary"

    set coverage [expr 100.0 * $cover / $total]
    set oov      [expr 100.0 - $coverage]
    puts "$total total words, $cover ([format %.2f $coverage]%) covered, [format %.2f $oov]% OOV"
    return "$diff $total $known $cover"
}
# -----------------------------------------------------------------------
#  We create an array wordL(<count>) with a list of words with a certain
#  count.
# -----------------------------------------------------------------------
proc sortByCount {} {
    global count wordL

    if [info exists wordL] {unset wordL}
    foreach word [array names count] {
	lappend wordL($count($word)) "$word"
    }
    # --- sort the lists ---
    foreach c [array names wordL] {
	set wordL($c) [lsort $wordL($c)]
    }
    return [lsort -integer -decreasing [array names wordL]]
}
# -----------------------------------------------------------------------
#  read the vocabulary from (dictionary) file
#  (take only first word of each line)
# -----------------------------------------------------------------------
proc vocabRead {file {reset 1}} {
    global vocab

    if {[catch {set FP [open $file r]} msg]} {
	puts stderr "Couldn't open file $file for reading"
	return -1
    }
    if {$reset && [info exists vocab]} { unset vocab }
    set newN  0
    set wordN 0
    while {[gets $FP line] >= 0} {
	set word [lindex $line 0]
	incr wordN
	if ![info exists vocab($word)] {
	    set vocab($word) 1
	    incr newN
	}
    }
    close $FP
    puts "read $wordN words ($newN new) from vocab file $file"
    return [totalVocab]
} 

# -----------------------------------------------------------------------
#  add all words with a certain minimal count as vocabulary
# -----------------------------------------------------------------------
proc vocabMinCount {minCount {reset 1}} {
    global wordL vocab

    if {$reset && [info exists vocab]} { unset vocab }
    set wordN 0
    set newN  0                         ;# number of new words in the vocabulary
    set total [lindex [coveredWords] 0] ;# words covered by the vocabulary
    foreach c [sortByCount] {
	if {$c < $minCount} break
	foreach word $wordL($c) {
	    incr wordN
	    if ![info exists vocab($word)] {
		set vocab($word) 1
		incr newN
		incr total $c
	    }
	}
    }
    set coverage [format %.2f [expr 100.0 * $total / [totalWords]]]
    puts stderr "adding $wordN words ($newN new) with min count >= $minCount now cover $total (${coverage}%) words in the text"
    set vocabN   [totalVocab]
    return "$vocabN $total $coverage"
}
    
# -----------------------------------------------------------------------
#  add the n most salient words as vocabulary
# -----------------------------------------------------------------------
proc vocabSalient {number {reset 1}} {
    global wordL vocab

    if {$reset && [info exists vocab]} { unset vocab }
    set wordN 0
    set newN  0                         ;# number of new words in the vocabulary
    set total [lindex [coveredWords] 0] ;# words covered by the vocabulary
    foreach c [sortByCount] {
	if {$wordN >= $number} break
	foreach word $wordL($c) {
	    if {$wordN >= $number} break
	    incr wordN
	    if ![info exists vocab($word)] {
		set vocab($word) 1       ;# add word to the vocabulary
		incr total $c
		incr newN
	    }
	}
    }
    set coverage [format %.2f [expr 100.0 * $total / [totalWords]]]
    puts stderr "adding $wordN most salient words ($newN new) now cover $total (${coverage}%) words in the text"
    set vocabN [totalVocab]
    return "$vocabN $total $coverage"
}

# -----------------------------------------------------------------------
#  add the most salient words until you reach a certain coverage
# -----------------------------------------------------------------------
proc vocabCoverage {coverage {reset 1}} {
    global countL wordL vocab

    if {$reset && [info exists vocab]} { unset vocab }
    set totalW [totalWords]
    set coverW [expr int(ceil($totalW * $coverage / 100.0))]
    set newN 0                           ;# number of new words in the vocabulary
    set total  [lindex [coveredWords] 0] ;# words covered by the vocabulary
    foreach c $countL {
	if {$total >= $coverW} break
	foreach word $wordL($c) {
	    if {$total >= $coverW} break
	    if ![info exists vocab($word)] {
		set vocab($word) 1       ;# add word to the vocabulary
		incr total $c
		incr newN
	    }
	}
    }
    set coverage [format %.2f [expr 100.0 * $total / [totalWords]]]
    puts stderr "adding $newN most salient words now cover $total (${coverage}%) words in the text"
    set vocabN   [totalVocab]
    return "$vocabN $total $coverage"
}

# -----------------------------------------------------------------------
#  take a maximum of n words from a text file as vocabulary until 
#  you have m words in the vocabulary or a certain coverage
# -----------------------------------------------------------------------
proc vocabText {file n m coverage {reset 1}} {
    global vocab count

    if {$reset && [info exists vocab]} { unset vocab }
    if {[catch {set FP [open $file r]} msg]} {
	puts stderr "Couldn't open file $file for reading"
	return -1
    }
    set totalW [totalWords]
    set coverW [expr int(ceil($totalW * $coverage / 100.0))]
    set wordN 0                         ;# words in the text
    set total [lindex [coveredWords] 0] ;# words covered by the vocabulary
    set vocabN [totalVocab]             ;# words in the vocabulary
    set break 0
    while {[gets $FP line] >= 0} {
	foreach word $line { 
	    if {$wordN >= $n || $vocabN >= $m || $total >= $coverW} {
		set break 1; break
	    }
	    incr wordN
	    if ![info exists vocab($word)] {
		set vocab($word) 1
		incr total $count($word)
		incr vocabN
	    }
	}
	if {$break} break
    }
    close $FP
    set coverage [format %.2f [expr 100.0 * $total / $totalW]]
    puts "read $wordN words from file $file"
    return "$wordN $vocabN $total $coverage"
}

# -----------------------------------------------------------------------
#  print vocabulary size and coverage after n words of text
#  n is taken from a given sorted list
# -----------------------------------------------------------------------
proc coverageText {file nL {reset 1}} {
    global vocab count

    if {$reset && [info exists vocab]} { unset vocab }
    if {[catch {set FP [open $file r]} msg]} {
	puts stderr "Couldn't open file $file for reading"
	return -1
    }
    set totalW [totalWords]
    set wordN  0                         ;# words from the text
    set total  [lindex [coveredWords] 0] ;# words covered by the vocabulary
    set vocabN [totalVocab]              ;# words in the vocabulary
    set i  0
    set iN [llength $nL]
    set n [lindex $nL $i]
    set break 0
    while {[gets $FP line] >= 0} {
	foreach word $line { 
	    incr wordN
	    if ![info exists vocab($word)] {
		set vocab($word) 1
		incr total $count($word)
		incr vocabN
	    }
	    if {$wordN >= $n} {
		set coverage [format %.2f [expr 100.0 * $total / $totalW]]
		puts "$wordN $vocabN $total $coverage"
		incr i
		if {$i >= $iN} {set break 1; break}
		set n [lindex $nL $i]
	    }
	}
	if {$break} break
    }
    close $FP
    set coverage [format %.2f [expr 100.0 * $total / $totalW]]
    return "$wordN $vocabN $total $coverage"
    
}