############################################################################
#
#	File:     dd2draft.icn
#
#	Subject:  Program to create draft information from drawdown
#
#	Author:   Ralph E. Griswold
#
#	Date:     November 16, 2001
#
############################################################################
#
#  This file is in the public domain.
#
############################################################################
#
#  This program reads a drawdown in terms of rows of zeros and ones from
#  standard input and outputs draft information in textual form.
#
#  It also accepts BLPs as input.
#
############################################################################
#
#   Links:  patutils. patxform
#
############################################################################

link patutils
link patxform

record analysis(rows, sequence, patterns)

procedure main()
   local threading, treadling, rows, columns,  pattern, i
   local symbols, symbol, tieup, line

   line := read() | stop("empty file")

   if upto("#", line) then rows := pat2rows(line)
   else {
      rows := [line]
      while put(rows, read())	# read in row pattern
      }

   write("Drawdown:")
   write()
   every write(!rows)
   write()

   treadling := analyze(rows)
   write("Treadling:")
   write()
   every writes(!treadling.sequence, ", ")
   write()
   write()

   columns := protate(rows)	# rotate 90 degrees

   threading := analyze(columns)
   write("Threading:")
   write()
   every writes(!threading.sequence, ", ")
   write()
   write()

   # Now do the tie-up.

   symbols := table("")

   every pattern := !treadling.patterns do {
      symbol := treadling.rows[pattern]
      symbols[symbol] := repl("0", *threading.rows)
      pattern ? {
         every i := upto('1') do
            symbols[symbol][threading.sequence[i]] := "1"
         }
      }

   symbols := sort(symbols, 3)
   tieup := []

   while get(symbols) do
      put(tieup, get(symbols))

   write("Tie-up:")
   write()
   every write(!tieup)

end

procedure analyze(drawdown)
   local sequence, rows, row, count, patterns

   sequence := []
   patterns := []

   rows := table()

   count := 0

   every row := !drawdown do {
      if /rows[row] then {
         rows[row] := count +:= 1
         put(patterns, row)
         }
      put(sequence, rows[row])
      }

   return analysis(rows, sequence, patterns)

end