############################################################################
#
#	File:     search.icn
#
#	Subject:  Procedures for charpatt searching
#
#	Author:   Ralph E. Griswold
#
#	Date:     August 29, 1998
#
############################################################################
#
#  This file is in the public domain.
#
############################################################################
#
#  This file contains support procedures
#
############################################################################
#
#  Requires:  Version 9 graphics
#
############################################################################

$include "defines.icn"

#  Search for a specific string.

procedure search_constant(s)
   local i, count, fom, pattern
   static range, savings, fields, widths, decoll

   initial {
      range := "1:0"
      savings := "-10"
      decoll := "1"
      fields := ["string", "range", "decollation factor", "minimum savings"]
      widths := [FindWidth, RangeWidth, 3, 5]
      }

   repeat {
      if TextDialog(
         "Find " || s || ":",
         fields,
         [find_string, range, decoll, savings],
         widths
         ) == "Cancel" then fail
      find_string := dialog_value[1]
      range := dialog_value[2]
      (savings <- intorempty(4), decoll <- pint(3)) | {
         Notice("Invalid value.")
         next
         }
      setup(range) | next
      if *find_string = 0 then {
         Notice("Search for empty string not allowed.")
         next
         }
      if s == "reverse" then find_string := reverse(find_string)
      break
      }

   WAttrib("pointer=watch")

   count := 0
   every count +:= strcnt(find_string, !symbol_tbl)

   WAttrib("pointer=arrow")

   if count = 0 then
      return FailNotice("Search failed.")

   if s == "reverse" then pattern := "<" || find_string || ">"
   else pattern := find_string

   if *savings > 0 then {
      fom := pat_fom(find_string, pattern)
      if fom < savings then return FailNotice("Search failed.")
      if TextDialog(
         "Found " || pat_count(find_string) || " ocurrences of " ||
            abbrev(find_string) || " with savings of " || fom,
         ,
         ,
         ,
         ["Okay", "Cancel"]
         ) == "Cancel" then fail
         }
      else if TextDialog(
         "Found " || pat_count(find_string) || " ocurrences of " ||
            abbrev(find_string),
         ,
         ,
         ,
         ["Okay", "Cancel"]
         ) == "Cancel" then fail

   if decoll > 1 then pattern := decol(pattern, decoll)

   encode(find_string, pattern)

   return

end

#  Get n-grams.

procedure search_ngrams()
   local info, count, gram, value, cnt_tbl, gram_set, i, fom, s, match_list
   local cwidth, fwidth, gwidth, match_tbl, match_lst, j, selector, gram_tbl
   local ceiling, val_tbl
   static fields, limit, savings, widths

   initial {
      limit := 20
      savings := "-10"
      fields := ["minimum length", "maximum length", "number", "minimum savings"]
      widths :=  [5, 5, 3, 5]
      }

   repeat {
      if TextDialog(
         "N-grams:",
         fields,
         [minn, maxn, limit, savings],
         widths,
         ) == "Cancel" then fail
   
      (minn <- pint(1), maxn <- pint(2), limit <- pint(3),
         savings <- intorempty(4)) | {
            Notice("Invalid value.")
            next
            }
      break
      }

   cwidth := fwidth := gwidth := 0

   WAttrib("pointer=watch")

   gram_set := ngrams(minn, maxn)

   gram_tbl := table()
   val_tbl := table()		# THIS NEEDS FIXING
   ceiling := []

   every i := minn to maxn do
   if *savings > 0 then
      every put(ceiling, (savings + i + 4) / (i - 1))
   every gram := !gram_set do {
      if *savings > 0 then {
         count := 0
         every count +:= strcnt(gram, !symbol_tbl)
         i := *gram
         if count >= ceiling[i - minn + 1] then {
            fom := count * (i - 1) - i - 4
            gram_tbl[gram] := fom
            val_tbl[gram] := gram
            fwidth <:= *fom
            gwidth <:= i 
            }
         }
      else {
         gram_tbl[gram] := 0
         val_tbl[gram] := gram			# GROSS
         gwidth <:= *gram
         }
      }

   WAttrib("pointer=arrow")

   if *gram_tbl = 0 then return FailNotice("Search failed.")

   gwidth >:= 30

   info := []

   gram := sort(gram_tbl, 4)
   gram := gram[0-:2 * limit]
   match_lst := []
   j := 0
   selector := []

   if *savings > 0 then {
      repeat {
         i := pull(gram) | break
         s := pull(gram)
         put(selector, valid(s))
         j +:= 1
         put(match_lst, s)
         put(info, right(j, *limit) || ". " || left(abbrev(s), gwidth) ||
            right(i, fwidth + 2))
         }
      }
   else {			# don't compute figures of merit
      while s := get(gram) do {
         get(gram)
         put(selector, valid(s))
         j +:= 1
         put(match_lst, s)
         put(info, right(j, *limit) || ". " || left(abbrev(s), gwidth))
         }
      }

   return show_results("N-grams found:", info, selector, match_lst, val_tbl)

