(* Modified by sweeks@sweeks.com 2001-10-03 to go in the MLton benchmark suite. * Hardwired in the u6 list of polynomials and added a loop. *) (* tyan.sml * A Grobner Basis calculation for polynomials over F17 * Adapted from the TIL benchmark suite by Allyn Dimock: * update to SML '97, Standard Basis Library, comment out unreachable code * Original code from Thomas Yan, who has given his permission for this * code be used as a benchmarking code for SML compilers * (e-mail message Tue, 10 Apr 2001 13:07:44 -0400 (EDT)) * * The data structure for the intermediate results is described in * @article{Yan:1998:GBSP, * author = {Yan, Thomas}, * title = {The Geobucked Data Structure For Polynomials}, * journal = {Journal Of Symbolic Computation}, * volume = 23, * number = 3, * pages = {285 -- 293}, * year = 1998, * } *) val print : string -> unit = print type 'a array1 = 'a Array.array val sub1 = Array.sub val update1 = Array.update val array1 = Array.array val length1 = Array.length val op && = fn (i1, i2) => (Word.toInt (Word.andb (Word.fromInt (i1), Word.fromInt (i2)))) val op || = fn (i1, i2) => (Word.toInt (Word.orb (Word.fromInt (i1), Word.fromInt (i2)))) val op << = fn (i1, i2) => (Word.toInt (Word.<< (Word.fromInt (i1), Word.fromInt (i2)))) val op >> = fn (i1, i2) => (Word.toInt (Word.>> (Word.fromInt (i1), Word.fromInt (i2)))) infix && || << >> fun fold f l b = List.foldl f b l fun revfold f l b = List.foldr f b l val input_line = TextIO.inputLine val end_of_stream = TextIO.endOfStream val open_in = TextIO.openIn val close_in = TextIO.closeIn nonfix smlnj_mod nonfix smlnj_div val smlnj_mod = op mod val smlnj_div = op div infix 7 smlnj_mod infix 7 smlnj_div exception Tabulate fun tabulate (i,f) = if i <= 0 then raise Tabulate else let val a = array1(i,f 0) fun tabify j = if j < i then (update1(a,j,f j); tabify (j+1)) else a in tabify 1 end exception ArrayofList fun arrayoflist (hd::tl) = let val a = array1((length tl) + 1,hd) fun al([],_) = a | al(hd::tl,i) = (update1(a,i,hd); al(tl,i+1)) in al(tl,1) end | arrayoflist ([]) = raise ArrayofList structure Util = struct datatype relation = Less | Equal | Greater exception NotImplemented of string exception Impossible of string (* flag "impossible" condition *) exception Illegal of string (* flag function use violating precondition *) fun error exn msg = raise (exn msg) fun notImplemented msg = error NotImplemented msg fun impossible msg = error Impossible msg fun illegal msg = error Illegal msg (* arr[i] := obj :: arr[i]; extend non-empty arr if necessary *) fun insert (obj,i,arr) = let val len = length1 arr val res = if i length l + n) ls 0,obj0) fun ins (i,[]) = i | ins (i,x::l) = (update1(a,i,x); ins(i+1,l)) fun insert (i,[]) = a | insert (i,l::ll) = insert(ins(i,l),ll) in insert(0,ls) end *) (* given compare and array a, return list of contents of a sorted in * ascending order, with duplicates stripped out; which copy of a duplicate * remains is random. NOTE that a is modified. *) fun stripSort compare = fn a => let infix sub val op sub = sub1 and update = update1 fun swap (i,j) = let val ai = a sub i in update(a,i,a sub j); update(a,j,ai) end (* sort all a[k], 0<=i<=k (swap (lo,k); partition (lo+1,k+1,hi)) | Equal => partition (lo,k+1,hi) | Greater => (swap (k,hi-1); partition (lo,k,hi-1)) val (lo,hi) = partition (i,i,j) in s(i,lo,pivot::s(hi,j,acc)) end val res = s(0,length1 a,[]) in res end end structure F = struct val p = 17 datatype field = F of int (* for (F n), always 0<=n

=p then F(k-p) else F k end fun subtract (F n,F m) = if n>=m then F(n-m) else F(n-m+p) fun negate (F 0) = F 0 | negate (F n) = F(p-n) fun multiply (F n,F m) = F ((n*m) smlnj_mod p) fun reciprocal (F 0) = raise Div | reciprocal (F n) = let (* consider euclid gcd alg on (a,b) starting with a=p, b=n. * if maintain a = a1 n + a2 p, b = b1 n + b2 p, a>b, * then when 1 = a = a1 n + a2 p, have a1 = inverse of n mod p * note that it is not necessary to keep a2, b2 around. *) fun gcd ((a,a1),(b,b1)) = if b=1 then (* by continued fraction expansion, 0<|b1|