!! Tables.i6: code for handling I7 tables

! A table T is represented by a "table" array: T-->0 holds the
! number of columns and T-->i is the address of column number i.
! Columns are therefore numbered from 1 to T-->0, but they are also
! identified by an ID number of 100 or more, with each different
! column name having its own ID number. Each column C is also a
! "table" array, with C-->1 holding the unique ID number for the
! column's name, and C-->2 up to C-->(C-->0) holding the entries.
! Except that C-->1 also contains two upper bit flags:

Constant I7_COLUMN_NUMBER $0fff;
Constant I7_COLUMN_SIGNED $4000;
Constant I7_COLUMN_TOPIC $2000;
Constant I7_COLUMN_DONTSORTME $1000;

[ TableFindCol tab col f i j n;
  j = tab-->0;
  for (i=1:i<=j:i++)
      if (col == ((tab-->i)-->1) & I7_COLUMN_NUMBER) return i;
  if (f) return RunTimeProblem(RTP_TABLE_NOCOL, tab);
  return 0;
];

! The columns in a table can be assumed all to have the same
! height (i.e., number of rows): thus the number of rows in T
! can be calculated as (T-->1)-->0 - 1.

[ TableRows tab; return ((tab-->1)-->0)-1; ];

! The following dummy value is invalid for most types and unlikely
! in the others, so is used to represent an empty cell.

Constant I7_TABLE_NOVALUE $7fe3;

! TableRowCorr(T, C, V) returns the first row on which value V
! appears in column C of table T, or prints an error if it doesn't.

[ TableRowCorr tab lookup_col lookup_value i j;
  if (lookup_col >= 100) lookup_col=TableFindCol(tab, lookup_col, true);
  lookup_col = tab-->lookup_col;
  j = lookup_col-->0;
  for (i=2:i<=j:i++)
      if (lookup_col-->i == lookup_value) return i-1;
  return RunTimeProblem(RTP_TABLE_NOCORR, tab);
];

! ExistsTableRowCorr(T, C, V) returns the first row on which V
! appears in column C of table T, or 0 if V does not occur at all.

[ ExistsTableRowCorr tab col entry i k v f;
  if (col >= 100) col=TableFindCol(tab, col);
  f = ((tab-->col)-->1) & I7_COLUMN_TOPIC;
  if (col == 0) rfalse;
  k = ((tab-->1)-->0)-1;
  for (i=1:i<=k:i++) {
  ! print "Checking row ", i, "^";
      v = (tab-->col)-->(i+1);
      if (v == I7_TABLE_NOVALUE) continue;
      if (f) {
          if ((v)(consult_from, consult_words) ~= GPR_FAIL)
              return i;
      } else {
          if (v == entry) return i;
      }
  }
  ! print "Giving up^";
  return 0;
];

! TableLookUpCorr(T, C1, C2, V) finds the first row on which value
! V appears in column C2, and returns the corresponding value in C1,
! or prints an error if the value V cannot be found or has no
! corresponding value in C1.

[ TableLookUpCorr tab col lookup_col lookup_value write_flag write_value i j v;
  if (col >= 100) col=TableFindCol(tab, col, true);
  if (lookup_col >= 100) lookup_col=TableFindCol(tab, lookup_col, true);
  col = tab-->col;
  lookup_col = tab-->lookup_col;
  j = lookup_col-->0;
  for (i=2:i<=j:i++)
      if (lookup_col-->i == lookup_value) {
          if (write_flag) { col-->i = write_value; rfalse; }
      	  v = col-->i;
	      if (v ~= I7_TABLE_NOVALUE) return v;
      }
  return RunTimeProblem(RTP_TABLE_NOCORR, tab);
];

! ExistsTableLookUpCorr(T, C1, C2, V) returns true if the operation
! TableLookUpCorr(T, C1, C2, V) can be done, false otherwise.

[ ExistsTableLookUpCorr tab col lookup_col lookup_value i j;
  if (col >= 100) col=TableFindCol(tab, col, false);
  if (lookup_col >= 100) lookup_col=TableFindCol(tab, lookup_col, false);
  if (col*lookup_col == 0) rfalse;
  col = tab-->col; lookup_col = tab-->lookup_col;
  j = lookup_col-->0;
  for (i=2:i<=j:i++)
      if ((lookup_col-->i == lookup_value)
          && (col-->i ~= I7_TABLE_NOVALUE)) rtrue;
  rfalse;
];

