// $Id: tst.lib,v 1.8 1998-06-12 17:41:42 obachman Exp $
//(obachman, last modified 2/13/98)
/////////////////////////////////////////////////////////////////////////////

version="$Id: tst.lib,v 1.8 1998-06-12 17:41:42 obachman Exp $";
info="
LIBRARY:  tst.lib      PROCEDURES FOR RUNNING AUTOMATIC TST TESTS


 tst_system(s)          returns string which is stdout of system(\"sh\", s)
 tst_ignore(any,[keyword], [link]) writes string(any) to link (or stdout),
                                   prepending prefix \"// ignore:\"
 tst_init()             writes some identification data to stdout
                        with tst_ignore
 tst_groebnerTest(ideal i)  
                        tests groebner command 
 tst_stdEqual(ideal i1, ideal i2) 
                        test whether two std's are \"equal\"
";

/////////////////////////////////////////////////////////////////////////////

proc tst_system(string s)
"USAGE:    tst_system(s); s string
RETURN:   string which is stdout and stderr of system(\"sh\", s)
EXAMPLE:  example tst_system; shows examples"
{
  string tmpfile = "/tmp/tst_" + string(system("pid"));
  int errno;

  s = s + " 1>" + tmpfile + " 2>&1";
  errno = system("sh", s);
  s = read(tmpfile);
  errno = system("sh", "rm " + tmpfile);
  return (s);
}
example
{
  "EXAMPLE"; echo = 2;
  string s = tst_system("echo This is is an example of tst_system");
  "The following is what the system call wrote to stdout: " + s;
}


proc tst_ignore
"USAGE:    tst_ignore(any,[keyword], [link])
            any     -- valid argument to string()
            keyword -- one of \"time\" or \"memory\"
            link    -- a link which can be written to
RETURN:   none; writes string(any) to link (or stdout, if no link given),
          prepending prefix \"// ignore:\", or \"// ignore: time:\",
          \"//ignore: memory:\"  if called with the respective keywords;
          should be used in tst files to output system dependent data
          (like date, pathnames) { and timings With the keyword \"time\",
          resp. memory usage with the keyword \"memory\"
EXAMPLE:  example tst_ignore; shows examples
"
{
  string s;
  string keyword = "";
  link outlink = "";

  // Check # of args
  if (size(#) < 1 || size(#) > 3)
  {
    "Error tst_ignore: Wrong number of arguments";
    "Usage: tst_ignore (any,[keyword], [link]);";
    return();
  }

  // Get Args
  s = string(#[1]);
  if (size(#) == 3)
  {
    keyword = #[2];
    outlink = #[3];
  }
  if (size(#) == 2)
  {
    if (typeof(#[2]) == "string")
    {
      keyword = #[2];
    }
    else
    {
      outlink = #[2];
    }
  }

  // check args
  if (typeof(keyword) != "string")
  {
    "Error tst_ignore: Keyword must be a string";
    "Usage: tst_ignore (any,[keyword], [link]);";
    return();
  }
  if (keyword == "time" || keyword == "memory")
  {
    keyword = keyword + ": ";
  }
  else
  {
    if (keyword != "")
    {
      "Warning tst_ignore: keyword should be \"time\" or \"memory\"";
    }
  }

  if (status(outlink, "open", "no"))
  {
    open(outlink);
  }
  if (status(outlink, "write", "not ready"))
  {
    "Error tst_ignore: Can not write to link";
    outlink;
    "Usage: tst_ignore (any,[keyword], [link]);";
    return();
  }

  // ready -- do the actual work
  write(outlink, "// ignore: " + keyword + s);
}
example
{
  "EXAMPLE";
  "System independent data can safely be output in tst files;";
  "However, system dependent data like dates, or pathnames, should be output";
  "using the command tst_ignore(...), like";
  echo = 2;
  tst_ignore(tst_system("date"));
  int t1 = timer;
  tst_ignore(t1, "time");
  tst_ignore(memory(1), "memory");
}

proc tst_init
"USAGE:   tst_init()
RETURN:  none; writes some identification data to stdout;
         should be called as first routine in a tst file
EXAMPLE: example tst_init; shows example
"
{
  tst_ignore("USER    : " + system("getenv", "USER"));
  tst_ignore("HOSTNAME: " + system("getenv", "HOST"));
  tst_ignore("uname -a: " + tst_system("uname -a"));
  tst_ignore("date    : " + tst_system("date"));
  tst_ignore("version : " + string(system("version")));
}
example
{
  "EXAMPLE";  echo = 2;
  tst_init();
}

///////////////////////////////////////////////////////////////////////

proc tst_groebnerTest(ideal i, list #)
"USAGE: tst_groebnerTesti,[v]) : ideal i, [int v]
RETURN: 1, if groebner command produced \"equal\" std as std command
        0, otherwise
        Two std's are \"equal\" here, if their redSB's are element-wise equal,
        and if they reduce each other to zero, and if their leading ideals 
        are equal
        On success, times of std - groebner is written with tst_ignore, and
        times are added to global variables tst_std_time and 
        tst_groebner_time. If v given, and <= 0, short ideal 
        characteristic is printed, if v > 0, ideals are printed.
        On failure, Error message and ideals are printed.
EXAMPLE: example tst_groebner; shows an example
"
{
  int st = timer;
  ideal si = std(i);
  st = timer - st;
  
  int gt = timer;
  ideal gi = groebner(i);
  gt = timer - gt;

  if (tst_stdEqual(si, gi))
  {
    tst_ignore(string(st) + " - " + string(gt) + " == " + string(st - gt));
    if (! defined(tst_groebner_time))
    {
      int tst_groebner_time;
      int tst_std_time;
      export tst_groebner_time, tst_std_time;
    }
    tst_std_time = tst_std_time + st;
    tst_groebner_time = tst_groebner_time + gt;
    if (size(#))
    {
      if (typeof(#[1] == "int"))
      {
        if (#[1] <= 0)
        {
          idPrintShort(si, "si");
          idPrintShort(gi, "gi");
        }
        else
        {
          si;
          gi;
        }
      }
    }
    return (1);
  }
  return (0);
}
example
{
  "EXAMPLE: "; echo = 2;
  ring r = 0, (a,b,c,d), lp;
  ideal i = a+b+c+d, ab+ad+bc+cd, abc+abd+acd+bcd, abcd-1; // cyclic 4
  tst_groebnerTest(i);
  tst_groebnerTest(i, 0);
  tst_groebnerTest(i, 1);
}

  
//
// A routine which test for equality of "std-bases"
// 
proc tst_stdEqual(ideal i1, ideal i2)
"USAGE: tst_stdEqual(i1, i2)  ideal i1, i2
RETURN 1, if i1 \"equald\" i2 as a std bases
       0, otherwise
       Two std's are \"equal\" here, if their redSB's are element-wise equal,
       and if they reduce each other to zero, and if their leading ideals 
       are equal
       On failure, error message is printed.
EXAMPLE: example tst_stdEqual; shows an example
"
{
  int i;
  int back;
  intvec opts = option(get);
  option(redSB);
  
  ideal ri1 = simplify(interred(i1), 1);
  ideal ri2 = simplify(interred(i2), 1);
  
  option(set, opts);

  if (size(ri1) != size(ri2))
  {
    "Error in tst_stdEqual: Reduced sizes differ";
    size(ri1);
    size(ri2);
    return(0);
  }

  for (i=1; i<=size(ri1); i++)
  {
    if (ri1[i] != ri2[i])
    {
      "Error in tst_stdEqual: " + string(i) + " th poly differ";
      ri1[i];
      ri2[i];
      return(0);
    }
  }

  // reduced SB are now equal
  if (size(reduce(i1, i2, 1)) == 0)
  {
    if (size(reduce(i2, i1, 1)) == 0)
    {
      poly p1, p2;
      
      ideal si1 = simplify(i1, 7);
      ideal si2 = simplify(i2, 7);
      
      if (size(si1) == size(si2))
      {
        for (i=1; i<=size(si1); i++)
        {
          p1 = p1 + lead(si1[i]);
          p2 = p2 + lead(si2[i]);
        }
        if (p1 != p2)
        {
          "Error in tst_stdEqual: Lead monoms differ:";
          p1;
          p2;
          return(0);
        }
      }
      else
      {
        "Error in tst_stdEqual: size differs:";
        size(si1);
        size(si2);
        return(0);
      }
    }
    else
    {
      "Error in tst_stdEqual: reduce(i2, i1) != 0";
      return(0);
    }
  }
  else
  {
    back = 1; "Error in tst_stdEqual: reduce(i1, i2) != 0";
    return(0);
  }

  return (1);
}
example
{
  "EXAMPLE: "; echo = 2;
  ring r = 0, (a,b,c,d), lp;
  ideal i = a+b+c+d, ab+ad+bc+cd, abc+abd+acd+bcd, abcd-1; // cyclic 4
  tst_stdEqual(groebner(i), std(i));
  tst_stdEqual(std(i), i);
}

static proc idPrintShort(ideal id, string name)
{
  "Summary of " + name + " (leading monoms and size of polys):";
  int i;
  for (i = 1; i<=size(id); i++)
  {
    "[" + string(i) + "]: #" + string(size(id[i])) + ":" + string(lead(id[i]));
  }
}