end

#  Search for palindroids.

procedure search_palindroid()
   local i, strip1, strip2, p, middle, pal, count, fom, middy, j, k, match_lst
   local mikle, pal_tbl, palt, gwidth, fwidth, info, tcount, s, value, selector
   local val_tbl
   static mine, maxm, occur, labels, widths, results, range, limit, tries
   static savings

   initial {
      mine := 3
      maxm := 3
      occur := 1
      range := "1:0"
      limit := 10
      tries := 10
      savings := "-10"
      labels :=  ["minimum ends", "maximum middle", "minimum occurrences",
          "range", "limit on results", "maximum attempts", "minimum savings"]
      widths := [5, 3, 3, 10, 3, 3, 5]
      }

   repeat {
      if TextDialog(
         "Find palindroid:",
         labels,
         [mine, maxm, occur, range, limit, tries, savings],
         widths
         ) == "Cancel" then fail
      (mine <- pint(1), maxm <- pint(2), occur <- pint(3), limit <- pint(5),
         tries <- pint(6), savings <- intorempty(7)) | {
          Notice("Invalid value.")
          next
          }
      range := dialog_value[4]
      setup(range) | {
         Notice("Invalid range.")
         next
         }
      results := table()
      break
      }

   pal_tbl := table()
   val_tbl := table()

   WAttrib("pointer=watch")

   tcount := 0

   every k := 1 to *mid do {		# sliding window in the range
      mikle := mid[k:0]
      every j := (*mikle + 1) to 1 by -1 do {
         middy := mikle[1:j]
         every i := 1 to (*middy / 2) + 1 do {
            if middy[i] ~== middy[-i] then break
            i +:= 1			# WHAT???? -- but seems to be needed
            }
         if i = 1 then next
         pal := middy[1:i - 1]			# we got one!
         if *pal = 0 then next
         middle := middy[i:-(i - 1)]
         tcount +:= 1			# ONE TO MANY HERE AND ELSEWHERE
         if tcount > tries then break break
         if *savings > 0 then {
            fom := pat_fom(pal, "x")
            if fom >= savings then {
               pal_tbl[pal] := fom
               val_tbl[pal] := pal
               }
            }
         else val_tbl[pal] := pal
         }
      }

   WAttrib("pointer=arrow")

   if *val_tbl = 0 then {
      Notice("Search failed.")
      fail
      }

   gwidth := 30		# TEMPORARY

   if *savings > 0 then {
      fwidth := 6
      info := []
      palt := sort(pal_tbl, 4)
      palt := palt[1+:limit * 2]
      match_lst := []
      j := 0
      selector := []
      repeat {
         i := pull(palt) | break
         s := pull(palt)
         put(selector, valid(s))
         j +:= 1
         put(match_lst, s)
         put(info, right(j, *limit) || ". " || left(abbrev(s), gwidth) ||
            right(i, fwidth + 2))
         }
      }
   else {
      info := []
      palt := sort(val_tbl, 4)
      palt := palt[0-:2 * limit]
      match_lst := []
      j := 0
      selector := []
      repeat {
         i := pull(palt) | break
         s := pull(palt)
         put(selector, valid(s))
         j +:= 1
         put(match_lst, s)
         put(info, right(j, *limit) || ". " || left(abbrev(s), gwidth))
         }
      }

   return show_results("Palindroids found:", info, selector, match_lst, val_tbl)