! TableLookUpEntry(T, C, R) returns the value at column C, row R,
! printing an error if that doesn't exist.

[ TableLookUpEntry tab col index write_flag write_value v;
  if (col >= 100) col=TableFindCol(tab, col, true);
  if ((index < 1) || (index > (((tab-->col)-->0)-1)))
      return RunTimeProblem(RTP_TABLE_NOROW, tab, index);
  if (write_flag) { (tab-->col)-->(index+1) = write_value; rfalse; }
  v = ((tab-->col)-->(index+1));
  if (v == I7_TABLE_NOVALUE)
      return RunTimeProblem(RTP_TABLE_NOENTRY, tab, col, 0, index);
  return v;
];

! ExistsTableLookUpEntry(T, C, R) returns true if a value exists
! at column C, row R, false otherwise.

[ ExistsTableLookUpEntry tab col index v;
  if (col >= 100) col=TableFindCol(tab, col);
  if (col == 0) rfalse;
  if ((index<1) || (index > (((tab-->col)-->0)-1))) rfalse;
  v = ((tab-->col)-->(index+1));
  if (v == I7_TABLE_NOVALUE) rfalse;
  rtrue;
];

! TableRowIsBlank(T, R) returns true if row R of table T is blank.
! (R must be a legal row number.)

[ TableRowIsBlank tab j k;
  for (k=1:k<=tab-->0:k++)
	  if (((tab-->k)-->(j+1)) ~= I7_TABLE_NOVALUE) rfalse;
  rtrue;
];

! TableBlankOutRow(T, R) fills row R of table T with blanks.
! (R must be a legal row number.)

[ TableBlankOutRow tab j k;
  if (tab==0) return RunTimeProblem(RTP_TABLE_NOTABLE, tab);
  for (k=1:k<=tab-->0:k++) (tab-->k)-->(j+1) = I7_TABLE_NOVALUE;
];

! TableBlankRows(T) returns the number of blank rows in T.

[ TableBlankRows tab i j c;
  i = TableRows(tab); !print i, " rows^";
  for (j=1:j<=i:j++)
      if (TableRowIsBlank(tab, j)) c++;
  !print c, " blank^";
  return c;
];

! TableFilledRows(T) returns the number of non-blank rows in T.

[ TableFilledRows tab;
  return TableRows(tab) - TableBlankRows(tab);
];

! TableBlankRow(T) finds the first blank row in T.

[ TableBlankRow tab i j;
  i = TableRows(tab);
  for (j=1:j<=i:j++)
      if (TableRowIsBlank(tab, j)) return j;
  RunTimeProblem(RTP_TABLE_NOMOREBLANKS, tab);
  return i;
];

! TableRandomRow(T) chooses a random non-blank row in T.

[ TableRandomRow tab i j k;
  i = TableRows(tab);
  j = TableFilledRows(tab);
  if (j==0) return RunTimeProblem(RTP_TABLE_NOROWS, tab);
  if (j>1) j = random(j);
  for (k=1:k<=i:k++) {
      if (TableRowIsBlank(tab, k) == false) j--;
      if (j==0) return k;
  }
];

! TableSwapRows(T, R1, R2) exchanges rows R1 and R2.

[ TableSwapRows tab i j k l m;
  if (i==j) return;
  l = tab-->0;
  for (k=1:k<=l:k++) {
      m = (tab-->k)-->(i+1);
      (tab-->k)-->(i+1) = (tab-->k)-->(j+1);
      (tab-->k)-->(j+1) = m;
  }
];

! TableShuffle(T) sorts T into random row order.

[ TableShuffle tab i j k;
  k = ((tab-->1)-->0)-1;
  for (i=2:i<=k:i++) TableSwapRows(tab, i, random(i));
];

! TableNextRow(T, C, R, D) is used when scanning through a
! table in order of the values in column C: ascending order
! if D = 1, descending if D = -1. The current position is row R
! of column C, or R=0 if we have not yet found the first row.
! The return value is the row number for the next value, or 0
! if we are already at the final value. Note that if there
! are several equal values in the column, they will be run
! through in turn, in order of their physical row numbers -
! ascending if D = 1, descending if D = -1, so that using
! the routine with D = -1 always produces the exact reverse
! ordering from using it with D = 1 and the same parameters.
! Rows with blank entries in C are skipped.
!
! for (R=TableNextRow(T,C,0,D): R : R=TableNextRow(T,C,R,D)) ...
! will perform a loop of valid row numbers in order of column C.

[ TableNextRow tab col row dir i k val v dv min_dv min_at signed_arithmetic f;
  if (col >= 100) col=TableFindCol(tab, col, false);
  signed_arithmetic = ((tab-->col)-->1) & I7_COLUMN_SIGNED;
  if (row == 0) {
      if (signed_arithmetic) {
          if (dir == 1) val = $8000; else val = $7fff;
      } else {
          if (dir == 1) val = 0; else val = $ffff;
      }
  } else val = (tab-->col)-->(row+1);
  if (signed_arithmetic) min_dv = $7fff; else min_dv = $ffff;
  k = ((tab-->1)-->0)-1;
  if (dir == 1) {
      for (i=1:i<=k:i++) {
          v = (tab-->col)-->(i+1);
          if (v == I7_TABLE_NOVALUE) continue;
          dv = dir*v;
          if (signed_arithmetic)
          f = (((dv > dir*val) || ((v == val) && (i>row))) &&
              (dv < min_dv));
          else
          f = (((UnsignedCompare(dv, dir*val) > 0) || ((v == val) && (i>row))) &&
              (UnsignedCompare(dv, min_dv) < 0));
          if (f) { min_dv = dv; min_at = i; }
      }
  } else {
      for (i=k:i>=1:i--) {
          v = (tab-->col)-->(i+1);
          if (v == I7_TABLE_NOVALUE) continue;
          dv = dir*v;
          if (signed_arithmetic)
          f = (((dv > dir*val) || ((v == val) && (i<row))) &&
              (dv < min_dv));
          else
          f = (((UnsignedCompare(dv, dir*val) > 0) || ((v == val) && (i<row))) &&
              (UnsignedCompare(dv, min_dv) < 0));
          if (f) { min_dv = dv; min_at = i; }
      }
  }
  return min_at;
];

! TableCompareRows(T, C, R1, R2, D) returns:
! +1 if the entry at row R1 of column C is > the entry at row R2,
! 0 if they are equal, and
! -1 if entry at R1 < entry at R2.
! When D = +1, a blank value is > all other values, so that in
! an ascending sort the blanks come last; when D = -1, a blank
! value is < all others, so that once again blanks are last.
! Finally, a wholly blank row is always placed after a row in
! which the entry in C is blank but where other entries are not.

[ TableCompareRows tab col row1 row2 dir val1 val2;
  if (col >= 100) col=TableFindCol(tab, col, false);
  val1 = (tab-->col)-->(row1+1);
  val2 = (tab-->col)-->(row2+1);
  if (val1 == val2) {
      if (val1 ~= I7_TABLE_NOVALUE) return 0;
      if (TableRowIsBlank(tab, row1)) {
          if (TableRowIsBlank(tab, row2)) return 0;
          return -1*dir;
      }
      if (TableRowIsBlank(tab, row2)) return dir;
      return 0;
  }
  if (val1 == I7_TABLE_NOVALUE) return -1*dir;
  if (val2 == I7_TABLE_NOVALUE) return dir;
  if (((tab-->col)-->1) & I7_COLUMN_SIGNED) {
      if (val1 > val2) return 1;
      return -1;
  } else {
      if (UnsignedCompare(val1, val2) > 0) return 1;
      return -1;
  }
];

[ TableSort tab col dir i j k f;
  for (i=1:i<=tab-->0:i++) {
      j = tab-->i; ! Address of column table
      if ((j-->1) & I7_COLUMN_DONTSORTME)
          return RunTimeProblem(RTP_TABLE_CANTSORT, tab);
  }
  if (col >= 100) col=TableFindCol(tab, col, false);
  k = TableRows(tab);
  f = true;
  while (f) {
      f = false;
      for (i=1:i<=k:i++)
          for (j=i+1:j<=k:j++)
              if (dir*TableCompareRows(tab, col, i, j, dir) > 0) {
                  TableSwapRows(tab, i, j); f = true; break;
              }
  }
];

#ifdef I7_RANKING_TABLE;
[ PrintRank i j v;
  print ", earning you the rank of ";
  j = TableRows(I7_RANKING_TABLE);
  for (i=j:i>=1:i--)
      if (score >= TableLookUpEntry(I7_RANKING_TABLE, 1, i)) {
          v = TableLookUpEntry(I7_RANKING_TABLE, 2, i);
          if (v ofclass String) print (string) v;
          else v();
          ".";
      }
  ".";
];
#endif;