end

#  Search for repetitions.

procedure search_repetition()
   local s, k, i, j, pattern, results, value, fom, rep_tbl, rept, match_lst
   local fwidth, gwidth, info, count, tcount, val_tbl, selector
   static rep, labels, widths, occur, range, limit, tries, savings

   initial {
      rep := "2"
      occur := "1"
      range := "1:0"
      limit := "10"
      tries := "10"
      savings := "-10"
      labels :=  ["minimum length", "maximum length", "minimum repetitions",
         "minimum occurrences", "range", "limit on results",
         "maximum attempts", "minimum savings"]
      widths := [6, 6, 6, 4, 10, 3, 3, 5]
      }

   repeat {
      if TextDialog(
         "Find repetition:",
         labels,
         [minl, maxl, rep, occur, range, limit, tries, savings],
         widths
         ) == "Cancel" then fail
      (minl <- pint(1), maxl <- pint(2), rep <- pint(3), occur <- pint(4),
          limit <- pint(6), tries <- pint(7), savings <- intorempty(8)) | {
          Notice("Invalid value.")
          next
          }
      range := dialog_value[5]
      setup(range) | {
         Notice("Invalid range.")
         next
         }
      break
      }

   WAttrib("pointer=watch")

   rep_tbl := table()
   val_tbl := table()

   tcount := 0

   every j := maxl to minl by -1 do {	# look for maximum first ...
      mid ? {
         every move(0 to *mid - minl * rep) do {
            i := &pos
            s := move(j) | next
            k := 1
            while =s do
               k +:= 1
            if k < rep then next
            if k > 1 then pattern := "[" || s || "," || k || "]"
               else pattern := s
            value := repl(s, k)
            tcount +:= 1
            if tcount > tries then break break
            if *savings > 0 then {	# compute figures of merit
               fom := pat_fom(value, pattern)
               if fom >= savings then {
                  rep_tbl[pattern] := fom
                  val_tbl[pattern] := value
                  }
               }
            else val_tbl[pattern] := value
            }
         }
      }

   WAttrib("pointer=arrow")

   gwidth := 15		# TEMPORARY

   if *savings > 1 then { 
      if *rep_tbl = 0 then {
         Notice("Search failed.")
         fail
         }
      fwidth := 6
      info := []
      rept := sort(rep_tbl, 4)
      rept := rept[0-:2 * limit]
      match_lst := []
      j := 0
      selector := []
      repeat {
         i := pull(rept) | break
         s := pull(rept)
         put(selector, valid(s))
         j +:= 1
         put(match_lst, s)
         put(info, right(j, *limit) || ". " || left(abbrev(s), gwidth) ||
            right(i, fwidth + 2))
         }
      }
   else {
      info := []
      rept := sort(val_tbl, 4)
      rept := rept[0-:2 * limit]
      match_lst := []
      j := 0
      selector := []
      repeat {
         i := pull(rept) | break
         s := pull(rept)
         put(selector, valid(s))
         j +:= 1
         put(match_lst, s)
         put(info, right(j, *limit) || ". " || left(abbrev(s), gwidth))
         }
      }

   return show_results("Repetiions found:", info, selector, match_lst, val_tbl)

end

#  Look for a run of a string.

procedure search_run()
   local s, k, i, j, pattern, results, value, fom, rep_tbl, rept, match_lst
   local fwidth, gwidth, info, count, tcount, val_tbl, selector
   static rep, labels, widths, occur, range, limit, tries, savings

   initial {
      rep := "2"
      occur := "1"
      range := "1:0"
      limit := "10"
      tries := "10"
      savings := "-10"
      labels :=  ["string", "minimum length", "maximum length",
         "minimum repetitions", "minimum occurrences", "range",
         "limit on results", "maximum attempts", "minimum savings"]
      widths := [30, 6, 6, 6, 4, 10, 3, 3, 5]
      }

   repeat {
      if TextDialog(
         "Find run:",
         labels,
         [find_string, minl, maxl, rep, occur, range, limit, tries, savings],
         widths
         ) == "Cancel" then fail
      if *dialog_value[1] = 0 then {
         Notice("Null string not allowed in run.")
         next
         }
      else find_string := dialog_value[1]
      (minl <- pint(2), maxl <- pint(3), rep <- pint(4), occur <- pint(5),
          limit <- pint(7), tries <- pint(8), savings <- intorempty(9)) | {
             Notice("Invalid value.")
             next
             }
      range := dialog_value[6]
      setup(range) | {
         Notice("Invalid range.")
         next
         }
      break
      }

   WAttrib("pointer=watch")

   rep_tbl := table()
   val_tbl := table()

   tcount := 0

   every j := maxl to minl by -1 do {	# look for maximum first ...
      mid ? {
         while tab(find(find_string)) do {
            s := ""
            k := 0
            while s ||:= =find_string do
               k +:= 1
            if k < rep then next
            if k > 1 then pattern := "[" || find_string || "," || k || "]"
               else pattern := s
            tcount +:= 1
            if tcount = tries then break break
            value := repl(find_string, k)
               if *savings > 0 then {
               fom := pat_fom(value, pattern)
               if fom >= savings then {
                  rep_tbl[pattern] := fom
                  val_tbl[pattern] := value
                  }
               }
            else val_tbl[pattern] := value
            }
         }
      }

   WAttrib("pointer=arrow")

   gwidth := 30		# TEMPORARY

   if *savings > 0 then {
      if *rep_tbl = 0 then {
         Notice("Search failed.")
         fail
         }
      fwidth := 6
      info := []
      rept := sort(rep_tbl, 4)
      rept := rept[1+:limit * 2]
      match_lst := []
      j := 0
      selector := []
      repeat {
         i := pull(rept) | break
         s := pull(rept)
         put(selector, valid(s))
         j +:= 1
         put(match_lst, s)
         put(info, right(j, *limit) || ". " || left(abbrev(s), gwidth) ||
            right(i, fwidth + 2))
         }
      }
   else {
      info := []
      rept := sort(val_tbl, 4)
      rept := rept[0-:2 * limit]
      match_lst := []
      j := 0
      selector := []
      repeat {
         i := pull(rept) | break
         s := pull(rept)
         put(selector, valid(s))
         j +:= 1
         put(match_lst, s)
         put(info, right(j, *limit) || ". " || left(abbrev(s), gwidth))
         }
      }

   return show_results("Runs found:", info, selector, match_lst, val_tbl)

end

#  Define a section.

procedure section()
   local fom, count, pattern, i
   static savings, fields, widths, decoll

   initial {
      savings := "-10"
      decoll := "1"
      fields := ["range", "minimum savings", "decollation factor"]
      widths := [10, 5, 3]
      }

   repeat {
      if TextDialog("Section:", fields, [secrange, savings, decoll], widths) ==
         "Cancel" then fail
      secrange := dialog_value[1]
      setup(secrange) | {
         Notice("Invalid range.")
         next
         }
      (savings <- intorempty(2), decoll <- pint(3)) | {
         Notice("Invalid value.")
         next
         }
      if decoll > 1 then pattern := decol(mid, decoll)
      else pattern := mid
      fom := pat_fom(mid, pattern)
      if fom < savings then {
         Notice("Search failed.")
         fail
         }
      if TextDialog( "Found " || abbrev(mid) || " with savings of " ||
         fom) == "Cancel" then fail
      encode(mid, pattern)
      return
      }

end