From 0157f67b387440fcc8aeca244052845b901f63db Mon Sep 17 00:00:00 2001 From: Tim Daly Date: Sat, 12 Sep 2015 20:22:56 -0400 Subject: [PATCH] books/bookvol10.3 add signatures for COQ Goal: Proving Axiom Correct All of the functions in every domain now have signatures. We are now prepared for the next step in the proof. --- books/bookvol10.3.pamphlet |10370 +++++++++++++++++++++++++++++++--------- changelog | 2 + patch | 33 +- src/axiom-website/patches.html | 2 + 4 files changed, 8220 insertions(+), 2187 deletions(-) diff --git a/books/bookvol10.3.pamphlet b/books/bookvol10.3.pamphlet index 0de9b22..c7beaf0 100644 --- a/books/bookvol10.3.pamphlet +++ b/books/bookvol10.3.pamphlet @@ -3721,7 +3721,6 @@ AlgebraicFunctionField(F, UP, UPUP, modulus): Exports == Implementation where import MatrixCommonDenominator(UP, RF) import UnivariatePolynomialCategoryFunctions2(RF, UPUP, UP, UP2) - brandNew?:Reference(Boolean) := ref true infBr?:Reference(Boolean) := ref true @@ -19770,15 +19769,18 @@ AttributeButtons(): E == I where attributeStep:F := 0.5 + setAttributeButtonStep : Float -> Float setAttributeButtonStep(n:F):F == positive?(n)$F and (n<1$F) => attributeStep:F := n error("setAttributeButtonStep",_ "New value must be in (0..1)")$ErrorFunctions + resetAttributeButtons : () -> Void resetAttributeButtons():Void == attributeButtons := buttons() void()$Void + setButtonValue : (String,String,Float) -> Float setButtonValue(routineName:ST,attributeName:ST,n:F):F == f := search(routineName attributeName,attributeButtons)$Rep f case Float => @@ -19789,6 +19791,7 @@ AttributeButtons(): E == I where error("setButtonValue","attribute name " attributeName " not found for routine " routineName)$ErrorFunctions + setButtonValue : (String,Float) -> Float setButtonValue(attributeName:ST,n:F):F == ro1 := selectODEIVPRoutines(r := routines()$RoutinesTable)$RoutinesTable ro2 := selectIntegrationRoutines(r)$RoutinesTable @@ -19802,6 +19805,7 @@ AttributeButtons(): E == I where setButtonValue(string(i)$Symbol,attributeName,n) n + increase : (String,String) -> Float increase(routineName:ST,attributeName:ST):F == f := search(routineName attributeName,attributeButtons)$Rep f case Float => @@ -19810,6 +19814,7 @@ AttributeButtons(): E == I where error("increase","attribute name " attributeName " not found for routine " routineName)$ErrorFunctions + increase : String -> Float increase(attributeName:ST):F == ro1 := selectODEIVPRoutines(r := routines()$RoutinesTable)$RoutinesTable ro2 := selectIntegrationRoutines(r)$RoutinesTable @@ -19823,6 +19828,7 @@ AttributeButtons(): E == I where increase(string(i)$Symbol,attributeName) getButtonValue(string(i)$Symbol,attributeName) + decrease : (String,String) -> Float decrease(routineName:ST,attributeName:ST):F == f := search(routineName attributeName,attributeButtons)$Rep f case Float => @@ -19831,6 +19837,7 @@ AttributeButtons(): E == I where error("increase","attribute name " attributeName " not found for routine " routineName)$ErrorFunctions + decrease : String -> Float decrease(attributeName:ST):F == ro1 := selectODEIVPRoutines(r := routines()$RoutinesTable)$RoutinesTable ro2 := selectIntegrationRoutines(r)$RoutinesTable @@ -19844,7 +19851,7 @@ AttributeButtons(): E == I where decrease(string(i)$Symbol,attributeName) getButtonValue(string(i)$Symbol,attributeName) - + getButtonValue : (String,String) -> Float getButtonValue(routineName:ST,attributeName:ST):F == f := search(routineName attributeName,attributeButtons)$Rep f case Float => f @@ -20015,10 +20022,10 @@ Automorphism(R:Ring): Join(Group, Eltable(R, R)) with \begin{chunk}{COQ AUTOMOR} (* domain AUTOMOR *) (* - Rep := ((R, Integer) -> R) + 1 : () -> % 1 == ident err: R -> R @@ -20027,20 +20034,28 @@ Automorphism(R:Ring): Join(Group, Eltable(R, R)) with ident: (R, Integer) -> R ident(r, n) == r + ?=? : (%,%) -> Boolean f = g == EQ(f, g)$Lisp + ?.? : (%,R) -> R elt(f, r) == apply(f, r, 1) + inv : % -> % inv f == (r1:R, i2:Integer):R +-> apply(f, r1, - i2) + ?**? : (%,Integer) -> % f ** n == (r1:R, i2:Integer):R +-> apply(f, r1, n * i2) + coerce : % -> OutputForm coerce(f:%):OutputForm == message("R -> R") + morphism : ((R,Integer) -> R) -> % morphism(f:(R, Integer) -> R):% == f + morphism : (R -> R) -> % morphism(f:R -> R):% == morphism(f, err) + morphism : ((R -> R),(R -> R)) -> % morphism(f, g) == (r1:R, i2:Integer):R +-> iterat(f, g, i2, r1) apply: (%, R, Integer) -> R @@ -20056,6 +20071,7 @@ Automorphism(R:Ring): Join(Group, Eltable(R, R)) with for i in 1..n repeat r := f r r + ?*? : (%,%) -> % f * g == f = g => f**2 (r1:R, i2:Integer):R +-> @@ -20537,10 +20553,12 @@ BalancedBinaryTree(S: SetCategory): Exports == Implementation where Rep := BinaryTree(S) + leaf? : % -> Boolean leaf? x == empty? x => false empty? left x and empty? right x + setleaves! : (%,List(S)) -> % setleaves_!(t, u) == n := #u n = 0 => @@ -20558,6 +20576,7 @@ BalancedBinaryTree(S: SetCategory): Exports == Implementation where setleaves_!(right t, u) t + balancedBinaryTree : (NonNegativeInteger,S) -> % balancedBinaryTree(n: NonNegativeInteger, val: S) == n = 0 => empty() n = 1 => node(empty(),val,empty()) @@ -20565,11 +20584,13 @@ BalancedBinaryTree(S: SetCategory): Exports == Implementation where node(balancedBinaryTree(m, val), val, balancedBinaryTree((n - m) pretend NonNegativeInteger, val)) + mapUp! : (%,((S,S) -> S)) -> S mapUp_!(x,fn) == empty? x => error "mapUp! called on a null tree" leaf? x => x.value x.value := fn(mapUp_!(x.left,fn),mapUp_!(x.right,fn)) + mapUp! : (%,%,((S,S,S,S) -> S)) -> % mapUp_!(x,y,fn) == empty? x => error "mapUp! is called on a null tree" leaf? x => @@ -20581,6 +20602,7 @@ BalancedBinaryTree(S: SetCategory): Exports == Implementation where x.value := fn(x.left.value,x.right.value,y.left.value,y.right.value) x + mapDown! : (%,S,((S,S) -> S)) -> % mapDown_!(x: %, p: S, fn: (S,S) -> S ) == empty? x => x x.value := fn(p, x.value) @@ -20588,6 +20610,7 @@ BalancedBinaryTree(S: SetCategory): Exports == Implementation where mapDown_!(x.right, x.value, fn) x + mapDown! : (%,S,((S,S,S) -> List(S))) -> % mapDown_!(x: %, p: S, fn: (S,S,S) -> List S) == empty? x => x x.value := p @@ -21172,10 +21195,12 @@ BasicFunctions(): E == I where Rep := Table(Symbol,RS) import Rep, SDF + f : DF -> DF f(x:DF):DF == positive?(x) => -x -x+1 + bf : () -> $ bf():$ == import RS dpi := pi()$DF @@ -21205,8 +21230,11 @@ BasicFunctions(): E == I where [atan@Symbol, atanEntry], [log@Symbol, logEntry]] construct(entryList)$Rep + bfKeys : () -> List(Symbol) bfKeys():List Symbol == keys(bf())$Rep + bfEntry : Symbol -> Record(zeros: Stream(DoubleFloat),_ + ones: Stream(DoubleFloat),singularities: Stream(DoubleFloat)) bfEntry(k:Symbol):RS == qelt(bf(),k)$Rep *) @@ -21814,70 +21842,96 @@ BasicOperator(): Exports == Implementation where -- if narg < 0 then the operator has variable arity. Rep := Record(opname:Symbol, narg:SingleInteger, props:P) - oper: (Symbol, SingleInteger, P) -> $ + is? : (%,Symbol) -> Boolean is?(op, s) == name(op) = s + name : % -> Symbol name op == op.opname + properties : % -> AssociationList(String,None) properties op == op.props + setProperties : (%,AssociationList(String,None)) -> % setProperties(op, l) == (op.props := l; op) + operator : Symbol -> % operator s == oper(s, -1::SingleInteger, table()) + operator : (Symbol,NonNegativeInteger) -> % operator(s, n) == oper(s, n::Integer::SingleInteger, table()) + property : (%,String) -> Union(None,"failed") property(op, name) == search(name, op.props) + assert : (%,String) -> % assert(op, s) == setProperty(op, s, NIL$Lisp) + has? : (%,String) -> Boolean has?(op, name) == key?(name, op.props) + oper: (Symbol, SingleInteger, P) -> $ oper(se, n, prop) == [se, n, prop] + weight : (%,NonNegativeInteger) -> % weight(op, n) == setProperty(op, WEIGHT, n pretend None) + nullary? : % -> Boolean nullary? op == zero?(op.narg) + unary? : % -> Boolean unary? op == ((op.narg) = 1) + nary? : % -> Boolean nary? op == negative?(op.narg) + equality : (%,((%,%) -> Boolean)) -> % equality(op, func) == setProperty(op, EQUAL?, func pretend None) + comparison : (%,((%,%) -> Boolean)) -> % comparison(op, func) == setProperty(op, LESS?, func pretend None) + display : (%,(OutputForm -> OutputForm)) -> % display(op:$, f:O -> O) == display(op,(x1:List(O)):O +-> f first x1) + deleteProperty! : (%,String) -> % deleteProperty_!(op, name) == (remove_!(name, properties op); op) + setProperty : (%,String,None) -> % setProperty(op, name, valu) == (op.props.name := valu; op) + coerce : % -> OutputForm coerce(op:$):OutputForm == name(op)::OutputForm + input : (%,(List(InputForm) -> InputForm)) -> % input(op:$, f:List SEX -> SEX) == setProperty(op, SEXPR, f pretend None) + display : (%,(List(OutputForm) -> OutputForm)) -> % display(op:$, f:List O -> O) == setProperty(op, DISPLAY, f pretend None) + display : % -> Union((List(OutputForm) -> OutputForm),"failed") display op == (u := property(op, DISPLAY)) case "failed" => "failed" (u::None) pretend (List O -> O) + input : % -> Union((List(InputForm) -> InputForm),"failed") input op == (u := property(op, SEXPR)) case "failed" => "failed" (u::None) pretend (List SEX -> SEX) + arity : % -> Union(NonNegativeInteger,"failed") arity op == negative?(n := op.narg) => "failed" convert(n)@Integer :: NonNegativeInteger + copy : % -> % copy op == oper(name op, op.narg, table([[r.key, r.entry] for r in entries(properties op)@L]$L)) -- property EQUAL? contains a function f: (BOP, BOP) -> Boolean -- such that f(o1, o2) is true iff o1 = o2 + ?=? : (%,%) -> Boolean op1 = op2 == (EQ$Lisp)(op1, op2) => true name(op1) ^= name(op2) => false @@ -21890,12 +21944,14 @@ BasicOperator(): Exports == Implementation where -- property WEIGHT allows one to change the ordering around -- by default, every operator has weigth 1 + weight : % -> NonNegativeInteger weight op == (w := property(op, WEIGHT)) case "failed" => 1 (w::None) pretend NonNegativeInteger -- property LESS? contains a function f: (BOP, BOP) -> Boolean -- such that f(o1, o2) is true iff o1 < o2 + ? Boolean op1 < op2 == (w1 := weight op1) ^= (w2 := weight op2) => w1 < w2 op1.narg ^= op2.narg => op1.narg < op2.narg @@ -22444,13 +22500,17 @@ BasicStochasticDifferential(): category == implementation where Rep := Symbol setBSD := empty()$Set(Symbol) + tableIto:Table(Symbol,%) := table() + tableBSD:Table(%,Symbol) := table() + convertIfCan : Symbol -> Union(%,"failed") convertIfCan(ds:Symbol):Union(%,"failed") == not(member?(ds,setBSD)) => "failed" ds::% + convert : Symbol -> % convert(ds:Symbol):% == (du:=convertIfCan(ds)) case "failed" => @@ -22459,20 +22519,25 @@ BasicStochasticDifferential(): category == implementation where error "above causes failure in convert$BSD" du + introduce! : (Symbol,Symbol) -> Union(%,"failed") introduce!(X,dX) == member?(dX,setBSD) => "failed" insert!(dX,setBSD) tableBSD(dX::%) := X tableIto(X) := dX::% + d : Symbol -> Union(%,Integer) d(X) == search(X,tableIto) case "failed" => 0::INT tableIto(X) + copyBSD : () -> List(%) copyBSD() == [ds::% for ds in members(setBSD)] + copyIto : () -> Table(Symbol,%) copyIto() == tableIto + getSmgl : % -> Union(Symbol,"failed") getSmgl(ds:%):Union(Symbol,"failed") == tableBSD(ds) *) @@ -22896,8 +22961,10 @@ BinaryExpansion(): Exports == Implementation where (* RadixExpansion(2) add + binary : Fraction(Integer) -> % binary r == r :: % + coerce : % -> RadixExpansion(2) coerce(x:%): RadixExpansion(2) == x pretend RadixExpansion(2) *) @@ -23085,6 +23152,7 @@ BinaryFile: Cat == Def where fileState: FileState, _ fileIOmode: String) + defstream : (FileName,String) -> FileState defstream(fn: FileName, mode: String): FileState == mode = "input" => not readable? fn => error ["File is not readable", fn] @@ -23094,16 +23162,19 @@ BinaryFile: Cat == Def where BINARY__OPEN__OUTPUT(fn::String)$Lisp error ["IO mode must be input or output", mode] + open : (FileName,String) -> % open(fname, mode) == fstream := defstream(fname, mode) [fname, fstream, mode] + reopen! : (%,String) -> % reopen_!(f, mode) == fname := f.fileName f.fileState := defstream(fname, mode) f.fileIOmode:= mode f + close! : % -> % close_! f == f.fileIOmode = "output" => BINARY__CLOSE__OUTPUT()$Lisp @@ -23113,11 +23184,13 @@ BinaryFile: Cat == Def where f error "file must be in read or write state" + read! : % -> SingleInteger read! f == f.fileIOmode ^= "input" => error "File not in read state" BINARY__SELECT__INPUT(f.fileState)$Lisp BINARY__READBYTE()$Lisp + readIfCan! : % -> Union(SingleInteger,"failed") readIfCan_! f == f.fileIOmode ^= "input" => error "File not in read state" BINARY__SELECT__INPUT(f.fileState)$Lisp @@ -23125,16 +23198,19 @@ BinaryFile: Cat == Def where n = -1 => "failed" n::Union(SingleInteger,"failed") + write! : (%,SingleInteger) -> SingleInteger write_!(f, x) == f.fileIOmode ^= "output" => error "File not in write state" x < 0 or x>255 => error "integer cannot be represented as a byte" BINARY__PRINBYTE(x)$Lisp x + position : % -> SingleInteger position f == f.fileIOmode ^= "input" => error "file must be in read state" FILE_-POSITION(f.fileState)$Lisp + position! : (%,SingleInteger) -> SingleInteger position_!(f,i) == f.fileIOmode ^= "input" => error "file must be in read state" (FILE_-POSITION(f.fileState,i)$Lisp ; i) @@ -23556,12 +23632,14 @@ BinarySearchTree(S: OrderedSet): Exports == Implementation where Rep := BinaryTree(S) + binarySearchTree : List(S) -> % binarySearchTree(u:List S) == null u => empty() tree := binaryTree(first u) for x in rest u repeat insert_!(x,tree) tree + insert! : (S,%) -> % insert_!(x,t) == empty? t => binaryTree(x) x >= value t => @@ -23570,6 +23648,7 @@ BinarySearchTree(S: OrderedSet): Exports == Implementation where setleft_!(t,insert_!(x,left t)) t + split : (S,%) -> Record(less: %,greater: %) split(x,t) == empty? t => [empty(),empty()] x > value t => @@ -23578,6 +23657,7 @@ BinarySearchTree(S: OrderedSet): Exports == Implementation where a := split(x,left t) [a.less, node(a.greater, value t, right t)] + insertRoot! : (S,%) -> % insertRoot_!(x,t) == a := split(x,t) node(a.less, x, a.greater) @@ -23785,12 +23865,14 @@ BinaryTournament(S: OrderedSet): Exports == Implementation where Rep := BinaryTree(S) + binaryTournament : List(S) -> % binaryTournament(u:List S) == null u => empty() tree := binaryTree(first u) for x in rest u repeat insert_!(x,tree) tree + insert! : (S,%) -> % insert_!(x,t) == empty? t => binaryTree(x) x > value t => @@ -23980,8 +24062,6 @@ BinaryTree(S: SetCategory): Exports == Implementation where empty()== [] pretend % - empty()== [] pretend % - node(l,v,r) == cons(tree(v,l:Rep),r:Rep) binaryTree(l,v,r) == node(l,v,r) @@ -24026,44 +24106,55 @@ BinaryTree(S: SetCategory): Exports == Implementation where Rep := List Tree S + ?=? : (%,%) -> Boolean t1 = t2 == (t1::Rep) =$Rep (t2::Rep) + empty : () -> % empty()== [] pretend % - empty()== [] pretend % - + node : (%,S,%) -> % node(l,v,r) == cons(tree(v,l:Rep),r:Rep) + binaryTree : (%,S,%) -> % binaryTree(l,v,r) == node(l,v,r) + binaryTree : S -> % binaryTree(v:S) == node(empty(),v,empty()) + empty? : % -> Boolean empty? t == empty?(t)$Rep + leaf? : % -> Boolean leaf? t == empty? t or empty? left t and empty? right t + right : % -> % right t == empty? t => error "binaryTree:no right" rest t + left : % -> % left t == empty? t => error "binaryTree:no left" children first t + value : % -> S value t== empty? t => error "binaryTree:no value" value first t + setvalue! : (%,S) -> S setvalue_! (t,nd)== empty? t => error "binaryTree:no value to set" setvalue_!(first(t:Rep),nd) nd + setleft! : (%,%) -> % setleft_!(t1,t2) == empty? t1 => error "binaryTree:no left to set" setchildren_!(first(t1:Rep),t2:Rep) t1 + setright! : (%,%) -> % setright_!(t1,t2) == empty? t1 => error "binaryTree:no right to set" setrest_!(t1:List Tree S,t2) @@ -24295,7 +24386,8 @@ Bits(): Exports == Implementation where (* IndexedBits(1) add - bits(n,b) == new(n,b) + bits : (NonNegativeInteger,Boolean) -> % + bits(n,b) == new(n,b) *) @@ -24418,22 +24510,32 @@ BlowUpWithHamburgerNoether: Exports == Implementation where Rep := MetRec + infClsPt? : % -> Boolean infClsPt_? a == a.infClsPt + createHN : (Integer,Integer,Integer,Integer,Integer,Boolean,_ + Union(left,center,right,vertical,horizontal)) -> % createHN( a,b,c,d,e,f,g)==[a,b,c,d,e,f,g]$Rep + excepCoord : % -> Integer excepCoord a == a.ex + chartCoord : % -> Integer chartCoord a == a.ch + transCoord : % -> Integer transCoord a == a.tr + ramifMult : % -> Integer ramifMult a == a.ramif + quotValuation : % -> Integer quotValuation a == a.quotVal + type : % -> Union(left,center,right,vertical,horizontal) type a == a.type + coerce : % -> OutputForm coerce(c:%):OutputForm== ( (c :: Rep ) :: MetRec) :: OutputForm *) @@ -24558,20 +24660,28 @@ BlowUpWithQuadTrans: Exports == Implementation where Rep := MetRec + coerce : List(Integer) -> % coerce(la:List(Integer)):% == [la.1, la.2,la.3, 1 ]$Rep + ramifMult : % -> Integer ramifMult a == One$Integer + excepCoord : % -> Integer excepCoord a == a.ex + chartCoord : % -> Integer chartCoord a == a.ch + transCoord : % -> Integer transCoord a == a.tr + ramifMult : % -> Integer ramifMult a == a.ramif + quotValuation : % -> Integer quotValuation a == One$Integer + coerce : % -> OutputForm coerce(c:%):OutputForm== oo: outRec := [ excepCoord(c) , chartCoord(c) ]$outRec oo :: OutputForm @@ -24783,62 +24893,83 @@ Boolean(): Join(OrderedSet, Finite, Logic, ConvertibleTo InputForm) with (* domain BOOLEAN *) (* - nt: % -> % - - test a == a pretend Boolean + test : % -> Boolean + test a == a pretend Boolean - nt b == (b pretend Boolean => false; true) + nt: % -> % + nt b == (b pretend Boolean => false; true) - true == EQ(2,2)$Lisp --well, 1 is rather special + true : () -> % + true == EQ(2,2)$Lisp --well, 1 is rather special - false == NIL$Lisp + false : () -> % + false == NIL$Lisp - sample() == true + sample() == true - not b == (test b => false; true) + ~? : % -> % + not b == (test b => false; true) - _^ b == (test b => false; true) + ^? : % -> % + _^ b == (test b => false; true) - _~ b == (test b => false; true) + ~? : % -> % + _~ b == (test b => false; true) - _and(a, b) == (test a => b; false) + ?and? : (%,%) -> % + _and(a, b) == (test a => b; false) - _/_\(a, b) == (test a => b; false) + ?/\? : (%,%) -> % + _/_\(a, b) == (test a => b; false) - _or(a, b) == (test a => true; b) + ?or? : (%,%) -> % + _or(a, b) == (test a => true; b) - _\_/(a, b) == (test a => true; b) + ?\/? : (%,%) -> % + _\_/(a, b) == (test a => true; b) - xor(a, b) == (test a => nt b; b) + xor : (%,%) -> % + xor(a, b) == (test a => nt b; b) - nor(a, b) == (test a => false; nt b) + nor : (%,%) -> % + nor(a, b) == (test a => false; nt b) - nand(a, b) == (test a => nt b; true) + nand : (%,%) -> % + nand(a, b) == (test a => nt b; true) - a = b == BooleanEquality(a, b)$Lisp + ?=? : (%,%) -> Boolean + a = b == BooleanEquality(a, b)$Lisp + implies : (%,%) -> % implies(a, b) == (test a => b; true) - a < b == (test b => not(test a);false) + ? Boolean + a < b == (test b => not(test a);false) - size() == 2 + size : () -> NonNegativeInteger + size() == 2 - index i == + index : PositiveInteger -> % + index i == even?(i::Integer) => false true - lookup a == + lookup : % -> PositiveInteger + lookup a == a pretend Boolean => 1 2 - random() == + random : () -> % + random() == even?(random()$Integer) => false true + convert : % -> InputForm convert(x:%):InputForm == x pretend Boolean => convert("true"::Symbol) convert("false"::Symbol) + coerce : % -> OutputForm coerce(x:%):OutputForm == x pretend Boolean => message "true" message "false" @@ -25450,53 +25581,65 @@ CardinalNumber: Join(OrderedSet, AbelianMonoid, Monoid, GCHypothesis: Reference(Boolean) := ref false -- Creation - 0 == [FINord, 0] + 0 : () -> % + 0 == [FINord, 0] - 1 == [FINord, 1] + 1 : () -> % + 1 == [FINord, 1] + coerce : NonNegativeInteger -> % coerce(n:NonNegativeInteger):% == [FINord, n] - Aleph n == [n, DUMMYval] + Aleph : NonNegativeInteger -> % + Aleph n == [n, DUMMYval] -- Output ALEPHexpr := "Aleph"::OutputForm + coerce : % -> OutputForm coerce(x: %): OutputForm == x.order = FINord => (x.ival)::OutputForm prefix(ALEPHexpr, [(x.order)::OutputForm]) -- Manipulation + ?=? : (%,%) -> Boolean x = y == x.order ^= y.order => false finite? x => x.ival = y.ival true -- equal transfinites + ? Boolean x < y == x.order < y.order => true x.order > y.order => false finite? x => x.ival < y.ival false -- equal transfinites + ?+? : (%,%) -> % x:% + y:% == finite? x and finite? y => [FINord, x.ival+y.ival] max(x, y) + ?-? : (%,%) -> Union(%,"failed") x - y == x < y => "failed" finite? x => [FINord, x.ival-y.ival] x > y => x "failed" -- equal transfinites + ?*? : (%,%) -> % x:% * y:% == finite? x and finite? y => [FINord, x.ival*y.ival] x = 0 or y = 0 => 0 max(x, y) + ?*? : (NonNegativeInteger,%) -> % n:NonNegativeInteger * x:% == finite? x => [FINord, n*x.ival] n = 0 => 0 x + ?**? : (%,%) -> % x**y == y = 0 => x ^= 0 => 1 @@ -25509,21 +25652,27 @@ CardinalNumber: Join(OrderedSet, AbelianMonoid, Monoid, GCHypothesis() => [max(x.order-1, y.order) + 1, DUMMYval] error "Transfinite exponentiation only implemented under GCH" - finite? x == x.order = FINord + finite? : % -> Boolean + finite? x == x.order = FINord + countable? : % -> Boolean countable? x == x.order < 1 + retract : % -> NonNegativeInteger retract(x:%):NonNegativeInteger == finite? x => (x.ival)::NNI error "Not finite" + retractIfCan : % -> Union(NonNegativeInteger,"failed") retractIfCan(x:%):Union(NonNegativeInteger, "failed") == finite? x => (x.ival)::NNI "failed" -- State manipulation + generalizedContinuumHypothesisAssumed? : () -> Boolean generalizedContinuumHypothesisAssumed?() == GCHypothesis() + generalizedContinuumHypothesisAssumed : Boolean -> Boolean generalizedContinuumHypothesisAssumed b == (GCHypothesis() := b) *) @@ -27197,8 +27346,10 @@ CartesianTensor(minix, dim, R): Exports == Implementation where dim3: NNI := dim**3 dim4: NNI := dim**4 + sample : () -> % sample()==kroneckerDelta()$% + int2index : (Integer,INDEX) -> INDEX int2index(n: Integer, indv: INDEX): INDEX == n < 0 => error "Index error (too small)" rnk := #indv @@ -27209,6 +27360,7 @@ CartesianTensor(minix, dim, R): Exports == Implementation where n ^= 0 => error "Index error (too big)" indv + index2int : INDEX -> Integer index2int(indv: INDEX): Integer == n: I := 0 for i in 1..#indv repeat @@ -27217,6 +27369,7 @@ CartesianTensor(minix, dim, R): Exports == Implementation where n := dim*n + ix n + lengthRankOrElse : Integer -> NNI lengthRankOrElse(v: Integer): NNI == v = 1 => 0 v = dim => 1 @@ -27233,6 +27386,7 @@ CartesianTensor(minix, dim, R): Exports == Implementation where rx -- l must be a list of the numbers 1..#l + mkPerm : (NNI,List Integer) -> PERM mkPerm(n: NNI, l: List Integer): PERM == #l ^= n => error "The list is not a permutation." @@ -27247,12 +27401,14 @@ CartesianTensor(minix, dim, R): Exports == Implementation where p -- permute s according to p into result t. + permute_! : (INDEX,INDEX,PERM) -> INDEX permute_!(t: INDEX, s: INDEX, p: PERM): INDEX == for i in 1..#p repeat t.i := s.(p.i) t -- permsign!(v) = 1, 0, or -1 according as -- v is an even, is not, or is an odd permutation of minix..minix+#v-1. + permsign_! : INDEX -> Integer permsign_!(v: INDEX): Integer == -- sum minix..minix+#v-1. maxix := minix+#v-1 @@ -27277,9 +27433,11 @@ CartesianTensor(minix, dim, R): Exports == Implementation where 1 ---- Exported functions + ravel : % -> List(R) ravel x == [get(x,i) for i in 0..#x-1] + unravel : List(R) -> % unravel l == -- lengthRankOrElse #l gives sytnax error nz: NNI := # l @@ -27288,10 +27446,13 @@ CartesianTensor(minix, dim, R): Exports == Implementation where for i in 0..nz-1 for r in l repeat set_!(z, i, r) z + kroneckerDelta : () -> % kroneckerDelta() == z := new(dim2, 0) for i in 1..dim for zi in 0.. by (dim+1) repeat set_!(z, zi, 1) z + + leviCivitaSymbol : () -> % leviCivitaSymbol() == nz := dim**dim z := new(nz, 0) @@ -27301,33 +27462,41 @@ CartesianTensor(minix, dim, R): Exports == Implementation where z -- from GradedModule + degree : % -> NonNegativeInteger degree x == rank x + rank : % -> NonNegativeInteger rank x == n := #x lengthRankOrElse n + elt : % -> R elt(x) == #x ^= 1 => error "Index error (the rank is not 0)" get(x,0) + ?.? : (%,Integer) -> R elt(x, i: I) == #x ^= dim => error "Index error (the rank is not 1)" get(x,(i-minix)) + elt : (%,Integer,Integer) -> R elt(x, i: I, j: I) == #x ^= dim2 => error "Index error (the rank is not 2)" get(x,(dim*(i-minix) + (j-minix))) + elt : (%,Integer,Integer,Integer) -> R elt(x, i: I, j: I, k: I) == #x ^= dim3 => error "Index error (the rank is not 3)" get(x,(dim2*(i-minix) + dim*(j-minix) + (k-minix))) + elt : (%,Integer,Integer,Integer,Integer) -> R elt(x, i: I, j: I, k: I, l: I) == #x ^= dim4 => error "Index error (the rank is not 4)" get(x,(dim3*(i-minix)+dim2*(j-minix)+dim*(k-minix)+(l-minix))) + ?.? : (%,List(Integer)) -> R elt(x, i: List I) == #i ^= rank x => error "Index error (wrong rank)" n: I := 0 @@ -27337,12 +27506,14 @@ CartesianTensor(minix, dim, R): Exports == Implementation where n := dim*n + ix get(x,n) + coerce : List(R) -> % coerce(lr: List R): % == #lr ^= dim => error "Incorrect number of components" z := new(dim, 0) for r in lr for i in 0..dim-1 repeat set_!(z, i, r) z + coerce : List(%) -> % coerce(lx: List %): % == #lx ^= dim => error "Incorrect number of slices" rx := rank first lx @@ -27354,12 +27525,14 @@ CartesianTensor(minix, dim, R): Exports == Implementation where for i in 0..nx-1 repeat set_!(z, offz + i, get(x,i)) z + retractIfCan : % -> Union(R,"failed") retractIfCan(x:%):Union(R,"failed") == zero? rank(x) => x() "failed" Outf ==> OutputForm + mkOutf : (%,I,NNI) -> Outf mkOutf(x:%, i0:I, rnk:NNI): Outf == odd? rnk => rnk1 := (rnk-1) pretend NNI @@ -27371,21 +27544,28 @@ CartesianTensor(minix, dim, R): Exports == Implementation where nskip := dim**rnk1 matrix [[mkOutf(x, i0+nskip*(dim*i + j), rnk1) for j in 0..dim-1] for i in 0..dim-1] + + coerce : % -> OutputForm coerce(x): Outf == mkOutf(x, 0, rank x) + 0 : () -> % 0 == 0$R::Rep + 1 : () -> % 1 == 1$R::Rep - --coerce(n: I): % == new(1, n::R) + coerce : R -> % coerce(r: R): % == new(1,r) + coerce : DirectProduct(dim,R) -> % coerce(v: DP(dim,R)): % == z := new(dim, 0) for i in 0..dim-1 for j in minIndex v .. maxIndex v repeat set_!(z, i, v.j) z + + coerce : SquareMatrix(dim,R) -> % coerce(m: SM(dim,R)): % == z := new(dim**2, 0) offz := 0 @@ -27395,12 +27575,14 @@ CartesianTensor(minix, dim, R): Exports == Implementation where offz := offz + dim z + ?=? : (%,%) -> Boolean x = y == #x ^= #y => false for i in 0..#x-1 repeat if get(x,i) ^= get(y,i) then return false true + ?+? : (%,%) -> % x + y == #x ^= #y => error "Rank mismatch" -- z := [xi + yi for xi in x for yi in y] @@ -27408,6 +27590,7 @@ CartesianTensor(minix, dim, R): Exports == Implementation where for i in 0..#x-1 repeat set_!(z, i, get(x,i) + get(y,i)) z + ?-? : (%,%) -> % x - y == #x ^= #y => error "Rank mismatch" -- [xi - yi for xi in x for yi in y] @@ -27415,36 +27598,42 @@ CartesianTensor(minix, dim, R): Exports == Implementation where for i in 0..#x-1 repeat set_!(z, i, get(x,i) - get(y,i)) z + -? : % -> % - x == -- [-xi for xi in x] z := new(#x, 0) for i in 0..#x-1 repeat set_!(z, i, -get(x,i)) z + ?*? : (Integer,%) -> % n * x == -- [n * xi for xi in x] z := new(#x, 0) for i in 0..#x-1 repeat set_!(z, i, n * get(x,i)) z + ?*? : (%,Integer) -> % x * n == -- [n * xi for xi in x] z := new(#x, 0) for i in 0..#x-1 repeat set_!(z, i, n* get(x,i)) -- Commutative!! z + ?*? : (R,%) -> % r * x == -- [r * xi for xi in x] z := new(#x, 0) for i in 0..#x-1 repeat set_!(z, i, r * get(x,i)) z + ?*? : (%,R) -> % x * r == -- [xi*r for xi in x] z := new(#x, 0) for i in 0..#x-1 repeat set_!(z, i, r* get(x,i)) -- Commutative!! z + product : (%,%) -> % product(x, y) == nx := #x; ny := #y z := new(nx * ny, 0) @@ -27452,6 +27641,8 @@ CartesianTensor(minix, dim, R): Exports == Implementation where for j in 0..ny-1 repeat set_!(z, ioff + j, get(x,i) * get(y,j)) z + + ?*? : (%,%) -> % x * y == rx := rank x ry := rank y @@ -27459,6 +27650,7 @@ CartesianTensor(minix, dim, R): Exports == Implementation where ry = 0 => x * get(y,0) contract(x, rx, y, 1) + contract : (%,Integer,Integer) -> % contract(x, i, j) == rx := rank x i < 1 or i > rx or j < 1 or j > rx or i = j => @@ -27482,6 +27674,7 @@ CartesianTensor(minix, dim, R): Exports == Implementation where set_!(z, zl, get(z,zl) + get(x,xk)) z + contract : (%,Integer,%,Integer) -> % contract(x, i, y, j) == rx := rank x ry := rank y @@ -27513,9 +27706,11 @@ CartesianTensor(minix, dim, R): Exports == Implementation where set_!(z, zly, get(z,zly)+get(x,xk)*get(y,yk)) z + transpose : % -> % transpose x == transpose(x, 1, rank x) + transpose : (%,Integer,Integer) -> % transpose(x, i, j) == rx := rank x i < 1 or i > rx or j < 1 or j > rx or i = j => @@ -27536,6 +27731,7 @@ CartesianTensor(minix, dim, R): Exports == Implementation where set_!(z, zq, get(x,xq)) z + reindex : (%,List(Integer)) -> % reindex(x, l) == nx := #x z: % := new(nx, 0) @@ -27706,33 +27902,42 @@ Cell(TheField) : PUB == PRIV where Rep := List(SCELL) + coerce : % -> OutputForm coerce(c:%):O == paren [sc::O for sc in c] + projection : % -> Union(%,"failed") projection(cell) == null cell => error "projection: should not appear" r := rest(cell) null r => "failed" r + makeCell : + List(SimpleCell(TheField,SparseUnivariatePolynomial(TheField))) -> % makeCell(l:List(SCELL)) == l + makeCell:(SimpleCell(TheField,SparseUnivariatePolynomial(TheField)),%) -> % makeCell(scell,toAdd) == cons(scell,toAdd) + mainVariableOf : % -> Symbol mainVariableOf(cell) == null(cell) => error "Should not appear" variableOf(first(cell)) + variablesOf : % -> List(Symbol) variablesOf(cell) == null(cell) => [] cons(mainVariableOf(cell),variablesOf(rest(cell)::%)) + dimension : % -> NonNegativeInteger dimension(cell) == null(cell) => 0 hasDimension?(first(cell)) => 1+dimension(rest(cell)) dimension(rest(cell)) + hasDimension? : (%,Symbol) -> Boolean hasDimension?(cell,var) == null(cell) => error "Should not appear" @@ -27743,6 +27948,7 @@ Cell(TheField) : PUB == PRIV where v > var => true error "Caca Prout" + samplePoint : % -> List(TheField) samplePoint(cell) == null(cell) => [] cons(samplePoint(first(cell)),samplePoint(rest(cell))) @@ -28193,53 +28399,75 @@ Character: OrderedFinite() with minChar := minIndex OutChars - a = b == a =$Rep b + ?=? : (%,%) -> Boolean + a = b == a =$Rep b - a < b == a <$Rep b + ? Boolean + a < b == a <$Rep b - size() == 256 + size : () -> NonNegativeInteger + size() == 256 - index n == char((n - 1)::Integer) + index : PositiveInteger -> % + index n == char((n - 1)::Integer) - lookup c == (1 + ord c)::PositiveInteger + lookup : % -> PositiveInteger + lookup c == (1 + ord c)::PositiveInteger - char(n:Integer) == n::% + char : Integer -> % + char(n:Integer) == n::% - ord c == convert(c)$Rep + ord : % -> Integer + ord c == convert(c)$Rep - random() == char(random()$Integer rem size()) + random : () -> % + random() == char(random()$Integer rem size()) - space == QENUM(" ", 0$Lisp)$Lisp + space : () -> % + space == QENUM(" ", 0$Lisp)$Lisp - quote == QENUM("_" ", 0$Lisp)$Lisp + quote : () -> % + quote == QENUM("_" ", 0$Lisp)$Lisp - escape == QENUM("__ ", 0$Lisp)$Lisp + escape : () -> % + escape == QENUM("__ ", 0$Lisp)$Lisp + coerce : % -> OutputForm coerce(c:%):OutputForm == OutChars(minChar + ord c) - digit? c == member?(c pretend Character, digit()) + digit? : % -> Boolean + digit? c == member?(c pretend Character, digit()) - hexDigit? c == member?(c pretend Character, hexDigit()) + hexDigit? : % -> Boolean + hexDigit? c == member?(c pretend Character, hexDigit()) - upperCase? c == member?(c pretend Character, upperCase()) + upperCase? : % -> Boolean + upperCase? c == member?(c pretend Character, upperCase()) - lowerCase? c == member?(c pretend Character, lowerCase()) + lowerCase? : % -> Boolean + lowerCase? c == member?(c pretend Character, lowerCase()) - alphabetic? c == member?(c pretend Character, alphabetic()) + alphabetic? : % -> Boolean + alphabetic? c == member?(c pretend Character, alphabetic()) - alphanumeric? c == member?(c pretend Character, alphanumeric()) + alphanumeric? : % -> Boolean + alphanumeric? c == member?(c pretend Character, alphanumeric()) + latex : % -> String latex c == concat("\mbox{`", concat(new(1,c pretend Character)$String, "'}")_ $String)$String + char : String -> % char(s:String) == (#s) = 1 => s(minIndex s) pretend % error "String is not a single character" + upperCase : % -> % upperCase c == QENUM(PNAME(UPCASE(CODE_-CHAR(ord c)$Lisp)$Lisp)$Lisp,0$Lisp)$Lisp + lowerCase : % -> % lowerCase c == QENUM(PNAME(DOWNCASE(CODE_-CHAR(ord c)$Lisp)$Lisp)$Lisp,0$Lisp)$Lisp @@ -28768,70 +28996,96 @@ CharacterClass: Join(SetCategory, ConvertibleTo String, a, b: % - digit() == charClass "0123456789" + digit : () -> % + digit() == charClass "0123456789" - hexDigit() == charClass "0123456789abcdefABCDEF" + hexDigit : () -> % + hexDigit() == charClass "0123456789abcdefABCDEF" - upperCase() == charClass "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + upperCase : () -> % + upperCase() == charClass "ABCDEFGHIJKLMNOPQRSTUVWXYZ" - lowerCase() == charClass "abcdefghijklmnopqrstuvwxyz" + lowerCase : () -> % + lowerCase() == charClass "abcdefghijklmnopqrstuvwxyz" - alphabetic() == union(upperCase(), lowerCase()) + alphabetic : () -> % + alphabetic() == union(upperCase(), lowerCase()) + alphanumeric : () -> % alphanumeric() == union(alphabetic(), digit()) - a = b == a =$Rep b + ?=? : (%,%) -> Boolean + a = b == a =$Rep b - member?(c, a) == a(ord c) + member? : (Character,%) -> Boolean + member?(c, a) == a(ord c) - union(a,b) == Or(a, b) + union : (%,%) -> % + union(a,b) == Or(a, b) + intersect : (%,%) -> % intersect (a,b) == And(a, b) + difference : (%,%) -> % difference(a,b) == And(a, Not b) - complement a == Not a + complement : % -> % + complement a == Not a + convert : % -> String convert(cl):String == construct(convert(cl)@List(Character)) + convert : % -> List(Character) convert(cl:%):List(Character) == [char(i) for i in 0..N-1 | cl.i] + charClass : String -> % charClass(s: String) == cl := new(N, false) for i in minIndex(s)..maxIndex(s) repeat cl(ord s.i) := true cl + charClass : List(Character) -> % charClass(l: List Character) == cl := new(N, false) for c in l repeat cl(ord c) := true cl + coerce : % -> OutputForm coerce(cl):OutputForm == (convert(cl)@String)::OutputForm -- Stuff to make a legal SetAggregate view + #? : % -> NonNegativeInteger # a == (n := 0; for i in 0..N-1 | a.i repeat n := n+1; n) + empty : () -> % empty():% == charClass [] + brace : () -> % brace():% == charClass [] + insert! : (Character,%) -> % insert_!(c, a) == (a(ord c) := true; a) + remove! : (Character,%) -> % remove_!(c, a) == (a(ord c) := false; a) + inspect : % -> Character inspect(a) == for i in 0..N-1 | a.i repeat return char i error "Cannot take a character from an empty class." + + extract! : % -> Character extract_!(a) == for i in 0..N-1 | a.i repeat a.i := false return char i error "Cannot take a character from an empty class." + map : ((Character -> Character),%) -> % map(f, a) == b := new(N, false) for i in 0..N-1 | a.i repeat b(ord f char i) := true @@ -28839,11 +29093,13 @@ CharacterClass: Join(SetCategory, ConvertibleTo String, temp: % := new(N, false)$Rep + map! : ((Character -> Character),%) -> % map_!(f, a) == fill_!(temp, false) for i in 0..N-1 | a.i repeat temp(ord f char i) := true copyInto_!(a, temp, 0) + parts : % -> List(Character) parts a == [char i for i in 0..N-1 | a.i] @@ -29955,33 +30211,46 @@ CliffordAlgebra(n, K, Q): T == Impl where c: K m: Integer + characteristic : () -> NonNegativeInteger characteristic() == characteristic()$K - dimension() == dim::CardinalNumber + dimension : () -> CardinalNumber + dimension() == dim::CardinalNumber + ?=? : (%,%) -> Boolean x = y == for i in 0..dim-1 repeat if x.i ^= y.i then return false true + ?+? : (%,%) -> % x + y == (z := New; for i in 0..dim-1 repeat z.i := x.i + y.i; z) + ?-? : (%,%) -> % x - y == (z := New; for i in 0..dim-1 repeat z.i := x.i - y.i; z) + -? : % -> % - x == (z := New; for i in 0..dim-1 repeat z.i := - x.i; z) + ?*? : (Integer,%) -> % m * x == (z := New; for i in 0..dim-1 repeat z.i := m*x.i; z) + ?*? : (K,%) -> % c * x == (z := New; for i in 0..dim-1 repeat z.i := c*x.i; z) - 0 == New + 0 : () -> % + 0 == New - 1 == (z := New; z.0 := 1; z) + 1 : () -> % + 1 == (z := New; z.0 := 1; z) + coerce : Integer -> % coerce(m): % == (z := New; z.0 := m::K; z) + coerce : K -> % coerce(c): % == (z := New; z.0 := c; z) + e : PositiveInteger -> % e b == b::NNI > n => error "No such basis element" iz := 2**((b-1)::NNI) @@ -29989,6 +30258,7 @@ CliffordAlgebra(n, K, Q): T == Impl where -- The ei*ej products could instead be precomputed in -- a (2**n)**2 multiplication table. + addMonomProd : (K,NNI,K,NNI,%) -> % addMonomProd(c1: K, b1: NNI, c2: K, b2: NNI, z: %): % == c := c1 * c2 bz := b2 @@ -30007,6 +30277,7 @@ CliffordAlgebra(n, K, Q): T == Impl where z.bz := z.bz + c z + ?*? : (%,%) -> % x * y == z := New for ix in 0..dim-1 repeat @@ -30014,6 +30285,7 @@ CliffordAlgebra(n, K, Q): T == Impl where if y.iy ^= 0 then addMonomProd(x.ix,ix,y.iy,iy,z) z + canonMonom : (K,List PI) -> Record(coef: K, basel: NNI) canonMonom(c: K, lb: List PI): Record(coef: K, basel: NNI) == -- 0. Check input for b in lb repeat b > n => error "No such basis element" @@ -30044,12 +30316,14 @@ CliffordAlgebra(n, K, Q): T == Impl where bz:= bz + 2**bn [c, bz::NNI] + monomial : (K,List(PositiveInteger)) -> % monomial(c, lb) == r := canonMonom(c, lb) z := New z r.basel := r.coef z + coefficient : (%,List(PositiveInteger)) -> K coefficient(z, lb) == r := canonMonom(1, lb) r.coef = 0 => error "Cannot take coef of 0" @@ -30057,6 +30331,7 @@ CliffordAlgebra(n, K, Q): T == Impl where Ex ==> OutputForm + coerceMonom : (K,NNI) -> Ex coerceMonom(c: K, b: NNI): Ex == b = 0 => c::Ex ml := [sub("e"::Ex, i::Ex) for i in 1..n | bit?(b,i-1)] @@ -30064,11 +30339,13 @@ CliffordAlgebra(n, K, Q): T == Impl where c = 1 => be c::Ex * be + coerce : % -> OutputForm coerce(x): Ex == tl := [coerceMonom(x.i,i) for i in 0..dim-1 | x.i^=0] null tl => "0"::Ex reduce("+", tl) + localPowerSets : NNI -> List(List(PI)) localPowerSets(j:NNI): List(List(PI)) == l: List List PI := list [] j = 0 => l @@ -30077,10 +30354,12 @@ CliffordAlgebra(n, K, Q): T == Impl where for x in Sm repeat Sn := cons(cons(j pretend PI, x),Sn) append(Sn, Sm) + powerSets : NNI -> List List PI powerSets(j:NNI):List List PI == map(reverse, localPowerSets j) Pn:List List PI := powerSets(n) + recip : % -> Union(%,"failed") recip(x: %): Union(%, "failed") == one:% := 1 -- tmp:c := x*yC - 1$C @@ -30089,7 +30368,6 @@ CliffordAlgebra(n, K, Q): T == Impl where lhsEqi: List K for pi in Pn repeat rhsEqs := cons(coefficient(one, pi), rhsEqs) - lhsEqi := [] for pj in Pn repeat lhsEqi := cons(coefficient(x*monomial(1,pj),pi),lhsEqi) @@ -30287,13 +30565,14 @@ Color(): Exports == Implementation where Rep := Record(hue:I, weight:SF) - + ?*? : (DoubleFloat,%) -> % f:SF * c:% == -- s * c returns the color c, whose weighted shade has been scaled by s zero? f => c -- 0 is the identitly function...or maybe an error is better? [c.hue, f * c.weight] + ?+? : (%,%) -> % x + y == x.hue = y.hue => [x.hue, x.weight + y.weight] if y.weight > x.weight then -- let x be color with bigger weight @@ -30312,29 +30591,39 @@ Color(): Exports == Implementation where else if (ans > totalHues) then ans := ans - totalHues [ans,1] - x = y == (x.hue = y.hue) and (x.weight = y.weight) + ?=? : (%,%) -> Boolean + x = y == (x.hue = y.hue) and (x.weight = y.weight) - red() == [1,1] + red : () -> % + red() == [1,1] - yellow() == [11::I,1] + yellow : () -> % + yellow() == [11::I,1] - green() == [14::I,1] + green : () -> % + green() == [14::I,1] - blue() == [22::I,1] + blue : () -> % + blue() == [22::I,1] - sample() == red() + sample() == red() - hue c == c.hue + hue : % -> Integer + hue c == c.hue + ?*? : (PositiveInteger,%) -> % i:PositiveInteger * c:% == i::SF * c + numberOfHues : () -> PositiveInteger numberOfHues() == totalHues + color : Integer -> % color i == if (i<0) or (i>totalHues) then error concat("Color should be in the range 1..",totalHues::String) [i::I, 1] + coerce : % -> OutputForm coerce(c:%):OutputForm == hconcat ["Hue: "::OutputForm, (c.hue)::OutputForm, " Weight: "::OutputForm, (c.weight)::OutputForm] @@ -30469,6 +30758,7 @@ Commutator: Export == Implement where i : I + ?=? : (%,%) -> Boolean x = y == (x case OSI) and (y case OSI) => x::OSI = y::OSI (x case P) and (y case P) => @@ -30477,10 +30767,13 @@ Commutator: Export == Implement where (xx.right = yy.right) and (xx.left = yy.left) false + mkcomm : Integer -> % mkcomm(i) == i::OSI + mkcomm : (%,%) -> % mkcomm(x,y) == construct(x,y)$P + coerce : % -> OutputForm coerce(x: %): O == x case OSI => x::OSI::O xx := x::P @@ -31201,6 +31494,7 @@ Complex(R:CommutativeRing): ComplexCategory(R) with if R has OpenMath then + writeOMComplex : (OpenMathDevice,%) -> Void writeOMComplex(dev: OpenMathDevice, x: %): Void == OMputApp(dev) OMputSymbol(dev, "complex1", "complex__cartesian") @@ -31208,6 +31502,7 @@ Complex(R:CommutativeRing): ComplexCategory(R) with OMwrite(dev, imag x) OMputEndApp(dev) + OMwrite : % -> String OMwrite(x: %): String == s: String := "" sp := OM_-STRINGTOSTRINGPTR(s)$Lisp @@ -31219,6 +31514,7 @@ Complex(R:CommutativeRing): ComplexCategory(R) with s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String s + OMwrite : (%,Boolean) -> String OMwrite(x: %, wholeObj: Boolean): String == s: String := "" sp := OM_-STRINGTOSTRINGPTR(s)$Lisp @@ -31232,11 +31528,13 @@ Complex(R:CommutativeRing): ComplexCategory(R) with s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String s + OMwrite : (OpenMathDevice,%) -> Void OMwrite(dev: OpenMathDevice, x: %): Void == OMputObject(dev) writeOMComplex(dev, x) OMputEndObject(dev) + OMwrite : (OpenMathDevice,%,Boolean) -> Void OMwrite(dev: OpenMathDevice, x: %, wholeObj: Boolean): Void == if wholeObj then OMputObject(dev) @@ -31244,31 +31542,43 @@ Complex(R:CommutativeRing): ComplexCategory(R) with if wholeObj then OMputEndObject(dev) - 0 == [0, 0] + 0 : () -> % + 0 == [0, 0] - 1 == [1, 0] + 1 : () -> % + 1 == [1, 0] - zero? x == zero?(x.real) and zero?(x.imag) + zero? : % -> Boolean + zero? x == zero?(x.real) and zero?(x.imag) - one? x == ((x.real) = 1) and zero?(x.imag) + one? : % -> Boolean + one? x == ((x.real) = 1) and zero?(x.imag) - coerce(r:R):% == [r, 0] + coerce : R -> % + coerce(r:R):% == [r, 0] - complex(r, i) == [r, i] + complex : (R,R) -> % + complex(r, i) == [r, i] - real x == x.real + real : % -> R + real x == x.real - imag x == x.imag + imag : % -> R + imag x == x.imag - x + y == [x.real + y.real, x.imag + y.imag] + ?+? : (%,%) -> % + x + y == [x.real + y.real, x.imag + y.imag] -- by re-defining this here, we save 5 fn calls + ?*? : (%,%) -> % x:% * y:% == [x.real * y.real - x.imag * y.imag, x.imag * y.real + y.imag * x.real] -- here we save nine! if R has IntegralDomain then + + exquo : (%,%) -> Union(%,"failed") _exquo(x:%, y:%) == -- to correct bad defaulting problem zero? y.imag => x exquo y.real x * conjugate(y) exquo norm(y) @@ -31615,26 +31925,37 @@ ComplexDoubleFloatMatrix : MatrixCategory(Complex DoubleFloat, Qncols ==> CDANCOLS$Lisp Qnew ==> MAKE_-CDOUBLE_-MATRIX$Lisp + minRowIndex : % -> Integer minRowIndex x == 0 + minColIndex : % -> Integer minColIndex x == 0 + nrows : % -> NonNegativeInteger nrows x == Qnrows(x) + ncols : % -> NonNegativeInteger ncols x == Qncols(x) + maxRowIndex : % -> Integer maxRowIndex x == Qnrows(x) - 1 + maxColIndex : % -> Integer maxColIndex x == Qncols(x) - 1 + qelt : (%,Integer,Integer) -> Complex(DoubleFloat) qelt(m, i, j) == Qelt2(m, i, j) + qsetelt! : (%,Integer,Integer,Complex(DoubleFloat)) -> Complex(DoubleFloat) qsetelt_!(m, i, j, r) == Qsetelt2(m, i, j, r) + empty : () -> % empty() == Qnew(0$Integer, 0$Integer) + qnew : (Integer,Integer) -> % qnew(rows, cols) == Qnew(rows, cols) + new : (NonNegativeInteger,NonNegativeInteger,Complex(DoubleFloat)) -> % new(rows, cols, a) == res := Qnew(rows, cols) for i in 0..(rows - 1) repeat @@ -31966,12 +32287,8 @@ ComplexDoubleFloatVector : VectorCategory Complex DoubleFloat with res := Qnew(n) fill_!(res, x) - qelt(x, i) == Qelt1(x, i) - elt(x:%, i:Integer) == Qelt1(x, i) - qsetelt_!(x, i, s) == Qsetelt1(x, i, s) - setelt(x : %, i : Integer, s : Complex DoubleFloat) == Qsetelt1(x, i, s) @@ -31989,35 +32306,41 @@ ComplexDoubleFloatVector : VectorCategory Complex DoubleFloat with Qsetelt1 ==> CDSETELT$Lisp + qelt : (%,Integer) -> Complex(DoubleFloat) qelt(x, i) == Qelt1(x, i) + qsetelt! : (%,Integer,Complex(DoubleFloat)) -> Complex(DoubleFloat) qsetelt_!(x, i, s) == Qsetelt1(x, i, s) Qsize ==> CDLEN$Lisp Qnew ==> MAKE_-CDOUBLE_-VECTOR$Lisp - #x == Qsize x + #? : % -> NonNegativeInteger + #x == Qsize x - minIndex x == 0 + minIndex : % -> Integer + minIndex x == 0 - empty() == Qnew(0$Lisp) + empty : () -> % + empty() == Qnew(0$Lisp) - qnew(n) == Qnew(n) + qnew : Integer -> % + qnew(n) == Qnew(n) - new(n, x) == + new : (NonNegativeInteger,Complex(DoubleFloat)) -> % + new(n, x) == res := Qnew(n) fill_!(res, x) - qelt(x, i) == Qelt1(x, i) - - elt(x:%, i:Integer) == Qelt1(x, i) - - qsetelt_!(x, i, s) == Qsetelt1(x, i, s) + ?.? : (%,Integer) -> Complex(DoubleFloat) + elt(x:%, i:Integer) == Qelt1(x, i) + setelt : (%,Integer,Complex(DoubleFloat)) -> Complex(DoubleFloat) setelt(x : %, i : Integer, s : Complex DoubleFloat) == Qsetelt1(x, i, s) + fill! : (%,Complex(DoubleFloat)) -> % fill_!(x, s) == for i in 0..((Qsize(x)) - 1) repeat Qsetelt1(x, i, s) x @@ -33068,24 +33391,7 @@ ContinuedFraction(R): Exports == Implementation where import Str - genFromSequence: Stream Q -> % - - genReducedForm: (Q, Stream Q, MT) -> Stream Rec - - genFractionA: (Stream R,Stream R) -> Stream Rec - - genFractionB: (Stream R,Stream R) -> Stream Rec - - genNumDen: (R,R, Stream Rec) -> Stream R - - genApproximants: (R,R,R,R,Stream Rec) -> Stream Q - - genConvergents: (R,R,R,R,Stream Rec) -> Stream Q - - iGenApproximants: (R,R,R,R,Stream Rec) -> Stream Q - - iGenConvergents: (R,R,R,R,Stream Rec) -> Stream Q - + reducedForm : % -> % reducedForm c == c.reduced? => c explicitlyFinite? c.value.fract => @@ -33093,8 +33399,10 @@ ContinuedFraction(R): Exports == Implementation where canReduce? => genFromSequence approximants c error "Reduced form not defined for this continued fraction." + eucWhole : Q -> R eucWhole(a: Q): R == numer a quo denom a + eucWhole0 : Q -> R eucWhole0(a: Q): R == isOrdered => n := numer a @@ -33105,6 +33413,7 @@ ContinuedFraction(R): Exports == Implementation where q eucWhole a + ?=? : (%,%) -> Boolean x = y == x := reducedForm x y := reducedForm y @@ -33118,11 +33427,15 @@ ContinuedFraction(R): Exports == Implementation where xl := rst xl; yl := rst yl empty? xl and empty? yl + continuedFraction : Fraction(R) -> % continuedFraction q == q :: % if isOrdered then + + continuedFraction : (R,Stream(R),Stream(R)) -> % continuedFraction(wh,nums,dens) == [[wh,genFractionA(nums,dens)],false] + genFractionA: (Stream R,Stream R) -> Stream Rec genFractionA(nums,dens) == empty? nums or empty? dens => empty() n := frst nums @@ -33132,21 +33445,27 @@ ContinuedFraction(R): Exports == Implementation where concat([n,d]$Rec, delay genFractionA(rst nums,rst dens)) else + continuedFraction : (R,Stream(R),Stream(R)) -> % continuedFraction(wh,nums,dens) == [[wh,genFractionB(nums,dens)],false] + genFractionB: (Stream R,Stream R) -> Stream Rec genFractionB(nums,dens) == empty? nums or empty? dens => empty() n := frst nums d := frst dens concat([n,d]$Rec, delay genFractionB(rst nums,rst dens)) + reducedContinuedFraction : (R,Stream(R)) -> % reducedContinuedFraction(wh,dens) == continuedFraction(wh, repeating [1], dens) + coerce : Integer -> % coerce(n:Integer):% == [[n::R,empty()], true] - coerce(r:R):% == [[r, empty()], true] + coerce : R -> % + coerce(r:R):% == [[r, empty()], true] + coerce : Fraction(R) -> % coerce(a: Q): % == wh := eucWhole0 a fr := a - wh::Q @@ -33162,8 +33481,10 @@ ContinuedFraction(R): Exports == Implementation where d := qr.remainder [[wh, construct rest reverse_! l], true] + characteristic : () -> NonNegativeInteger characteristic() == characteristic()$Q + genFromSequence: Stream Q -> % genFromSequence apps == lo := first apps; apps := rst apps hi := first apps; apps := rst apps @@ -33173,6 +33494,7 @@ ContinuedFraction(R): Exports == Implementation where wh := eucWhole0 lo [[wh, genReducedForm(wh::Q, apps, moebius(1,0,0,1))], canReduce?] + genReducedForm: (Q, Stream Q, MT) -> Stream Rec genReducedForm(wh0, apps, mt) == lo: Q := first apps - wh0; apps := rst apps hi: Q := first apps - wh0; apps := rst apps @@ -33185,18 +33507,23 @@ ContinuedFraction(R): Exports == Implementation where whi := eucWhole eval(mt, first apps - wh0); apps := rst apps concat([1,wlo], delay genReducedForm(wh0, apps, shift(mt, -wlo::Q))) + wholePart : % -> R wholePart c == c.value.whole + partialNumerators : % -> Stream(R) partialNumerators c == map(x1+->x1.num, c.value.fract)$StreamFunctions2(Rec,R) + partialDenominators : % -> Stream(R) partialDenominators c == map(x1+->x1.den, c.value.fract)$StreamFunctions2(Rec,R) + partialQuotients : % -> Stream(R) partialQuotients c == concat(c.value.whole, partialDenominators c) + approximants : % -> Stream(Fraction(R)) approximants c == empty? c.value.fract => repeating [c.value.whole::Q] genApproximants(1,0,c.value.whole,1,c.value.fract) @@ -33209,33 +33536,41 @@ ContinuedFraction(R): Exports == Implementation where empty? c.value.fract => concat(c.value.whole, empty()) genNumDen(1,c.value.whole,c.value.fract) + denominators : % -> Stream(R) denominators c == genNumDen(0,1,c.value.fract) + extend : (%,Integer) -> % extend(x,n) == (extend(x.value.fract,n); x) + complete : % -> % complete(x) == (complete(x.value.fract); x) + iGenApproximants: (R,R,R,R,Stream Rec) -> Stream Q iGenApproximants(pm2,qm2,pm1,qm1,fr) == delay nd := frst fr pm := nd.num*pm2 + nd.den*pm1 qm := nd.num*qm2 + nd.den*qm1 genApproximants(pm1,qm1,pm,qm,rst fr) + genApproximants: (R,R,R,R,Stream Rec) -> Stream Q genApproximants(pm2,qm2,pm1,qm1,fr) == empty? fr => repeating [pm1/qm1] concat(pm1/qm1,iGenApproximants(pm2,qm2,pm1,qm1,fr)) + iGenConvergents: (R,R,R,R,Stream Rec) -> Stream Q iGenConvergents(pm2,qm2,pm1,qm1,fr) == delay nd := frst fr pm := nd.num*pm2 + nd.den*pm1 qm := nd.num*qm2 + nd.den*qm1 genConvergents(pm1,qm1,pm,qm,rst fr) + genConvergents: (R,R,R,R,Stream Rec) -> Stream Q genConvergents(pm2,qm2,pm1,qm1,fr) == empty? fr => concat(pm1/qm1, empty()) concat(pm1/qm1,iGenConvergents(pm2,qm2,pm1,qm1,fr)) + genNumDen: (R,R, Stream Rec) -> Stream R genNumDen(m2,m1,fr) == empty? fr => concat(m1,empty()) concat(m1,delay genNumDen(m1,m2*frst(fr).num + m1*frst(fr).den,rst fr)) @@ -33249,26 +33584,37 @@ ContinuedFraction(R): Exports == Implementation where q: Q n: Integer + 0 : () -> % 0 == (0$R) :: % + 1 : () -> % 1 == (1$R) :: % + ?+? : (%,%) -> % c + d == genFromSequence map((x,y) +-> x + y, apx c, apx d) + ?-? : (%,%) -> % c - d == genFromSequence map((x,y) +-> x - y, apx c, rest apx d) - - c == genFromSequence map(x +-> - x, rest apx c) + -? : % -> % + - c == genFromSequence map(x +-> - x, rest apx c) + ?*? : (%,%) -> % c * d == genFromSequence map((x,y) +-> x * y, apx c, apx d) + ?*? : (R,%) -> % a * d == genFromSequence map(x +-> a * x, apx d) + ?*? : (Fraction(R),%) -> % q * d == genFromSequence map(x +-> q * x, apx d) + ?*? : (Integer,%) -> % n * d == genFromSequence map(x +-> n * x, apx d) + ?/? : (%,%) -> % c / d == genFromSequence map((x,y) +-> x / y, apx c, rest apx d) + recip : % -> Union(%,"failed") recip c ==(c = 0 => "failed"; genFromSequence map(x +-> 1/x, rest apx c)) @@ -33277,8 +33623,10 @@ ContinuedFraction(R): Exports == Implementation where NULL(_$streamsShowAll$Lisp)$Lisp => false true + zagRec : Rec -> OUT zagRec(t:Rec):OUT == zag(t.num :: OUT,t.den :: OUT) + coerce : % -> OutputForm coerce(c:%): OUT == wh := c.value.whole fr := c.value.fract @@ -33454,25 +33802,34 @@ Database(S): Exports == Implementation where Rep := List S + coerce : List(S) -> % coerce(u: List S):% == u@% + ?.? : (%,Symbol) -> DataList(String) elt(data: %,s: Symbol) == [x.s for x in data] :: DataList(String) + ?.? : (%,QueryEquation) -> % elt(data: %,eq: QueryEquation) == field := variable eq val := value eq [x for x in data | stringMatches?(val,x.field)$Lisp] - x+y==removeDuplicates_! merge(x,y) + ?+? : (%,%) -> % + x+y == removeDuplicates_! merge(x,y) - x-y==mergeDifference(copy(x::Rep),y::Rep)$MergeThing(S) + ?-? : (%,%) -> % + x-y == mergeDifference(copy(x::Rep),y::Rep)$MergeThing(S) + coerce : % -> OutputForm coerce(data): OutputForm == (#data):: OutputForm + display : % -> Void display(data) == for x in data repeat display x + fullDisplay : % -> Void fullDisplay(data) == for x in data repeat fullDisplay x + fullDisplay : (%,PositiveInteger,PositiveInteger) -> Void fullDisplay(data,n,m) == for x in data for i in 1..m repeat if i >= n then fullDisplay x @@ -33790,18 +34147,25 @@ DataList(S:OrderedSet) : Exports == Implementation where (* domain DLIST *) (* + ?.unique : (%,unique) -> % elt(x,"unique") == removeDuplicates(x) + ?.sort : (%,sort) -> % elt(x,"sort") == sort(x) + ?.count : (%,count) -> NonNegativeInteger elt(x,"count") == #x + coerce : List(S) -> % coerce(x:List S) == x pretend % + coerce : % -> List(S) coerce(x:%):List S == x pretend (List S) + coerce : % -> OutputForm coerce(x:%): OutputForm == (x :: List S) :: OutputForm + datalist : List(S) -> % datalist(x:List S) == x::% *) @@ -34214,8 +34578,10 @@ DecimalExpansion(): Exports == Implementation where (* RadixExpansion(10) add + decimal : Fraction(Integer) -> % decimal r == r :: % + coerce : % -> RadixExpansion(10) coerce(x:%): RadixExpansion(10) == x pretend RadixExpansion(10) *) @@ -36798,8 +37164,10 @@ DenavitHartenbergMatrix(R): Exports == Implementation where (* Matrix(R) add + identity : () -> % identity() == matrix([[1,0,0,0],[0,1,0,0],[0,0,1,0],[0,0,0,1]]) + ?*? : (%,Point(R)) -> Point(R) d * p == v := p pretend Vector R v := concat(v, 1$R) @@ -38042,10 +38410,13 @@ Dequeue(S:SetCategory): DequeueAggregate S with Rep := Reference List S + bottom! : % -> S bottom! d == extractBottom! d + dequeue : List(S) -> % dequeue d == ref copy d + extractBottom! : % -> S extractBottom! d == if empty? d then error "empty dequeue" p := deref d @@ -38059,29 +38430,37 @@ Dequeue(S:SetCategory): DequeueAggregate S with q.rest := [] r + top! : % -> S top! d == extractTop! d + extractTop! : % -> S extractTop! d == if empty? d then error "empty dequeue" e := top d setref(d,rest deref d) e + height : % -> NonNegativeInteger height d == # deref d + depth : % -> NonNegativeInteger depth d == # deref d + insertTop! : (S,%) -> S insertTop!(e,d) == (setref(d,cons(e,deref d)); e) lastTail==> LAST$Lisp + insertBottom! : (S,%) -> S insertBottom!(e,d) == if empty? d then setref(d, list e) else lastTail.(deref d).rest := list e e + top : % -> S top d == if empty? d then error "empty dequeue" else first deref d + reverse! : % -> % reverse! d == (setref(d,reverse deref d); d) *) @@ -41735,6 +42114,7 @@ DeRhamComplex(CoefRing,listIndVar:List Symbol): Export == Implement where dim := #listIndVar + totalDifferential : Expression(CoefRing) -> % totalDifferential(f) == divs:=[differentiate(f,listIndVar.i)*generator(i)$ASY for i in 1..dim] reduce("+",divs) @@ -41743,6 +42123,7 @@ DeRhamComplex(CoefRing,listIndVar:List Symbol): Export == Implement where termDiff(r,e) == totalDifferential(r) * e + exteriorDifferential : % -> % exteriorDifferential(x) == x = 0 => 0 termDiff(leadingCoefficient(x)$Rep,leadingBasisTerm x) + _ @@ -41773,19 +42154,23 @@ DeRhamComplex(CoefRing,listIndVar:List Symbol): Export == Implement where err4:="Index out of range" -- coord space dimension + dim : % -> NonNegativeInteger dim(f) == dim -- flip 0->1, 1->0 + flip : ExtAlgBasis -> ExtAlgBasis flip(b:ExtAlgBasis):ExtAlgBasis == bl := b pretend List(NNI) [(i+1) rem 2 for i in bl] pretend ExtAlgBasis -- list the positions of a's (a=0,1) in x + pos : (EAB,NNI) -> List(NNI) pos(x:EAB, a:NNI):List(NNI) == y:= x pretend List(NNI) [j for j in 1..#y | y.j=a] -- compute dot of singletons + dot1 : (Record(k:EAB,c:R),Record(k:EAB,c:R),SMR) -> R dot1(r:Record(k:EAB,c:R),s:Record(k:EAB,c:R),g:SMR):R == not CoefRing has IntegralDomain => error(err1) test(r.k ^= s.k) => 0::R @@ -41794,6 +42179,7 @@ DeRhamComplex(CoefRing,listIndVar:List Symbol): Export == Implement where reduce("*",[1/g(j,j) for j in idx]::List(R))*r.c*s.c -- compute dot of singleton terms, general symmetric g + dot2 : (REABR,REABR,SMR) -> R dot2(r:REABR, s:REABR, g:SMR):R == not CoefRing has IntegralDomain => error(err1) pr := pos(r.k,1) -- list positions of 1 in r @@ -41807,6 +42193,8 @@ DeRhamComplex(CoefRing,listIndVar:List Symbol): Export == Implement where determinant(M)::R * r.c * s.c -- export + dot : (%,%,SquareMatrix(#(listIndVar),Expression(CoefRing))) -> + Expression(CoefRing) dot(x,y,g) == not symmetric? g => error(err2) tx:=terms(x) @@ -41818,6 +42206,7 @@ DeRhamComplex(CoefRing,listIndVar:List Symbol): Export == Implement where reduce("+",[dot1(tx.j,ty.j,g) for j in 1..#tx]) -- export + hodgeStar : (%,SquareMatrix(#(listIndVar),Expression(CoefRing))) -> % hodgeStar(x,g) == not CoefRing has IntegralDomain => error(err1) not diagonal? g => error(err2) @@ -41833,6 +42222,7 @@ DeRhamComplex(CoefRing,listIndVar:List Symbol): Export == Implement where s pretend % -- export + proj : (%,NonNegativeInteger) -> % proj(x,p) == p < 0 or p > dim => error(err4) t := terms(x) @@ -41840,6 +42230,8 @@ DeRhamComplex(CoefRing,listIndVar:List Symbol): Export == Implement where s := [copy(t.j) for j in idx::List(NNI)] s pretend % + interiorProduct : (Vector(Expression(CoefRing)),%,_ + SquareMatrix(#(listIndVar),Expression(CoefRing))) -> % interiorProduct(v,x,g) == not CoefRing has IntegralDomain => error(err1) f := reduce("+",[generator(i)$% for i in 1..dim]::List(%)) @@ -41855,11 +42247,14 @@ DeRhamComplex(CoefRing,listIndVar:List Symbol): Export == Implement where m:R := (-1)**degree(x)*sg m * hodgeStar(f*hodgeStar(x,g),g) + lieDerivative : (Vector(Expression(CoefRing)),%,_ + SquareMatrix(#(listIndVar),Expression(CoefRing))) -> % lieDerivative(v,x,g) == a:= exteriorDifferential(interiorProduct(v,x,g)) b:= interiorProduct(v,exteriorDifferential(x),g) a+b + coerce : % -> OutputForm coerce(a):O == a = 0$Rep => 0$I::O ta := terms a @@ -42076,30 +42471,39 @@ DesingTree(S: SetCategory): T==C where (* Rep ==> Record(value: S, args: List %) + fullOut : % -> OutputForm fullOut(t:%): OutputForm == empty? children t => (value t) ::OutputForm prefix((value t)::OutputForm, [fullOut(tr) for tr in children t]) fullOutputFlag:Boolean:=false() + fullOutput : Boolean -> Boolean fullOutput(f)== fullOutputFlag:=f + fullOutput : () -> Boolean fullOutput == fullOutputFlag + leaves : % -> List(S) leaves(t)== empty?(chdr:=children(t)) => list(value(t)) concat([leaves(subt) for subt in chdr]) + ?=? : (%,%) -> Boolean t1=t2 == value t1 = value t2 and children t1 = children t2 + coerce : % -> OutputForm coerce(t:%):OutputForm== ^fullOutput() => encode(t) :: OutputForm fullOut(t) + tree : (S,List(%)) -> % tree(s,ls) == ([s,ls]:Rep):% + tree : S -> % tree(s:S) == ([s,[]]:Rep):% + tree : List(S) -> % tree(ls:List(S))== empty?(ls) => error "Cannot create a tree with an empty list" @@ -42108,14 +42512,19 @@ DesingTree(S: SetCategory): T==C where tree(f) tree(f,[tree(rs)]) + value : % -> S value t == (t:Rep).value + children : % -> List(%) children t == ((t:Rep).args):List % + setchildren! : (%,List(%)) -> % setchildren_!(t,ls) == ((t:Rep).args:=ls;t pretend %) + setvalue! : (%,S) -> S setvalue_!(t,s) == ((t:Rep).value:=s;s) + encode : % -> String encode(t)== empty?(chtr:=children(t)) => empty()$String concat([concat(["U",encode(arb),"."]) for arb in chtr]) @@ -42462,12 +42871,14 @@ DifferentialSparseMultivariatePolynomial(R, S, V): (* P add + retractIfCan : % -> Union(R,"failed") retractIfCan(p:$):Union(SMP, "failed") == zero? order p => map(x+->retract(x)@S :: SMP,y+->y::SMP, p)$PCL( IndexedExponents V, V, R, $, SMP) "failed" + coerce : SparseMultivariatePolynomial(R,S) -> % coerce(p:SMP):$ == map(x+->x::V::$, y+->y::$, p)$PCL(IndexedExponents S, S, R, SMP, $) @@ -42810,41 +43221,59 @@ DirectProduct(dim:NonNegativeInteger, R:Type): coerce(z:%):Vector(R) == copy(z)$Rep pretend Vector(R) coerce(r:R):% == new(dim, r)$Rep + parts : % -> List(R) parts x == VEC2LIST(x)$Lisp + directProduct : Vector(R) -> % directProduct z == size?(z, dim) => copy(z)$Rep error "Not of the correct length" - if R has SetCategory then + same?: % -> Boolean same? z == every?(x +-> x = z(minIndex z), z) + ?=? : (%,%) -> Boolean x = y == _and/[qelt(x,i)$Rep = qelt(y,i)$Rep for i in 1..dim] + retract : % -> R retract(z:%):R == same? z => z(minIndex z) error "Not retractable" + retractIfCan : % -> Union(R,"failed") retractIfCan(z:%):Union(R, "failed") == same? z => z(minIndex z) "failed" - if R has AbelianSemiGroup then + + ?+? : (%,%) -> % u:% + v:% == map(_+ , u, v)$Rep if R has AbelianMonoid then + + 0 : () -> % 0 == zero(dim)$Vector(R) pretend % if R has Monoid then + + 1 : () -> % 1 == new(dim, 1)$Vector(R) pretend % - u:% * r:R == map(x +-> x * r, u) - r:R * u:% == map(x +-> r * x, u) + + ?*? : (%,R) -> % + u:% * r:R == map(x +-> x * r, u) + + ?*? : (R,%) -> % + r:R * u:% == map(x +-> r * x, u) + + ?*? : (%,%) -> % x:% * y:% == [x.i * y.i for i in 1..dim]$Vector(R) pretend % if R has CancellationAbelianMonoid then + + subtractIfCan : (%,%) -> Union(%,"failed") subtractIfCan(u:%, v:%):Union(%,"failed") == w := new(dim,0)$Vector(R) for i in 1..dim repeat @@ -42855,8 +43284,10 @@ DirectProduct(dim:NonNegativeInteger, R:Type): if R has Ring then - u:% * v:% == map(_* , u, v)$Rep + ?*? : (%,%) -> % + u:% * v:% == map(_* , u, v)$Rep + recip : % -> Union(%,"failed") recip z == w := new(dim,0)$Vector(R) for i in minIndex w .. maxIndex w repeat @@ -42864,19 +43295,25 @@ DirectProduct(dim:NonNegativeInteger, R:Type): qsetelt_!(w, i, u::R) w pretend % + unitVector : PositiveInteger -> % unitVector i == v:= new(dim,0)$Vector(R) v.i := 1 v pretend % if R has OrderedSet then + + ? Boolean x < y == for i in 1..dim repeat qelt(x,i) < qelt(y,i) => return true qelt(x,i) > qelt(y,i) => return false false - if R has OrderedAbelianMonoidSup then sup(x, y) == map(sup, x, y) + if R has OrderedAbelianMonoidSup then + + sup : (%,%) -> % + sup(x, y) == map(sup, x, y) --)bo $noSubsumption := false @@ -43146,8 +43583,10 @@ DirectProductMatrixModule(n, R, M, S): DPcategory == DPcapsule where Rep := Vector(S) + ?*? : (R,%) -> % r:R * x:$ == [r*x.i for i in 1..n] + ?*? : (M,%) -> % m:M * x:$ == [ +/[m(i,j)*x.j for j in 1..n] for i in 1..n] *) @@ -43411,12 +43850,11 @@ DirectProductModule(n, R, S): DPcategory == DPcapsule where R: Ring S: LeftModule(R) - DPcategory == Join(DirectProductCategory(n,S), LeftModule(R)) - -- with if S has Algebra(R) then Algebra(R) - -- + DirectProduct(n,S) add - DPcapsule == DirectProduct(n,S) add Rep := Vector(S) + + ?*? : (R,%) -> % r:R * x:$ == [r * x.i for i in 1..n] *) @@ -43853,53 +44291,70 @@ DirichletRing(Coef: Ring): Rep := Record(function: FUN) + per : Rep -> % per(f: Rep): % == f pretend % + + rep : % -> Rep rep(a: %): Rep == a pretend Rep + ?.? : (%,PositiveInteger) -> Coef elt(a: %, n: PI): Coef == f: FUN := (rep a).function f n + coerce : % -> (PositiveInteger -> Coef) coerce(a: %): FUN == (rep a).function + coerce : (PositiveInteger -> Coef) -> % coerce(f: FUN): % == per [f] indices: Stream Integer := integers(1)$StreamTaylorSeriesOperations(Integer) + coerce : % -> Stream(Coef) coerce(a: %): Stream Coef == f: FUN := (rep a).function map((n: Integer): Coef +-> f(n::PI), indices) $StreamFunctions2(Integer, Coef) + coerce : Stream(Coef) -> % coerce(f: Stream Coef): % == ((n: PI): Coef +-> f.(n::Integer))::% + coerce : % -> OutputForm coerce(f: %): OutputForm == f::Stream Coef::OutputForm + 1 : () -> % 1: % == ((n: PI): Coef +-> (if one? n then 1$Coef else 0$Coef))::% + 0 : () -> % 0: % == ((n: PI): Coef +-> 0$Coef)::% + zeta : () -> % zeta: % == ((n: PI): Coef +-> 1$Coef)::% + ?+? : (%,%) -> % (f: %) + (g: %) == ((n: PI): Coef +-> f(n)+g(n))::% + -? : % -> % - (f: %) == ((n: PI): Coef +-> -f(n))::% + ?*? : (Integer,%) -> % (a: Integer) * (f: %) == ((n: PI): Coef +-> a*f(n))::% + ?*? : (Coef,%) -> % (a: Coef) * (f: %) == ((n: PI): Coef +-> a*f(n))::% import IntegerNumberTheoryFunctions + ?*? : (%,%) -> % (f: %) * (g: %) == conv := (n: PI): Coef +-> _ reduce((a: Coef, b: Coef): Coef +-> a + b, _ @@ -43907,6 +44362,7 @@ DirichletRing(Coef: Ring): $ListFunctions2(Coef, Coef) conv::% + unit? : % -> Boolean unit?(a: %): Boolean == not (recip(a(1$PI))$Coef case "failed") qrecip: (%, Coef, PI) -> Coef @@ -43917,6 +44373,7 @@ DirichletRing(Coef: Ring): for d in rest divisors(n)], 0) _ $ListFunctions2(Coef, Coef) + recip : % -> Union(%,"failed") recip f == if (f1inv := recip(f(1$PI))$Coef) case "failed" then "failed" else @@ -43924,6 +44381,7 @@ DirichletRing(Coef: Ring): mp::%::Union(%, "failed") + multiplicative? : (%,PositiveInteger) -> Boolean multiplicative?(a, n) == for i in 2..n repeat fl := factors(factor i)$Factored(Integer) @@ -43935,6 +44393,7 @@ DirichletRing(Coef: Ring): return false true + additive? : (%,PositiveInteger) -> Boolean additive?(a, n) == for i in 2..n repeat fl := factors(factor i)$Factored(Integer) @@ -44692,21 +45151,23 @@ Divisor(S:SetCategoryWithDegree):Exports == Implementation where Rep := List PT + incr : % -> % incr(d)== [ [ pt.gen , pt.exp + 1 ] for pt in d ] inOut: PT -> OutputForm - inOut(pp)== one?(pp.exp) => pp.gen :: OutputForm bl:OutputForm:= " " ::OutputForm (pp.exp :: OutputForm) * hconcat(bl,pp.gen :: OutputForm) + coerce : % -> OutputForm coerce(d:%):OutputForm== zero?(d) => ("0"::OutputForm) ll:List OutputForm:=[inOut df for df in d] reduce("+",ll) + reductum : % -> % reductum(d)== zero?(d) => d dl:Rep:= d pretend Rep @@ -44714,17 +45175,21 @@ Divisor(S:SetCategoryWithDegree):Exports == Implementation where empty?(dlr) => 0 dlr + head : % -> Record(gen: S,exp: Integer) head(d)== zero?(d) => error "Cannot take head of zero" dl:Rep:= d pretend Rep first dl + coerce : S -> % coerce(s:S) == [[s,1]$PT]::% + split : % -> List(%) split(a) == zero?(a) => [] [[r]::% for r in a] + coefficient : (S,%) -> Integer coefficient(s,a)== r:INT:=0 for pt in terms(a) repeat @@ -44732,33 +45197,42 @@ Divisor(S:SetCategoryWithDegree):Exports == Implementation where r:=pt.exp r - terms(a)==a::Rep + terms : % -> List(Record(gen: S,exp: Integer)) + terms(a) == a::Rep - 0==empty()$Rep + 0 : () -> % + 0 == empty()$Rep + supp : % -> List(S) supp(a)== aa:=terms(collect(a)) [p.gen for p in aa | ^zero?(p.exp)] + suppOfZero : % -> List(S) suppOfZero(a)== aa:=terms(collect(a)) [p.gen for p in aa | (p.exp) > 0 ] + suppOfPole : % -> List(S) suppOfPole(a)== aa:=terms(collect(a)) [p.gen for p in aa | p.exp < 0 ] + divOfZero : % -> % divOfZero(a)== aa:=terms(collect(a)) [p for p in aa | (p.exp) > 0 ]::% + divOfPole : % -> % divOfPole(a)== aa:=terms(collect(a)) [p for p in aa | p.exp < 0 ]::% + zero? : % -> Boolean zero?(a)== ((collect(a)::Rep)=empty()$Rep)::BOOLEAN + collect : % -> % collect(d)== a:=d::Rep empty?(a) => 0 @@ -44787,14 +45261,18 @@ Divisor(S:SetCategoryWithDegree):Exports == Implementation where t:=cons(ff,t) t::% + ?+? : (%,%) -> % a:% + b:% == collect(concat(a pretend Rep,b pretend Rep)) + ?-? : (%,%) -> % a:% - b:% == a + (-1)*b + -? : % -> % -a:% == (-1)*a + ?*? : (Integer,%) -> % n:INT * a:% == zero?(n) => 0 t:Rep:=empty() @@ -44802,13 +45280,16 @@ Divisor(S:SetCategoryWithDegree):Exports == Implementation where t:=concat(t,[ p.gen, n*p.exp]$PT) t::% + ?<=? : (%,%) -> Boolean a:% <= b:% == bma:= b - a effective? bma => true false + effective? : % -> Boolean effective?(a)== empty?(suppOfPole(a)) + degree : % -> Integer degree(d:%):Integer== reduce("+",[(p.exp * degree(p.gen)) for p in d @ Rep],0$INT) @@ -45861,13 +46342,13 @@ DoubleFloat(): Join(FloatingPointSystem, DifferentialRing, OpenMath, MER ==> Record(MANTISSA:Integer,EXPONENT:Integer) - manexp: % -> MER - + doubleFloatFormat : String -> String doubleFloatFormat(s:String): String == ss: String := format format := s ss + OMwrite : % -> String OMwrite(x: %): String == s: String := "" sp := OM_-STRINGTOSTRINGPTR(s)$Lisp @@ -45879,6 +46360,7 @@ DoubleFloat(): Join(FloatingPointSystem, DifferentialRing, OpenMath, s := OM_-STRINGPTRTOSTRING(sp)$Lisp @ String s + OMwrite : (%,Boolean) -> String OMwrite(x: %, wholeObj: Boolean): String == s: String := "" sp := OM_-STRINGTOSTRINGPTR(s)$Lisp @@ -45892,11 +46374,13 @@ DoubleFloat(): Join(FloatingPointSystem, DifferentialRing, OpenMath, s := OM_-STRINGPTRTOSTRING(sp)$Lisp @ String s + OMwrite : (OpenMathDevice,%) -> Void OMwrite(dev: OpenMathDevice, x: %): Void == OMputObject(dev) OMputFloat(dev, convert x) OMputEndObject(dev) + OMwrite : (OpenMathDevice,%,Boolean) -> Void OMwrite(dev: OpenMathDevice, x: %, wholeObj: Boolean): Void == if wholeObj then OMputObject(dev) @@ -45904,194 +46388,275 @@ DoubleFloat(): Join(FloatingPointSystem, DifferentialRing, OpenMath, if wholeObj then OMputEndObject(dev) + checkComplex : % -> % checkComplex(x:%):% == C_-TO_-R(x)$Lisp -- In AKCL we used to have to make the arguments to ASIN ACOS ACOSH ATANH -- complex to get the correct behaviour. --makeComplex(x: %):% == COMPLEX(x, 0$%)$Lisp + machineFraction : % -> Fraction(Integer) machineFraction(df:%):Fraction(Integer) == numer:Integer:=INTEGER_-DECODE_-FLOAT_-NUMERATOR(df)$Lisp denom:Integer:=INTEGER_-DECODE_-FLOAT_-DENOMINATOR(df)$Lisp sign:Integer:=INTEGER_-DECODE_-FLOAT_-SIGN(df)$Lisp sign*numer/denom + integerDecode : % -> List(Integer) integerDecode(df:%):List(Integer) == numer:Integer:=INTEGER_-DECODE_-FLOAT_-NUMERATOR(df)$Lisp exp:Integer:=INTEGER_-DECODE_-FLOAT_-EXPONENT(df)$Lisp sign:Integer:=INTEGER_-DECODE_-FLOAT_-SIGN(df)$Lisp [numer,exp,sign] - base() == FLOAT_-RADIX(0$%)$Lisp + base : () -> PositiveInteger + base() == FLOAT_-RADIX(0$%)$Lisp - mantissa x == manexp(x).MANTISSA + mantissa : % -> Integer + mantissa x == manexp(x).MANTISSA - exponent x == manexp(x).EXPONENT + exponent : % -> Integer + exponent x == manexp(x).EXPONENT - precision() == FLOAT_-DIGITS(0$%)$Lisp + precision : () -> PositiveInteger + precision() == FLOAT_-DIGITS(0$%)$Lisp - bits() == + bits : () -> PositiveInteger + bits() == base() = 2 => precision() base() = 16 => 4*precision() wholePart(precision()*log2(base()::%))::PositiveInteger - max() == MOST_-POSITIVE_-DOUBLE_-FLOAT$Lisp + max : () -> % + max() == MOST_-POSITIVE_-DOUBLE_-FLOAT$Lisp - min() == MOST_-NEGATIVE_-DOUBLE_-FLOAT$Lisp + min : () -> % + min() == MOST_-NEGATIVE_-DOUBLE_-FLOAT$Lisp + order : % -> Integer order(a) == precision() + exponent a - 1 - 0 == FLOAT(0$Lisp,MOST_-POSITIVE_-DOUBLE_-FLOAT$Lisp)$Lisp + 0 : () -> % + 0 == FLOAT(0$Lisp,MOST_-POSITIVE_-DOUBLE_-FLOAT$Lisp)$Lisp - 1 == FLOAT(1$Lisp,MOST_-POSITIVE_-DOUBLE_-FLOAT$Lisp)$Lisp -- rational approximation to e accurate to 23 digits + 1 : () -> % + 1 == FLOAT(1$Lisp,MOST_-POSITIVE_-DOUBLE_-FLOAT$Lisp)$Lisp + exp1 : () -> % exp1() == FLOAT(534625820200,MOST_-POSITIVE_-DOUBLE_-FLOAT$Lisp)$Lisp / _ FLOAT(196677847971,MOST_-POSITIVE_-DOUBLE_-FLOAT$Lisp)$Lisp + pi : () -> % pi() == FLOAT(PI$Lisp,MOST_-POSITIVE_-DOUBLE_-FLOAT$Lisp)$Lisp + coerce : % -> OutputForm coerce(x:%):OutputForm == x >= 0 => message(FORMAT(NIL$Lisp,format,x)$Lisp @ String) - (message(FORMAT(NIL$Lisp,format,-x)$Lisp @ String)) + convert : % -> InputForm convert(x:%):InputForm == convert(x pretend DoubleFloat)$InputForm - x < y == DFLESSTHAN(x,y)$Lisp + ? Boolean + x < y == DFLESSTHAN(x,y)$Lisp - - x == DFUNARYMINUS(x)$Lisp + -? : % -> % + - x == DFUNARYMINUS(x)$Lisp - x + y == DFADD(x,y)$Lisp + ?+? : (%,%) -> % + x + y == DFADD(x,y)$Lisp - x:% - y:% == DFSUBTRACT(x,y)$Lisp + ?-? : (%,%) -> % + x:% - y:% == DFSUBTRACT(x,y)$Lisp - x:% * y:% == DFMULTIPLY(x,y)$Lisp + ?*? : (%,%) -> % + x:% * y:% == DFMULTIPLY(x,y)$Lisp + ?*? : (Integer,%) -> % i:Integer * x:% == DFINTEGERMULTIPLY(i,x)$Lisp - max(x,y) == DFMAX(x,y)$Lisp + max : (%,%) -> % + max(x,y) == DFMAX(x,y)$Lisp - min(x,y) == DFMIN(x,y)$Lisp + min : (%,%) -> % + min(x,y) == DFMIN(x,y)$Lisp - x = y == DFEQL(x,y)$Lisp + ?=? : (%,%) -> Boolean + x = y == DFEQL(x,y)$Lisp + ?/? : (%,Integer) -> % x:% / i:Integer == DFINTEGERDIVIDE(x,i)$Lisp - sqrt x == checkComplex DFSQRT(x)$Lisp + sqrt : % -> % + sqrt x == checkComplex DFSQRT(x)$Lisp - log10 x == checkComplex DFLOG(x,10)$Lisp + log10 : % -> % + log10 x == checkComplex DFLOG(x,10)$Lisp + ?**? : (%,Integer) -> % x:% ** i:Integer == DFINTEGEREXPT(x,i)$Lisp + ?**? : (%,%) -> % x:% ** y:% == checkComplex DFEXPT(x,y)$Lisp + coerce : Integer -> % coerce(i:Integer):% == FLOAT(i,MOST_-POSITIVE_-DOUBLE_-FLOAT$Lisp)$Lisp - exp x == DFEXP(x)$Lisp + exp : % -> % + exp x == DFEXP(x)$Lisp - log x == checkComplex DFLOGE(x)$Lisp + log : % -> % + log x == checkComplex DFLOGE(x)$Lisp - log2 x == checkComplex DFLOG(x,2)$Lisp + log2 : % -> % + log2 x == checkComplex DFLOG(x,2)$Lisp - sin x == DFSIN(x)$Lisp + sin : % -> % + sin x == DFSIN(x)$Lisp - cos x == DFCOS(x)$Lisp + cos : % -> % + cos x == DFCOS(x)$Lisp - tan x == DFTAN(x)$Lisp + tan : % -> % + tan x == DFTAN(x)$Lisp - cot x == COT(x)$Lisp + cot : % -> % + cot x == COT(x)$Lisp - sec x == SEC(x)$Lisp + sec : % -> % + sec x == SEC(x)$Lisp - csc x == CSC(x)$Lisp + csc : % -> % + csc x == CSC(x)$Lisp - asin x == checkComplex DFASIN(x)$Lisp -- can be complex + asin : % -> % + asin x == checkComplex DFASIN(x)$Lisp -- can be complex - acos x == checkComplex DFACOS(x)$Lisp -- can be complex + acos : % -> % + acos x == checkComplex DFACOS(x)$Lisp -- can be complex - atan x == DFATAN(x)$Lisp + atan : (%,%) -> % + atan x == DFATAN(x)$Lisp - acsc x == checkComplex ACSC(x)$Lisp + acsc : % -> % + acsc x == checkComplex ACSC(x)$Lisp - acot x == ACOT(x)$Lisp + acot : % -> % + acot x == ACOT(x)$Lisp - asec x == checkComplex ASEC(x)$Lisp + asec : % -> % + asec x == checkComplex ASEC(x)$Lisp - sinh x == SINH(x)$Lisp + sinh : % -> % + sinh x == SINH(x)$Lisp - cosh x == COSH(x)$Lisp + cosh : % -> % + cosh x == COSH(x)$Lisp - tanh x == TANH(x)$Lisp + tanh : % -> % + tanh x == TANH(x)$Lisp - csch x == CSCH(x)$Lisp + csch : % -> % + csch x == CSCH(x)$Lisp - coth x == COTH(x)$Lisp + coth : % -> % + coth x == COTH(x)$Lisp - sech x == SECH(x)$Lisp + sech : % -> % + sech x == SECH(x)$Lisp - asinh x == DFASINH(x)$Lisp + asinh : % -> % + asinh x == DFASINH(x)$Lisp - acosh x == checkComplex DFACOSH(x)$Lisp -- can be complex + acosh : % -> % + acosh x == checkComplex DFACOSH(x)$Lisp -- can be complex - atanh x == checkComplex DFATANH(x)$Lisp -- can be complex + atanh : % -> % + atanh x == checkComplex DFATANH(x)$Lisp -- can be complex - acsch x == ACSCH(x)$Lisp + acsch : % -> % + acsch x == ACSCH(x)$Lisp - acoth x == checkComplex ACOTH(x)$Lisp + acoth : % -> % + acoth x == checkComplex ACOTH(x)$Lisp - asech x == checkComplex ASECH(x)$Lisp + asech : % -> % + asech x == checkComplex ASECH(x)$Lisp - x:% / y:% == DFDIVIDE(x,y)$Lisp + ?/? : (%,%) -> % + x:% / y:% == DFDIVIDE(x,y)$Lisp - negative? x == DFMINUSP(x)$Lisp + negative? : % -> Boolean + negative? x == DFMINUSP(x)$Lisp - zero? x == ZEROP(x)$Lisp + zero? : % -> Boolean + zero? x == ZEROP(x)$Lisp - hash x == SXHASH(x)$Lisp + hash : % -> Integer + hash x == SXHASH(x)$Lisp - recip(x) == (zero? x => "failed"; 1 / x) + recip : % -> Union(%,"failed") + recip(x) == (zero? x => "failed"; 1 / x) + differentiate : % -> % differentiate x == 0 - SFSFUN ==> DoubleFloatSpecialFunctions() + SFSFUN ==> DoubleFloatSpecialFunctions() - sfx ==> x pretend DoubleFloat + sfx ==> x pretend DoubleFloat - sfy ==> y pretend DoubleFloat + sfy ==> y pretend DoubleFloat - airyAi x == airyAi(sfx)$SFSFUN pretend % + airyAi : % -> % + airyAi x == airyAi(sfx)$SFSFUN pretend % - airyBi x == airyBi(sfx)$SFSFUN pretend % + airyBi : % -> % + airyBi x == airyBi(sfx)$SFSFUN pretend % - besselI(x,y) == besselI(sfx,sfy)$SFSFUN pretend % + besselI : (%,%) -> % + besselI(x,y) == besselI(sfx,sfy)$SFSFUN pretend % - besselJ(x,y) == besselJ(sfx,sfy)$SFSFUN pretend % + besselJ : (%,%) -> % + besselJ(x,y) == besselJ(sfx,sfy)$SFSFUN pretend % - besselK(x,y) == besselK(sfx,sfy)$SFSFUN pretend % + besselK : (%,%) -> % + besselK(x,y) == besselK(sfx,sfy)$SFSFUN pretend % - besselY(x,y) == besselY(sfx,sfy)$SFSFUN pretend % + besselY : (%,%) -> % + besselY(x,y) == besselY(sfx,sfy)$SFSFUN pretend % - Beta(x,y) == Beta(sfx,sfy)$SFSFUN pretend % + Beta : (%,%) -> % + Beta(x,y) == Beta(sfx,sfy)$SFSFUN pretend % - digamma x == digamma(sfx)$SFSFUN pretend % + digamma : % -> % + digamma x == digamma(sfx)$SFSFUN pretend % - Gamma x == Gamma(sfx)$SFSFUN pretend % + Gamma : % -> % + Gamma x == Gamma(sfx)$SFSFUN pretend % - polygamma(x,y) == + polygamma : (%,%) -> % + polygamma(x,y) == if (n := retractIfCan(x@%)@Union(Integer, "failed")) case Integer _ and n >= 0 then polygamma(n::Integer::NonNegativeInteger,sfy)$SFSFUN pretend % else error "polygamma: first argument should be a nonnegative integer" - wholePart x == TRUNCATE(x)$Lisp + wholePart : % -> Integer + wholePart x == TRUNCATE(x)$Lisp - float(ma,ex,b) == ma*(b::%)**ex + float : (Integer,Integer) -> % + float(ma,ex,b) == ma*(b::%)**ex + convert : % -> DoubleFloat convert(x:%):DoubleFloat == x pretend DoubleFloat + convert : % -> Float convert(x:%):Float == convert(x pretend DoubleFloat)$Float + rationalApproximation : (%,NonNegativeInteger) -> Fraction(Integer) rationalApproximation(x, d) == rationalApproximation(x, d, 10) + atan : % -> % atan(x,y) == x = 0 => y > 0 => pi()/2 @@ -46103,24 +46668,31 @@ DoubleFloat(): Join(FloatingPointSystem, DifferentialRing, OpenMath, if y < 0 then theta := - theta theta + retract : % -> Fraction(Integer) retract(x:%):Fraction(Integer) == rationalApproximation(x, (precision() - 1)::NonNegativeInteger, base()) + retractIfCan : % -> Union(Fraction(Integer),"failed") retractIfCan(x:%):Union(Fraction Integer, "failed") == rationalApproximation(x, (precision() - 1)::NonNegativeInteger, base()) + retract : % -> Integer retract(x:%):Integer == x = ((n := wholePart x)::%) => n error "Not an integer" + retractIfCan : % -> Union(Integer,"failed") retractIfCan(x:%):Union(Integer, "failed") == x = ((n := wholePart x)::%) => n "failed" + sign : % -> Integer sign(x) == retract FLOAT_-SIGN(x,1)$Lisp + abs : % -> % abs x == FLOAT_-SIGN(1,x)$Lisp + manexp: % -> MER manexp(x) == zero? x => [0,0] s := sign x; x := abs x @@ -46129,6 +46701,8 @@ DoubleFloat(): Join(FloatingPointSystem, DifferentialRing, OpenMath, two53:= base()**precision() [s*wholePart(two53 * me.man ),me.exp-precision()] + rationalApproximation : (%,NonNegativeInteger,NonNegativeInteger) -> + Fraction(Integer) rationalApproximation(f,d,b) == -- this algorithm expresses f as n / d where d = BASE ** k -- then all arithmetic operations are done over the integers @@ -46149,6 +46723,7 @@ DoubleFloat(): Join(FloatingPointSystem, DifferentialRing, OpenMath, (q0,q1) := (q1,q2) (s,t) := (t,r) + ?*? : (%,Fraction(Integer)) -> % x:% ** r:Fraction Integer == zero? x => zero? r => error "0**0 is undefined" @@ -46523,26 +47098,37 @@ DoubleFloatMatrix : MatrixCategory(DoubleFloat, Qnew1 ==> MAKE_-DOUBLE_-MATRIX1$Lisp + minRowIndex : % -> Integer minRowIndex x == 0 + minColIndex : % -> Integer minColIndex x == 0 + nrows : % -> NonNegativeInteger nrows x == Qnrows(x) + ncols : % -> NonNegativeInteger ncols x == Qncols(x) + maxRowIndex : % -> Integer maxRowIndex x == Qnrows(x) - 1 + maxColIndex : % -> Integer maxColIndex x == Qncols(x) - 1 + qelt : (%,Integer,Integer) -> DoubleFloat qelt(m, i, j) == Qelt2(m, i, j) + qsetelt! : (%,Integer,Integer,DoubleFloat) -> DoubleFloat qsetelt_!(m, i, j, r) == Qsetelt2(m, i, j, r) + empty : () -> % empty() == Qnew(0$Integer, 0$Integer) + qnew : (Integer,Integer) -> % qnew(rows, cols) == Qnew(rows, cols) + new : (NonNegativeInteger,NonNegativeInteger,DoubleFloat) -> % new(rows, cols, a) == Qnew1(rows, cols, a) *) @@ -46862,12 +47448,8 @@ DoubleFloatVector : VectorCategory DoubleFloat with new(n, x) == Qnew1(n, x) - qelt(x, i) == Qelt1(x, i) - elt(x:%, i:Integer) == Qelt1(x, i) - qsetelt_!(x, i, s) == Qsetelt1(x, i, s) - setelt(x : %, i : Integer, s : DoubleFloat) == Qsetelt1(x, i, s) fill_!(x, s) == @@ -46884,8 +47466,10 @@ DoubleFloatVector : VectorCategory DoubleFloat with Qsetelt1 ==> DSETELT$Lisp + qelt : (%,Integer) -> DoubleFloat qelt(x, i) == Qelt1(x, i) + qsetelt! : (%,Integer,DoubleFloat) -> DoubleFloat qsetelt_!(x, i, s) == Qsetelt1(x, i, s) Qsize ==> DLEN$Lisp @@ -46894,25 +47478,29 @@ DoubleFloatVector : VectorCategory DoubleFloat with Qnew1 ==> MAKE_-DOUBLE_-VECTOR1$Lisp - #x == Qsize x - - minIndex x == 0 - - empty() == Qnew(0$Lisp) + #? : % -> NonNegativeInteger + #x == Qsize x - qnew(n) == Qnew(n) + minIndex : % -> Integer + minIndex x == 0 - new(n, x) == Qnew1(n, x) + empty : () -> % + empty() == Qnew(0$Lisp) - qelt(x, i) == Qelt1(x, i) + qnew : Integer -> % + qnew(n) == Qnew(n) - elt(x:%, i:Integer) == Qelt1(x, i) + new : (NonNegativeInteger,DoubleFloat) -> % + new(n, x) == Qnew1(n, x) - qsetelt_!(x, i, s) == Qsetelt1(x, i, s) + ?.? : (%,Integer) -> DoubleFloat + elt(x:%, i:Integer) == Qelt1(x, i) + setelt : (%,Integer,DoubleFloat) -> DoubleFloat setelt(x : %, i : Integer, s : DoubleFloat) == Qsetelt1(x, i, s) - fill_!(x, s) == + fill! : (%,DoubleFloat) -> % + fill_!(x, s) == for i in 0..((Qsize(x)) - 1) repeat Qsetelt1(x, i, s) x @@ -47273,54 +47861,74 @@ DrawOption(): Exports == Implementation where Rep := Record(keyword:Symbol, value:Any) - length:List SEG -> NonNegativeInteger -- these lists will become tuples in a later version + length:List SEG -> NonNegativeInteger length tup == # tup - lengthR:List Segment Fraction Integer -> NonNegativeInteger -- these lists will become tuples in a later version + lengthR:List Segment Fraction Integer -> NonNegativeInteger lengthR tup == # tup - lengthI:List Integer -> NonNegativeInteger -- these lists will become tuples in a later version + lengthI:List Integer -> NonNegativeInteger lengthI tup == # tup + viewpoint : Record(theta: DoubleFloat,phi: DoubleFloat, + scale: DoubleFloat,scaleX: DoubleFloat, + scaleY: DoubleFloat,scaleZ: DoubleFloat, + deltaX: DoubleFloat,deltaY: DoubleFloat) -> % viewpoint vp == ["viewpoint"::Symbol, vp::Any] + title : String -> % title s == ["title"::Symbol, s::Any] + style : String -> % style s == ["style"::Symbol, s::Any] + toScale : Boolean -> % toScale b == ["toScale"::Symbol, b::Any] + clip : Boolean -> % clip(b:Boolean) == ["clipBoolean"::Symbol, b::Any] + adaptive : Boolean -> % adaptive b == ["adaptive"::Symbol, b::Any] + pointColor : Float -> % pointColor(x:Float) == ["pointColorFloat"::Symbol, x::Any] + pointColor : Palette -> % pointColor(c:PAL) == ["pointColorPalette"::Symbol, c::Any] + curveColor : Float -> % curveColor(x:Float) == ["curveColorFloat"::Symbol, x::Any] + curveColor : Palette -> % curveColor(c:PAL) == ["curveColorPalette"::Symbol, c::Any] + colorFunction : (DoubleFloat -> DoubleFloat) -> % colorFunction(f:SF -> SF) == ["colorFunction1"::Symbol, f::Any] + colorFunction : ((DoubleFloat,DoubleFloat) -> DoubleFloat) -> % colorFunction(f:(SF,SF) -> SF) == ["colorFunction2"::Symbol, f::Any] + colorFunction : ((DoubleFloat,DoubleFloat,DoubleFloat) -> DoubleFloat) -> % colorFunction(f:(SF,SF,SF) -> SF) == ["colorFunction3"::Symbol, f::Any] + clip : List(Segment(Float)) -> % clip(tup:List SEG) == length tup > 3 => error "clip: at most 3 segments may be specified" ["clipSegment"::Symbol, tup::Any] + coordinates : (Point(DoubleFloat) -> Point(DoubleFloat)) -> % coordinates f == ["coordinates"::Symbol, f::Any] + tubeRadius : Float -> % tubeRadius x == ["tubeRadius"::Symbol, x::Any] + range : List(Segment(Float)) -> % range(tup:List Segment Float) == ((n := length tup) > 3) => error "range: at most 3 segments may be specified" @@ -47328,6 +47936,7 @@ DrawOption(): Exports == Implementation where error "range: at least 2 segments may be specified" ["rangeFloat"::Symbol, tup::Any] + range : List(Segment(Fraction(Integer))) -> % range(tup:List Segment Fraction Integer) == ((n := lengthR tup) > 3) => error "range: at most 3 segments may be specified" @@ -47335,29 +47944,40 @@ DrawOption(): Exports == Implementation where error "range: at least 2 segments may be specified" ["rangeRat"::Symbol, tup::Any] - ranges s == ["ranges"::Symbol, s::Any] + ranges : List(Segment(Float)) -> % + ranges s == ["ranges"::Symbol, s::Any] - space s == ["space"::Symbol, s::Any] + space : ThreeSpace(DoubleFloat) -> % + space s == ["space"::Symbol, s::Any] - var1Steps s == ["var1Steps"::Symbol, s::Any] + var1Steps : PositiveInteger -> % + var1Steps s == ["var1Steps"::Symbol, s::Any] - var2Steps s == ["var2Steps"::Symbol, s::Any] + var2Steps : PositiveInteger -> % + var2Steps s == ["var2Steps"::Symbol, s::Any] - tubePoints s == ["tubePoints"::Symbol, s::Any] + tubePoints : PositiveInteger -> % + tubePoints s == ["tubePoints"::Symbol, s::Any] - coord s == ["coord"::Symbol, s::Any] + coord : (Point(DoubleFloat) -> Point(DoubleFloat)) -> % + coord s == ["coord"::Symbol, s::Any] - unit s == ["unit"::Symbol, s::Any] + unit : List(Float) -> % + unit s == ["unit"::Symbol, s::Any] + coerce : % -> OutputForm coerce(x:%):OutputForm == x.keyword::OutputForm = x.value::OutputForm - x:% = y:% == x.keyword = y.keyword and x.value = y.value + ?=? : (%,%) -> Boolean + x:% = y:% == x.keyword = y.keyword and x.value = y.value + option? : (List(%),Symbol) -> Boolean option?(l, s) == for x in l repeat x.keyword = s => return true false + option : (List(%),Symbol) -> Union(Any,"failed") option(l, s) == for x in l repeat x.keyword = s => return(x.value) @@ -47512,6 +48132,11 @@ d01ajfAnnaType(): NumericalIntegrationCategory == Result add Rep:=Result import Rep, NagIntegrationPackage, d01AgentsPackage + measure : (RoutinesTable, + Record(var: Symbol,fn: Expression(DoubleFloat),range: + Segment(OrderedCompletion(DoubleFloat)), + abserr: DoubleFloat,relerr: DoubleFloat)) -> + Record(measure: Float,explanations: String,extra: Result) measure(R:RT,args:NIA) == ext:Result := empty()$Result pp:SDF := singularitiesOf(args) @@ -47521,6 +48146,10 @@ d01ajfAnnaType(): NumericalIntegrationCategory == Result add [getMeasure(R,d01ajf :: S)$RT, "The general routine d01ajf is our default",ext] + numericalIntegration : (Record(var: Symbol,fn: Expression(DoubleFloat), + range: Segment(OrderedCompletion(DoubleFloat)), + abserr: DoubleFloat,relerr: DoubleFloat),Result) -> + Result numericalIntegration(args:NIA,hints:Result) == ArgsFn := map(x+->convert(x)$DF,args.fn)$EF2(DF,Float) b:Float := getButtonValue("d01ajf","functionEvaluations")$AttributeButtons @@ -47684,6 +48313,10 @@ d01akfAnnaType(): NumericalIntegrationCategory == Result add Rep:=Result import Rep, d01AgentsPackage, NagIntegrationPackage + measure : (RoutinesTable,Record(var: Symbol,fn: Expression(DoubleFloat), + range: Segment(OrderedCompletion(DoubleFloat)), + abserr: DoubleFloat,relerr: DoubleFloat)) -> + Record(measure: Float,explanations: String,extra: Result) measure(R:RT,args:NIA) == ext:Result := empty()$Result pp:SDF := singularitiesOf(args) @@ -47698,6 +48331,10 @@ d01akfAnnaType(): NumericalIntegrationCategory == Result add m > 0.5 => [m,"d01akf: The expression shows little oscillation",ext] [m,"d01akf: The expression shows little or no oscillation",ext] + numericalIntegration : (Record(var: Symbol,fn: Expression(DoubleFloat), + range: Segment(OrderedCompletion(DoubleFloat)), + abserr: DoubleFloat,relerr: DoubleFloat),Result) -> + Result numericalIntegration(args:NIA,hints:Result) == ArgsFn := map(x+->convert(x)$DF,args.fn)$EF2(DF,Float) b:Float := getButtonValue("d01akf","functionEvaluations")$AttributeButtons @@ -47872,6 +48509,10 @@ d01alfAnnaType(): NumericalIntegrationCategory == Result add Rep:=Result import Rep, d01AgentsPackage, NagIntegrationPackage + measure : (RoutinesTable,Record(var: Symbol,fn: Expression(DoubleFloat), + range: Segment(OrderedCompletion(DoubleFloat)), + abserr: DoubleFloat,relerr: DoubleFloat)) -> + Record(measure: Float,explanations: String,extra: Result) measure(R:RT,args:NIA) == ext:Result := empty()$Result streamOfZeros:SDF := singularitiesOf(args) @@ -47892,6 +48533,10 @@ d01alfAnnaType(): NumericalIntegrationCategory == Result add [m, st, ext] [0.0, "d01alf: A list of suitable singularities has not been found", ext] + numericalIntegration : (Record(var: Symbol,fn: Expression(DoubleFloat), + range: Segment(OrderedCompletion(DoubleFloat)), + abserr: DoubleFloat,relerr: DoubleFloat),Result) -> + Result numericalIntegration(args:NIA,hints:Result) == la:Any := coerce(search((d01alfextra@S),hints)$Result)@Any listOfZeros:LDF := retract(la)$AnyFunctions1(LDF) @@ -48069,6 +48714,10 @@ d01amfAnnaType(): NumericalIntegrationCategory == Result add Rep:=Result import Rep, d01AgentsPackage, NagIntegrationPackage + measure : (RoutinesTable,Record(var: Symbol,fn: Expression(DoubleFloat), + range: Segment(OrderedCompletion(DoubleFloat)), + abserr: DoubleFloat,relerr: DoubleFloat)) -> + Record(measure: Float,explanations: String,extra: Result) measure(R:RT,args:NIA) == ext:Result := empty()$Result Range:=rangeIsFinite(args) @@ -48080,6 +48729,10 @@ d01amfAnnaType(): NumericalIntegrationCategory == Result add "integral is infinite or semi-infinite and d01transform cannot " "do better than using general routines",ext] + numericalIntegration : (Record(var: Symbol,fn: Expression(DoubleFloat), + range: Segment(OrderedCompletion(DoubleFloat)), + abserr: DoubleFloat,relerr: DoubleFloat),Result) -> + Result numericalIntegration(args:NIA,hints:Result) == r:INT bound:DF @@ -48265,6 +48918,10 @@ d01anfAnnaType(): NumericalIntegrationCategory == Result add Rep:=Result import Rep, d01WeightsPackage, d01AgentsPackage, NagIntegrationPackage + measure : (RoutinesTable,Record(var: Symbol,fn: Expression(DoubleFloat), + range: Segment(OrderedCompletion(DoubleFloat)), + abserr: DoubleFloat,relerr: DoubleFloat)) -> + Record(measure: Float,explanations: String,extra: Result) measure(R:RT,args:NIA) == ext:Result := empty()$Result weight:Union(Record(op:BOP,w:DF),"failed") := @@ -48280,6 +48937,10 @@ d01anfAnnaType(): NumericalIntegrationCategory == Result add [getMeasure(R,d01anf@S)$RT, "d01anf: The expression has a suitable weight:- " ws, ext] + numericalIntegration : (Record(var: Symbol,fn: Expression(DoubleFloat), + range: Segment(OrderedCompletion(DoubleFloat)), + abserr: DoubleFloat,relerr: DoubleFloat),Result) -> + Result numericalIntegration(args:NIA,hints:Result) == a:INT r:Any := coerce(search((d01anfextra@S),hints)$Result)@Any @@ -48476,6 +49137,10 @@ d01apfAnnaType(): NumericalIntegrationCategory == Result add Rep:=Result import Rep, NagIntegrationPackage, d01AgentsPackage, d01WeightsPackage + measure : (RoutinesTable,Record(var: Symbol,fn: Expression(DoubleFloat), + range: Segment(OrderedCompletion(DoubleFloat)), + abserr: DoubleFloat,relerr: DoubleFloat)) -> + Record(measure: Float,explanations: String,extra: Result) measure(R:RT,args:NIA) == ext:Result := empty()$Result d := (c := 0$DF) @@ -48493,8 +49158,11 @@ d01apfAnnaType(): NumericalIntegrationCategory == Result add df2st(d) " and l = " string(l)$ST [getMeasure(R,d01apf@S)$RT, st, ext] + numericalIntegration : (Record(var: Symbol,fn: Expression(DoubleFloat), + range: Segment(OrderedCompletion(DoubleFloat)), + abserr: DoubleFloat,relerr: DoubleFloat),Result) -> + Result numericalIntegration(args:NIA,hints:Result) == - Var:EDF := coerce(args.var)$EDF la:Any := coerce(search((d01apfextra@S),hints)$Result)@Any list:LDF := retract(la)$AnyFunctions1(LDF) @@ -48691,6 +49359,10 @@ d01aqfAnnaType(): NumericalIntegrationCategory == Result add Rep:=Result import Rep, d01AgentsPackage, NagIntegrationPackage + measure : (RoutinesTable,Record(var: Symbol,fn: Expression(DoubleFloat), + range: Segment(OrderedCompletion(DoubleFloat)), + abserr: DoubleFloat,relerr: DoubleFloat)) -> + Record(measure: Float,explanations: String,extra: Result) measure(R:RT,args:NIA) == ext:Result := empty()$Result Den := denominator(args.fn) @@ -48714,6 +49386,10 @@ d01aqfAnnaType(): NumericalIntegrationCategory == Result add [0.0,"d01aqf: More than one factor has been found and so does not " "have a suitable weight function",ext] + numericalIntegration : (Record(var: Symbol,fn: Expression(DoubleFloat), + range: Segment(OrderedCompletion(DoubleFloat)), + abserr: DoubleFloat,relerr: DoubleFloat),Result) -> + Result numericalIntegration(args:NIA,hints:Result) == Args := copy args ca:Any := coerce(search((d01aqfextra@S),hints)$Result)@Any @@ -48902,6 +49578,10 @@ d01asfAnnaType(): NumericalIntegrationCategory == Result add Rep:=Result import Rep, d01WeightsPackage, d01AgentsPackage, NagIntegrationPackage + measure : (RoutinesTable,Record(var: Symbol,fn: Expression(DoubleFloat), + range: Segment(OrderedCompletion(DoubleFloat)), + abserr: DoubleFloat,relerr: DoubleFloat)) -> + Record(measure: Float,explanations: String,extra: Result) measure(R:RT,args:NIA) == ext:Result := empty()$Result Range := rangeIsFinite(args) @@ -48920,6 +49600,10 @@ d01asfAnnaType(): NumericalIntegrationCategory == Result add [getMeasure(R,d01asf@S)$RT, "d01asf: A suitable weight has been found:- " ws, ext] + numericalIntegration : (Record(var: Symbol,fn: Expression(DoubleFloat), + range: Segment(OrderedCompletion(DoubleFloat)), + abserr: DoubleFloat,relerr: DoubleFloat),Result) -> + Result numericalIntegration(args:NIA,hints:Result) == i:INT r:Any := coerce(search((d01asfextra@S),hints)$Result)@Any @@ -49101,6 +49785,10 @@ d01fcfAnnaType(): NumericalIntegrationCategory == Result add Rep:=Result import Rep, d01AgentsPackage, NagIntegrationPackage + measure : (RoutinesTable,Record(var: Symbol,fn: Expression(DoubleFloat), + range: Segment(OrderedCompletion(DoubleFloat)), + abserr: DoubleFloat,relerr: DoubleFloat)) -> + Record(measure: Float,explanations: String,extra: Result) measure(R:RT,args:MDNIA) == ext:Result := empty()$Result segs := args.range @@ -49111,6 +49799,10 @@ d01fcfAnnaType(): NumericalIntegrationCategory == Result add [0.0,"d01fcf is not a suitable routine for infinite integrals",ext] [getMeasure(R,d01fcf@S)$RT, "Recommended is d01fcf", ext] + numericalIntegration : (Record(var: Symbol,fn: Expression(DoubleFloat), + range: Segment(OrderedCompletion(DoubleFloat)), + abserr: DoubleFloat,relerr: DoubleFloat),Result) -> + Result numericalIntegration(args:MDNIA,hints:Result) == import Integer segs := args.range @@ -49293,6 +49985,10 @@ d01gbfAnnaType(): NumericalIntegrationCategory == Result add Rep:=Result import Rep, d01AgentsPackage, NagIntegrationPackage + measure : (RoutinesTable,Record(var: Symbol,fn: Expression(DoubleFloat), + range: Segment(OrderedCompletion(DoubleFloat)), + abserr: DoubleFloat,relerr: DoubleFloat)) -> + Record(measure: Float,explanations: String,extra: Result) measure(R:RT,args:MDNIA) == ext:Result := empty()$Result (rel := args.relerr) < 0.01 :: DF => @@ -49305,6 +50001,10 @@ d01gbfAnnaType(): NumericalIntegrationCategory == Result add [0.0,"d01gbf is not a suitable routine for infinite integrals",ext] [getMeasure(R,d01gbf@S)$RT, "Recommended is d01gbf", ext] + numericalIntegration : (Record(var: Symbol,fn: Expression(DoubleFloat), + range: Segment(OrderedCompletion(DoubleFloat)), + abserr: DoubleFloat,relerr: DoubleFloat),Result) -> + Result numericalIntegration(args:MDNIA,hints:Result) == import Integer segs := args.range @@ -49563,20 +50263,24 @@ d01TransformFunctionType():NumericalIntegrationCategory == Result add Rep:=Result import d01AgentsPackage,Rep + rec2any : (Record(str:ST,fn:EDF,range:SOCDF) -> Any rec2any(re:Record(str:ST,fn:EDF,range:SOCDF)):Any == coerce(re)$AnyFunctions1(Record(str:ST,fn:EDF,range:SOCDF)) + changeName : (Result,ST) -> Result changeName(ans:Result,name:ST):Result == sy:S := coerce(name "Answer")$S anyAns:Any := coerce(ans)$AnyFunctions1(Result) construct([[sy,anyAns]])$Result + getIntegral : (NIA,HINT) -> Result getIntegral(args:NIA,hint:HINT) : Result == Args := copy args Args.fn := hint.fn Args.range := hint.range integrate(Args::NumericalIntegrationProblem)$AnnaNumericalIntegrationPackage + transformFunction : NIA -> NIA transformFunction(args:NIA) : NIA == Args := copy args Var := Args.var :: EFI -- coerce Symbol to EFI @@ -49589,11 +50293,13 @@ d01TransformFunctionType():NumericalIntegrationCategory == Result add Args.fn:= map(x+->convert(x)$FI,Afn)$EF2(FI,DF) Args + doit : (SOCDF,NIA) -> MS doit(seg:SOCDF,args:NIA):MS == Args := copy args Args.range := seg measure(Args::NumericalIntegrationProblem)$AnnaNumericalIntegrationPackage + transform : (Boolean,NIA) -> Measure transform(c:Boolean,args:NIA):Measure == if c then l := coerce(recip(lo(args.range)))@OCDF @@ -49611,6 +50317,7 @@ d01TransformFunctionType():NumericalIntegrationCategory == Result add extr:Result := construct([ex])$Result [m.measure,out1,extr] + split : (PI,NIA) -> Measure split(c:PI,args:NIA):Measure == Args := copy args Args.relerr := Args.relerr/2 @@ -49641,6 +50348,10 @@ d01TransformFunctionType():NumericalIntegrationCategory == Result add extr:Result := construct([ex])$Result [m,out1,extr] + measure : (RoutinesTable,Record(var: Symbol,fn: Expression(DoubleFloat), + range: Segment(OrderedCompletion(DoubleFloat)), + abserr: DoubleFloat,relerr: DoubleFloat)) -> + Record(measure: Float,explanations: String,extra: Result) measure(R:RoutinesTable,args:NIA) == Range:=rangeIsFinite(args) Range case bothInfinite => split(1,args) @@ -49653,6 +50364,10 @@ d01TransformFunctionType():NumericalIntegrationCategory == Result add transform(false,args) split(3,args) + numericalIntegration : (Record(var: Symbol,fn: Expression(DoubleFloat), + range: Segment(OrderedCompletion(DoubleFloat)), + abserr: DoubleFloat,relerr: DoubleFloat),Result) -> + Result numericalIntegration(args:NIA,hints:Result) == mainResult:DF := mainAbserr:DF := 0$DF ans:Result := empty()$Result @@ -49874,26 +50589,35 @@ d02bbfAnnaType():OrdinaryDifferentialEquationsSolverCategory == Result add import d02AgentsPackage, NagOrdinaryDifferentialEquationsPackage import AttributeButtons + accuracyCF : ODEA -> F accuracyCF(ode:ODEA):F == b := getButtonValue("d02bbf","accuracy")$AttributeButtons accuracyIntensityValue := combineFeatureCompatibility(b,accuracyIF(ode)) accuracyIntensityValue > 0.999 => 0$F 0.8*exp(-((10*accuracyIntensityValue)**3)$F/266)$F + stiffnessCF : F -> F stiffnessCF(stiffnessIntensityValue:F):F == b := getButtonValue("d02bbf","stiffness")$AttributeButtons 0.5*exp(-(2*combineFeatureCompatibility(b,stiffnessIntensityValue))**2)$F + stabilityCF : F -> F stabilityCF(stabilityIntensityValue:F):F == b := getButtonValue("d02bbf","stability")$AttributeButtons 0.5 * cos(combineFeatureCompatibility(b,stabilityIntensityValue))$F + expenseOfEvaluationCF : ODEA -> F expenseOfEvaluationCF(ode:ODEA):F == b := getButtonValue("d02bbf","expense")$AttributeButtons expenseOfEvaluationIntensityValue := combineFeatureCompatibility(b,expenseOfEvaluationIF(ode)) 0.35+0.2*exp(-(2.0*expenseOfEvaluationIntensityValue)**3)$F + measure : (RoutinesTable,Record(xinit: DoubleFloat,xend: DoubleFloat, + fn: Vector(Expression(DoubleFloat)),yinit: List(DoubleFloat), + intvals: List(DoubleFloat),g: Expression(DoubleFloat), + abserr: DoubleFloat,relerr: DoubleFloat)) -> + Record(measure: Float,explanations: String) measure(R:RoutinesTable,args:ODEA) == m := getMeasure(R,d02bbf :: Symbol)$RoutinesTable ssf := stiffnessAndStabilityOfODEIF args @@ -49903,6 +50627,11 @@ d02bbfAnnaType():OrdinaryDifferentialEquationsSolverCategory == Result add stabilityCF(ssf.stabilityFactor)]) [m,"Runge-Kutta Merson method"] + ODESolve : Record(xinit: DoubleFloat,xend: DoubleFloat, + fn: Vector(Expression(DoubleFloat)), + yinit: List(DoubleFloat),intvals: List(DoubleFloat), + g: Expression(DoubleFloat),abserr: DoubleFloat, + relerr: DoubleFloat) -> Result ODESolve(ode:ODEA) == i:LDF := ode.intvals M := inc(# i)$INT @@ -50110,26 +50839,35 @@ d02bhfAnnaType():OrdinaryDifferentialEquationsSolverCategory == Result add import d02AgentsPackage, NagOrdinaryDifferentialEquationsPackage import AttributeButtons + accuracyCF : ODEA -> F accuracyCF(ode:ODEA):F == b := getButtonValue("d02bhf","accuracy")$AttributeButtons accuracyIntensityValue := combineFeatureCompatibility(b,accuracyIF(ode)) accuracyIntensityValue > 0.999 => 0$F 0.8*exp(-((10*accuracyIntensityValue)**3)$F/266)$F + stiffnessCF : F -> F stiffnessCF(stiffnessIntensityValue:F):F == b := getButtonValue("d02bhf","stiffness")$AttributeButtons 0.5*exp(-(2*combineFeatureCompatibility(b,stiffnessIntensityValue))**2)$F + stabilityCF : F -> F stabilityCF(stabilityIntensityValue:F):F == b := getButtonValue("d02bhf","stability")$AttributeButtons 0.5 * cos(combineFeatureCompatibility(b,stabilityIntensityValue))$F + expenseOfEvaluationCF : ODEA -> F expenseOfEvaluationCF(ode:ODEA):F == b := getButtonValue("d02bhf","expense")$AttributeButtons expenseOfEvaluationIntensityValue := combineFeatureCompatibility(b,expenseOfEvaluationIF(ode)) 0.35+0.2*exp(-(2.0*expenseOfEvaluationIntensityValue)**3)$F + measure : (RoutinesTable,Record(xinit: DoubleFloat,xend: DoubleFloat, + fn: Vector(Expression(DoubleFloat)),yinit: List(DoubleFloat), + intvals: List(DoubleFloat),g: Expression(DoubleFloat), + abserr: DoubleFloat,relerr: DoubleFloat)) -> + Record(measure: Float,explanations: String) measure(R:RoutinesTable,args:ODEA) == m := getMeasure(R,d02bhf :: Symbol)$RoutinesTable ssf := stiffnessAndStabilityOfODEIF args @@ -50139,6 +50877,10 @@ d02bhfAnnaType():OrdinaryDifferentialEquationsSolverCategory == Result add stabilityCF(ssf.stabilityFactor)]) [m,"Runge-Kutta Merson method"] + ODESolve : Record(xinit: DoubleFloat,xend: DoubleFloat, + fn: Vector(Expression(DoubleFloat)),yinit: List(DoubleFloat), + intvals: List(DoubleFloat),g: Expression(DoubleFloat), + abserr: DoubleFloat,relerr: DoubleFloat) -> Result ODESolve(ode:ODEA) == irelab := 0$INT if positive?(a := ode.abserr) then @@ -50336,12 +51078,14 @@ d02cjfAnnaType():OrdinaryDifferentialEquationsSolverCategory == Result add import d02AgentsPackage, NagOrdinaryDifferentialEquationsPackage + accuracyCF : ODEA -> F accuracyCF(ode:ODEA):F == b := getButtonValue("d02cjf","accuracy")$AttributeButtons accuracyIntensityValue := combineFeatureCompatibility(b,accuracyIF(ode)) accuracyIntensityValue > 0.9999 => 0$F 0.6*(cos(accuracyIntensityValue*(pi()$F)/2)$F)**0.755 + stiffnessCF : ODEA -> F stiffnessCF(ode:ODEA):F == b := getButtonValue("d02cjf","stiffness")$AttributeButtons ssf := stiffnessAndStabilityOfODEIF ode @@ -50349,11 +51093,20 @@ d02cjfAnnaType():OrdinaryDifferentialEquationsSolverCategory == Result add combineFeatureCompatibility(b,ssf.stiffnessFactor) 0.5*exp(-(1.1*stiffnessIntensityValue)**3)$F + measure : (RoutinesTable,Record(xinit: DoubleFloat,xend: DoubleFloat, + fn: Vector(Expression(DoubleFloat)),yinit: List(DoubleFloat), + intvals: List(DoubleFloat),g: Expression(DoubleFloat), + abserr: DoubleFloat,relerr: DoubleFloat)) -> + Record(measure: Float,explanations: String) measure(R:RoutinesTable,args:ODEA) == m := getMeasure(R,d02cjf :: Symbol)$RoutinesTable m := combineFeatureCompatibility(m,[accuracyCF(args), stiffnessCF(args)]) [m,"Adams method"] + ODESolve : Record(xinit: DoubleFloat,xend: DoubleFloat, + fn: Vector(Expression(DoubleFloat)),yinit: List(DoubleFloat), + intvals: List(DoubleFloat),g: Expression(DoubleFloat), + abserr: DoubleFloat,relerr: DoubleFloat) -> Result ODESolve(ode:ODEA) == i:LDF := ode.intvals if empty?(i) then @@ -50581,18 +51334,21 @@ d02ejfAnnaType():OrdinaryDifferentialEquationsSolverCategory == Result add import d02AgentsPackage, NagOrdinaryDifferentialEquationsPackage + accuracyCF : ODEA -> F accuracyCF(ode:ODEA):F == b := getButtonValue("d02ejf","accuracy")$AttributeButtons accuracyIntensityValue := combineFeatureCompatibility(b,accuracyIF(ode)) accuracyIntensityValue > 0.999 => 0$F 0.5*exp(-((10*accuracyIntensityValue)**3)$F/250)$F + intermediateResultsCF : ODEA -> F intermediateResultsCF(ode:ODEA):F == intermediateResultsIntensityValue := intermediateResultsIF(ode) i := 0.5 * exp(-(intermediateResultsIntensityValue/1.649)**3)$F a := accuracyCF(ode) i+(0.5-i)*(0.5-a) + stabilityCF : ODEA -> F stabilityCF(ode:ODEA):F == b := getButtonValue("d02ejf","stability")$AttributeButtons ssf := stiffnessAndStabilityOfODEIF ode @@ -50600,15 +51356,22 @@ d02ejfAnnaType():OrdinaryDifferentialEquationsSolverCategory == Result add combineFeatureCompatibility(b,ssf.stabilityFactor) 0.68 - 0.5 * exp(-(stabilityIntensityValue)**3)$F + expenseOfEvaluationCF : ODEA -> F expenseOfEvaluationCF(ode:ODEA):F == b := getButtonValue("d02ejf","expense")$AttributeButtons expenseOfEvaluationIntensityValue := combineFeatureCompatibility(b,expenseOfEvaluationIF(ode)) 0.5 * exp(-(1.7*expenseOfEvaluationIntensityValue)**3)$F + systemSizeCF : ODEA -> F systemSizeCF(args:ODEA):F == (1$F - systemSizeIF(args))/2.0 + measure : (RoutinesTable,Record(xinit: DoubleFloat,xend: DoubleFloat, + fn: Vector(Expression(DoubleFloat)),yinit: List(DoubleFloat), + intvals: List(DoubleFloat),g: Expression(DoubleFloat), + abserr: DoubleFloat,relerr: DoubleFloat)) -> + Record(measure: Float,explanations: String) measure(R:RoutinesTable,args:ODEA) == arg := copy args m := getMeasure(R,d02ejf :: Symbol)$RoutinesTable @@ -50619,6 +51382,10 @@ d02ejfAnnaType():OrdinaryDifferentialEquationsSolverCategory == Result add stabilityCF(arg)]) [m,"BDF method for Stiff Systems"] + ODESolve : Record(xinit: DoubleFloat,xend: DoubleFloat, + fn: Vector(Expression(DoubleFloat)),yinit: List(DoubleFloat), + intvals: List(DoubleFloat),g: Expression(DoubleFloat), + abserr: DoubleFloat,relerr: DoubleFloat) -> Result ODESolve(ode:ODEA) == i:LDF := ode.intvals m := inc(# i)$INT @@ -50816,6 +51583,12 @@ d03eefAnnaType():PartialDifferentialEquationsSolverCategory == Result add import d03AgentsPackage, NagPartialDifferentialEquationsPackage import ExpertSystemToolsPackage + measure : (RoutinesTable,Record(pde: List(Expression(DoubleFloat)), + constraints: List(Record(start: DoubleFloat,finish: DoubleFloat, + grid: NonNegativeInteger,boundaryType: Integer, + dStart: Matrix(DoubleFloat),dFinish: Matrix(DoubleFloat))), + f: List(List(Expression(DoubleFloat))),st: String,tol: DoubleFloat)) -> + Record(measure: Float,explanations: String) measure(R:RoutinesTable,args:PDEB) == (# (args.constraints) > 2)@Boolean => [0$F,"d03eef/d03edf is unsuitable for PDEs of order more than 2"] @@ -50824,6 +51597,12 @@ d03eefAnnaType():PartialDifferentialEquationsSolverCategory == Result add [m,"d03eef/d03edf is suitable"] [0$F,"d03eef/d03edf is unsuitable for hyperbolic or parabolic PDEs"] + PDESolve : Record(pde: List(Expression(DoubleFloat)), + constraints: List(Record(start: DoubleFloat,finish: DoubleFloat, + grid: NonNegativeInteger,boundaryType: Integer, + dStart: Matrix(DoubleFloat),dFinish: Matrix(DoubleFloat))), + f: List(List(Expression(DoubleFloat))),st: String,tol: DoubleFloat) -> + Result PDESolve(args:PDEB) == xcon := first(args.constraints) ycon := second(args.constraints) @@ -50961,8 +51740,8 @@ d03fafAnnaType():PartialDifferentialEquationsSolverCategory == Result add \end{chunk} -\begin{chunk}{COQ D03FAFAs} -(* domain D03FAFAs *) +\begin{chunk}{COQ D03FAFA} +(* domain D03FAFA *) (* -- 3D Helmholtz PDE LEDF ==> List Expression DoubleFloat @@ -50985,6 +51764,12 @@ d03fafAnnaType():PartialDifferentialEquationsSolverCategory == Result add import d03AgentsPackage, NagPartialDifferentialEquationsPackage import ExpertSystemToolsPackage + measure : (RoutinesTable,Record(pde: List(Expression(DoubleFloat)), + constraints: List(Record(start: DoubleFloat,finish: DoubleFloat, + grid: NonNegativeInteger,boundaryType: Integer, + dStart: Matrix(DoubleFloat),dFinish: Matrix(DoubleFloat))), + f: List(List(Expression(DoubleFloat))),st: String,tol: DoubleFloat)) -> + Record(measure: Float,explanations: String) measure(R:RoutinesTable,args:PDEB) == (# (args.constraints) < 3)@Boolean => [0$F,"d03faf is unsuitable for PDEs of order other than 3"] @@ -51544,6 +52329,7 @@ ElementaryFunctionsUnivariateLaurentSeries(Coef,UTS,ULS):_ RATPOWERS => uts ** inv(n::RN) "failed" + nthRootIfCan : (ULS,NonNegativeInteger) -> Union(ULS,"failed") nthRootIfCan(uls,nn) == (n := nn :: I) < 1 => error "nthRootIfCan: n must be positive" n = 1 => uls @@ -51558,6 +52344,8 @@ ElementaryFunctionsUnivariateLaurentSeries(Coef,UTS,ULS):_ monomial(1,k :: I) * (root :: UTS :: ULS) if Coef has Field then + + ?**? : (ULS,Fraction(Integer)) -> ULS (uls:ULS) ** (r:RN) == num := numer r; den := denom r den = 1 => uls ** num @@ -51579,42 +52367,59 @@ ElementaryFunctionsUnivariateLaurentSeries(Coef,UTS,ULS):_ uts case "failed" => "failed" fcn(uts :: UTS) :: ULS + expIfCan : ULS -> Union(ULS,"failed") expIfCan uls == applyIfCan(exp,uls) + sinIfCan : ULS -> Union(ULS,"failed") sinIfCan uls == applyIfCan(sin,uls) + cosIfCan : ULS -> Union(ULS,"failed") cosIfCan uls == applyIfCan(cos,uls) + asinIfCan : ULS -> Union(ULS,"failed") asinIfCan uls == applyIfCan(asin,uls) + acosIfCan : ULS -> Union(ULS,"failed") acosIfCan uls == applyIfCan(acos,uls) + asecIfCan : ULS -> Union(ULS,"failed") asecIfCan uls == applyIfCan(asec,uls) + acscIfCan : ULS -> Union(ULS,"failed") acscIfCan uls == applyIfCan(acsc,uls) + sinhIfCan : ULS -> Union(ULS,"failed") sinhIfCan uls == applyIfCan(sinh,uls) + coshIfCan : ULS -> Union(ULS,"failed") coshIfCan uls == applyIfCan(cosh,uls) + asinhIfCan : ULS -> Union(ULS,"failed") asinhIfCan uls == applyIfCan(asinh,uls) + acoshIfCan : ULS -> Union(ULS,"failed") acoshIfCan uls == applyIfCan(acosh,uls) + atanhIfCan : ULS -> Union(ULS,"failed") atanhIfCan uls == applyIfCan(atanh,uls) + acothIfCan : ULS -> Union(ULS,"failed") acothIfCan uls == applyIfCan(acoth,uls) + asechIfCan : ULS -> Union(ULS,"failed") asechIfCan uls == applyIfCan(asech,uls) + acschIfCan : ULS -> Union(ULS,"failed") acschIfCan uls == applyIfCan(acsch,uls) + logIfCan : ULS -> Union(ULS,"failed") logIfCan uls == uts := taylorIfCan uls uts case "failed" => "failed" zero? coefficient(ts := uts :: UTS,0) => "failed" log(ts) :: ULS + tanIfCan : ULS -> Union(ULS,"failed") tanIfCan uls == -- don't call 'tan' on a UTS (tan(uls) may have a singularity) uts := taylorIfCan uls @@ -51623,6 +52428,7 @@ ElementaryFunctionsUnivariateLaurentSeries(Coef,UTS,ULS):_ (cosInv := recip(series(sc.cos) :: ULS)) case "failed" => "failed" (series(sc.sin) :: ULS) * (cosInv :: ULS) + cotIfCan : ULS -> Union(ULS,"failed") cotIfCan uls == -- don't call 'cot' on a UTS (cot(uls) may have a singularity) uts := taylorIfCan uls @@ -51631,18 +52437,21 @@ ElementaryFunctionsUnivariateLaurentSeries(Coef,UTS,ULS):_ (sinInv := recip(series(sc.sin) :: ULS)) case "failed" => "failed" (series(sc.cos) :: ULS) * (sinInv :: ULS) + secIfCan : ULS -> Union(ULS,"failed") secIfCan uls == cos := cosIfCan uls cos case "failed" => "failed" (cosInv := recip(cos :: ULS)) case "failed" => "failed" cosInv :: ULS + cscIfCan : ULS -> Union(ULS,"failed") cscIfCan uls == sin := sinIfCan uls sin case "failed" => "failed" (sinInv := recip(sin :: ULS)) case "failed" => "failed" sinInv :: ULS + atanIfCan : ULS -> Union(ULS,"failed") atanIfCan uls == coef := coefficient(uls,0) (ord := order(uls,0)) = 0 and coef * coef = -1 => "failed" @@ -51663,6 +52472,7 @@ ElementaryFunctionsUnivariateLaurentSeries(Coef,UTS,ULS):_ (z := recip(1 + uls*uls)) case "failed" => "failed" (cc :: ULS) + integrate(differentiate(uls) * (z :: ULS)) + acotIfCan : ULS -> Union(ULS,"failed") acotIfCan uls == coef := coefficient(uls,0) (ord := order(uls,0)) = 0 and coef * coef = -1 => "failed" @@ -51680,6 +52490,7 @@ ElementaryFunctionsUnivariateLaurentSeries(Coef,UTS,ULS):_ (z := recip(1 + uls*uls)) case "failed" => "failed" (cc :: ULS) - integrate(differentiate(uls) * (z :: ULS)) + tanhIfCan : ULS -> Union(ULS,"failed") tanhIfCan uls == -- don't call 'tanh' on a UTS (tanh(uls) may have a singularity) uts := taylorIfCan uls @@ -51689,6 +52500,7 @@ ElementaryFunctionsUnivariateLaurentSeries(Coef,UTS,ULS):_ "failed" (series(sc.sinh) :: ULS) * (coshInv :: ULS) + cothIfCan : ULS -> Union(ULS,"failed") cothIfCan uls == -- don't call 'coth' on a UTS (coth(uls) may have a singularity) uts := taylorIfCan uls @@ -51698,12 +52510,14 @@ ElementaryFunctionsUnivariateLaurentSeries(Coef,UTS,ULS):_ "failed" (series(sc.cosh) :: ULS) * (sinhInv :: ULS) + sechIfCan : ULS -> Union(ULS,"failed") sechIfCan uls == cosh := coshIfCan uls cosh case "failed" => "failed" (coshInv := recip(cosh :: ULS)) case "failed" => "failed" coshInv :: ULS + cschIfCan : ULS -> Union(ULS,"failed") cschIfCan uls == sinh := sinhIfCan uls sinh case "failed" => "failed" @@ -51716,55 +52530,80 @@ ElementaryFunctionsUnivariateLaurentSeries(Coef,UTS,ULS):_ ans case "failed" => error concat(name," of function with singularity") ans :: ULS - + + exp : ULS -> ULS exp uls == applyOrError(expIfCan,"exp",uls) + log : ULS -> ULS log uls == applyOrError(logIfCan,"log",uls) + sin : ULS -> ULS sin uls == applyOrError(sinIfCan,"sin",uls) + cos : ULS -> ULS cos uls == applyOrError(cosIfCan,"cos",uls) + tan : ULS -> ULS tan uls == applyOrError(tanIfCan,"tan",uls) + cot : ULS -> ULS cot uls == applyOrError(cotIfCan,"cot",uls) + sec : ULS -> ULS sec uls == applyOrError(secIfCan,"sec",uls) + csc : ULS -> ULS csc uls == applyOrError(cscIfCan,"csc",uls) + asin : ULS -> ULS asin uls == applyOrError(asinIfCan,"asin",uls) + acos : ULS -> ULS acos uls == applyOrError(acosIfCan,"acos",uls) + asec : ULS -> ULS asec uls == applyOrError(asecIfCan,"asec",uls) + acsc : ULS -> ULS acsc uls == applyOrError(acscIfCan,"acsc",uls) + sinh : ULS -> ULS sinh uls == applyOrError(sinhIfCan,"sinh",uls) + cosh : ULS -> ULS cosh uls == applyOrError(coshIfCan,"cosh",uls) + tanh : ULS -> ULS tanh uls == applyOrError(tanhIfCan,"tanh",uls) + coth : ULS -> ULS coth uls == applyOrError(cothIfCan,"coth",uls) + sech : ULS -> ULS sech uls == applyOrError(sechIfCan,"sech",uls) + csch : ULS -> ULS csch uls == applyOrError(cschIfCan,"csch",uls) + asinh : ULS -> ULS asinh uls == applyOrError(asinhIfCan,"asinh",uls) + acosh : ULS -> ULS acosh uls == applyOrError(acoshIfCan,"acosh",uls) + atanh : ULS -> ULS atanh uls == applyOrError(atanhIfCan,"atanh",uls) + acoth : ULS -> ULS acoth uls == applyOrError(acothIfCan,"acoth",uls) + asech : ULS -> ULS asech uls == applyOrError(asechIfCan,"asech",uls) + acsch : ULS -> ULS acsch uls == applyOrError(acschIfCan,"acsch",uls) + atan : ULS -> ULS atan uls == -- code is duplicated so that correct error messages will be returned coef := coefficient(uls,0) @@ -51788,6 +52627,7 @@ ElementaryFunctionsUnivariateLaurentSeries(Coef,UTS,ULS):_ error "atan: leading coefficient not invertible" (cc :: ULS) + integrate(differentiate(uls) * (z :: ULS)) + acot : ULS -> ULS acot uls == -- code is duplicated so that correct error messages will be returned coef := coefficient(uls,0) @@ -52274,6 +53114,7 @@ ElementaryFunctionsUnivariatePuiseuxSeries(Coef,ULS,UPXS,EFULS):_ --% roots + nthRootIfCan : (UPXS,NonNegativeInteger) -> Union(UPXS,"failed") nthRootIfCan(upxs,n) == n = 1 => upxs r := rationalPower upxs; uls := laurentRep upxs @@ -52287,6 +53128,8 @@ ElementaryFunctionsUnivariatePuiseuxSeries(Coef,ULS,UPXS,EFULS):_ puiseux(r,ulsRoot :: ULS) * monomial(1,deg * r * inv(n :: RN)) if Coef has Field then + + ?**? : (UPXS,Fraction(Integer)) -> UPXS (upxs:UPXS) ** (q:RN) == num := numer q; den := denom q den = 1 => upxs ** num @@ -52307,50 +53150,95 @@ ElementaryFunctionsUnivariatePuiseuxSeries(Coef,ULS,UPXS,EFULS):_ uls case "failed" => "failed" puiseux(rationalPower upxs,uls :: ULS) + expIfCan : UPXS -> Union(UPXS,"failed") expIfCan upxs == applyIfCan(expIfCan,upxs) + logIfCan : UPXS -> Union(UPXS,"failed") logIfCan upxs == applyIfCan(logIfCan,upxs) + sinIfCan : UPXS -> Union(UPXS,"failed") sinIfCan upxs == applyIfCan(sinIfCan,upxs) + cosIfCan : UPXS -> Union(UPXS,"failed") cosIfCan upxs == applyIfCan(cosIfCan,upxs) + tanIfCan : UPXS -> Union(UPXS,"failed") tanIfCan upxs == applyIfCan(tanIfCan,upxs) + cotIfCan : UPXS -> Union(UPXS,"failed") cotIfCan upxs == applyIfCan(cotIfCan,upxs) + secIfCan : UPXS -> Union(UPXS,"failed") secIfCan upxs == applyIfCan(secIfCan,upxs) + cscIfCan : UPXS -> Union(UPXS,"failed") cscIfCan upxs == applyIfCan(cscIfCan,upxs) + atanIfCan : UPXS -> Union(UPXS,"failed") atanIfCan upxs == applyIfCan(atanIfCan,upxs) + acotIfCan : UPXS -> Union(UPXS,"failed") acotIfCan upxs == applyIfCan(acotIfCan,upxs) + sinhIfCan : UPXS -> Union(UPXS,"failed") sinhIfCan upxs == applyIfCan(sinhIfCan,upxs) + coshIfCan : UPXS -> Union(UPXS,"failed") coshIfCan upxs == applyIfCan(coshIfCan,upxs) + tanhIfCan : UPXS -> Union(UPXS,"failed") tanhIfCan upxs == applyIfCan(tanhIfCan,upxs) + cothIfCan : UPXS -> Union(UPXS,"failed") cothIfCan upxs == applyIfCan(cothIfCan,upxs) + sechIfCan : UPXS -> Union(UPXS,"failed") sechIfCan upxs == applyIfCan(sechIfCan,upxs) + cschIfCan : UPXS -> Union(UPXS,"failed") cschIfCan upxs == applyIfCan(cschIfCan,upxs) + asinhIfCan : UPXS -> Union(UPXS,"failed") asinhIfCan upxs == applyIfCan(asinhIfCan,upxs) + asinhIfCan upxs == + order(upxs,0) < 0 => "failed" + TRANSFCN or (coefficient(upxs,0) = 0) => + log(upxs + (1 + upxs*upxs)**(1/2)) + "failed" + acoshIfCan : UPXS -> Union(UPXS,"failed") acoshIfCan upxs == applyIfCan(acoshIfCan,upxs) + acoshIfCan upxs == + TRANSFCN => + order(upxs,0) < 0 => "failed" + log(upxs + (upxs*upxs - 1)**(1/2)) + "failed" + atanhIfCan : UPXS -> Union(UPXS,"failed") atanhIfCan upxs == applyIfCan(atanhIfCan,upxs) + acothIfCan : UPXS -> Union(UPXS,"failed") acothIfCan upxs == applyIfCan(acothIfCan,upxs) + asechIfCan : UPXS -> Union(UPXS,"failed") asechIfCan upxs == applyIfCan(asechIfCan,upxs) + asechIfCan upxs == + TRANSFCN => + order(upxs,0) < 0 => "failed" + (rec := recip upxs) case "failed" => "failed" + log((1 + (1 - upxs*upxs)*(1/2)) * (rec :: UPXS)) + "failed" + acschIfCan : UPXS -> Union(UPXS,"failed") acschIfCan upxs == applyIfCan(acschIfCan,upxs) - + acschIfCan upxs == + TRANSFCN => + order(upxs,0) < 0 => "failed" + (rec := recip upxs) case "failed" => "failed" + log((1 + (1 + upxs*upxs)*(1/2)) * (rec :: UPXS)) + "failed" + + asinIfCan : UPXS -> Union(UPXS,"failed") asinIfCan upxs == order(upxs,0) < 0 => "failed" (coef := coefficient(upxs,0)) = 0 => @@ -52360,6 +53248,7 @@ ElementaryFunctionsUnivariatePuiseuxSeries(Coef,ULS,UPXS,EFULS):_ cc + integrate((1 - upxs*upxs)**(-1/2) * (differentiate upxs)) "failed" + acosIfCan : UPXS -> Union(UPXS,"failed") acosIfCan upxs == order(upxs,0) < 0 => "failed" TRANSFCN => @@ -52367,6 +53256,7 @@ ElementaryFunctionsUnivariatePuiseuxSeries(Coef,ULS,UPXS,EFULS):_ cc + integrate(-(1 - upxs*upxs)**(-1/2) * (differentiate upxs)) "failed" + asecIfCan : UPXS -> Union(UPXS,"failed") asecIfCan upxs == order(upxs,0) < 0 => "failed" TRANSFCN => @@ -52376,6 +53266,7 @@ ElementaryFunctionsUnivariatePuiseuxSeries(Coef,ULS,UPXS,EFULS):_ cc + integrate(f * (rec :: UPXS)) "failed" + acscIfCan : UPXS -> Union(UPXS,"failed") acscIfCan upxs == order(upxs,0) < 0 => "failed" TRANSFCN => @@ -52385,32 +53276,6 @@ ElementaryFunctionsUnivariatePuiseuxSeries(Coef,ULS,UPXS,EFULS):_ cc + integrate(f * (rec :: UPXS)) "failed" - asinhIfCan upxs == - order(upxs,0) < 0 => "failed" - TRANSFCN or (coefficient(upxs,0) = 0) => - log(upxs + (1 + upxs*upxs)**(1/2)) - "failed" - - acoshIfCan upxs == - TRANSFCN => - order(upxs,0) < 0 => "failed" - log(upxs + (upxs*upxs - 1)**(1/2)) - "failed" - - asechIfCan upxs == - TRANSFCN => - order(upxs,0) < 0 => "failed" - (rec := recip upxs) case "failed" => "failed" - log((1 + (1 - upxs*upxs)*(1/2)) * (rec :: UPXS)) - "failed" - - acschIfCan upxs == - TRANSFCN => - order(upxs,0) < 0 => "failed" - (rec := recip upxs) case "failed" => "failed" - log((1 + (1 + upxs*upxs)*(1/2)) * (rec :: UPXS)) - "failed" - applyOrError:(UPXS -> Union(UPXS,"failed"),String,UPXS) -> UPXS applyOrError(fcn,name,upxs) == ans := fcn upxs @@ -52418,56 +53283,82 @@ ElementaryFunctionsUnivariatePuiseuxSeries(Coef,ULS,UPXS,EFULS):_ error concat(name," of function with singularity") ans :: UPXS + exp : UPXS -> UPXS exp upxs == applyOrError(expIfCan,"exp",upxs) + log : UPXS -> UPXS log upxs == applyOrError(logIfCan,"log",upxs) + sin : UPXS -> UPXS sin upxs == applyOrError(sinIfCan,"sin",upxs) + cos : UPXS -> UPXS cos upxs == applyOrError(cosIfCan,"cos",upxs) + tan : UPXS -> UPXS tan upxs == applyOrError(tanIfCan,"tan",upxs) + cot : UPXS -> UPXS cot upxs == applyOrError(cotIfCan,"cot",upxs) + sec : UPXS -> UPXS sec upxs == applyOrError(secIfCan,"sec",upxs) + csc : UPXS -> UPXS csc upxs == applyOrError(cscIfCan,"csc",upxs) + asin : UPXS -> UPXS asin upxs == applyOrError(asinIfCan,"asin",upxs) + acos : UPXS -> UPXS acos upxs == applyOrError(acosIfCan,"acos",upxs) + atan : UPXS -> UPXS atan upxs == applyOrError(atanIfCan,"atan",upxs) + acot : UPXS -> UPXS acot upxs == applyOrError(acotIfCan,"acot",upxs) + asec : UPXS -> UPXS asec upxs == applyOrError(asecIfCan,"asec",upxs) + acsc : UPXS -> UPXS acsc upxs == applyOrError(acscIfCan,"acsc",upxs) + sinh : UPXS -> UPXS sinh upxs == applyOrError(sinhIfCan,"sinh",upxs) + cosh : UPXS -> UPXS cosh upxs == applyOrError(coshIfCan,"cosh",upxs) + tanh : UPXS -> UPXS tanh upxs == applyOrError(tanhIfCan,"tanh",upxs) + coth : UPXS -> UPXS coth upxs == applyOrError(cothIfCan,"coth",upxs) + sech : UPXS -> UPXS sech upxs == applyOrError(sechIfCan,"sech",upxs) + csch : UPXS -> UPXS csch upxs == applyOrError(cschIfCan,"csch",upxs) + asinh : UPXS -> UPXS asinh upxs == applyOrError(asinhIfCan,"asinh",upxs) + acosh : UPXS -> UPXS acosh upxs == applyOrError(acoshIfCan,"acosh",upxs) + atanh : UPXS -> UPXS atanh upxs == applyOrError(atanhIfCan,"atanh",upxs) + acoth : UPXS -> UPXS acoth upxs == applyOrError(acothIfCan,"acoth",upxs) + asech : UPXS -> UPXS asech upxs == applyOrError(asechIfCan,"asech",upxs) + acsch : UPXS -> UPXS acsch upxs == applyOrError(acschIfCan,"acsch",upxs) *) @@ -52978,8 +53869,6 @@ Equation(S: Type): public == private where l:S * eqn:$ == l * eqn.lhs = l * eqn.rhs - l:S * eqn:$ == l * eqn.lhs = l * eqn.rhs - eqn:$ * l:S == eqn.lhs * l = eqn.rhs * l -- We have to be a bit careful here: raising to a +ve integer is OK -- (since it's the equivalent of repeated multiplication) @@ -53064,23 +53953,30 @@ Equation(S: Type): public == private where if S has IntegralDomain then + factorAndSplit : % -> List(%) factorAndSplit eq == (S has factor : S -> Factored S) => eq0 := rightZero eq [equation(rcf.factor,0) for rcf in factors factor lhs eq0] [eq] + ?=? : (S,S) -> % l:S = r:S == [l, r] + equation : (S,S) -> % equation(l, r) == [l, r] -- hack! See comment above. - lhs eqn == eqn.lhs + lhs : % -> S + lhs eqn == eqn.lhs - rhs eqn == eqn.rhs + rhs : % -> S + rhs eqn == eqn.rhs - swap eqn == [rhs eqn, lhs eqn] + swap : % -> % + swap eqn == [rhs eqn, lhs eqn] - map(fn, eqn) == equation(fn(eqn.lhs), fn(eqn.rhs)) + map : ((S -> S),%) -> % + map(fn, eqn) == equation(fn(eqn.lhs), fn(eqn.rhs)) if S has InnerEvalable(Symbol,S) then s:Symbol @@ -53088,100 +53984,128 @@ Equation(S: Type): public == private where x:S lx:List S + eval : (%,Symbol,S) -> % eval(eqn,s,x) == eval(eqn.lhs,s,x) = eval(eqn.rhs,s,x) + eval : (%,List(Symbol),List(S)) -> % eval(eqn,ls,lx) == eval(eqn.lhs,ls,lx) = eval(eqn.rhs,ls,lx) if S has Evalable(S) then + eval : (%,%) -> % eval(eqn1:$, eqn2:$):$ == eval(eqn1.lhs, eqn2 pretend Equation S) = eval(eqn1.rhs, eqn2 pretend Equation S) + eval : (%,List(%)) -> % eval(eqn1:$, leqn2:List $):$ == eval(eqn1.lhs, leqn2 pretend List Equation S) = eval(eqn1.rhs, leqn2 pretend List Equation S) if S has SetCategory then + ?=? : (%,%) -> Boolean eq1 = eq2 == (eq1.lhs = eq2.lhs)@Boolean and (eq1.rhs = eq2.rhs)@Boolean + coerce : % -> OutputForm coerce(eqn:$):Ex == eqn.lhs::Ex = eqn.rhs::Ex + coerce : % -> Boolean coerce(eqn:$):Boolean == eqn.lhs = eqn.rhs if S has AbelianSemiGroup then + ?+? : (%,%) -> % eq1 + eq2 == eq1.lhs + eq2.lhs = eq1.rhs + eq2.rhs + ?+? : (S,%) -> % s + eq2 == [s,s] + eq2 + ?+? : (%,S) -> % eq1 + s == eq1 + [s,s] if S has AbelianGroup then + -? : % -> % - eq == (- lhs eq) = (-rhs eq) + ?-? : (S,%) -> % s - eq2 == [s,s] - eq2 + ?-? : (%,S) -> % eq1 - s == eq1 - [s,s] + leftZero : % -> % leftZero eq == 0 = rhs eq - lhs eq + rightZero : % -> % rightZero eq == lhs eq - rhs eq = 0 + 0 : () -> % 0 == equation(0$S,0$S) + ?-? : (%,%) -> % eq1 - eq2 == eq1.lhs - eq2.lhs = eq1.rhs - eq2.rhs if S has SemiGroup then + ?*? : (%,%) -> % eq1:$ * eq2:$ == eq1.lhs * eq2.lhs = eq1.rhs * eq2.rhs - l:S * eqn:$ == l * eqn.lhs = l * eqn.rhs + ?*? : (S,%) -> % + l:S * eqn:$ == l * eqn.lhs = l * eqn.rhs - l:S * eqn:$ == l * eqn.lhs = l * eqn.rhs - - eqn:$ * l:S == eqn.lhs * l = eqn.rhs * l -- We have to be a bit careful here: raising to a +ve integer is OK -- (since it's the equivalent of repeated multiplication) -- but other powers may cause contradictions -- Watch what else you add here! JHD 2/Aug 1990 + ?*? : (%,S) -> % + eqn:$ * l:S == eqn.lhs * l = eqn.rhs * l if S has Monoid then + 1 : () -> % 1 == equation(1$S,1$S) + recip : % -> Union(%,"failed") recip eq == (lh := recip lhs eq) case "failed" => "failed" (rh := recip rhs eq) case "failed" => "failed" [lh :: S, rh :: S] + leftOne : % -> Union(%,"failed") leftOne eq == (re := recip lhs eq) case "failed" => "failed" 1 = rhs eq * re + rightOne : % -> Union(%,"failed") rightOne eq == (re := recip rhs eq) case "failed" => "failed" lhs eq * re = 1 if S has Group then + inv : % -> % inv eq == [inv lhs eq, inv rhs eq] + leftOne : % -> Union(%,"failed") leftOne eq == 1 = rhs eq * inv rhs eq + rightOne : % -> Union(%,"failed") rightOne eq == lhs eq * inv rhs eq = 1 if S has Ring then + characteristic : () -> NonNegativeInteger characteristic() == characteristic()$S + ?*? : (Integer,%) -> % i:Integer * eq:$ == (i::S) * eq if S has IntegralDomain then + factorAndSplit : % -> List(%) factorAndSplit eq == (S has factor : S -> Factored S) => eq0 := rightZero eq @@ -53197,19 +54121,24 @@ Equation(S: Type): public == private where if S has PartialDifferentialRing(Symbol) then + differentiate : (%,Symbol) -> % differentiate(eq:$, sym:Symbol):$ == [differentiate(lhs eq, sym), differentiate(rhs eq, sym)] if S has Field then + dimension : () -> CardinalNumber dimension() == 2 :: CardinalNumber + ?/? : (%,%) -> % eq1:$ / eq2:$ == eq1.lhs / eq2.lhs = eq1.rhs / eq2.rhs + inv : % -> % inv eq == [inv lhs eq, inv rhs eq] if S has ExpressionSpace then + subst : (%,%) -> % subst(eq1,eq2) == eq3 := eq2 pretend Equation S [subst(lhs eq1,eq3),subst(rhs eq1,eq3)] @@ -53755,6 +54684,7 @@ EuclideanModularRing(S,R,Mod,reduction:(R,Mod) -> R, --declarations x,y,z: % + divide : (%,%) -> Record(quotient: %,remainder: %) divide(x,y) == t:=merge(x.modulo,y.modulo) t case "failed" => error "incompatible moduli" @@ -53768,9 +54698,10 @@ EuclideanModularRing(S,R,Mod,reduction:(R,Mod) -> R, r:=monicDivide(x.val,yv) [reduce(invlcy*r.quotient,xm),reduce(r.remainder,xm)] - if R has fmecg:(R,NonNegativeInteger,S,R)->R + if R has fmecg:(R,NonNegativeInteger,S,R)->R then - then x rem y == + ?rem? : (%,%) -> % + x rem y == t:=merge(x.modulo,y.modulo) t case "failed" => error "incompatible moduli" xm:=t::Mod @@ -53787,7 +54718,10 @@ EuclideanModularRing(S,R,Mod,reduction:(R,Mod) -> R, xv = 0 => return [xv,xm]$Rep [xv,xm]$Rep - else x rem y == + else + + ?rem? : (%,%) -> % + x rem y == t:=merge(x.modulo,y.modulo) t case "failed" => error "incompatible moduli" xm:=t::Mod @@ -53799,8 +54733,10 @@ EuclideanModularRing(S,R,Mod,reduction:(R,Mod) -> R, r:=monicDivide(x.val,yv) reduce(r.remainder,xm) + euclideanSize : % -> NonNegativeInteger euclideanSize x == degree x.val + unitCanonical : % -> % unitCanonical x == zero? x => x degree(x.val) = 0 => 1 @@ -53808,6 +54744,7 @@ EuclideanModularRing(S,R,Mod,reduction:(R,Mod) -> R, invlcx:%:=inv reduce((leadingCoefficient(x.val))::R,x.modulo) invlcx * x + unitNormal : % -> Record(unit: %,canonical: %,associate: %) unitNormal x == zero?(x) or ((leadingCoefficient(x.val)) = 1) => [1, x, 1] lcx := reduce((leadingCoefficient(x.val))::R,x.modulo) @@ -53815,6 +54752,7 @@ EuclideanModularRing(S,R,Mod,reduction:(R,Mod) -> R, degree(x.val) = 0 => [lcx, 1, invlcx] [lcx, invlcx * x, invlcx] + ?.? : (%,R) -> R elt(x : %,s : R) : R == reduction(elt(x.val,s),x.modulo) *) @@ -53985,8 +54923,10 @@ Exit: SetCategory == add (* domain EXIT *) (* + coerce : % -> OutputForm coerce(n:%) == error "Cannot use an Exit value." + ?=? : (%,%) -> Boolean n1 = n2 == error "Cannot use an Exit value." *) @@ -54396,31 +55336,25 @@ ExponentialExpansion(R,FE,var,cen): Exports == Implementation where (* Fraction(UPXSSING) add - coeff : Term -> UPXS - - exponent : Term -> EXPUPXS - - upxssingIfCan : % -> Union(UPXSSING,"failed") - - seriesQuotientLimit: (UPXS,UPXS) -> Union(OFE,"failed") - - seriesQuotientInfinity: (UPXS,UPXS) -> Union(OFE,"failed") - Rep := Fraction UPXSSING ZEROCOUNT : RN := 1000/1 + coeff : Term -> UPXS coeff term == term.%coef + exponent : Term -> EXPUPXS exponent term == term.%expon --!! why is this necessary? --!! code can run forever in retractIfCan if original assignment --!! for 'ff' is used + upxssingIfCan : % -> Union(UPXSSING,"failed") upxssingIfCan f == (denom f = 1) => numer f "failed" + retractIfCan : % -> Union(UPXS,"failed") retractIfCan(f:%):Union(UPXS,"failed") == --ff := (retractIfCan$Rep)(f)@Union(UPXSSING,"failed") --ff case "failed" => "failed" @@ -54429,16 +55363,21 @@ ExponentialExpansion(R,FE,var,cen): Exports == Implementation where "failed" fff :: UPXS + ?/? : (UnivariatePuiseuxSeriesWithExponentialSingularity(R,FE,var,cen), + UnivariatePuiseuxSeriesWithExponentialSingularity(R,FE,var,cen)) -> % f:UPXSSING / g:UPXSSING == (rec := recip g) case "failed" => f /$Rep g f * (rec :: UPXSSING) :: % + ?/? : (%,%) -> % f:% / g:% == (rec := recip numer g) case "failed" => f /$Rep g (rec :: UPXSSING) * (denom g) * f + coerce : UnivariatePuiseuxSeries(FE,var,cen) -> % coerce(f:UPXS) == f :: UPXSSING :: % + seriesQuotientLimit: (UPXS,UPXS) -> Union(OFE,"failed") seriesQuotientLimit(num,den) == -- limit of the quotient of two series series := num / den @@ -54450,6 +55389,7 @@ ExponentialExpansion(R,FE,var,cen): Exports == Implementation where (sig :: Integer) = 1 => plusInfinity() minusInfinity() + seriesQuotientInfinity: (UPXS,UPXS) -> Union(OFE,"failed") seriesQuotientInfinity(num,den) == -- infinite limit: plus or minus? -- look at leading coefficients of series to tell @@ -54461,6 +55401,7 @@ ExponentialExpansion(R,FE,var,cen): Exports == Implementation where (sig :: Integer) = 1 => plusInfinity() minusInfinity() + limitPlus : % -> Union(OrderedCompletion(FE),"failed") limitPlus f == zero? f => 0 (den := denom f) = 1 => limitPlus numer f @@ -55937,66 +56878,63 @@ Expression(R:OrderedSet): Exports == Implementation where import KernelFunctions2(R, %) - retNotUnit : % -> R - - retNotUnitIfCan: % -> Union(R, "failed") - belong? op == true + retNotUnit : % -> R retNotUnit x == (u := constantIfCan(k := retract(x)@K)) case R => u::R error "Not retractable" + retNotUnitIfCan: % -> Union(R, "failed") retNotUnitIfCan x == (r := retractIfCan(x)@Union(K,"failed")) case "failed" => "failed" constantIfCan(r::K) if R has IntegralDomain then - reduc : (%, List Kernel %) -> % - - commonk : (%, %) -> List K - - commonk0 : (List K, List K) -> List K - - toprat : % -> % - - algkernels: List K -> List K - - evl : (MP, K, SparseUnivariatePolynomial %) -> Fraction MP - - evl0 : (MP, K) -> SparseUnivariatePolynomial Fraction MP - Rep := Fraction MP - 0 == 0$Rep + 0 : () -> % + 0 == 0$Rep - 1 == 1$Rep + 1 : () -> % + 1 == 1$Rep - one? x == (x = 1)$Rep + one? : % -> Boolean + one? x == (x = 1)$Rep - zero? x == zero?(x)$Rep + zero? : % -> Boolean + zero? x == zero?(x)$Rep - - x:% == -$Rep x + -? : % -> % + - x:% == -$Rep x + ?*? : (Integer,%) -> % n:Integer * x:% == n *$Rep x + coerce : Integer -> % coerce(n:Integer) == coerce(n)$Rep@Rep::% - x:% * y:% == reduc(x *$Rep y, commonk(x, y)) + ?*? : (%,%) -> % + x:% * y:% == reduc(x *$Rep y, commonk(x, y)) - x:% + y:% == reduc(x +$Rep y, commonk(x, y)) + ?+? : (%,%) -> % + x:% + y:% == reduc(x +$Rep y, commonk(x, y)) - (x:% - y:%):% == reduc(x -$Rep y, commonk(x, y)) + ?-? : (%,%) -> % + (x:% - y:%):% == reduc(x -$Rep y, commonk(x, y)) - x:% / y:% == reduc(x /$Rep y, commonk(x, y)) + ?/? : (%,%) -> % + x:% / y:% == reduc(x /$Rep y, commonk(x, y)) + number? : % -> Boolean number?(x:%):Boolean == if R has RetractableTo(Integer) then ground?(x) or ((retractIfCan(x)@Union(Q,"failed")) case Q) else ground?(x) + simplifyPower : (%,Integer) -> % simplifyPower(x:%,n:Integer):% == k : List K := kernels x is?(x,POWER) => @@ -56008,12 +56946,14 @@ Expression(R:OrderedSet): Exports == Implementation where (first args)**(n*second(args)) reduc(x **$Rep n, algkernels k) + ?**? : (%,NonNegativeInteger) -> % x:% ** n:NonNegativeInteger == n = 0 => 1$% n = 1 => x simplifyPower(numerator x,n pretend Integer) / simplifyPower(denominator x,n pretend Integer) + ?**? : (%,Integer) -> % x:% ** n:Integer == n = 0 => 1$% n = 1 => x @@ -56021,27 +56961,37 @@ Expression(R:OrderedSet): Exports == Implementation where simplifyPower(numerator x,n) / simplifyPower(denominator x,n) + ?**? : (%,PositiveInteger) -> % x:% ** n:PositiveInteger == n = 1 => x simplifyPower(numerator x,n pretend Integer) / simplifyPower(denominator x,n pretend Integer) - x:% < y:% == x <$Rep y + ? Boolean + x:% < y:% == x <$Rep y - x:% = y:% == x =$Rep y + ?=? : (%,%) -> Boolean + x:% = y:% == x =$Rep y - numer x == numer(x)$Rep + numer : % -> SparseMultivariatePolynomial(R,Kernel(%)) + numer x == numer(x)$Rep - denom x == denom(x)$Rep + denom : % -> SparseMultivariatePolynomial(R,Kernel(%)) + denom x == denom(x)$Rep - coerce(p:MP):% == coerce(p)$Rep + coerce : SparseMultivariatePolynomial(R,Kernel(%)) -> % + coerce(p:MP):% == coerce(p)$Rep - reduce x == reduc(x, algkernels kernels x) + reduce : % -> % + reduce x == reduc(x, algkernels kernels x) + commonk : (%, %) -> List K commonk(x, y) == commonk0(algkernels kernels x, algkernels kernels y) + algkernels: List K -> List K algkernels l == select_!(x +-> has?(operator x, ALGOP), l) + toprat : % -> % toprat f == ratDenom(f,algkernels kernels f)$AlgebraicManipulations(R, %) x:MP / y:MP == @@ -56049,12 +56999,15 @@ Expression(R:OrderedSet): Exports == Implementation where -- since we use the reduction from FRAC SMP which asssumes that the -- variables are independent, we must remove algebraic from the denominators + reducedSystem : Matrix(%) -> Matrix(R) reducedSystem(m:Matrix %):Matrix(R) == mm:Matrix(MP) := reducedSystem(map(toprat, m))$Rep reducedSystem(mm)$MP -- since we use the reduction from FRAC SMP which asssumes that the -- variables are independent, we must remove algebraic from the denominators + reducedSystem : (Matrix(%),Vector(%)) -> + Record(mat: Matrix(Integer),vec: Vector(Integer)) reducedSystem(m:Matrix %, v:Vector %): Record(mat:Matrix R, vec:Vector R) == r:Record(mat:Matrix MP, vec:Vector MP) := @@ -56062,131 +57015,192 @@ Expression(R:OrderedSet): Exports == Implementation where reducedSystem(r.mat, r.vec)$MP -- The result MUST be left sorted deepest first MB 3/90 + commonk0 : (List K, List K) -> List K commonk0(x, y) == ans := empty()$List(K) for k in reverse_! x repeat if member?(k, y) then ans := concat(k, ans) ans + rootOf : (SparseUnivariatePolynomial(%),Symbol) -> % rootOf(x:SparseUnivariatePolynomial %, v:Symbol) == rootOf(x,v)$AF - pi() == pi()$EF + pi : () -> % + pi() == pi()$EF - exp x == exp(x)$EF + exp : % -> % + exp x == exp(x)$EF - log x == log(x)$EF + log : % -> % + log x == log(x)$EF - sin x == sin(x)$EF + sin : % -> % + sin x == sin(x)$EF - cos x == cos(x)$EF + cos : % -> % + cos x == cos(x)$EF - tan x == tan(x)$EF + tan : % -> % + tan x == tan(x)$EF - cot x == cot(x)$EF + cot : % -> % + cot x == cot(x)$EF - sec x == sec(x)$EF + sec : % -> % + sec x == sec(x)$EF - csc x == csc(x)$EF + csc : % -> % + csc x == csc(x)$EF - asin x == asin(x)$EF + asin : % -> % + asin x == asin(x)$EF - acos x == acos(x)$EF + acos : % -> % + acos x == acos(x)$EF - atan x == atan(x)$EF + atan : % -> % + atan x == atan(x)$EF - acot x == acot(x)$EF + acot : % -> % + acot x == acot(x)$EF - asec x == asec(x)$EF + asec : % -> % + asec x == asec(x)$EF - acsc x == acsc(x)$EF + acsc : % -> % + acsc x == acsc(x)$EF - sinh x == sinh(x)$EF + sinh : % -> % + sinh x == sinh(x)$EF - cosh x == cosh(x)$EF + cosh : % -> % + cosh x == cosh(x)$EF - tanh x == tanh(x)$EF + tanh : % -> % + tanh x == tanh(x)$EF - coth x == coth(x)$EF + coth : % -> % + coth x == coth(x)$EF - sech x == sech(x)$EF + sech x == sech(x)$EF - csch x == csch(x)$EF + csch : % -> % + csch x == csch(x)$EF - asinh x == asinh(x)$EF + asinh : % -> % + asinh x == asinh(x)$EF - acosh x == acosh(x)$EF + acosh : % -> % + acosh x == acosh(x)$EF - atanh x == atanh(x)$EF + atanh : % -> % + atanh x == atanh(x)$EF - acoth x == acoth(x)$EF + acoth : % -> % + acoth x == acoth(x)$EF - asech x == asech(x)$EF + asech : % -> % + asech x == asech(x)$EF - acsch x == acsch(x)$EF + acsch : % -> % + acsch x == acsch(x)$EF - abs x == abs(x)$FSF + abs : % -> % + abs x == abs(x)$FSF - Gamma x == Gamma(x)$FSF + Gamma : % -> % + Gamma x == Gamma(x)$FSF + + Gamma : (%,%) -> % + Gamma(a, x) == Gamma(a, x)$FSF - Gamma(a, x) == Gamma(a, x)$FSF + Beta : (%,%) -> % + Beta(x,y) == Beta(x,y)$FSF - Beta(x,y) == Beta(x,y)$FSF + digamma : % -> % + digamma x == digamma(x)$FSF - digamma x == digamma(x)$FSF + polygamma : (%,%) -> % + polygamma(k,x) == polygamma(k,x)$FSF - polygamma(k,x) == polygamma(k,x)$FSF + besselJ : (%,%) -> % + besselJ(v,x) == besselJ(v,x)$FSF - besselJ(v,x) == besselJ(v,x)$FSF + besselY : (%,%) -> % + besselY(v,x) == besselY(v,x)$FSF - besselY(v,x) == besselY(v,x)$FSF + besselI : (%,%) -> % + besselI(v,x) == besselI(v,x)$FSF - besselI(v,x) == besselI(v,x)$FSF + besselK : (%,%) -> % + besselK(v,x) == besselK(v,x)$FSF - besselK(v,x) == besselK(v,x)$FSF + airyAi : % -> % + airyAi x == airyAi(x)$FSF - airyAi x == airyAi(x)$FSF + airyBi : % -> % + airyBi x == airyBi(x)$FSF - airyBi x == airyBi(x)$FSF + ?**? : (%,%) -> % + x:% ** y:% == x **$CF y - x:% ** y:% == x **$CF y + factorial : % -> % + factorial x == factorial(x)$CF - factorial x == factorial(x)$CF + binomial : (%,%) -> % + binomial(n, m) == binomial(n, m)$CF - binomial(n, m) == binomial(n, m)$CF + permutation : (%,%) -> % + permutation(n, m) == permutation(n, m)$CF - permutation(n, m) == permutation(n, m)$CF - - factorials x == factorials(x)$CF + factorials : % -> % + factorials x == factorials(x)$CF - factorials(x, n) == factorials(x, n)$CF + factorials : (%,Symbol) -> % + factorials(x, n) == factorials(x, n)$CF - summation(x:%, n:Symbol) == summation(x, n)$CF + summation : (%,Symbol) -> % + summation(x:%, n:Symbol) == summation(x, n)$CF + summation : (%,SegmentBinding(%)) -> % summation(x:%, s:SegmentBinding %) == summation(x, s)$CF - product(x:%, n:Symbol) == product(x, n)$CF + product : (%,Symbol) -> % + product(x:%, n:Symbol) == product(x, n)$CF - product(x:%, s:SegmentBinding %) == product(x, s)$CF + product : (%,SegmentBinding(%)) -> % + product(x:%, s:SegmentBinding %) == product(x, s)$CF - erf x == erf(x)$LF + erf : % -> % + erf x == erf(x)$LF - Ei x == Ei(x)$LF + Ei : % -> % + Ei x == Ei(x)$LF - Si x == Si(x)$LF + Si : % -> % + Si x == Si(x)$LF - Ci x == Ci(x)$LF + Ci : % -> % + Ci x == Ci(x)$LF - li x == li(x)$LF + li : % -> % + li x == li(x)$LF - dilog x == dilog(x)$LF + dilog : % -> % + dilog x == dilog(x)$LF - fresnelS x == fresnelS(x)$LF + fresnelS : % -> % + fresnelS x == fresnelS(x)$LF - fresnelC x == fresnelC(x)$LF + fresnelC : % -> % + fresnelC x == fresnelC(x)$LF - integral(x:%, n:Symbol) == integral(x, n)$LF + integral : (%,Symbol) -> % + integral(x:%, n:Symbol) == integral(x, n)$LF + integral : (%,SegmentBinding(%)) -> % integral(x:%, s:SegmentBinding %) == integral(x, s)$LF + operator : BasicOperator -> BasicOperator operator op == belong?(op)$AF => operator(op)$AF belong?(op)$EF => operator(op)$EF @@ -56199,12 +57213,14 @@ Expression(R:OrderedSet): Exports == Implementation where (n := arity op) case "failed" => operator name op operator(name op, n::NonNegativeInteger) + reduc : (%, List Kernel %) -> % reduc(x, l) == for k in l repeat p := minPoly k x := evl(numer x, k, p) /$Rep evl(denom x, k, p) x + evl0 : (MP, K) -> SparseUnivariatePolynomial Fraction MP evl0(p, k) == numer univariate(p::Fraction(MP), k)$PolynomialCategoryQuotientFunctions(IndexedExponents K, @@ -56212,6 +57228,7 @@ Expression(R:OrderedSet): Exports == Implementation where -- uses some operations from Rep instead of % in order not to -- reduce recursively during those operations. + evl : (MP, K, SparseUnivariatePolynomial %) -> Fraction MP evl(p, k, m) == degree(p, k) < degree m => p::Fraction(MP) (((evl0(p, k) pretend SparseUnivariatePolynomial($)) rem m) @@ -56220,22 +57237,28 @@ Expression(R:OrderedSet): Exports == Implementation where if R has GcdDomain then noalg?: SUP % -> Boolean - noalg? p == while p ^= 0 repeat not empty? algkernels kernels leadingCoefficient p => return false p := reductum p true + gcdPolynomial : (SparseUnivariatePolynomial(%), + SparseUnivariatePolynomial(%)) -> + SparseUnivariatePolynomial(%) gcdPolynomial(p:SUP %, q:SUP %) == noalg? p and noalg? q => gcdPolynomial(p, q)$Rep gcdPolynomial(p, q)$GcdDomain_&(%) + factorPolynomial : SparseUnivariatePolynomial(%) -> + Factored(SparseUnivariatePolynomial(%)) factorPolynomial(x:SUP %) : Factored SUP % == uf:= factor(x pretend SUP(Rep))$SupFractionFactorizer( IndexedExponents K,K,R,MP) uf pretend Factored SUP % + squareFreePolynomial : SparseUnivariatePolynomial(%) -> + Factored(SparseUnivariatePolynomial(%)) squareFreePolynomial(x:SUP %) : Factored SUP % == uf:= squareFree(x pretend SUP(Rep))$SupFractionFactorizer( IndexedExponents K,K,R,MP) @@ -56245,51 +57268,52 @@ Expression(R:OrderedSet): Exports == Implementation where -- this is to force the coercion R -> EXPR R to be used -- instead of the coercioon AN -> EXPR R which loops. -- simpler looking code will fail! MB 10/91 + coerce : AlgebraicNumber -> % coerce(x:AN):% == (monomial(x, 0$IndexedExponents(K))$MP)::% if (R has RetractableTo Integer) then - x:% ** r:Q == x **$AF r + ?**? : (%,Fraction(Integer)) -> % + x:% ** r:Q == x **$AF r - minPoly k == minPoly(k)$AF + minPoly : Kernel(%) -> SparseUnivariatePolynomial(%) + minPoly k == minPoly(k)$AF - definingPolynomial x == definingPolynomial(x)$AF + definingPolynomial : % -> % + definingPolynomial x == definingPolynomial(x)$AF - retract(x:%):Q == retract(x)$Rep + retract : % -> Fraction(Integer) + retract(x:%):Q == retract(x)$Rep + retractIfCan : % -> Union(Fraction(Integer),"failed") retractIfCan(x:%):Union(Q, "failed") == retractIfCan(x)$Rep if not(R is AN) then - k2expr : KAN -> % - - smp2expr: SparseMultivariatePolynomial(Integer, KAN) -> % - - R2AN : R -> Union(AN, "failed") - - k2an : K -> Union(AN, "failed") - - smp2an : MP -> Union(AN, "failed") - - + coerce : AN -> % coerce(x:AN):% == smp2expr(numer x) / smp2expr(denom x) - k2expr k == map(x+->x::%, k)$ExpressionSpaceFunctions2(AN, %) + k2expr : KAN -> % + k2expr k == map(x+->x::%, k)$ExpressionSpaceFunctions2(AN, %) + smp2expr: SparseMultivariatePolynomial(Integer, KAN) -> % smp2expr p == map(k2expr,x+->x::%,p)_ $PolynomialCategoryLifting(IndexedExponents KAN, KAN, Integer, SparseMultivariatePolynomial(Integer, KAN), %) + retractIfCan : % -> Union(AN, "failed") retractIfCan(x:%):Union(AN, "failed") == ((n:= smp2an numer x) case AN) and ((d:= smp2an denom x) case AN) => (n::AN) / (d::AN) "failed" + R2AN : R -> Union(AN, "failed") R2AN r == (u := retractIfCan(r::%)@Union(Q, "failed")) case Q => u::Q::AN "failed" + k2an : K -> Union(AN, "failed") k2an k == not(belong?(op := operator k)$AN) => "failed" arg:List(AN) := empty() @@ -56299,6 +57323,7 @@ Expression(R:OrderedSet): Exports == Implementation where else arg := concat(a::AN, arg) (operator(op)$AN) reverse_!(arg) + smp2an : MP -> Union(AN, "failed") smp2an p == (x1 := mainVariable p) case "failed" => R2AN leadingCoefficient p up := univariate(p, k := x1::K) @@ -56318,9 +57343,11 @@ Expression(R:OrderedSet): Exports == Implementation where import MakeUnaryCompiledFunction(%, %, %) + eval : (%,BasicOperator,%,Symbol) -> % eval(f:%, op: BasicOperator, g:%, x:Symbol):% == eval(f,[op],[g],x) + eval : (%,List(BasicOperator),List(%),Symbol) -> % eval(f:%, ls:List BasicOperator, lg:List %, x:Symbol) == -- handle subsrcipted symbols by renaming -> eval -> renaming back llsym:List List Symbol:=[variables g for g in lg] @@ -56338,18 +57365,23 @@ Expression(R:OrderedSet): Exports == Implementation where if R has PatternMatchable Integer then + patternMatch : (%,Pattern(Integer),PatternMatchResult(Integer,%)) ->_ + PatternMatchResult(Integer,%) if R has PATMAB(INT) patternMatch(x:%, p:Pattern Integer, l:PatternMatchResult(Integer, %)) == patternMatch(x, p, l)$PatternMatchFunctionSpace(Integer, R, %) if R has PatternMatchable Float then + patternMatch : (%,Pattern(Float),PatternMatchResult(Float,%)) ->_ + PatternMatchResult(Float,%) if R has PATMAB(FLOAT) patternMatch(x:%, p:Pattern Float, l:PatternMatchResult(Float, %)) == patternMatch(x, p, l)$PatternMatchFunctionSpace(Float, R, %) else -- R is not an integral domain + operator : BasicOperator -> BasicOperator operator op == belong?(op)$FSD => operator(op)$FSD belong?(op)$ESD => operator(op)$ESD @@ -56361,47 +57393,62 @@ Expression(R:OrderedSet): Exports == Implementation where Rep := MP - 0 == 0$Rep + 0 : () -> % + 0 == 0$Rep - 1 == 1$Rep + 1 : () -> % + 1 == 1$Rep - - x:% == -$Rep x + -? : % -> % + - x:% == -$Rep x + ?*? : (Integer,%) -> % n:Integer *x:% == n *$Rep x - x:% * y:% == x *$Rep y + ?*? : (%,%) -> % + x:% * y:% == x *$Rep y - x:% + y:% == x +$Rep y + ?+? : (%,%) -> % + x:% + y:% == x +$Rep y - x:% = y:% == x =$Rep y + ?=? : (%,%) -> Boolean + x:% = y:% == x =$Rep y - x:% < y:% == x <$Rep y + ? Boolean + x:% < y:% == x <$Rep y - numer x == x@Rep + numer : % -> SparseMultivariatePolynomial(R,Kernel(%)) + numer x == x@Rep + coerce : SparseMultivariatePolynomial(R,Kernel(%)) -> % coerce(p:MP):% == p + reducedSystem : Matrix(%) -> Matrix(Integer) reducedSystem(m:Matrix %):Matrix(R) == reducedSystem(m)$Rep + reducedSystem : (Matrix(%),Vector(%)) -> + Record(mat: Matrix(Integer),vec: Vector(Integer)) reducedSystem(m:Matrix %, v:Vector %): Record(mat:Matrix R, vec:Vector R) == reducedSystem(m, v)$Rep if R has ConvertibleTo InputForm then + convert : % -> InputForm convert(x:%):InputForm == convert(x)$Rep if R has PatternMatchable Integer then kintmatch: (K,Pattern Integer,PatternMatchResult(Integer,Rep)) -> PatternMatchResult(Integer, Rep) - kintmatch(k, p, l) == patternMatch(k, p, l pretend PatternMatchResult(Integer, %) )$PatternMatchKernel(Integer, %) pretend PatternMatchResult(Integer, Rep) + patternMatch: (%,Pattern(Integer),PatternMatchResult(Integer,%)) -> + PatternMatchResult(Integer,%) patternMatch(x:%, p:Pattern Integer, l:PatternMatchResult(Integer, %)) == patternMatch(x@Rep, p, @@ -56415,12 +57462,13 @@ Expression(R:OrderedSet): Exports == Implementation where kfltmatch: (K, Pattern Float, PatternMatchResult(Float, Rep)) -> PatternMatchResult(Float, Rep) - kfltmatch(k, p, l) == patternMatch(k, p, l pretend PatternMatchResult(Float, %) )$PatternMatchKernel(Float, %) pretend PatternMatchResult(Float, Rep) + patternMatch : (%,Pattern(Float),PatternMatchResult(Float,%)) -> + PatternMatchResult(Float,%) patternMatch(x:%, p:Pattern Float, l:PatternMatchResult(Float, %)) == patternMatch(x@Rep, p, @@ -56435,59 +57483,73 @@ Expression(R:OrderedSet): Exports == Implementation where if R has AbelianMonoid then import ListToMap(K, %) - - kereval : (K, List K, List %) -> % - - subeval : (K, List K, List %) -> % - Rep := FreeAbelianGroup K - 0 == 0$Rep + 0 : () -> % + 0 == 0$Rep - x:% + y:% == x +$Rep y + ?+? : (%,%) -> % + x:% + y:% == x +$Rep y - x:% = y:% == x =$Rep y + ?=? : (%,%) -> Boolean + x:% = y:% == x =$Rep y - x:% < y:% == x <$Rep y + ? Boolean + x:% < y:% == x <$Rep y + coerce : Kernel(%) -> % coerce(k:K):% == coerce(k)$Rep - kernels x == [f.gen for f in terms x] + kernels : % -> List(Kernel(%)) + kernels x == [f.gen for f in terms x] + coerce : R -> % coerce(x:R):% == (zero? x => 0; constantKernel(x)::%) + retract : % -> R retract(x:%):R == (zero? x => 0; retNotUnit x) + coerce : % -> OutputForm coerce(x:%):OutputForm == coerce(x)$Rep + kereval : (K, List K, List %) -> % kereval(k, lk, lv) == match(lk, lv, k, (x2:K):% +-> map(x1 +-> eval(x1, lk, lv), x2)) + subeval : (K, List K, List %) -> % subeval(k, lk, lv) == match(lk, lv, k, (x:K):% +-> kernel(operator x, [subst(a, lk, lv) for a in argument x])) + isPlus : % -> Union(List(%),"failed") isPlus x == empty?(l := terms x) or empty? rest l => "failed" [t.exp *$Rep t.gen for t in l]$List(%) + isMult : % -> Union(Record(coef: Integer,var: Kernel(%)),"failed") isMult x == empty?(l := terms x) or not empty? rest l => "failed" t := first l [t.exp, t.gen] + eval : (%,List(Kernel(%)),List(%)) -> % eval(x:%, lk:List K, lv:List %) == _+/[t.exp * kereval(t.gen, lk, lv) for t in terms x] + subst : (%,List(Kernel(%)),List(%)) -> % subst(x:%, lk:List K, lv:List %) == _+/[t.exp * subeval(t.gen, lk, lv) for t in terms x] + retractIfCan : % -> Union(R,"failed") retractIfCan(x:%):Union(R, "failed") == zero? x => 0 retNotUnitIfCan x - if R has AbelianGroup then -(x:%) == -$Rep x + if R has AbelianGroup then + + -? : % -> % + -(x:%) == -$Rep x else -- R is nothing @@ -56495,32 +57557,44 @@ Expression(R:OrderedSet): Exports == Implementation where Rep := K - x:% < y:% == x <$Rep y + ? Boolean + x:% < y:% == x <$Rep y - x:% = y:% == x =$Rep y + ?=? : (%,%) -> Boolean + x:% = y:% == x =$Rep y + coerce : Kernel(%) -> % coerce(k:K):% == k - kernels x == [x pretend K] + kernels : % -> List(Kernel(%)) + kernels x == [x pretend K] + coerce : R -> % coerce(x:R):% == constantKernel x + retract : % -> R retract(x:%):R == retNotUnit x + retractIfCan : % -> Union(R,"failed") retractIfCan(x:%):Union(R, "failed") == retNotUnitIfCan x - coerce(x:%):OutputForm == coerce(x)$Rep + coerce : % -> OutputForm + coerce(x:%):OutputForm == coerce(x)$Rep + eval : (%,List(Kernel(%)),List(%)) -> % eval(x:%, lk:List K, lv:List %) == match(lk, lv, x pretend K, (x1:K):% +-> map(x2 +-> eval(x2, lk, lv), x1)) + subst : (%,List(Kernel(%)),List(%)) -> % subst(x, lk, lv) == match(lk, lv, x pretend K, (x1:K):% +-> kernel(operator x1, [subst(a, lk, lv) for a in argument x1])) if R has ConvertibleTo InputForm then + + convert : % -> InputForm convert(x:%):InputForm == convert(x)$Rep *) @@ -56891,19 +57965,25 @@ ExponentialOfUnivariatePuiseuxSeries(FE,var,cen):_ Rep := UPXS + exponential : UnivariatePuiseuxSeries(FE,var,cen) -> % exponential f == complete f + exponent : % -> UnivariatePuiseuxSeries(FE,var,cen) exponent f == f pretend UPXS + exponentialOrder : % -> Fraction(Integer) exponentialOrder f == order(exponent f,0) + zero? : % -> Boolean zero? f == empty? entries complete terms f - f = g == -- we redefine equality because we know that we are dealing with -- a FINITE series, so there is no danger in computing all terms + ?=? : (%,%) -> Boolean + f = g == (entries complete terms f) = (entries complete terms g) + ? Boolean f < g == zero? f => not zero? g zero? g => false @@ -56913,6 +57993,7 @@ ExponentialOfUnivariatePuiseuxSeries(FE,var,cen):_ reductum(f) < reductum(g) fCoef < gCoef -- this is "random" if FE is EXPR INT + coerce : % -> OutputForm coerce(f:%):OutputForm == ("%e" :: OutputForm) ** ((coerce$Rep)(complete f)@OutputForm) @@ -57092,26 +58173,33 @@ ExtAlgBasis(): Export == Implement where x,y : % + ?=? : (%,%) -> Boolean x = y == x =$Rep y + ? Boolean x < y == null x => not null y null y => false first x = first y => rest x < rest y first x > first y + coerce : List(Integer) -> % coerce(li:(L I)) == for x in li repeat if x ^= 1 and x ^= 0 then error "coerce: values can only be 0 and 1" li - degree x == (_+/x)::NNI + degree : % -> NonNegativeInteger + degree x == (_+/x)::NNI - exponents x == copy(x @ Rep) + exponents : % -> List(Integer) + exponents x == copy(x @ Rep) - Nul n == [0 for i in 1..n] + Nul : NonNegativeInteger -> % + Nul n == [0 for i in 1..n] - coerce x == coerce(x @ Rep)$(L I) + coerce : % -> OutputForm + coerce x == coerce(x @ Rep)$(L I) *) @@ -57299,6 +58387,12 @@ e04dgfAnnaType(): NumericalOptimizationCategory == Result add Rep:=Result import Rep, NagOptimisationPackage, ExpertSystemToolsPackage + measure : (RoutinesTable,Record(fn: Expression(DoubleFloat), + init: List(DoubleFloat), + lb: List(OrderedCompletion(DoubleFloat)), + cf: List(Expression(DoubleFloat)), + ub: List(OrderedCompletion(DoubleFloat)))) -> + Record(measure: Float,explanations: String) measure(R:RoutinesTable,args:NOA) == string:String := "e04dgf is " positive?(#(args.cf) + #(args.lb) + #(args.ub)) => @@ -57307,6 +58401,10 @@ e04dgfAnnaType(): NumericalOptimizationCategory == Result add string := concat(string,"recommended") [getMeasure(R,e04dgf@Symbol)$RoutinesTable, string] + numericalOptimization : Record(fn: Expression(DoubleFloat), + init: List(DoubleFloat),lb: List(OrderedCompletion(DoubleFloat)), + cf: List(Expression(DoubleFloat)), + ub: List(OrderedCompletion(DoubleFloat))) -> Result numericalOptimization(args:NOA) == argsFn:EDF := args.fn n:NNI := #(variables(argsFn)$EDF) @@ -57532,6 +58630,11 @@ e04fdfAnnaType(): NumericalOptimizationCategory == Result add import Rep, NagOptimisationPackage import e04AgentsPackage,ExpertSystemToolsPackage + measure : (RoutinesTable,Record(fn: Expression(DoubleFloat), + init: List(DoubleFloat),lb: List(OrderedCompletion(DoubleFloat)), + cf: List(Expression(DoubleFloat)), + ub: List(OrderedCompletion(DoubleFloat)))) -> + Record(measure: Float,explanations: String) measure(R:RoutinesTable,args:NOA) == argsFn := args.fn string:String := "e04fdf is " @@ -57550,10 +58653,16 @@ e04fdfAnnaType(): NumericalOptimizationCategory == Result add "recommended since the function is a sum of squares.") [getMeasure(R,e04fdf@Symbol)$RoutinesTable, string] + measure : (RoutinesTable,Record(lfn: List(Expression(DoubleFloat)), + init: List(DoubleFloat))) -> Record(measure: Float,explanations: String) measure(R:RoutinesTable,args:LSA) == string:String := "e04fdf is recommended" [getMeasure(R,e04fdf@Symbol)$RoutinesTable, string] + numericalOptimization : Record(fn: Expression(DoubleFloat), + init: List(DoubleFloat),lb: List(OrderedCompletion(DoubleFloat)), + cf: List(Expression(DoubleFloat)), + ub: List(OrderedCompletion(DoubleFloat))) -> Result numericalOptimization(args:NOA) == argsFn := args.fn lw:INT := 14 @@ -57565,6 +58674,8 @@ e04fdfAnnaType(): NumericalOptimizationCategory == Result add changeNameToObjf(fsumsq@Symbol,out) empty()$Result + numericalOptimization : Record(lfn: List(Expression(DoubleFloat)), + init: List(DoubleFloat)) -> Result numericalOptimization(args:LSA) == argsFn := copy args.lfn m:INT := #(argsFn) @@ -57808,6 +58919,11 @@ e04gcfAnnaType(): NumericalOptimizationCategory == Result add import Rep, NagOptimisationPackage,ExpertSystemContinuityPackage import e04AgentsPackage,ExpertSystemToolsPackage + measure : (RoutinesTable,Record(fn: Expression(DoubleFloat), + init: List(DoubleFloat),lb: List(OrderedCompletion(DoubleFloat)), + cf: List(Expression(DoubleFloat)), + ub: List(OrderedCompletion(DoubleFloat)))) -> + Record(measure: Float,explanations: String) measure(R:RoutinesTable,args:NOA) == argsFn:EDF := args.fn string:String := "e04gcf is " @@ -57833,6 +58949,8 @@ e04gcfAnnaType(): NumericalOptimizationCategory == Result add "recommended since the function is a sum of squares.") [getMeasure(R,e04gcf@Symbol)$RoutinesTable, string] + measure : (RoutinesTable,Record(lfn: List(Expression(DoubleFloat)), + init: List(DoubleFloat))) -> Record(measure: Float,explanations: String) measure(R:RoutinesTable,args:LSA) == string:String := "e04gcf is " a := coerce(float(10,0,10))$OCDF @@ -57848,6 +58966,10 @@ e04gcfAnnaType(): NumericalOptimizationCategory == Result add m := m-(1-exp(-(expenseOfEvaluation(args))**3)) [m, string] + numericalOptimization : Record(fn: Expression(DoubleFloat), + init: List(DoubleFloat),lb: List(OrderedCompletion(DoubleFloat)), + cf: List(Expression(DoubleFloat)), + ub: List(OrderedCompletion(DoubleFloat))) -> Result numericalOptimization(args:NOA) == argsFn:EDF := args.fn lw:INT := 16 @@ -57859,6 +58981,8 @@ e04gcfAnnaType(): NumericalOptimizationCategory == Result add changeNameToObjf(fsumsq@Symbol,out) empty()$Result + numericalOptimization : Record(lfn: List(Expression(DoubleFloat)), + init: List(DoubleFloat)) -> Result numericalOptimization(args:LSA) == argsFn := copy args.lfn m:NNI := #(argsFn) @@ -58073,12 +59197,18 @@ e04jafAnnaType(): NumericalOptimizationCategory == Result add import Rep, NagOptimisationPackage import e04AgentsPackage,ExpertSystemToolsPackage + bound : LOCDF,LOCDF -> Integer bound(a:LOCDF,b:LOCDF):Integer == empty?(concat(a,b)) => 1 (#(removeDuplicates(a)) = 1) and zero?(first(a)) => 2 (#(removeDuplicates(a)) = 1) and (#(removeDuplicates(b)) = 1) => 3 0 + measure : (RoutinesTable,Record(fn: Expression(DoubleFloat), + init: List(DoubleFloat),lb: List(OrderedCompletion(DoubleFloat)), + cf: List(Expression(DoubleFloat)), + ub: List(OrderedCompletion(DoubleFloat)))) -> + Record(measure: Float,explanations: String) measure(R:RoutinesTable,args:NOA) == string:String := "e04jaf is " if positive?(#(args.cf)) then @@ -58095,6 +59225,10 @@ e04jafAnnaType(): NumericalOptimizationCategory == Result add [getMeasure(R,e04jaf@Symbol)$RoutinesTable, string] [0.0,string] + numericalOptimization : Record(fn: Expression(DoubleFloat), + init: List(DoubleFloat),lb: List(OrderedCompletion(DoubleFloat)), + cf: List(Expression(DoubleFloat)), + ub: List(OrderedCompletion(DoubleFloat))) -> Result numericalOptimization(args:NOA) == argsFn:EDF := args.fn n:NNI := #(variables(argsFn)$EDF) @@ -58299,11 +59433,20 @@ e04mbfAnnaType(): NumericalOptimizationCategory == Result add import Rep, NagOptimisationPackage import e04AgentsPackage,ExpertSystemToolsPackage + measure : (RoutinesTable,Record(fn: Expression(DoubleFloat), + init: List(DoubleFloat),lb: List(OrderedCompletion(DoubleFloat)), + cf: List(Expression(DoubleFloat)), + ub: List(OrderedCompletion(DoubleFloat)))) -> + Record(measure: Float,explanations: String) measure(R:RoutinesTable,args:NOA) == (not linear?([args.fn])) or (not linear?(args.cf)) => [0.0,"e04mbf is for a linear objective function and constraints only."] [getMeasure(R,e04mbf@Symbol)$RoutinesTable,"e04mbf is recommended" ] + numericalOptimization : Record(fn: Expression(DoubleFloat), + init: List(DoubleFloat),lb: List(OrderedCompletion(DoubleFloat)), + cf: List(Expression(DoubleFloat)), + ub: List(OrderedCompletion(DoubleFloat))) -> Result numericalOptimization(args:NOA) == argsFn:EDF := args.fn c := args.cf @@ -58528,6 +59671,11 @@ e04nafAnnaType(): NumericalOptimizationCategory == Result add import Rep, NagOptimisationPackage import e04AgentsPackage,ExpertSystemToolsPackage + measure : (RoutinesTable,Record(fn: Expression(DoubleFloat), + init: List(DoubleFloat),lb: List(OrderedCompletion(DoubleFloat)), + cf: List(Expression(DoubleFloat)), + ub: List(OrderedCompletion(DoubleFloat)))) -> + Record(measure: Float,explanations: String) measure(R:RoutinesTable,args:NOA) == string:String := "e04naf is " argsFn:EDF := args.fn @@ -58539,6 +59687,10 @@ e04nafAnnaType(): NumericalOptimizationCategory == Result add [getMeasure(R,e04naf@Symbol)$RoutinesTable, string] [0.0,string] + numericalOptimization : Record(fn: Expression(DoubleFloat), + init: List(DoubleFloat),lb: List(OrderedCompletion(DoubleFloat)), + cf: List(Expression(DoubleFloat)), + ub: List(OrderedCompletion(DoubleFloat))) -> Result numericalOptimization(args:NOA) == argsFn:EDF := args.fn c := args.cf @@ -58788,6 +59940,11 @@ e04ucfAnnaType(): NumericalOptimizationCategory == Result add import Rep,NagOptimisationPackage import e04AgentsPackage,ExpertSystemToolsPackage + measure : (RoutinesTable,Record(fn: Expression(DoubleFloat), + init: List(DoubleFloat),lb: List(OrderedCompletion(DoubleFloat)), + cf: List(Expression(DoubleFloat)), + ub: List(OrderedCompletion(DoubleFloat)))) -> + Record(measure: Float,explanations: String) measure(R:RoutinesTable,args:NOA) == zero?(#(args.lb) + #(args.ub)) => [0.0,"e04ucf is not recommended if there are no bounds specified"] @@ -58797,6 +59954,10 @@ e04ucfAnnaType(): NumericalOptimizationCategory == Result add [getMeasure(R,e04ucf@Symbol)$RoutinesTable*0.5,string] [getMeasure(R,e04ucf@Symbol)$RoutinesTable,"e04ucf is recommended"] + numericalOptimization : Record(fn: Expression(DoubleFloat), + init: List(DoubleFloat),lb: List(OrderedCompletion(DoubleFloat)), + cf: List(Expression(DoubleFloat)), + ub: List(OrderedCompletion(DoubleFloat))) -> Result numericalOptimization(args:NOA) == Args := sortConstraints(args) argsFn := Args.fn @@ -60201,6 +61362,8 @@ Factored(R: IntegralDomain): Exports == Implementation where Rep := Record(unt:R, fct:List FF) if R has ConvertibleTo InputForm then + + convert : % -> InputForm convert(x:%):InputForm == empty?(lf := reverse factorList x) => convert(unit x)@InputForm l := empty()$List(InputForm) @@ -60233,75 +61396,84 @@ Factored(R: IntegralDomain): Exports == Implementation where orderedR? := R has OrderedSet - -- Private function signatures: - reciprocal : % -> % + nilFactor : (R,Integer) -> % + nilFactor(r, i) == flagFactor(r, i, "nil") - qexpand : % -> R + sqfrFactor : (R,Integer) -> % + sqfrFactor(r, i) == flagFactor(r, i, "sqfr") - negexp? : % -> Boolean + irreducibleFactor(r, i) == flagFactor(r, i, "irred") - SimplifyFactorization : List FF -> List FF + primeFactor : (R,Integer) -> % + primeFactor(r, i) == flagFactor(r, i, "prime") - LispLessP : (FF, FF) -> Boolean + unit? : % -> Boolean + unit? u == (empty? u.fct) and (not zero? u.unt) - mkFF : (R, List FF) -> % + factorList : % -> + List(Record(flg: Union("nil","sqfr","irred","prime"), + fctr: R,xpnt: Integer)) + factorList u == u.fct - SimplifyFactorization1 : (FF, List FF) -> List FF - - stricterFlag : (fUnion, fUnion) -> fUnion - - nilFactor(r, i) == flagFactor(r, i, "nil") + unit : % -> R + unit u == u.unt - sqfrFactor(r, i) == flagFactor(r, i, "sqfr") + numberOfFactors : % -> NonNegativeInteger + numberOfFactors u == # u.fct - irreducibleFactor(r, i) == flagFactor(r, i, "irred") + 0 : () -> % + 0 == [1, [["nil", 0, 1]$FF]] - primeFactor(r, i) == flagFactor(r, i, "prime") - - unit? u == (empty? u.fct) and (not zero? u.unt) - - factorList u == u.fct - - unit u == u.unt - - numberOfFactors u == # u.fct - - 0 == [1, [["nil", 0, 1]$FF]] - - zero? u == # u.fct = 1 and - (first u.fct).flg case "nil" and - zero? (first u.fct).fctr and - (u.unt = 1) + zero? : % -> Boolean + zero? u == # u.fct = 1 and + (first u.fct).flg case "nil" and + zero? (first u.fct).fctr and + (u.unt = 1) - 1 == [1, empty()] + 1 : () -> % + 1 == [1, empty()] - one? u == empty? u.fct and u.unt = 1 + one? : % -> Boolean + one? u == empty? u.fct and u.unt = 1 - mkFF(r, x) == [r, x] + mkFF : (R, List FF) -> % + mkFF(r, x) == [r, x] + coerce : Integer -> % coerce(j:Integer):% == (j::R)::% - characteristic() == characteristic()$R + characteristic : () -> NonNegativeInteger + characteristic() == characteristic()$R - i:Integer * u:% == (i :: %) * u + ?*? : (Integer,%) -> % + i:Integer * u:% == (i :: %) * u - r:R * u:% == (r :: %) * u + ?*? : (R,%) -> % + r:R * u:% == (r :: %) * u - factors u == [[fe.fctr, fe.xpnt] for fe in factorList u] + factors : % -> List(Record(factor: R,exponent: Integer)) + factors u == [[fe.fctr, fe.xpnt] for fe in factorList u] - expand u == retract u + expand : % -> R + expand u == retract u - negexp? x == "or"/[negative?(y.xpnt) for y in factorList x] + negexp? : % -> Boolean + negexp? x == "or"/[negative?(y.xpnt) for y in factorList x] + makeFR : (R,List(Record(flg: Union("nil","sqfr","irred","prime"), + fctr: R,xpnt: Integer))) -> % makeFR(u, l) == unitNormalize mkFF(u, SimplifyFactorization l) if R has IntegerNumberSystem then - rational? x == true + rational? : % -> Boolean if R has INS + rational? x == true + rationalIfCan : % -> Union(Fraction(Integer),"failed") if R has INS rationalIfCan x == rational x + rational : % -> Fraction(Integer) if R has INS rational x == convert(unit x)@Integer * _*/[(convert(f.fctr)@Integer)::Fraction(Integer) @@ -60309,28 +61481,34 @@ Factored(R: IntegralDomain): Exports == Implementation where if R has Eltable(R, R) then + ?.? : (%,%) -> % if R has ELTAB($,$) elt(x:%, v:%) == x(expand v) if R has Evalable(R) then + eval : (%,List(Equation(%))) -> % if R has EVALAB($) eval(x:%, l:List Equation %) == eval(x,[expand lhs e = expand rhs e for e in l]$List(Equation R)) if R has InnerEvalable(Symbol, R) then + eval : (%,List(Symbol),List(%)) -> % if R has IEVALAB(SYMBOL,$) eval(x:%, ls:List Symbol, lv:List %) == eval(x, ls, [expand v for v in lv]$List(R)) if R has RealConstant then + convert : % -> Float convert(x:%):Float == convert(unit x)@Float * _*/[convert(f.fctr)@Float ** f.xpnt for f in factorList x] + convert : % -> DoubleFloat if R has REAL convert(x:%):DoubleFloat == convert(unit x)@DoubleFloat * _*/[convert(f.fctr)@DoubleFloat ** f.xpnt for f in factorList x] + ?*? : (%,%) -> % u:% * v:% == zero? u or zero? v => 0 (u = 1) => v @@ -60338,9 +61516,11 @@ Factored(R: IntegralDomain): Exports == Implementation where mkFF(unit u * unit v, SimplifyFactorization concat(factorList u, copy factorList v)) + ?**? : (%,NonNegativeInteger) -> % u:% ** n:NonNegativeInteger == mkFF(unit(u)**n, [[x.flg, x.fctr, n * x.xpnt] for x in factorList u]) + SimplifyFactorization : List FF -> List FF SimplifyFactorization x == empty? x => empty() x := sort_!(LispLessP, x) @@ -60348,6 +61528,7 @@ Factored(R: IntegralDomain): Exports == Implementation where if orderedR? then x := sort_!(LispLessP, x) x + SimplifyFactorization1 : (FF, List FF) -> List FF SimplifyFactorization1(f, x) == empty? x => zero?(f.xpnt) => empty() @@ -60360,7 +61541,7 @@ Factored(R: IntegralDomain): Exports == Implementation where zero?(f.xpnt) => l concat(f, l) - + coerce : % -> OutputForm coerce(x:%):OutputForm == empty?(lf := reverse factorList x) => (unit x)::OutputForm l := empty()$List(OutputForm) @@ -60376,23 +61557,28 @@ Factored(R: IntegralDomain): Exports == Implementation where 1 = unit x => e (unit x)::OutputForm * e + retract : % -> R retract(u:%):R == negexp? u => error "Negative exponent in factored object" qexpand u + qexpand : % -> R qexpand u == unit u * _*/[y.fctr ** (y.xpnt::NonNegativeInteger) for y in factorList u] + retractIfCan : % -> Union(R,"failed") retractIfCan(u:%):Union(R, "failed") == negexp? u => "failed" qexpand u + LispLessP : (FF, FF) -> Boolean LispLessP(y, y1) == orderedR? => y.fctr < y1.fctr GGREATERP(y.fctr, y1.fctr)$Lisp => false true + stricterFlag : (fUnion, fUnion) -> fUnion stricterFlag(fl1, fl2) == fl1 case "prime" => fl1 fl1 case "irred" => @@ -60405,46 +61591,61 @@ Factored(R: IntegralDomain): Exports == Implementation where if R has IntegerNumberSystem then + + coerce : R -> % coerce(r:R):% == factor(r)$IntegerFactorizationPackage(R) pretend % + else if R has UniqueFactorizationDomain then + + coerce : R -> % coerce(r:R):% == zero? r => 0 unit? r => mkFF(r, empty()) unitNormalize(squareFree(r) pretend %) + else + + coerce : R -> % coerce(r:R):% == (r = 1) => 1 unitNormalize mkFF(1, [["nil", r, 1]$FF]) + ?=? : (%,%) -> Boolean u = v == (unit u = unit v) and # u.fct = # v.fct and set(factors u)$SRFE =$SRFE set(factors v)$SRFE + -? : % -> % - u == zero? u => u mkFF(- unit u, factorList u) + recip : % -> Union(%,"failed") recip u == not empty? factorList u => "failed" (r := recip unit u) case "failed" => "failed" mkFF(r::R, empty()) + reciprocal : % -> % reciprocal u == mkFF((recip unit u)::R, [[y.flg, y.fctr, - y.xpnt]$FF for y in factorList u]) + exponent : % -> Integer exponent u == -- exponent of first factor empty?(fl := factorList u) or zero? u => 0 first(fl).xpnt + nthExponent : (%,Integer) -> Integer nthExponent(u, i) == l := factorList u zero? u or i < 1 or i > #l => 0 (l.(minIndex(l) + i - 1)).xpnt + nthFactor : (%,Integer) -> R nthFactor(u, i) == zero? u => 0 zero? i => unit u @@ -60452,25 +61653,30 @@ Factored(R: IntegralDomain): Exports == Implementation where negative? i or i > #l => 1 (l.(minIndex(l) + i - 1)).fctr + nthFlag : (%,Integer) -> Union("nil","sqfr","irred","prime") nthFlag(u, i) == l := factorList u zero? u or i < 1 or i > #l => "nil" (l.(minIndex(l) + i - 1)).flg + flagFactor : (R,Integer,Union("nil","sqfr","irred","prime")) -> % flagFactor(r, i, fl) == zero? i => 1 zero? r => 0 unitNormalize mkFF(1, [[fl, r, i]$FF]) + differentiate : (%,(R -> R)) -> % differentiate(u:%, deriv: R -> R) == ans := deriv(unit u) * ((u exquo unit(u)::%)::%) ans + (_+/[fact.xpnt * deriv(fact.fctr) * ((u exquo nilFactor(fact.fctr, 1))::%) for fact in factorList u]) + map : ((R -> R),%) -> % map(fn, u) == fn(unit u) * _*/[irreducibleFactor(fn(f.fctr),f.xpnt)_ for f in factorList u] + exquo : (%,%) -> Union(%,"failed") u exquo v == empty?(x1 := factorList v) => unitNormal(retract v).associate * u empty? factorList u => "failed" @@ -60483,6 +61689,7 @@ Factored(R: IntegralDomain): Exports == Implementation where goodQuotient => v1 "failed" + unitNormal : % -> Record(unit: %,canonical: %,associate: %) unitNormal u == -- does a bunch of work, but more canonical (ur := recip(un := unit u)) case "failed" => [1, u, 1] as := ur::R @@ -60501,18 +61708,21 @@ Factored(R: IntegralDomain): Exports == Implementation where vl := concat([x.flg, ucar.canonical, x.xpnt], vl) [mkFF(un, empty()), mkFF(1, reverse_! vl), mkFF(as, empty())] + unitNormalize : % -> % unitNormalize u == uca := unitNormal u mkFF(unit(uca.unit)*unit(uca.canonical),factorList(uca.canonical)) if R has GcdDomain then + ?+? : (%,%) -> % u + v == zero? u => v zero? v => u v1 := reciprocal(u1 := gcd(u, v)) (expand(u * v1) + expand(v * v1)) * u1 + gcd : (%,%) -> % gcd(u, v) == (u = 1) or (v = 1) => 1 zero? u => v @@ -60548,6 +61758,7 @@ Factored(R: IntegralDomain): Exports == Implementation where else -- R not a GCD domain + ?+? : (%,%) -> % u + v == zero? u => v zero? v => u @@ -60555,6 +61766,7 @@ Factored(R: IntegralDomain): Exports == Implementation where if R has UniqueFactorizationDomain then + prime? : % -> Boolean prime? u == not(empty?(l := factorList u)) and (empty? rest l) and ((l.first.xpnt) = 1) and (l.first.flg case "prime") @@ -60850,27 +62062,34 @@ File(S:SetCategory): FileCategory(FileName, S) with f1 = f2 == f1.fileName = f2.fileName + coerce(f: %): OutputForm == f.fileName::OutputForm open fname == open(fname, "input") + open(fname, mode) == fstream := defstream(fname, mode) [fname, fstream, mode] + reopen_!(f, mode) == fname := f.fileName f.fileState := defstream(fname, mode) f.fileIOmode:= mode f + close_! f == SHUT(f.fileState)$Lisp f.fileIOmode := "closed" f + name f == f.fileName + iomode f == f.fileIOmode + read_! f == f.fileIOmode ^= "input" => error "File not in read state" @@ -60878,12 +62097,14 @@ File(S:SetCategory): FileCategory(FileName, S) with PLACEP(x)$Lisp => error "End of file" x + readIfCan_! f == f.fileIOmode ^= "input" => error "File not in read state" x: S := VMREAD(f.fileState)$Lisp PLACEP(x)$Lisp => "failed" x + write_!(f, x) == f.fileIOmode ^= "output" => error "File not in write state" @@ -60900,6 +62121,91 @@ File(S:SetCategory): FileCategory(FileName, S) with \begin{chunk}{COQ FILE} (* domain FILE *) (* + FileState ==> SExpression + IOMode ==> String + + Rep:=Record(fileName: FileName, _ + fileState: FileState, _ + fileIOmode: IOMode) + + defstream : (FileName,IOMode) -> FileState + defstream(fn: FileName, mode: IOMode): FileState == + mode = "input" => + not readable? fn => error ["File is not readable", fn] + MAKE_-INSTREAM(fn::String)$Lisp + mode = "output" => + not writable? fn => error ["File is not writable", fn] + MAKE_-OUTSTREAM(fn::String)$Lisp + error ["IO mode must be input or output", mode] + + ?=? : (%,%) -> Boolean + f1 = f2 == + f1.fileName = f2.fileName + + coerce : % -> OutputForm + coerce(f: %): OutputForm == + f.fileName::OutputForm + + open : FileName -> % + open fname == + open(fname, "input") + + open : (FileName,String) -> % + open(fname, mode) == + fstream := defstream(fname, mode) + [fname, fstream, mode] + + reopen! : (%,String) -> % + reopen_!(f, mode) == + fname := f.fileName + f.fileState := defstream(fname, mode) + f.fileIOmode:= mode + f + + close! : % -> % + close_! f == + SHUT(f.fileState)$Lisp + f.fileIOmode := "closed" + f + + name : % -> FileName + name f == + f.fileName + + iomode : % -> String + iomode f == + f.fileIOmode + + read! : % -> S + read_! f == + f.fileIOmode ^= "input" => + error "File not in read state" + x := VMREAD(f.fileState)$Lisp + PLACEP(x)$Lisp => + error "End of file" + x + + readIfCan! : % -> Union(S,"failed") + readIfCan_! f == + f.fileIOmode ^= "input" => + error "File not in read state" + x: S := VMREAD(f.fileState)$Lisp + PLACEP(x)$Lisp => "failed" + x + + write! : (%,S) -> S + write_!(f, x) == + f.fileIOmode ^= "output" => + error "File not in write state" + z := PRINT_-FULL(x, f.fileState)$Lisp + TERPRI(f.fileState)$Lisp + x + + flush : % -> Void + flush f == + f.fileIOmode ^= "output" => error "File not in write state" + FORCE_-OUTPUT(f.fileState)$Lisp + *) \end{chunk} @@ -61274,29 +62580,41 @@ FileName(): FileNameCategory == add (* domain FNAME *) (* - f1 = f2 == EQUAL(f1, f2)$Lisp + ?=? : (%,%) -> Boolean + f1 = f2 == EQUAL(f1, f2)$Lisp + coerce : % -> OutputForm coerce(f: %): OutputForm == f::String::OutputForm - coerce(f: %): String == NAMESTRING(f)$Lisp + coerce : % -> String + coerce(f: %): String == NAMESTRING(f)$Lisp - coerce(s: String): % == PARSE_-NAMESTRING(s)$Lisp + coerce : String -> % + coerce(s: String): % == PARSE_-NAMESTRING(s)$Lisp - filename(d,n,e) == fnameMake(d,n,e)$Lisp + filename : (String,String,String) -> % + filename(d,n,e) == fnameMake(d,n,e)$Lisp - directory(f:%): String == fnameDirectory(f)$Lisp + directory : % -> String + directory(f:%): String == fnameDirectory(f)$Lisp - name(f:%): String == fnameName(f)$Lisp + name : % -> String + name(f:%): String == fnameName(f)$Lisp - extension(f:%): String == fnameType(f)$Lisp + extension : % -> String + extension(f:%): String == fnameType(f)$Lisp - exists? f == fnameExists?(f)$Lisp + exists? : % -> Boolean + exists? f == fnameExists?(f)$Lisp - readable? f == fnameReadable?(f)$Lisp + readable? : % -> Boolean + readable? f == fnameReadable?(f)$Lisp - writable? f == fnameWritable?(f)$Lisp + writable? : % -> Boolean + writable? f == fnameWritable?(f)$Lisp - new(d,pref,e) == fnameNew(d,pref,e)$Lisp + new : (String,String,String) -> % + new(d,pref,e) == fnameNew(d,pref,e)$Lisp *) @@ -61543,45 +62861,56 @@ FiniteDivisor(F, UP, UPUP, R): Exports == Implementation where import CommonDenominator(UP, RF, Vector RF) import UnivariatePolynomialCommonDenominator(UP, RF, UPUP) - makeDivisor : (UP, UPUP, UP) -> % - - intReduce : (R, UP) -> R - ww := integralBasis()$R - 0 == [1, empty()] + 0 : () -> % + 0 == [1, empty()] - divisor(i:ID) == [i, empty()] + divisor : FractionalIdeal(UP,Fraction(UP),UPUP,R) -> % + divisor(i:ID) == [i, empty()] - divisor(f:R) == divisor ideal [f] + divisor : R -> % + divisor(f:R) == divisor ideal [f] + coerce : % -> OutputForm coerce(d:%):OutputForm == ideal(d)::OutputForm - ideal d == d.id + ideal : % -> FractionalIdeal(UP,Fraction(UP),UPUP,R) + ideal d == d.id - decompose d == [ideal d, 1] + decompose : % -> + Record(id: FractionalIdeal(UP,Fraction(UP),UPUP,R),principalPart: R) + decompose d == [ideal d, 1] - d1 = d2 == basis(ideal d1) = basis(ideal d2) + ?=? : (%,%) -> Boolean + d1 = d2 == basis(ideal d1) = basis(ideal d2) - n * d == divisor(ideal(d) ** n) + ?*? : (Integer,%) -> % + n * d == divisor(ideal(d) ** n) - d1 + d2 == divisor(ideal d1 * ideal d2) + ?+? : (%,%) -> % + d1 + d2 == divisor(ideal d1 * ideal d2) - - d == divisor inv ideal d + -? : % -> % + - d == divisor inv ideal d + divisor : (R,UP,UP,UP,F) -> % divisor(h, d, dp, g, r) == makeDivisor(d, lift h - (r * dp)::RF::UPUP, g) + intReduce : (R, UP) -> R intReduce(h, b) == v := integralCoordinates(h).num integralRepresents( [qelt(v, i) rem b for i in minIndex v .. maxIndex v], 1) + divisor : (F,F) -> % divisor(a, b) == x := monomial(1, 1)$UP not ground? gcd(d := x - a::UP, retract(discriminant())@UP) => error "divisor: point is singular" makeDivisor(d, monomial(1, 1)$UPUP - b::UP::RF::UPUP, 1) + divisor : (F,F,Integer) -> % divisor(a, b, n) == not(ground? gcd(d := monomial(1, 1)$UP - a::UP, retract(discriminant())@UP)) and @@ -61594,6 +62923,7 @@ FiniteDivisor(F, UP, UPUP, R): Exports == Implementation where n < 0 => -g g + reduce : % -> % reduce d == (i := minimize(j := ideal d)) = j => d #(n := numer i) ^= 2 => divisor i @@ -61604,12 +62934,14 @@ FiniteDivisor(F, UP, UPUP, R): Exports == Implementation where divisor ideal([(b / e)::R, reduce map((s:RF):RF+->(retract(s)@UP rem b)/e, cd.num)]$Vector(R)) + finiteBasis : % -> Vector(R) finiteBasis d == if empty?(d.fbasis) then d.fbasis := normalizeAtInfinity basis module(ideal d)$FramedModule(UP, RF, UPUP, R, ww) d.fbasis + generator : % -> Union(R,"failed") generator d == bsis := finiteBasis d for i in minIndex bsis .. maxIndex bsis repeat @@ -61617,10 +62949,12 @@ FiniteDivisor(F, UP, UPUP, R): Exports == Implementation where return primitivePart qelt(bsis,i) "failed" + lSpaceBasis : % -> Vector(R) lSpaceBasis d == map_!(primitivePart, reduceBasisAtInfinity finiteBasis(-d)) --- b = center, hh = integral function, g = gcd(b, discriminant) + -- b = center, hh = integral function, g = gcd(b, discriminant) + makeDivisor : (UP, UPUP, UP) -> % makeDivisor(b, hh, g) == b := gcd(b, retract(norm(h := reduce hh))@UP) h := intReduce(h, b) @@ -63052,30 +64386,33 @@ FiniteFieldCyclicGroupExtensionByPolynomial(GF,defpol):_ -- 'tableForDiscreteLogarithm', although this function is not -- necessary in the cyclic group representation case + tableForDiscreteLogarithm : Integer -> + Table(PositiveInteger,NonNegativeInteger) tableForDiscreteLogarithm(fac) == table()$TBL + getZechTable : () -> PrimitiveArray(SingleInteger) getZechTable() == zechlog - initializeZech:() -> Void - - initializeElt: () -> Void - + order : % -> PositiveInteger order(x:$):PI == zero?(x) => error"order: order of zero undefined" (sizeCG quo gcd(sizeCG,x pretend NNI))::PI + primitive? : % -> Boolean primitive?(x:$) == zero?(x) or (x = 1) => false gcd(x::Rep,sizeCG)$Rep = 1$Rep => true false + coordinates : % -> Vector(GF) coordinates(x:$) == x=0 => new(extdeg,0)$(Vector GF) primElement:SAE:=convert(monomial(1,1)$(SUP GF))$SAE -- the primitive element in the corresponding algebraic extension coordinates(primElement **$SAE (x pretend SI))$SAE + ?+? : (%,%) -> % x:$ + y:$ == if initzech? then initializeZech() zero? x => y @@ -63089,20 +64426,24 @@ FiniteFieldCyclicGroupExtensionByPolynomial(GF,defpol):_ addmod(y,zechlog.(d pretend SI) pretend Rep,sizeCG)$Rep --positiveRemainder(x +$Rep zechlog.(d pretend SI) -$Rep d,sizeCG)$Rep + initializeZech:() -> Void initializeZech() == zechlog:=createZechTable(defpol)$FFF -- set initialization flag initzech? := false void()$Void + basis : PositiveInteger -> Vector(%) basis(n:PI) == extensionDegree() rem n ^= 0 => error("argument must divide extension degree") m:=sizeCG quo (size()$GF**n-1) [index((1+i*m) ::PI) for i in 0..(n-1)]::Vector $ + ?*? : (Integer,%) -> % n:I * x:$ == ((n::GF)::$) * x + minimalPolynomial : % -> SparseUnivariatePolynomial(GF) minimalPolynomial(a) == f:SUP $:=monomial(1,1)$(SUP $) - monomial(a,0)$(SUP $) u:$:=Frobenius(a) @@ -63117,22 +64458,29 @@ FiniteFieldCyclicGroupExtensionByPolynomial(GF,defpol):_ f:=reductum(f)$(SUP $) p + factorsOfCyclicGroupSize : () -> + List(Record(factor: Integer,exponent: Integer)) factorsOfCyclicGroupSize() == if empty? facOfGroupSize then initializeElt() facOfGroupSize + representationType : () -> Union("prime",polynomial,normal,cyclic) representationType() == "cyclic" + definingPolynomial : () -> SparseUnivariatePolynomial(GF) definingPolynomial() == defpol + random : () -> % random() == positiveRemainder(random()$Rep,sizeFF pretend Rep)$Rep -$Rep 1$Rep + represents : Vector(GF) -> % represents(v) == u:FFP:=represents(v)$FFP u =$FFP 0$FFP => 0 discreteLog(u)$FFP pretend Rep + coerce : GF -> % coerce(e:GF):$ == zero?(e)$GF => 0 log:I:=discreteLog(primEltGF,e)$GF::NNI *$I sizeFG @@ -63141,24 +64489,29 @@ FiniteFieldCyclicGroupExtensionByPolynomial(GF,defpol):_ -- now 1$GF is coerced to 0$Rep which is correct. positiveRemainder(log,sizeCG) pretend Rep + retractIfCan : % -> Union(GF,"failed") retractIfCan(x:$) == zero? x => 0$GF u:= (x::Rep) exquo$Rep (sizeFG pretend Rep) u = "failed" => "failed" primEltGF **$GF ((u::$) pretend SI) + retract : % -> GF retract(x:$) == a:=retractIfCan(x) a="failed" => error "element not in groundfield" a :: GF + basis : () -> Vector(%) basis() == [index(i :: PI) for i in 1..extdeg]::Vector $ + inGroundField? : % -> Boolean inGroundField?(x) == zero? x=> true positiveRemainder(x::Rep,sizeFG pretend Rep)$Rep =$Rep 0$Rep => true false + discreteLog : (%,%) -> Union(NonNegativeInteger,"failed") discreteLog(b:$,x:$) == zero? x => "failed" e:= extendedEuclidean(b,sizeCG,x)$Rep @@ -63166,71 +64519,95 @@ FiniteFieldCyclicGroupExtensionByPolynomial(GF,defpol):_ e1:Record(coef1:$,coef2:$) := e :: Record(coef1:$,coef2:$) positiveRemainder(e1.coef1,sizeCG)$Rep pretend NNI + -? : % -> % - x:$ == zero? x => 0 characteristic() =$I 2 => x addmod(x,shift(sizeCG,-1)$SI pretend Rep,sizeCG) + generator : () -> % generator() == 1$SI + + createPrimitiveElement : () -> % createPrimitiveElement() == 1$SI + + primitiveElement : () -> % primitiveElement() == 1$SI + discreteLog : % -> NonNegativeInteger discreteLog(x:$) == zero? x => error "discrete logarithm error" x pretend NNI + normalElement : () -> % normalElement() == if initelt? then initializeElt() normalElt::$ + initializeElt: () -> Void initializeElt() == facOfGroupSize := factors(factor(sizeCG)$Integer) normalElt:=createNormalElement() pretend SI initelt?:=false void()$Void + extensionDegree : () -> PositiveInteger extensionDegree() == extdeg pretend PI + characteristic : () -> NonNegativeInteger characteristic() == characteristic()$GF + lookup : % -> PositiveInteger lookup(x:$) == x =$Rep (-$Rep 1$Rep) => sizeFF pretend PI (x +$Rep 1$Rep) pretend PI + index : PositiveInteger -> % index(a:PI) == positiveRemainder(a,sizeFF)$I pretend Rep -$Rep 1$Rep + 0 : () -> % 0 == (-$Rep 1$Rep) + 1 : () -> % 1 == 0$Rep --- to get a "exponent like" output form + -- to get a "exponent like" output form + coerce : % -> OutputForm coerce(x:$):OUT == x =$Rep (-$Rep 1$Rep) => "0"::OUT x =$Rep 0$Rep => "1"::OUT y:I:=lookup(x)-1 alpha **$OUT (y::OUT) + ?=? : (%,%) -> Boolean x:$ = y:$ == x =$Rep y + ?*? : (%,%) -> % x:$ * y:$ == x = 0 => 0 y = 0 => 0 addmod(x,y,sizeCG)$Rep + ?*? : (GF,%) -> % a:GF * x:$ == coerce(a)@$ * x + ?/? : (%,GF) -> % x:$/a:GF == x/coerce(a)@$ + inv : % -> % inv(x:$) == zero?(x) => error "inv: not invertible" (x = 1) => 1 sizeCG -$Rep x + ?**? : (%,PositiveInteger) -> % x:$ ** n:PI == x ** n::I + ?**? : (%,NonNegativeInteger) -> % x:$ ** n:NNI == x ** n::I + ?**? : (%,Integer) -> % x:$ ** n:I == m:Rep:=positiveRemainder(n,sizeCG)$I pretend Rep m =$Rep 0$Rep => 1 @@ -63984,10 +65361,10 @@ FiniteFieldExtensionByPolynomial(GF:FiniteFieldCategory,_ Rep:=SAE - extdeg:PI := degree(defpol)$(SUP GF) pretend PI + extdeg:PI := degree(defpol)$(SUP GF) pretend PI -- the extension degree - alpha := new()$Symbol :: OutputForm + alpha := new()$Symbol :: OutputForm -- a new symbol for the output form of field elements sizeCG:Integer := size()$GF**extdeg - 1 @@ -64020,19 +65397,19 @@ FiniteFieldExtensionByPolynomial(GF:FiniteFieldCategory,_ -- functions =========================================================== + generator : () -> % generator() == reduce(monomial(1,1)$SUP(GF))$Rep - norm x == resultant(defpol, lift x) - - initializeElt: () -> Void - - initializeLog: () -> Void + norm : % -> GF + norm x == resultant(defpol, lift x) + basis : PositiveInteger -> Vector(%) basis(n:PI) == (extdeg rem n) ^= 0 => error "argument must divide extension degree" a:$:=norm(primitiveElement(),n) vector [a**i for i in 0..n-1] + degree : % -> PositiveInteger degree(x) == y:$:=1 m:=zero(extdeg,extdeg+1)$(Matrix GF) @@ -64041,6 +65418,7 @@ FiniteFieldExtensionByPolynomial(GF:FiniteFieldCategory,_ y:=y*x rank(m)::PI + minimalPolynomial : % -> SparseUnivariatePolynomial(GF) minimalPolynomial(x:$) == y:$:=1 m:=zero(extdeg,extdeg+1)$(Matrix GF) @@ -64050,7 +65428,7 @@ FiniteFieldExtensionByPolynomial(GF:FiniteFieldCategory,_ v:=first nullSpace(m)$(Matrix GF) +/[monomial(v.(i+1),i)$(SUP GF) for i in 0..extdeg] - + normal? : % -> Boolean normal?(x) == l:List List GF:=[entries coordinates x] a:=x @@ -64060,54 +65438,80 @@ FiniteFieldExtensionByPolynomial(GF:FiniteFieldCategory,_ ((rank matrix(l)$(Matrix GF)) = extdeg::NNI) => true false + ?*? : (GF,%) -> % a:GF * x:$ == a *$Rep x + ?*? : (Integer,%) -> % n:I * x:$ == n *$Rep x + -? : % -> % -x == -$Rep x + random : () -> % random() == random()$Rep + coordinates : % -> Vector(GF) coordinates(x:$) == coordinates(x)$Rep + represents : Vector(GF) -> % represents(v) == represents(v)$Rep + coerce : GF -> % coerce(x:GF):$ == coerce(x)$Rep + definingPolynomial : () -> SparseUnivariatePolynomial(GF) definingPolynomial() == defpol + retract : % -> GF retract(x) == retract(x)$Rep + retractIfCan : % -> Union(GF,"failed") retractIfCan(x) == retractIfCan(x)$Rep + index : PositiveInteger -> % index(x) == index(x)$Rep + lookup : % -> PositiveInteger lookup(x) == lookup(x)$Rep + ?/? : (%,%) -> % x:$/y:$ == x /$Rep y + ?/? : (%,GF) -> % x:$/a:GF == x/coerce(a) + ?*? : (%,%) -> % x:$ * y:$ == x *$Rep y + ?+? : (%,%) -> % x:$ + y:$ == x +$Rep y + ?-? : (%,%) -> % x:$ - y:$ == x -$Rep y + ?=? : (%,%) -> Boolean x:$ = y:$ == x =$Rep y + basis : () -> Vector(%) basis() == basis()$Rep + 0 : () -> % 0 == 0$Rep + 1 : () -> % 1 == 1$Rep + factorsOfCyclicGroupSize : () -> + List(Record(factor: Integer,exponent: Integer)) factorsOfCyclicGroupSize() == if empty? facOfGroupSize then initializeElt() facOfGroupSize + representationType : () -> Union("prime",polynomial,normal,cyclic) representationType() == "polynomial" + tableForDiscreteLogarithm : Integer -> + Table(PositiveInteger,NonNegativeInteger) tableForDiscreteLogarithm(fac) == if initlog? then initializeLog() tbl:=search(fac::PI,discLogTable)$Table(PI,TBL) @@ -64116,14 +65520,17 @@ FiniteFieldExtensionByPolynomial(GF:FiniteFieldCategory,_ of the order of the multiplicative group" tbl pretend TBL + primitiveElement : () -> % primitiveElement() == if initelt? then initializeElt() index(primitiveElt) + normalElement : () -> % normalElement() == if initelt? then initializeElt() index(normalElt) + initializeElt: () -> Void initializeElt() == facOfGroupSize:=factors(factor(sizeCG)$Integer) -- get a primitive element @@ -64138,6 +65545,7 @@ FiniteFieldExtensionByPolynomial(GF:FiniteFieldCategory,_ initelt? := false void()$Void + initializeLog: () -> Void initializeLog() == if initelt? then initializeElt() -- set up tables for discrete logarithm @@ -64166,16 +65574,21 @@ FiniteFieldExtensionByPolynomial(GF:FiniteFieldCategory,_ --print("discrete logarithm tables initialized"::OUT) void()$Void + coerce : % -> OutputForm coerce(e:$):OutputForm == outputForm(lift(e),alpha) + extensionDegree : () -> PositiveInteger extensionDegree() == extdeg + size : () -> NonNegativeInteger size() == (sizeCG + 1) pretend NNI + inGroundField? : % -> Boolean inGroundField?(x) == retractIfCan(x) = "failed" => false true + characteristic : () -> NonNegativeInteger characteristic() == characteristic()$GF *) @@ -65369,7 +66782,7 @@ divisor of the order of the multiplicative group" Rep:= V -- elements are represented by vectors over GF - alpha :=new()$Symbol :: OutputForm + alpha :=new()$Symbol :: OutputForm -- get a new Symbol for the output representation of the elements initlog?:Boolean:=true @@ -65382,7 +66795,7 @@ divisor of the order of the multiplicative group" -- gets false after initialization of the multiplication -- table or the primitive element - extdeg:PI :=1 + extdeg:PI :=1 defpol:SUP(GF):=0$SUP(GF) -- the defining polynomial @@ -65428,15 +66841,13 @@ divisor of the order of the multiplicative group" -- functions =========================================================== - initializeLog: () -> Void - - initializeElt: () -> Void + coerce : GF -> % + coerce(v:GF):$ == new(extdeg,v /$GF traceAlpha)$Rep - initializeMult: () -> Void - - coerce(v:GF):$ == new(extdeg,v /$GF traceAlpha)$Rep - represents(v) == v::$ + represents : Vector(GF) -> % + represents(v) == v::$ + degree : % -> PositiveInteger degree(a) == d:PI:=1 b:= qPot(a::Rep,1)$INBFF @@ -65445,17 +66856,22 @@ divisor of the order of the multiplicative group" d:=d+1 d + linearAssociatedExp : (%,SparseUnivariatePolynomial(GF)) -> % linearAssociatedExp(x,f) == xm:SUP(GF):=monomial(1$GF,extdeg)$(SUP GF) - 1$(SUP GF) r:= (f * pol(x::Rep)$INBFF) rem xm vectorise(r,extdeg)$(SUP GF) + linearAssociatedLog : (%,%) -> + Union(SparseUnivariatePolynomial(GF),"failed") linearAssociatedLog(x) == pol(x::Rep)$INBFF + linearAssociatedOrder : % -> SparseUnivariatePolynomial(GF) linearAssociatedOrder(x) == xm:SUP(GF):=monomial(1$GF,extdeg)$(SUP GF) - 1$(SUP GF) xm quo gcd(xm,pol(x::Rep)$INBFF) + linearAssociatedLog : % -> SparseUnivariatePolynomial(GF) linearAssociatedLog(b,x) == zero? x => 0 xm:SUP(GF):=monomial(1$GF,extdeg)$(SUP GF) - 1$(SUP GF) @@ -65464,48 +66880,62 @@ divisor of the order of the multiplicative group" e1:= e :: Record(coef1:(SUP GF),coef2:(SUP GF)) e1.coef1 + getMultiplicationTable : () -> + Vector(List(Record(value: GF,index: SingleInteger))) getMultiplicationTable() == if initmult? then initializeMult() multTable + getMultiplicationMatrix : () -> Matrix(GF) getMultiplicationMatrix() == if initmult? then initializeMult() createMultiplicationMatrix(multTable)$FFF + sizeMultiplication : () -> NonNegativeInteger sizeMultiplication() == if initmult? then initializeMult() sizeMultiplication(multTable)$FFF + trace : % -> GF trace(a:$) == retract trace(a,1) + norm : % -> GF norm(a:$) == retract norm(a,1) + generator : () -> % generator() == normalElement(extdeg)$INBFF + basis : PositiveInteger -> Vector(%) basis(n:PI) == (extdeg rem n) ^= 0 => error "argument must divide extension degree" [Frobenius(trace(normalElement,n),i) for i in 0..(n-1)]::(Vector $) + ?*? : (GF,%) -> % a:GF * x:$ == a *$Rep x + ?/? : (%,GF) -> % x:$/a:GF == x/coerce(a) + coordinates : % -> Vector(GF) coordinates(x:$) == x::Rep Frobenius(e) == qPot(e::Rep,1)$INBFF Frobenius(e,n) == qPot(e::Rep,n)$INBFF + retractIfCan : % -> Union(GF,"failed") retractIfCan(x) == inGroundField?(x) => x.1 *$GF traceAlpha "failed" + retract : % -> GF retract(x) == inGroundField?(x) => x.1 *$GF traceAlpha error("element not in ground field") -- to get a "normal basis like" output form + coerce : % -> OutputForm coerce(x:$):OUT == l:List OUT:=nil()$(List OUT) n : PI := extdeg @@ -65520,6 +66950,7 @@ divisor of the order of the multiplicative group" r:=reduce("+",l)$(List OUT) r + initializeElt: () -> Void initializeElt() == facOfGroupSize := factors factor(size()$GF**extdeg-1)$I -- get a primitive element @@ -65527,6 +66958,7 @@ divisor of the order of the multiplicative group" initelt?:=false void()$Void + initializeMult: () -> Void initializeMult() == multTable:=createMultiplicationTable(defpol)$FFF setFieldInfo(multTable,traceAlpha)$INBFF @@ -65534,6 +66966,7 @@ divisor of the order of the multiplicative group" initmult?:=false void()$Void + initializeLog: () -> Void initializeLog() == if initelt? then initializeElt() -- set up tables for discrete logarithm @@ -65561,6 +66994,8 @@ divisor of the order of the multiplicative group" --print("discrete logarithm table initialized"::OUT) void()$Void + tableForDiscreteLogarithm : Integer -> + Table(PositiveInteger,NonNegativeInteger) tableForDiscreteLogarithm(fac) == if initlog? then initializeLog() tbl:=search(fac::PI,discLogTable)$Table(PI,TBL) @@ -65569,20 +67004,26 @@ divisor of the order of the multiplicative group" divisor of the order of the multiplicative group" tbl :: TBL + primitiveElement : () -> % primitiveElement() == if initelt? then initializeElt() index(primitiveElt) + factorsOfCyclicGroupSize : () -> + List(Record(factor: Integer,exponent: Integer)) factorsOfCyclicGroupSize() == if empty? facOfGroupSize then initializeElt() facOfGroupSize + extensionDegree : () -> PositiveInteger extensionDegree() == extdeg sizeOfGroundField() == size()$GF pretend NNI + definingPolynomial : () -> SparseUnivariatePolynomial(GF) definingPolynomial() == defpol + trace : (%,PositiveInteger) -> % trace(a,d) == v:=trace(a::Rep,d)$INBFF erg:=v @@ -65590,75 +67031,98 @@ divisor of the order of the multiplicative group" erg:=concat(erg,v)$Rep erg + characteristic : () -> NonNegativeInteger characteristic() == characteristic()$GF + random : () -> % random() == random(extdeg)$INBFF + ?*? : (%,%) -> % x:$ * y:$ == if initmult? then initializeMult() setFieldInfo(multTable,traceAlpha)$INBFF x::Rep *$INBFF y::Rep + 1 : () -> % 1 == new(extdeg,inv(traceAlpha)$GF)$Rep + 0 : () -> % 0 == zero(extdeg)$Rep + size : () -> NonNegativeInteger size() == size()$GF ** extdeg + index : PositiveInteger -> % index(n:PI) == index(extdeg,n)$INBFF + lookup : % -> PositiveInteger lookup(x:$) == lookup(x::Rep)$INBFF + basis : () -> Vector(%) basis() == a:=basis(extdeg)$INBFF vector([e::$ for e in entries a]) + ?**? : (%,Integer) -> % x:$ ** e:I == if initmult? then initializeMult() setFieldInfo(multTable,traceAlpha)$INBFF (x::Rep) **$INBFF e + normal? : % -> Boolean normal?(x) == normal?(x::Rep)$INBFF + -? : % -> % -(x:$) == -$Rep x + ?+? : (%,%) -> % x:$ + y:$ == x +$Rep y + ?-? : (%,%) -> % x:$ - y:$ == x -$Rep y + ?=? : (%,%) -> Boolean x:$ = y:$ == x =$Rep y + ?*? : (Integer,%) -> % n:I * x:$ == x *$Rep (n::GF) + representationType : () -> Union("prime",polynomial,normal,cyclic) representationType() == "normal" + minimalPolynomial : % -> SparseUnivariatePolynomial(GF) minimalPolynomial(a) == if initmult? then initializeMult() setFieldInfo(multTable,traceAlpha)$INBFF minimalPolynomial(a::Rep)$INBFF -- is x an element of the ground field GF ? + inGroundField? : % -> Boolean inGroundField?(x) == erg:=true for i in 2..extdeg repeat not(x.i =$GF x.1) => erg:=false erg + ?/? : (%,%) -> % x:$ / y:$ == if initmult? then initializeMult() setFieldInfo(multTable,traceAlpha)$INBFF x::Rep /$INBFF y::Rep + inv : % -> % inv(a) == if initmult? then initializeMult() setFieldInfo(multTable,traceAlpha)$INBFF inv(a::Rep)$INBFF + norm : (%,PositiveInteger) -> % norm(a,d) == if initmult? then initializeMult() setFieldInfo(multTable,traceAlpha)$INBFF norm(a::Rep,d)$INBFF + normalElement : () -> % normalElement() == normalElement(extdeg)$INBFF *) @@ -68534,46 +69998,8 @@ Float(): dec ==> decreasePrecision -- local utility operations - - shift2 : (I,I) -> I -- WSP: fix bug in shift - - times : (%,%) -> % -- multiply x and y with no rounding - - itimes: (I,%) -> % -- multiply by a small integer - - chop: (%,PI) -> % -- chop x at p bits of precision - - dvide: (%,%) -> % -- divide x by y with no rounding - - square: (%,I) -> % -- repeated squaring with chopping - - power: (%,I) -> % -- x ** n with chopping - - plus: (%,%) -> % -- addition with no rounding - - sub: (%,%) -> % -- subtraction with no rounding - - negate: % -> % -- negation with no rounding - - ceillog10base2: PI -> PI -- rational approximation - floorln2: PI -> PI -- rational approximation - atanSeries: % -> % -- atan(x) by taylor series |x| < 1/2 - - atanInverse: I -> % -- atan(1/n) for n an integer > 1 - - expInverse: I -> % -- exp(1/n) for n an integer - - expSeries: % -> % -- exp(x) by taylor series |x| < 1/2 - - logSeries: % -> % -- log(x) by taylor series 1/2 < x < 2 - - sinSeries: % -> % -- sin(x) by taylor series |x| < 1/2 - - cosSeries: % -> % -- cos(x) by taylor series |x| < 1/2 - - piRamanujan: () -> % -- pi using Ramanujans series writeOMFloat(dev: OpenMathDevice, x: %): Void == OMputApp(dev) @@ -68619,8 +70045,10 @@ Float(): if wholeObj then OMputEndObject(dev) + shift2 : (I,I) -> I -- WSP: fix bug in shift shift2(x,y) == sign(x)*shift(sign(x)*x,y) + asin : % -> % asin x == zero? x => 0 negative? x => -asin(-x) @@ -68629,6 +70057,7 @@ Float(): inc 5; r := atan(x/sqrt(sub(1,times(x,x)))); dec 5 normalize r + acos : % -> % acos x == zero? x => pi()/2 negative? x => (inc 3; r := pi()-acos(-x); dec 3; normalize r) @@ -68637,6 +70066,7 @@ Float(): inc 5; r := atan(sqrt(sub(1,times(x,x)))/x); dec 5 normalize r + atan : (%,%) -> % atan(x,y) == x = 0 => y > 0 => pi()/2 @@ -68648,6 +70078,7 @@ Float(): if y < 0 then theta := - theta theta + atan : % -> % atan x == zero? x => 0 negative? x => -atan(-x) @@ -68670,6 +70101,7 @@ Float(): t := shift(t,k) normalize t + atanSeries: % -> % -- atan(x) by taylor series |x| < 1/2 atanSeries x == -- atan(x) = x (1 - x**2/3 + x**4/5 - x**6/7 + ...) |x| < 1 p := bits() + LENGTH bits() + 2 @@ -68681,6 +70113,7 @@ Float(): t := (m * t) quo d x * [s,-p] + atanInverse: I -> % -- atan(1/n) for n an integer > 1 atanInverse n == -- compute atan(1/n) for an integer n > 1 -- atan n = 1/n - 1/n**3/3 + 1/n**5/4 - ... @@ -68694,6 +70127,7 @@ Float(): t := t quo n2 normalize [s,-e] + sin : % -> % sin x == s := sign x; x := abs x; p := bits(); inc 4 if x > [6,0] then (inc p; x := 2*pi*fractionPart(x/pi/2); bits p) @@ -68710,6 +70144,7 @@ Float(): bits p s * r + sinSeries: % -> % -- sin(x) by taylor series |x| < 1/2 sinSeries x == -- sin(x) = x (1 - x**2/3! + x**4/5! - x**6/7! + ... |x| < 1/2 p := bits() + LENGTH bits() + 2 @@ -68723,6 +70158,7 @@ Float(): t := t quo d x * [s,-p] + cos : % -> % cos x == s:I := 1; x := abs x; p := bits(); inc 4 if x > [6,0] then (inc p; x := 2*pi*fractionPart(x/pi/2); dec p) @@ -68745,6 +70181,7 @@ Float(): bits p s * r + cosSeries: % -> % -- cos(x) by taylor series |x| < 1/2 cosSeries x == -- cos(x) = 1 - x**2/2! + x**4/4! - x**6/6! + ... |x| < 1/2 p := bits() + LENGTH bits() + 1 @@ -68758,6 +70195,7 @@ Float(): t := t quo d normalize [s,-p] + tan : % -> % tan x == s := sign x; x := abs x; p := bits(); inc 6 if x > [3,0] then (inc p; x := pi()*fractionPart(x/pi()); dec p) @@ -68769,6 +70207,7 @@ Float(): P:StoredConstant := [1,[1,2]] + pi : () -> % pi() == -- We use Ramanujan's identity to compute pi. -- The running time is quadratic in the precision. @@ -68777,6 +70216,7 @@ Float(): bits() <= P.precision => normalize P.value (P := [bits(), piRamanujan()]) value + piRamanujan: () -> % -- pi using Ramanujans series piRamanujan() == -- Ramanujans identity for 1/pi -- Reference: Shanks and Wrench, Math Comp, 1962 @@ -68791,6 +70231,7 @@ Float(): t := (m*t) quo (d*i**3) 1 / [s,-n-2] + sinh : % -> % sinh x == zero? x => 0 lost:I := max(- order x,0) @@ -68798,9 +70239,11 @@ Float(): inc(5+lost); e := exp x; s := (e-1/e)/2; dec(5+lost) normalize s + cosh : % -> % cosh x == (inc 5; e := exp x; c := (e+1/e)/2; dec 5; normalize c) + tanh : % -> % tanh x == zero? x => 0 lost:I := max(- order x,0) @@ -68808,17 +70251,20 @@ Float(): inc(6+lost); e := exp x; e := e*e; t := (e-1)/(e+1); dec(6+lost) normalize t + asinh : % -> % asinh x == p := min(0,order x) if zero? x or 2*p < -bits() then return x inc(5-p); r := log(x+sqrt(1+x*x)); dec(5-p) normalize r + acosh : % -> % acosh x == if x < 1 then error "invalid argument to acosh" inc 5; r := log(x+sqrt(sub(times(x,x),1))); dec 5 normalize r + atanh : % -> % atanh x == if x > 1 or x < -1 then error "invalid argument to atanh" p := min(0,order x) @@ -68826,6 +70272,7 @@ Float(): inc(5-p); r := log((x+1)/(1-x))/2; dec(5-p) normalize r + log : % -> % log x == negative? x => error "negative log" zero? x => error "log 0 generated" @@ -68849,6 +70296,7 @@ Float(): bits p normalize l + logSeries: % -> % -- log(x) by taylor series 1/2 < x < 2 logSeries x == -- log(x) = 2 y (1 + y**2/3 + y**4/5 ...) for y = (x-1) / (x+1) -- given 1/2 < x < 2 on input we have -1/3 < y < 1/3 @@ -68864,6 +70312,7 @@ Float(): L2:StoredConstant := [1,1] + log2 : () -> % log2() == -- log x = 2 * sum( ((x-1)/(x+1))**(2*k+1)/(2*k+1), k=1.. ) -- log 2 = 2 * sum( 1/9**k / (2*k+1), k=0..n ) / 3 @@ -68880,6 +70329,7 @@ Float(): L10:StoredConstant := [1,[1,1]] + log10 : () -> % log10() == -- log x = 2 * sum( ((x-1)/(x+1))**(2*k+1)/(2*k+1), k=0.. ) -- log 5/4 = 2 * sum( 1/81**k / (2*k+1), k=0.. ) / 9 @@ -68895,10 +70345,13 @@ Float(): inc 2; L10 := [bits(),[s,-n] + 3*log2]; dec 2 normalize L10.value + log2 : % -> % log2(x) == (inc 2; r := log(x)/log2; dec 2; normalize r) + log10 : % -> % log10(x) == (inc 2; r := log(x)/log10; dec 2; normalize r) + exp : % -> % exp(x) == -- exp(n+x) = exp(1)**n exp(x) for n such that |x| < 1 p := bits(); inc 5; e1:% := 1 @@ -68917,6 +70370,7 @@ Float(): bits p e * e1 + expSeries: % -> % -- exp(x) by taylor series |x| < 1/2 expSeries x == -- exp(x) = 1 + x + x**2/2 + ... + x**i/i! valid for all x p := bits() + LENGTH bits() + 1 @@ -68928,6 +70382,7 @@ Float(): t := t quo d normalize [s,-p] + expInverse: I -> % -- exp(1/n) for n an integer expInverse k == -- computes exp(1/k) via continued fraction p0:I := 2*k+1; p1:I := 6*k*p0+1 @@ -68939,10 +70394,12 @@ Float(): E:StoredConstant := [1,[1,1]] + exp1 : () -> % exp1() == if bits() > E.precision then E := [bits(),expInverse 1] normalize E.value + sqrt : % -> % sqrt x == negative? x => error "negative sqrt" m := x.mantissa; e := x.exponent @@ -68954,58 +70411,82 @@ Float(): i := ISQRT i normalize [i,(e-p) quo 2] + bits : () -> PositiveInteger bits() == BITS() + bits : PositiveInteger -> PositiveInteger bits(n) == (t := bits(); BITS() := n; t) + precision : () -> PositiveInteger precision() == bits() + precision : PositiveInteger -> PositiveInteger precision(n) == bits(n) + increasePrecision : Integer -> PositiveInteger increasePrecision n == (b := bits(); bits((b + n)::PI); b) + decreasePrecision : Integer -> PositiveInteger decreasePrecision n == (b := bits(); bits((b - n)::PI); b) + ceillog10base2: PI -> PI -- rational approximation ceillog10base2 n == ((13301 * n + 4003) quo 4004) :: PI + digits : () -> PositiveInteger digits() == max(1,4004 * (bits()-1) quo 13301)::PI + digits : PositiveInteger -> PositiveInteger digits(n) == (t := digits(); bits (1 + ceillog10base2 n); t) + order : % -> Integer order(a) == LENGTH a.mantissa + a.exponent - 1 + relerror : (%,%) -> Integer relerror(a,b) == order((a-b)/b) + 0 : () -> % 0 == [0,0] + 1 : () -> % 1 == [1,0] + base : () -> PositiveInteger base() == BASE + mantissa : % -> Integer mantissa x == x.mantissa + exponent : % -> Integer exponent x == x.exponent + one? : % -> Boolean one? a == a = 1 + zero? : % -> Boolean zero? a == zero?(a.mantissa) + negative? : % -> Boolean negative? a == negative?(a.mantissa) + positive? : % -> Boolean positive? a == positive?(a.mantissa) + chop: (%,PI) -> % -- chop x at p bits of precision chop(x,p) == e : I := LENGTH x.mantissa - p if e > 0 then x := [shift2(x.mantissa,-e),x.exponent+e] x + float : (Integer,Integer) -> % float(m,e) == normalize [m,e] + float : (Integer,Integer,PositiveInteger) -> % float(m,e,b) == m = 0 => 0 inc 4; r := m * [b,0] ** e; dec 4 normalize r + normalize : % -> % normalize x == m := x.mantissa m = 0 => 0 @@ -69021,11 +70502,14 @@ Float(): x := [y,x.exponent+e] x + shift : (%,Integer) -> % shift(x:%,n:I) == [x.mantissa,x.exponent+n] + ?=? : (%,%) -> Boolean x = y == order x = order y and sign x = sign y and zero? (x - y) + ? Boolean x < y == y.mantissa = 0 => x.mantissa < 0 x.mantissa = 0 => y.mantissa > 0 @@ -69035,38 +70519,53 @@ Float(): order x > order y => negative? x negative? (x-y) + abs : % -> % abs x == if negative? x then -x else normalize x + ceiling : % -> % ceiling x == if negative? x then return (-floor(-x)) if zero? fractionPart x then x else truncate x + 1 + wholePart : % -> Integer wholePart x == shift2(x.mantissa,x.exponent) + floor : % -> % floor x == if negative? x then -ceiling(-x) else truncate x + round : % -> % round x == (half := [sign x,-1]; truncate(x + half)) + sign : % -> Integer sign x == if x.mantissa < 0 then -1 else 1 + truncate : % -> % truncate x == if x.exponent >= 0 then return x normalize [shift2(x.mantissa,x.exponent),0] + recip : % -> Union(%,"failed") recip(x) == if x=0 then "failed" else 1/x + differentiate : % -> % differentiate x == 0 + -? : % -> % - x == normalize negate x + negate: % -> % -- negation with no rounding negate x == [-x.mantissa,x.exponent] + ?+? : (%,%) -> % x + y == normalize plus(x,y) + ?-? : (%,%) -> % x - y == normalize plus(x,negate y) + sub: (%,%) -> % -- subtraction with no rounding sub(x,y) == plus(x,negate y) + plus: (%,%) -> % -- addition with no rounding plus(x,y) == mx := x.mantissa; my := y.mantissa mx = 0 => y @@ -69080,29 +70579,38 @@ Float(): mw := my + shift2(mx,ex-ey) [mw,ey] + ?*? : (%,%) -> % x:% * y:% == normalize times (x,y) + ?*? : (Integer,%) -> % x:I * y:% == if LENGTH x > bits() then normalize [x,0] * y else normalize [x * y.mantissa,y.exponent] + ?/? : (%,%) -> % x:% / y:% == normalize dvide(x,y) + ?/? : (%,Integer) -> % x:% / y:I == if LENGTH y > bits() then x / normalize [y,0] else x / [y,0] + inv : % -> % inv x == 1 / x + times : (%,%) -> % -- multiply x and y with no rounding times(x:%,y:%) == [x.mantissa * y.mantissa, x.exponent + y.exponent] + itimes: (I,%) -> % -- multiply by a small integer itimes(n:I,y:%) == [n * y.mantissa,y.exponent] + dvide: (%,%) -> % -- divide x by y with no rounding dvide(x,y) == ew := LENGTH y.mantissa - LENGTH x.mantissa + bits() + 1 mw := shift2(x.mantissa,ew) quo y.mantissa ew := x.exponent - y.exponent - ew [mw,ew] + square: (%,I) -> % -- repeated squaring with chopping square(x,n) == ma := x.mantissa; ex := x.exponent for k in 1..n repeat @@ -69111,6 +70619,7 @@ Float(): ma := shift2(ma,l); ex := ex - l [ma,ex] + power: (%,I) -> % -- x ** n with chopping power(x,n) == y:% := 1; z:% := x repeat @@ -69118,6 +70627,7 @@ Float(): if (n := n quo 2) = 0 then return y z := chop( times(z,z), bits() ) + ?**? : (%,%) -> % x:% ** y:% == x = 0 => y = 0 => error "0**0 is undefined" @@ -69130,6 +70640,7 @@ Float(): inc p; r := exp(y*log(x)); dec p normalize r + ?**? : (%,Fraction(Integer)) -> % x:% ** r:RN == x = 0 => r = 0 => error "0**0 is undefined" @@ -69151,6 +70662,7 @@ Float(): y := [n,0]/[d,0] x ** y + ?**? : (%,Integer) -> % x:% ** n:I == x = 0 => n = 0 => error "0**0 is undefined" @@ -69168,24 +70680,7 @@ Float(): -- Utility routines for conversion to decimal - ceilLength10: I -> I - - chop10: (%,I) -> % - convert10:(%,I) -> % - - floorLength10: I -> I - - length10: I -> I - - normalize10: (%,I) -> % - - quotient10: (%,%,I) -> % - - power10: (%,I,I) -> % - - times10: (%,%,I) -> % - convert10(x,d) == m := x.mantissa; e := x.exponent --!! deal with bits here @@ -69197,10 +70692,13 @@ Float(): if e < 0 then h := quotient10([m,0],h,d) else times10([m,0],h,d) + ceilLength10: I -> I ceilLength10 n == 146 * LENGTH n quo 485 + 1 + floorLength10: I -> I floorLength10 n == 643 * LENGTH n quo 2136 + length10: I -> I length10 n == ln := LENGTH(n:=abs n) upper := 76573 * ln quo 254370 @@ -69212,11 +70710,13 @@ Float(): lower := lower + 1 lower + 1 + chop10: (%,I) -> % chop10(x,p) == e : I := floorLength10 x.mantissa - p if e > 0 then x := [x.mantissa quo 10**e::N,x.exponent+e] x + normalize10: (%,I) -> % normalize10(x,p) == ma := x.mantissa ex := x.exponent @@ -69230,8 +70730,10 @@ Float(): if ma = 10**p::N then (ma := 1; ex := ex + p) [ma,ex] + times10: (%,%,I) -> % times10(x,y,p) == normalize10(times(x,y),p) + quotient10: (%,%,I) -> % quotient10(x,y,p) == ew := floorLength10 y.mantissa - ceilLength10 x.mantissa + p + 2 if ew < 0 then ew := 0 @@ -69239,6 +70741,7 @@ Float(): ew := x.exponent - y.exponent - ew normalize10([mw,ew],p) + power10: (%,I,I) -> % power10(x,n,d) == x = 0 => 0 n = 0 => 1 @@ -69266,12 +70769,7 @@ Float(): OUTPREC : Reference(I) := ref(-1) - fixed : % -> S - - floating : % -> S - - general : % -> S - + padFromLeft : S -> S padFromLeft(s:S):S == zero? SPACING() => s n:I := #s - 1 @@ -69280,6 +70778,8 @@ Float(): t.j := s.(i + minIndex s) if (i+1) rem SPACING() = 0 then j := j+1 t + + padFromRight : S -> S padFromRight(s:S):S == SPACING() = 0 => s n:I := #s - 1 @@ -69289,6 +70789,7 @@ Float(): if (n-i+1) rem SPACING() = 0 then j := j-1 t + fixed : % -> S fixed f == d := if OUTPREC() = -1 then digits::I else OUTPREC() dpos:N:= if (d > 0) then d::N else 1::N @@ -69333,6 +70834,7 @@ Float(): else t := concat(t, new((p-n)::N,zero)) concat(padFromRight s, concat(".", padFromLeft t)) + floating : % -> S floating f == zero? f => "0.0" negative? f => concat("-", floating abs f) @@ -69348,6 +70850,7 @@ Float(): s := padFromLeft s concat ["0.", s, t, convert(o)@S] + general : % -> S general(f) == zero? f => "0.0" negative? f => concat("-", general abs f) @@ -69381,20 +70884,28 @@ Float(): s := if zero? SPACING() then "E" else " E " concat ["0.", t, s, convert(e+n)@S] + outputSpacing : NonNegativeInteger -> Void outputSpacing n == SPACING() := n + outputFixed : () -> Void outputFixed() == (OUTMODE() := "fixed"; OUTPREC() := -1) + outputFixed : NonNegativeInteger -> Void outputFixed n == (OUTMODE() := "fixed"; OUTPREC() := n::I) + outputGeneral : () -> Void outputGeneral() == (OUTMODE() := "general"; OUTPREC() := -1) + outputGeneral : NonNegativeInteger -> Void outputGeneral n == (OUTMODE() := "general"; OUTPREC() := n::I) + outputFloating : () -> Void outputFloating() == (OUTMODE() := "floating"; OUTPREC() := -1) + outputFloating : NonNegativeInteger -> Void outputFloating n == (OUTMODE() := "floating"; OUTPREC() := n::I) + convert : % -> String convert(f):S == b:Integer := OUTPREC() = -1 and not zero? f => @@ -69409,39 +70920,52 @@ Float(): s = empty()$String => error "bad output mode" s + coerce : % -> OutputForm coerce(f):OutputForm == f >= 0 => message(convert(f)@S) - (coerce(-f)@OutputForm) + convert : % -> InputForm convert(f):InputForm == convert [convert("float"::Symbol), convert mantissa f, convert exponent f, convert base()]$List(InputForm) -- Conversion routines + convert : % -> Float convert(x:%):Float == x pretend Float + convert : % -> DoubleFloat convert(x:%):SF == makeSF(x.mantissa,x.exponent)$Lisp + coerce : % -> DoubleFloat coerce(x:%):SF == convert(x)@SF + convert : DoubleFloat -> % convert(sf:SF):% == float(mantissa sf,exponent sf,base()$SF) + retract : % -> Fraction(Integer) retract(f:%):RN == rationalApproximation(f,(bits()-1)::N,BASE) + retractIfCan : % -> Union(Fraction(Integer),"failed") retractIfCan(f:%):Union(RN, "failed") == rationalApproximation(f,(bits()-1)::N,BASE) + retract : % -> Integer retract(f:%):I == (f = (n := wholePart f)::%) => n error "Not an integer" + retractIfCan : % -> Union(Integer,"failed") retractIfCan(f:%):Union(I, "failed") == (f = (n := wholePart f)::%) => n "failed" + rationalApproximation : (%,NonNegativeInteger) -> Fraction(Integer) rationalApproximation(f,d) == rationalApproximation(f,d,10) + rationalApproximation : (%,NonNegativeInteger,NonNegativeInteger) -> + Fraction(Integer) rationalApproximation(f,d,b) == t: Integer nu := f.mantissa; ex := f.exponent @@ -70210,15 +71734,19 @@ FortranCode(): public == private where -- We need to be able to generate unique labels labelValue:SingleInteger := 25000::SingleInteger + setLabelValue : SingleInteger -> SingleInteger setLabelValue(u:SingleInteger):SingleInteger == labelValue := u + newLabel : () -> SingleInteger newLabel():SingleInteger == labelValue := labelValue + 1$SingleInteger labelValue + commaSep : List String -> List(String) commaSep(l:List String):List(String) == [(l.1),:[:[",",u] for u in rest(l)]] + getReturn : RETURN -> SEX getReturn(rec:RETURN):SEX == returnToken : SEX := convert("RETURN"::Symbol::O)$SEX elt(rec,empty?)$RETURN => @@ -70228,22 +71756,27 @@ FortranCode(): public == private where getStatement([returnToken,convert(rv)$SEX]$Lisp, elt(rt,ints2Floats?)$EXPRESSION )$Lisp + getStop : () -> SEX getStop():SEX == fortran2Lines(LIST("STOP")$Lisp)$Lisp + getSave : () -> SEX getSave():SEX == fortran2Lines(LIST("SAVE")$Lisp)$Lisp + getCommon : COMMON -> SEX getCommon(u:COMMON):SEX == fortran2Lines(APPEND(LIST("COMMON"," /",string (u.name),"/ ")$Lisp,_ addCommas(u.contents)$Lisp)$Lisp)$Lisp + getPrint : PRINTLIST -> SEX getPrint(l:PRINTLIST):SEX == ll : SEX := LIST("PRINT*")$Lisp for i in l repeat ll := APPEND(ll,CONS(",",expression2Fortran(i)$Lisp)$Lisp)$Lisp fortran2Lines(ll)$Lisp + getBlock : BLOCK -> SEX getBlock(rec:BLOCK):SEX == indentFortLevel(convert(1@Integer)$SEX)$Lisp expr : SEX := LIST()$Lisp @@ -70252,6 +71785,7 @@ FortranCode(): public == private where indentFortLevel(convert(-1@Integer)$SEX)$Lisp expr + getBody : $ -> SEX getBody(f:$):SEX == operation(f) case Block => getCode f indentFortLevel(convert(1@Integer)$SEX)$Lisp @@ -70259,6 +71793,7 @@ FortranCode(): public == private where indentFortLevel(convert(-1@Integer)$SEX)$Lisp expr + getElseIf : $ -> SEX getElseIf(f:$):SEX == rec := code f expr := @@ -70273,6 +71808,7 @@ FortranCode(): public == private where expr := APPEND(expr, getBody elseBranch)$Lisp expr + getContinue : SingleInteger -> SEX getContinue(label:SingleInteger):SEX == lab : O := label::O if (width(lab) > 6) then error "Label too big" @@ -70281,10 +71817,12 @@ FortranCode(): public == private where sp : O := hspace(_$fortIndent$Lisp -width lab) LIST(STRCONC(PRINC_-TO_-STRING(lab)$Lisp,sp,cnt)$Lisp)$Lisp + getGoto : SingleInteger -> SEX getGoto(label:SingleInteger):SEX == fortran2Lines( LIST(STRCONC("GOTO ",PRINC_-TO_-STRING(label::O)$Lisp)$Lisp)$Lisp)$Lisp + getRepeat : LOOP -> SEX getRepeat(repRec:LOOP):SEX == sw : Switch := NOT elt(repRec,switch)$LOOP lab := newLabel() @@ -70292,6 +71830,7 @@ FortranCode(): public == private where APPEND(getContinue lab,getBody bod, fortFormatIfGoto(sw::O,lab)$Lisp)$Lisp + getWhile : LOOP -> SEX getWhile(whileRec:LOOP):SEX == sw := NOT elt(whileRec,switch)$LOOP lab1 := newLabel() @@ -70300,9 +71839,11 @@ FortranCode(): public == private where APPEND(fortFormatLabelledIfGoto(sw::O,lab1,lab2)$Lisp, getBody bod, getBody goto(lab1), getContinue lab2)$Lisp + getArrayAssign : ARRAYASS -> SEX getArrayAssign(rec:ARRAYASS):SEX == getfortarrayexp((rec.var)::O,rec.rand,rec.ints2Floats?)$Lisp + getAssign : ASS -> SEX getAssign(rec:ASS):SEX == indices : L PIN := elt(rec,arrayIndex)$ASS if indices = []::(L PIN) then @@ -70316,6 +71857,7 @@ FortranCode(): public == private where integerAssignment2Fortran1(lhs,_ elt(elt(rec,rand)$ASS,expr)$EXPRESSION)$Lisp + getCond : COND -> SEX getCond(rec:COND):SEX == expr := APPEND(fortFormatIf(elt(rec,switch)$COND::O)$Lisp, getBody elt(rec,thenClause)$COND)$Lisp @@ -70327,14 +71869,17 @@ FortranCode(): public == private where getBody elseBranch)$Lisp APPEND(expr,getStatement(ENDIF::O,NIL$Lisp)$Lisp)$Lisp + getComment : COMMENT -> SEX getComment(rec:COMMENT):SEX == convert([convert(concat("C ",c)$String)@SEX for c in rec])@SEX + getCall : CALL -> SEX getCall(rec:CALL):SEX == expr := concat("CALL ",rec)$String #expr > 1320 => error "Fortran CALL too large" fortran2Lines(convert([convert(expr)@SEX ])@SEX)$Lisp + getFor : FOR -> SEX getFor(rec:FOR):SEX == rnge : SegmentBinding PIN := elt(rec,range)$FOR increment : PIN := elt(rec,span)$FOR @@ -70344,6 +71889,7 @@ FortranCode(): public == private where (hi segment rnge)::O,increment::O,lab)$Lisp APPEND(expr, getBody elt(rec,body)$FOR, getContinue(lab))$Lisp + getCode : % -> SExpression getCode(f:$):SEX == opp:OP := operation f rec:OPREC:= code f @@ -70366,187 +71912,261 @@ FortranCode(): public == private where error "Unsupported program construct." convert(0)@SEX + printCode : % -> Void printCode(f:$):Void == displayLines1$Lisp getCode f void()$Void + code : % -> Union(nullBranch: null,assignmentBranch: Record(var: Symbol, + arrayIndex: List(Polynomial(Integer)), + rand: Record(ints2Floats?: Boolean,expr: OutputForm)), + arrayAssignmentBranch: Record(var: Symbol,rand: OutputForm, + ints2Floats?: Boolean),conditionalBranch: Record(switch: Switch, + thenClause: %,elseClause: %),returnBranch: Record(empty?: Boolean, + value: Record(ints2Floats?: Boolean,expr: OutputForm)), + blockBranch: List(%),commentBranch: List(String),callBranch: String, + forBranch: Record(range: SegmentBinding(Polynomial(Integer)), + span: Polynomial(Integer),body: %),labelBranch: SingleInteger, + loopBranch: Record(switch: Switch,body: %), + commonBranch: Record(name: Symbol,contents: List(Symbol)), + printBranch: List(OutputForm)) code (f:$):OPREC == elt(f,data)$Rep + operation : % -> Union(Null: null,Assignment: assignment, + Conditional: conditional,Return: return,Block: block, + Comment: comment,Call: call,For: for,While: while,Repeat: repeat, + Goto: goto,Continue: continue,ArrayAssignment: arrayAssignment, + Save: save,Stop: stop,Common: common,Print: print) operation (f:$):OP == elt(f,op)$Rep + common : (Symbol,List(Symbol)) -> % common(name:Symbol,contents:List Symbol):$ == [["common"]$OP,[[name,contents]$COMMON]$OPREC]$Rep + stop : () -> % stop():$ == [["stop"]$OP,["null"]$OPREC]$Rep + save : () -> % save():$ == [["save"]$OP,["null"]$OPREC]$Rep + printStatement : List(OutputForm) -> % printStatement(l:List O):$ == [["print"]$OP,[l]$OPREC]$Rep + comment : List(String) -> % comment(s:List String):$ == [["comment"]$OP,[s]$OPREC]$Rep + comment : String -> % comment(s:String):$ == [["comment"]$OP,[list s]$OPREC]$Rep + forLoop : (SegmentBinding(Polynomial(Integer)),%) -> % forLoop(r:SegmentBinding PIN,body:$):$ == [["for"]$OP,[[r,(incr segment r)::PIN,body]$FOR]$OPREC]$Rep + forLoop : (SegmentBinding(Polynomial(Integer)),Polynomial(Integer),%) -> % forLoop(r:SegmentBinding PIN,increment:PIN,body:$):$ == [["for"]$OP,[[r,increment,body]$FOR]$OPREC]$Rep + goto : SingleInteger -> % goto(l:SingleInteger):$ == [["goto"]$OP,[l]$OPREC]$Rep + continue : SingleInteger -> % continue(l:SingleInteger):$ == [["continue"]$OP,[l]$OPREC]$Rep + whileLoop : (Switch,%) -> % whileLoop(sw:Switch,b:$):$ == [["while"]$OP,[[sw,b]$LOOP]$OPREC]$Rep + repeatUntilLoop : (Switch,%) -> % repeatUntilLoop(sw:Switch,b:$):$ == [["repeat"]$OP,[[sw,b]$LOOP]$OPREC]$Rep + returns : () -> % returns():$ == v := [false,0::O]$EXPRESSION [["return"]$OP,[[true,v]$RETURN]$OPREC]$Rep + returns : Expression(MachineInteger) -> % returns(v:Expression MachineInteger):$ == [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep + returns : Expression(MachineFloat) -> % returns(v:Expression MachineFloat):$ == [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep + returns : Expression(MachineComplex) -> % returns(v:Expression MachineComplex):$ == [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep + returns : Expression(Integer) -> % returns(v:Expression Integer):$ == [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep + returns : Expression(Float) -> % returns(v:Expression Float):$ == [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep + returns : Expression(Complex(Float)) -> % returns(v:Expression Complex Float):$ == [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep + block : List(%) -> % block(l:List $):$ == [["block"]$OP,[l]$OPREC]$Rep + cond : (Switch,%) -> % cond(sw:Switch,thenC:$):$ == [["conditional"]$OP, [[sw,thenC,[["null"]$OP,["null"]$OPREC]$Rep]$COND]$OPREC]$Rep + cond : (Switch,%,%) -> % cond(sw:Switch,thenC:$,elseC:$):$ == [["conditional"]$OP,[[sw,thenC,elseC]$COND]$OPREC]$Rep + coerce : % -> OutputForm coerce(f : $):O == (f.op)::O + assign : (Symbol,String) -> % assign(v:Symbol,rhs:String):$ == [["assignment"]$OP,_ [[v,nil()::L PIN,[false,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep + assign : (Symbol,Matrix(MachineInteger)) -> % assign(v:Symbol,rhs:Matrix MachineInteger):$ == [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep + assign : (Symbol,Matrix(MachineFloat)) -> % assign(v:Symbol,rhs:Matrix MachineFloat):$ == [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep + assign : (Symbol,Matrix(MachineComplex)) -> % assign(v:Symbol,rhs:Matrix MachineComplex):$ == [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep + assign : (Symbol,Vector(MachineInteger)) -> % assign(v:Symbol,rhs:Vector MachineInteger):$ == [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep + assign : (Symbol,Vector(MachineFloat)) -> % assign(v:Symbol,rhs:Vector MachineFloat):$ == [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep + assign : (Symbol,Vector(MachineComplex)) -> % assign(v:Symbol,rhs:Vector MachineComplex):$ == [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep + assign : (Symbol,Matrix(Expression(MachineInteger))) -> % assign(v:Symbol,rhs:Matrix Expression MachineInteger):$ == [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep + assign : (Symbol,Matrix(Expression(MachineFloat))) -> % assign(v:Symbol,rhs:Matrix Expression MachineFloat):$ == [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep + assign : (Symbol,Matrix(Expression(MachineComplex))) -> % assign(v:Symbol,rhs:Matrix Expression MachineComplex):$ == [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep + assign : (Symbol,Vector(Expression(MachineInteger))) -> % assign(v:Symbol,rhs:Vector Expression MachineInteger):$ == [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep + assign : (Symbol,Vector(Expression(MachineFloat))) -> % assign(v:Symbol,rhs:Vector Expression MachineFloat):$ == [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep + assign : (Symbol,Vector(Expression(MachineComplex))) -> % assign(v:Symbol,rhs:Vector Expression MachineComplex):$ == [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep + assign : (Symbol,List(Polynomial(Integer)),Expression(MachineInteger)) -> % assign(v:Symbol,index:L PIN,rhs:Expression MachineInteger):$ == [["assignment"]$OP,[[v,index,[false,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep + assign : (Symbol,List(Polynomial(Integer)),Expression(MachineFloat)) -> % assign(v:Symbol,index:L PIN,rhs:Expression MachineFloat):$ == [["assignment"]$OP,[[v,index,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep + assign : (Symbol,List(Polynomial(Integer)),Expression(MachineComplex)) -> % assign(v:Symbol,index:L PIN,rhs:Expression MachineComplex):$ == [["assignment"]$OP,[[v,index,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep + assign : (Symbol,Expression(MachineInteger)) -> % assign(v:Symbol,rhs:Expression MachineInteger):$ == [["assignment"]$OP,_ [[v,nil()::L PIN,[false,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep + assign : (Symbol,Expression(MachineFloat)) -> % assign(v:Symbol,rhs:Expression MachineFloat):$ == [["assignment"]$OP,_ [[v,nil()::L PIN,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep + assign : (Symbol,Expression(MachineComplex)) -> % assign(v:Symbol,rhs:Expression MachineComplex):$ == [["assignment"]$OP,_ [[v,nil()::L PIN,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep + assign : (Symbol,Matrix(Expression(Integer))) -> % assign(v:Symbol,rhs:Matrix Expression Integer):$ == [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep + assign : (Symbol,Matrix(Expression(Float))) -> % assign(v:Symbol,rhs:Matrix Expression Float):$ == [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep + assign : (Symbol,Matrix(Expression(Complex(Float)))) -> % assign(v:Symbol,rhs:Matrix Expression Complex Float):$ == [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep + assign : (Symbol,Vector(Expression(Integer))) -> % assign(v:Symbol,rhs:Vector Expression Integer):$ == [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep + assign : (Symbol,Vector(Expression(Float))) -> % assign(v:Symbol,rhs:Vector Expression Float):$ == [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep + assign : (Symbol,Vector(Expression(Complex(Float)))) -> % assign(v:Symbol,rhs:Vector Expression Complex Float):$ == [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep + assign : (Symbol,List(Polynomial(Integer)),Expression(Integer)) -> % assign(v:Symbol,index:L PIN,rhs:Expression Integer):$ == [["assignment"]$OP,[[v,index,[false,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep + assign : (Symbol,List(Polynomial(Integer)),Expression(Float)) -> % assign(v:Symbol,index:L PIN,rhs:Expression Float):$ == [["assignment"]$OP,[[v,index,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep + assign : (Symbol,List(Polynomial(Integer)),Expression(Complex(Float))) -> % assign(v:Symbol,index:L PIN,rhs:Expression Complex Float):$ == [["assignment"]$OP,[[v,index,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep + assign : (Symbol,Expression(Integer)) -> % assign(v:Symbol,rhs:Expression Integer):$ == [["assignment"]$OP,_ [[v,nil()::L PIN,[false,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep + assign : (Symbol,Expression(Float)) -> % assign(v:Symbol,rhs:Expression Float):$ == [["assignment"]$OP,_ [[v,nil()::L PIN,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep + assign : (Symbol,Expression(Complex(Float))) -> % assign(v:Symbol,rhs:Expression Complex Float):$ == [["assignment"]$OP,_ [[v,nil()::L PIN,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep + call : String -> % call(s:String):$ == [["call"]$OP,[s]$OPREC]$Rep @@ -71120,9 +72740,11 @@ FortranExpression(basicSymbols,subscriptedSymbols,R): -- Local functions to check for "unassigned" symbols etc. + mkEqn : (Symbol,Symbol) -> Equation EXPR(R) mkEqn(s1:Symbol,s2:Symbol):Equation EXPR(R) == equation(s2::EXPR(R),script(s1,scripts(s2))::EXPR(R)) + fixUpSymbols : EXPR R -> Union(EXPR R,"failed") fixUpSymbols(u:EXPR R):Union(EXPR R,"failed") == -- If its a univariate expression then just fix it up: syms : L S := variables(u) @@ -71139,12 +72761,14 @@ FortranExpression(basicSymbols,subscriptedSymbols,R): subst(u,[mkEqn(sym,i) for i in variables(u)]) "failed" + extraSymbols? : EXPR R -> Boolean extraSymbols?(u:EXPR R):Boolean == syms : L S := [name(v) for v in variables(u)] extras : L S := setDifference(syms, setUnion(basicSymbols,subscriptedSymbols)) not empty? extras + checkSymbols : EXPR R -> EXPR(R) checkSymbols(u:EXPR R):EXPR(R) == syms : L S := [name(v) for v in variables(u)] extras : L S := setDifference(syms, @@ -71155,12 +72779,14 @@ FortranExpression(basicSymbols,subscriptedSymbols,R): error("Extra symbols detected:",[string(v) for v in extras]$L(String)) u + notSymbol? : BO -> Boolean notSymbol?(v:BO):Boolean == s : S := name v member?(s,basicSymbols) or scripted?(s) and member?(name s,subscriptedSymbols) => false true + extraOperators? : EXPR R -> Boolean extraOperators?(u:EXPR R):Boolean == ops : L S := [name v for v in operators(u) | notSymbol?(v)] if useNagFunctionsFlag then @@ -71170,6 +72796,7 @@ FortranExpression(basicSymbols,subscriptedSymbols,R): extras : L S := setDifference(ops,fortranFunctions) not empty? extras + checkOperators : EXPR R -> Void checkOperators(u:EXPR R):Void == ops : L S := [name v for v in operators(u) | notSymbol?(v)] if useNagFunctionsFlag then @@ -71181,6 +72808,7 @@ FortranExpression(basicSymbols,subscriptedSymbols,R): error("Non FORTRAN-77 functions detected:",[string(v) for v in extras]) void() + checkForNagOperators : EXPR R -> $ checkForNagOperators(u:EXPR R):$ == useNagFunctionsFlag => import Pi @@ -71195,64 +72823,84 @@ FortranExpression(basicSymbols,subscriptedSymbols,R): if R has RetractableTo(Integer) then + retractIfCan : Polynomial(Integer) -> Union(%,"failed") retractIfCan(u:POLY Integer):Union($,"failed") == retractIfCan((u::EXPR Integer)$EXPR(Integer))@Union($,"failed") + retract : Polynomial(Integer) -> % retract(u:POLY Integer):$ == retract((u::EXPR Integer)$EXPR(Integer))@$ + retractIfCan : Fraction(Polynomial(Integer)) -> Union(%,"failed") retractIfCan(u:FRAC POLY Integer):Union($,"failed") == retractIfCan((u::EXPR Integer)$EXPR(Integer))@Union($,"failed") + retract : Fraction(Polynomial(Integer)) -> % retract(u:FRAC POLY Integer):$ == retract((u::EXPR Integer)$EXPR(Integer))@$ + int2R : Integer -> R int2R(u:Integer):R == u::R + retractIfCan : Expression(Integer) -> Union(%,"failed") retractIfCan(u:EXPR Integer):Union($,"failed") == retractIfCan(map(int2R,u)$EXF2(Integer,R))@Union($,"failed") + retract : Expression(Integer) -> % retract(u:EXPR Integer):$ == retract(map(int2R,u)$EXF2(Integer,R))@$ if R has RetractableTo(Float) then + retractIfCan : Polynomial(Float) -> Union(%,"failed") retractIfCan(u:POLY Float):Union($,"failed") == retractIfCan((u::EXPR Float)$EXPR(Float))@Union($,"failed") + retract : Polynomial(Float) -> % retract(u:POLY Float):$ == retract((u::EXPR Float)$EXPR(Float))@$ + retractIfCan : Fraction(Polynomial(Float)) -> Union(%,"failed") retractIfCan(u:FRAC POLY Float):Union($,"failed") == retractIfCan((u::EXPR Float)$EXPR(Float))@Union($,"failed") + retract : Fraction(Polynomial(Float)) -> % retract(u:FRAC POLY Float):$ == retract((u::EXPR Float)$EXPR(Float))@$ + float2R : Float -> R float2R(u:Float):R == (u::R) + retractIfCan : Expression(Float) -> Union(%,"failed") retractIfCan(u:EXPR Float):Union($,"failed") == retractIfCan(map(float2R,u)$EXF2(Float,R))@Union($,"failed") + retract : Expression(Float) -> % retract(u:EXPR Float):$ == retract(map(float2R,u)$EXF2(Float,R))@$ -- Exported Functions + useNagFunctions : () -> Boolean useNagFunctions():Boolean == useNagFunctionsFlag + useNagFunctions : Boolean -> Boolean useNagFunctions(v:Boolean):Boolean == old := useNagFunctionsFlag useNagFunctionsFlag := v old + log10 : % -> % log10(x:$):$ == kernel(operator log10,x) + pi : () -> % pi():$ == kernel(operator X01AAF,0) + coerce : % -> Expression(R) coerce(u:$):EXPR R == u pretend EXPR(R) + retractIfCan : Expression(R) -> Union(%,"failed") retractIfCan(u:EXPR R):Union($,"failed") == if (extraSymbols? u) then m := fixUpSymbols(u) @@ -71261,16 +72909,19 @@ FortranExpression(basicSymbols,subscriptedSymbols,R): extraOperators? u => "failed" checkForNagOperators(u) + retract : Expression(R) -> % retract(u:EXPR R):$ == u:=checkSymbols(u) checkOperators(u) checkForNagOperators(u) + retractIfCan : Symbol -> Union(%,"failed") retractIfCan(u:Symbol):Union($,"failed") == not (member?(u,basicSymbols) or scripted?(u) and member?(name u,subscriptedSymbols)) => "failed" (((u::EXPR(R))$(EXPR R))pretend Rep)::$ + retract : Symbol -> % retract(u:Symbol):$ == res : Union($,"failed") := retractIfCan(u) res case "failed" => error("Illegal Symbol Detected:",u::String) @@ -71587,12 +73238,15 @@ FortranProgram(name,returnType,arguments,symbols): Exports == Implement where import TheSymbolTable import FortranCode + makeRep : List FortranCode -> $ makeRep(b:List FortranCode):$ == construct(empty()$SymbolTable,b)$REP + codeFrom : $ -> List FortranCode codeFrom(u:$):List FortranCode == elt(u::Rep,code)$REP + outputAsFortran : $ -> Void outputAsFortran(p:$):Void == setLabelValue(25000::SingleInteger)$FC -- Do this first to catch any extra type declarations: @@ -71613,9 +73267,11 @@ FortranProgram(name,returnType,arguments,symbols): Exports == Implement where dispStatement(END::OutputForm)$Lisp void()$Void + mkString : List Symbol -> String mkString(l:List Symbol):String == unparse(convert(l::OutputForm)@InputForm)$InputForm + checkVariables : (List Symbol,List Symbol) -> Void checkVariables(user:List Symbol,target:List Symbol):Void == -- We don't worry about whether the user has subscripted the -- variables or not. @@ -71625,11 +73281,13 @@ FortranProgram(name,returnType,arguments,symbols): Exports == Implement where error ["Incompatible variable lists:", s1, s2] void()$Void + coerce : Expression(MachineInteger) -> % coerce(u:EXPR MINT) : $ == checkVariables(variables(u)$EXPR(MINT),arguments) l : List(FC) := [assign(name,u)$FC,returns()$FC] makeRep l + coerce : Equation(Expression(MachineInteger)) -> % coerce(u:Equation EXPR MINT) : $ == retractIfCan(lhs u)@Union(Kernel(EXPR MINT),"failed") case "failed" => error "left hand side is not a kernel" @@ -71642,11 +73300,13 @@ FortranProgram(name,returnType,arguments,symbols): Exports == Implement where [equation(w,v) for w in veList for v in aeList] (subst(rhs u,eList))::$ + coerce : Expression(MachineFloat) -> % coerce(u:EXPR MFLOAT) : $ == checkVariables(variables(u)$EXPR(MFLOAT),arguments) l : List(FC) := [assign(name,u)$FC,returns()$FC] makeRep l + coerce : Equation(Expression(MachineFloat)) -> % coerce(u:Equation EXPR MFLOAT) : $ == retractIfCan(lhs u)@Union(Kernel(EXPR MFLOAT),"failed") case "failed" => error "left hand side is not a kernel" @@ -71659,11 +73319,13 @@ FortranProgram(name,returnType,arguments,symbols): Exports == Implement where [equation(w,v) for w in veList for v in aeList] (subst(rhs u,eList))::$ + coerce : Expression(MachineComplex) -> % coerce(u:EXPR MCMPLX) : $ == checkVariables(variables(u)$EXPR(MCMPLX),arguments) l : List(FC) := [assign(name,u)$FC,returns()$FC] makeRep l + coerce : Equation(Expression(MachineComplex)) -> % coerce(u:Equation EXPR MCMPLX) : $ == retractIfCan(lhs u)@Union(Kernel EXPR MCMPLX,"failed") case "failed"=> error "left hand side is not a kernel" @@ -71676,23 +73338,29 @@ FortranProgram(name,returnType,arguments,symbols): Exports == Implement where [equation(w,v) for w in veList for v in aeList] (subst(rhs u,eList))::$ + coerce : Record(localSymbols: SymbolTable,code: List(FortranCode)) -> % coerce(u:REP):$ == u@Rep + coerce : % -> OutputForm coerce(u:$):OutputForm == coerce(name)$Symbol + coerce : List(FortranCode) -> % coerce(c:List FortranCode):$ == makeRep c + coerce : FortranCode -> % coerce(c:FortranCode):$ == makeRep [c] + coerce : Expression(Integer) -> % coerce(u:EXPR INT) : $ == checkVariables(variables(u)$EXPR(INT),arguments) l : List(FC) := [assign(name,u)$FC,returns()$FC] makeRep l + coerce : Equation(Expression(Integer)) -> % coerce(u:Equation EXPR INT) : $ == retractIfCan(lhs u)@Union(Kernel(EXPR INT),"failed") case "failed" => error "left hand side is not a kernel" @@ -71705,11 +73373,13 @@ FortranProgram(name,returnType,arguments,symbols): Exports == Implement where [equation(w,v) for w in veList for v in aeList] (subst(rhs u,eList))::$ + coerce : Expression(Float) -> % coerce(u:EXPR Float) : $ == checkVariables(variables(u)$EXPR(Float),arguments) l : List(FC) := [assign(name,u)$FC,returns()$FC] makeRep l + coerce : Equation(Expression(Float)) -> % coerce(u:Equation EXPR Float) : $ == retractIfCan(lhs u)@Union(Kernel(EXPR Float),"failed") case "failed" => error "left hand side is not a kernel" @@ -71722,11 +73392,13 @@ FortranProgram(name,returnType,arguments,symbols): Exports == Implement where [equation(w,v) for w in veList for v in aeList] (subst(rhs u,eList))::$ + coerce : Expression(Complex(Float)) -> % coerce(u:EXPR Complex Float) : $ == checkVariables(variables(u)$EXPR(Complex Float),arguments) l : List(FC) := [assign(name,u)$FC,returns()$FC] makeRep l + coerce : Equation(Expression(Complex(Float))) -> % coerce(u:Equation EXPR CMPX Float) : $ == retractIfCan(lhs u)@Union(Kernel EXPR CMPX Float,"failed")_ case "failed"=> @@ -71988,6 +73660,7 @@ FortranScalarType() : exports == implementation where upperDoubleComplexSymbol : Symbol := "DOUBLE COMPLEX"::Symbol + ?=? : (%,%) -> Boolean u = v == u case RealThing and v case RealThing => true u case IntegerThing and v case IntegerThing => true @@ -71998,6 +73671,7 @@ FortranScalarType() : exports == implementation where u case DoubleComplexThing and v case DoubleComplexThing => true false + coerce : % -> OutputForm coerce(t:$):OutputForm == t case RealThing => coerce(REAL)$Symbol t case IntegerThing => coerce(INTEGER)$Symbol @@ -72007,6 +73681,7 @@ FortranScalarType() : exports == implementation where t case DoubleComplexThing => coerce(upperDoubleComplexSymbol)$Symbol coerce(LOGICAL)$Symbol + coerce : % -> SExpression coerce(t:$):SExpression == t case RealThing => convert(real::Symbol)@SExpression t case IntegerThing => convert(integer::Symbol)@SExpression @@ -72016,6 +73691,7 @@ FortranScalarType() : exports == implementation where t case DoubleComplexThing => convert(doubleComplexSymbol)@SExpression convert(logical::Symbol)@SExpression + coerce : % -> Symbol coerce(t:$):Symbol == t case RealThing => real::Symbol t case IntegerThing => integer::Symbol @@ -72025,6 +73701,7 @@ FortranScalarType() : exports == implementation where t case DoublePrecisionThing => doubleComplexSymbol logical::Symbol + coerce : Symbol -> % coerce(s:Symbol):$ == s = real => ["real"]$Rep s = REAL => ["real"]$Rep @@ -72041,6 +73718,7 @@ FortranScalarType() : exports == implementation where s = doubleComplexSymbol => ["double complex"]$Rep s = upperDoubleCOmplexSymbol => ["double complex"]$Rep + coerce : String -> % coerce(s:String):$ == s = "real" => ["real"]$Rep s = "integer" => ["integer"]$Rep @@ -72058,18 +73736,25 @@ FortranScalarType() : exports == implementation where s = "DOUBLE COMPLEX" => ["double complex"]$Rep error concat([s," is invalid as a Fortran Type"])$String + real? : % -> Boolean real?(t:$):Boolean == t case RealThing + double? : % -> Boolean double?(t:$):Boolean == t case DoublePrecisionThing + logical? : % -> Boolean logical?(t:$):Boolean == t case LogicalThing + integer? : % -> Boolean integer?(t:$):Boolean == t case IntegerThing + character? : % -> Boolean character?(t:$):Boolean == t case CharacterThing + complex? : % -> Boolean complex?(t:$):Boolean == t case ComplexThing + doubleComplex? : % -> Boolean doubleComplex?(t:$):Boolean == t case DoubleComplexThing *) @@ -72257,26 +73942,32 @@ FortranTemplate() : specification == implementation where Rep := TextFile + fortranLiteralLine : String -> Void fortranLiteralLine(s:String):Void == PRINC(s,_$fortranOutputStream$Lisp)$Lisp TERPRI(_$fortranOutputStream$Lisp)$Lisp + fortranLiteral : String -> Void fortranLiteral(s:String):Void == PRINC(s,_$fortranOutputStream$Lisp)$Lisp + fortranCarriageReturn : () -> Void fortranCarriageReturn():Void == TERPRI(_$fortranOutputStream$Lisp)$Lisp - writePassiveLine!(line:String):Void == -- We might want to be a bit clever here and look for new SubPrograms etc. + writePassiveLine! : String -> Void + writePassiveLine!(line:String):Void == fortranLiteralLine line + processTemplate : (FileName,FileName) -> FileName processTemplate(tp:FileName, fn:FileName):FileName == pushFortranOutputStack(fn) processTemplate(tp) popFortranOutputStack() fn + getLine : TextFile -> String getLine(fp:TextFile):String == line : String := stripCommentsAndBlanks readLine!(fp) while not empty?(line) and elt(line,maxIndex line) = char "__" repeat @@ -72284,6 +73975,7 @@ FortranTemplate() : specification == implementation where line := concat(line, stripCommentsAndBlanks readLine!(fp))$String line + processTemplate : FileName -> FileName processTemplate(tp:FileName):FileName == fp : TextFile := open(tp,"input") active : Boolean := true @@ -72505,6 +74197,7 @@ FortranType() : exports == implementation where Rep := Record(type : FSTU, dimensions : Dims, external : Boolean) + coerce : % -> OutputForm coerce(a:$):OutputForm == t : OutputForm if external?(a) then @@ -72519,40 +74212,55 @@ FortranType() : exports == implementation where sub(t, paren([u::OutputForm for u in dimensionsOf(a)])$OutputForm)$OutputForm + scalarTypeOf : % -> Union(fst: FortranScalarType,void: void) scalarTypeOf(u:$):FSTU == u.type + dimensionsOf : % -> List(Polynomial(Integer)) dimensionsOf(u:$):Dims == u.dimensions + external? : % -> Boolean external?(u:$):Boolean == u.external + construct : + (Union(fst: FortranScalarType,void: void),List(Symbol),Boolean) -> % construct(t:FSTU, d:List Symbol, e:Boolean):$ == e and not empty? d => error "EXTERNAL objects cannot have dimensions" not(e) and t case void => error "VOID objects must be EXTERNAL" construct(t,[l::Polynomial(Integer) for l in d],e)$Rep + construct : (Union(fst: FortranScalarType,void: void), + List(Polynomial(Integer)),Boolean) -> % construct(t:FSTU, d:List Polynomial Integer, e:Boolean):$ == e and not empty? d => error "EXTERNAL objects cannot have dimensions" not(e) and t case void => error "VOID objects must be EXTERNAL" construct(t,d,e)$Rep + coerce : FortranScalarType -> % coerce(u:FST):$ == construct([u]$FSTU,[]@List Polynomial Integer,false) + fortranReal : () -> % fortranReal():$ == ("real"::FST)::$ + fortranDouble : () -> % fortranDouble():$ == ("double precision"::FST)::$ + fortranInteger : () -> % fortranInteger():$ == ("integer"::FST)::$ + fortranComplex : () -> % fortranComplex():$ == ("complex"::FST)::$ + fortranDoubleComplex : () -> % fortranDoubleComplex():$ == ("double complex"::FST)::$ + fortranCharacter : () -> % fortranCharacter():$ == ("character"::FST)::$ + fortranLogical : () -> % fortranLogical():$ == ("logical"::FST)::$ *) @@ -72688,17 +74396,24 @@ FourierComponent(E:OrderedSet): e:E x,y:$ + sin : E -> % sin e == [true,e] + cos : E -> % cos e == [false,e] + sin? : % -> Boolean sin? x == x.SinIfTrue + argument : % -> E argument x == x.arg + coerce : % -> OutputForm coerce(x):OutputForm == hconcat((if x.SinIfTrue then "sin" else "cos")::OutputForm, bracket((x.arg)::OutputForm)) + + ? Boolean x true y.arg < x.arg => false @@ -72878,8 +74593,9 @@ FourierSeries(R:Join(CommutativeRing,Algebra(Fraction Integer)), (* domain FSERIES *) (* Term := Record(k:FourierComponent(E),c:R) + Rep := List Term - multiply : (Term,Term) -> $ + w,x1,x2:$ t1,t2:Term n:NonNegativeInteger @@ -72890,6 +74606,7 @@ FourierSeries(R:Join(CommutativeRing,Algebra(Fraction Integer)), 1 == [[cos 0,1]] + coerce : FourierComponent(E) -> % coerce e == sin? e and zero? argument e => 0 if argument e < 0 then @@ -72897,6 +74614,7 @@ FourierSeries(R:Join(CommutativeRing,Algebra(Fraction Integer)), return [[sin(- argument e),-1]] [[e,1]] + multiply : (Term,Term) -> $ multiply(t1,t2) == r:=(t1.c*t2.c)*(1/2) s1:=argument t1.k @@ -72911,15 +74629,18 @@ FourierSeries(R:Join(CommutativeRing,Algebra(Fraction Integer)), makeSin(sum,r) + makeSin(diff,r) makeCos(diff,r) + makeCos(sum,r) + ?*? : (%,%) -> % x1*x2 == null x1 => 0 null x2 => 0 +/[+/[multiply(t1,t2) for t2 in x2] for t1 in x1] + makeCos : (E,R) -> % makeCos(a,r) == a<0 => [[cos(-a),r]] [[cos a,r]] + makeSin : (E,R) -> % makeSin(a,r) == zero? a => [] a<0 => [[sin(-a),-r]] @@ -73745,40 +75466,50 @@ Fraction(S: IntegralDomain): QuotientFieldCategory S with Rep:= Record(num:S, den:S) + coerce : S -> % coerce(d:S):% == [d,1] + zero? : % -> Boolean zero?(x:%) == zero? x.num if S has GcdDomain and S has canonicalUnitNormal then + retract : % -> S retract(x:%):S == ((x.den) = 1) => x.num error "Denominator not equal to 1" + retractIfCan : % -> Union(S,"failed") retractIfCan(x:%):Union(S, "failed") == ((x.den) = 1) => x.num "failed" else + retract : % -> S retract(x:%):S == (a:= x.num exquo x.den) case "failed" => error "Denominator not equal to 1" a + retractIfCan : % -> Union(S,"failed") retractIfCan(x:%):Union(S,"failed") == x.num exquo x.den if S has EuclideanDomain then + + wholePart : % -> S wholePart x == ((x.den) = 1) => x.num x.num quo x.den if S has IntegerNumberSystem then + floor : % -> S floor x == ((x.den) = 1) => x.num x < 0 => -ceiling(-x) wholePart x + ceiling : % -> S ceiling x == ((x.den) = 1) => x.num x < 0 => -floor(-x) @@ -73788,6 +75519,7 @@ Fraction(S: IntegralDomain): QuotientFieldCategory S with -- TODO: somwhere this file does something which redefines the division -- operator. Doh! + writeOMFrac : (OpenMathDevice,%) -> Void writeOMFrac(dev: OpenMathDevice, x: %): Void == OMputApp(dev) OMputSymbol(dev, "nums1", "rational") @@ -73795,6 +75527,7 @@ Fraction(S: IntegralDomain): QuotientFieldCategory S with OMwrite(dev, x.den, false) OMputEndApp(dev) + OMwrite : % -> String OMwrite(x: %): String == s: String := "" sp := OM_-STRINGTOSTRINGPTR(s)$Lisp @@ -73806,6 +75539,7 @@ Fraction(S: IntegralDomain): QuotientFieldCategory S with s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String s + OMwrite : (%,Boolean) -> String OMwrite(x: %, wholeObj: Boolean): String == s: String := "" sp := OM_-STRINGTOSTRINGPTR(s)$Lisp @@ -73819,11 +75553,13 @@ Fraction(S: IntegralDomain): QuotientFieldCategory S with s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String s + OMwrite : (OpenMathDevice,%) -> Void OMwrite(dev: OpenMathDevice, x: %): Void == OMputObject(dev) writeOMFrac(dev, x) OMputEndObject(dev) + OMwrite : (OpenMathDevice,%,Boolean) -> Void OMwrite(dev: OpenMathDevice, x: %, wholeObj: Boolean): Void == if wholeObj then OMputObject(dev) @@ -73833,10 +75569,7 @@ Fraction(S: IntegralDomain): QuotientFieldCategory S with if S has GcdDomain then - cancelGcd: % -> S - normalize: % -> % - normalize x == zero?(x.num) => 0 ((x.den) = 1) => x @@ -73845,10 +75578,12 @@ Fraction(S: IntegralDomain): QuotientFieldCategory S with x.num := x.num * uca.associate x + recip : % -> Union(%,"failed") recip x == zero?(x.num) => "failed" normalize [x.den, x.num] + cancelGcd: % -> S cancelGcd x == ((x.den) = 1) => x.den d := gcd(x.num, x.den) @@ -73862,11 +75597,13 @@ Fraction(S: IntegralDomain): QuotientFieldCategory S with x.den := xd :: S d + ?/? : (S,S) -> % nn:S / dd:S == zero? dd => error "division by zero" cancelGcd(z := [nn, dd]) normalize z + ?+? : (%,%) -> % x + y == zero? y => x zero? x => y @@ -73887,6 +75624,7 @@ Fraction(S: IntegralDomain): QuotientFieldCategory S with -- places a default definition in Localize, -- which uses Localize's +, which does not -- cancel gcds + ?-? : (%,%) -> % x - y == zero? y => x z := [x.den, y.den] @@ -73896,6 +75634,7 @@ Fraction(S: IntegralDomain): QuotientFieldCategory S with g.den := g.den * z.num * z.den normalize g + ?*? : (%,%) -> % x:% * y:% == zero? x or zero? y => 0 (x = 1) => y @@ -73904,16 +75643,19 @@ Fraction(S: IntegralDomain): QuotientFieldCategory S with cancelGcd x; cancelGcd y; normalize [x.num * y.num, x.den * y.den] + ?*? : (Integer,%) -> % n:Integer * x:% == y := [n::S, x.den] cancelGcd y normalize [x.num * y.num, y.den] + ?*? : (S,%) -> % nn:S * x:% == y := [nn, x.den] cancelGcd y normalize [x.num * y.num, y.den] + differentiate : (%,(S -> S)) -> % differentiate(x:%, deriv:S -> S) == y := [deriv(x.den), x.den] d := cancelGcd(y) @@ -73925,32 +75667,40 @@ Fraction(S: IntegralDomain): QuotientFieldCategory S with if S has canonicalUnitNormal then + ?=? : (%,%) -> Boolean x = y == (x.num = y.num) and (x.den = y.den) + one? : % -> Boolean one? x == ((x.num) = 1) and ((x.den) = 1) -- again assuming canonical nature of representation else + ?/? : (S,S) -> % nn:S/dd:S == if zero? dd then error "division by zero" else [nn,dd] + recip : % -> Union(%,"failed") recip x == zero?(x.num) => "failed" [x.den, x.num] if (S has RetractableTo Fraction Integer) then + retract : % -> Fraction(Integer) retract(x:%):Fraction(Integer) == retract(retract(x)@S) + retractIfCan : % -> Union(Fraction(Integer),"failed") retractIfCan(x:%):Union(Fraction Integer, "failed") == (u := retractIfCan(x)@Union(S, "failed")) case "failed" => "failed" retractIfCan(u::S) else if (S has RetractableTo Integer) then + retract : % -> Fraction(Integer) retract(x:%):Fraction(Integer) == retract(numer x) / retract(denom x) + retractIfCan : % -> Union(Fraction(Integer),"failed") retractIfCan(x:%):Union(Fraction Integer, "failed") == (n := retractIfCan numer x) case "failed" => "failed" (d := retractIfCan denom x) case "failed" => "failed" @@ -73966,6 +75716,9 @@ Fraction(S: IntegralDomain): QuotientFieldCategory S with if S has GcdDomain then + gcdPolynomial : (SparseUnivariatePolynomial(%), + SparseUnivariatePolynomial(%)) -> + SparseUnivariatePolynomial(%) gcdPolynomial(pp,qq) == zero? pp => qq zero? qq => pp @@ -73982,6 +75735,7 @@ Fraction(S: IntegralDomain): QuotientFieldCategory S with if (S has PolynomialFactorizationExplicit) then -- we'll let the solveLinearPolynomialEquations operator -- default from Field + pp,qq: QFP lpp: List QFP import Factored SparseUnivariatePolynomial % @@ -73990,6 +75744,7 @@ Fraction(S: IntegralDomain): QuotientFieldCategory S with if S has canonicalUnitNormal and S has GcdDomain then + charthRoot : % -> Union(%,"failed") charthRoot x == n:= charthRoot x.num n case "failed" => "failed" @@ -73999,6 +75754,7 @@ Fraction(S: IntegralDomain): QuotientFieldCategory S with else + charthRoot : % -> Union(%,"failed") charthRoot x == -- to find x = p-th root of n/d -- observe that xd is p-th root of n*d**(p-1) @@ -74008,13 +75764,13 @@ Fraction(S: IntegralDomain): QuotientFieldCategory S with ans / x.den clear: List % -> List S - clear l == d:="lcm"/[x.den for x in l] [ x.num * (d exquo x.den)::S for x in l] mat: Matrix % + conditionP : Matrix(%) -> Union(Vector(%),"failed") conditionP mat == matD: Matrix S matD:= matrix [ clear l for l in listOfLists mat ] @@ -74023,6 +75779,8 @@ Fraction(S: IntegralDomain): QuotientFieldCategory S with ansDD:=ansD :: Vector(S) [ ansDD(i)::% for i in 1..#ansDD]$Vector(%) + factorPolynomial : SparseUnivariatePolynomial(%) -> + Factored(SparseUnivariatePolynomial(%)) factorPolynomial(pp) == zero? pp => 0 denpp:="lcm"/[denom u for u in coefficients pp] @@ -74040,6 +75798,8 @@ Fraction(S: IntegralDomain): QuotientFieldCategory S with w.xpnt] for w in factorList ff] makeFR(map(x+->x::%/den1,unit(ff)),lfact) + factorSquareFreePolynomial : SparseUnivariatePolynomial(%) -> + Factored(SparseUnivariatePolynomial(%)) factorSquareFreePolynomial(pp) == zero? pp => 0 degree pp = 0 => makeFR(pp,empty()) @@ -74351,40 +76111,39 @@ FractionalIdeal(R, F, UP, A): Exports == Implementation where Rep := Record(num:VA, den:R) - poly : % -> UPA - invrep : Matrix F -> A - upmat : (A, NonNegativeInteger) -> Matrix UP - summat : % -> Matrix UP - num2O : VA -> OutputForm - agcd : List A -> R - vgcd : VF -> R - mkIdeal : (VA, R) -> % - intIdeal: (List A, R) -> % - ret? : VA -> Boolean - tryRange: (NonNegativeInteger, VA, R, %) -> Union(%, "failed") - - 1 == [[1]$VA, 1] + 1 : () -> % + 1 == [[1]$VA, 1] - numer i == i.num + numer : % -> Vector(A) + numer i == i.num - denom i == i.den + denom : % -> R + denom i == i.den - mkIdeal(v, d) == [v, d] + mkIdeal : (VA, R) -> % + mkIdeal(v, d) == [v, d] - invrep m == represents(transpose(m) * coordinates(1$A)) + invrep : Matrix F -> A + invrep m == represents(transpose(m) * coordinates(1$A)) - upmat(x, i) == map(s +-> monomial(s, i)$UP, regularRepresentation x) + upmat : (A, NonNegativeInteger) -> Matrix UP + upmat(x, i) == map(s +-> monomial(s, i)$UP, regularRepresentation x) - ret? v == any?(s+->retractIfCan(s)@Union(F,"failed") case F, v) + ret? : VA -> Boolean + ret? v == any?(s+->retractIfCan(s)@Union(F,"failed") case F, v) - x = y == denom(x) = denom(y) and numer(x) = numer(y) + ?=? : (%,%) -> Boolean + x = y == denom(x) = denom(y) and numer(x) = numer(y) + agcd : List A -> R agcd l == reduce("gcd", [vgcd coordinates a for a in l]$List(R), 0) + norm : % -> F norm i == ("gcd"/[retract(u)@R for u in coefficients determinant summat i]) / denom(i) ** rank()$A + tryRange: (NonNegativeInteger, VA, R, %) -> Union(%, "failed") tryRange(range, nm, nrm, i) == for j in 0..10 repeat a := randomLC(10 * range, nm) @@ -74392,11 +76151,13 @@ FractionalIdeal(R, F, UP, A): Exports == Implementation where return intIdeal([nrm::F::A, a], denom i) "failed" + summat : % -> Matrix UP summat i == m := minIndex(v := numer i) reduce("+", [upmat(qelt(v, j + m), j) for j in 0..#v-1]$List(Matrix UP)) + inv : % -> % inv i == m := inverse(map(s+->s::QF, summat i))::Matrix(QF) cd := splitDenominator(denom(i)::F::UP::QF * m) @@ -74406,11 +76167,13 @@ FractionalIdeal(R, F, UP, A): Exports == Implementation where ideal [invd * invrep map(s+->coefficient(s, j), cd.num) for j in 0..d]$VA + ideal : Vector(A) -> % ideal v == d := reduce("lcm", [commonDenominator coordinates qelt(v, i) for i in minIndex v .. maxIndex v]$List(R)) intIdeal([d::F * qelt(v, i) for i in minIndex v .. maxIndex v], d) + intIdeal: (List A, R) -> % intIdeal(l, d) == lr := empty()$List(R) nr := empty()$List(A) @@ -74428,17 +76191,21 @@ FractionalIdeal(R, F, UP, A): Exports == Implementation where zero? a => mkIdeal(va, d) mkIdeal(concat(a, va), d) + vgcd : VF -> R vgcd v == reduce("gcd", [retract(v.i)@R for i in minIndex v .. maxIndex v]$List(R)) + poly : % -> UPA poly i == m := minIndex(v := numer i) +/[monomial(qelt(v, i + m), i) for i in 0..#v-1] + ?*? : (%,%) -> % i1 * i2 == intIdeal(coefficients(poly i1 * poly i2), denom i1 * denom i2) + ?**? : (%,Integer) -> % i:$ ** m:Integer == m < 0 => inv(i) ** (-m) n := m::NonNegativeInteger @@ -74446,15 +76213,18 @@ FractionalIdeal(R, F, UP, A): Exports == Implementation where intIdeal([qelt(v, j) ** n for j in minIndex v .. maxIndex v], denom(i) ** n) + num2O : VA -> OutputForm num2O v == paren [qelt(v, i)::OutputForm for i in minIndex v .. maxIndex v]$List(OutputForm) + basis : % -> Vector(A) basis i == v := numer i d := inv(denom(i)::F) [d * qelt(v, j) for j in minIndex v .. maxIndex v] + coerce : % -> OutputForm coerce(i:$):OutputForm == nm := num2O numer i (denom i = 1) => nm @@ -74462,15 +76232,18 @@ FractionalIdeal(R, F, UP, A): Exports == Implementation where if F has Finite then + randomLC : (NonNegativeInteger,Vector(A)) -> A randomLC(m, v) == +/[random()$F * qelt(v, j) for j in minIndex v .. maxIndex v] else + randomLC : (NonNegativeInteger,Vector(A)) -> A randomLC(m, v) == +/[(random()$Integer rem m::Integer) * qelt(v, j) for j in minIndex v .. maxIndex v] + minimize : % -> % minimize i == n := (#(nm := numer i)) (n = 1) or (n < 3 and ret? nm) => i @@ -74692,29 +76465,29 @@ FramedModule(R, F, UP, A, ibasis): Exports == Implementation where imat := new(#ibasis, #ibasis, 0)$M wmat := new(#ibasis, #ibasis, 0)$M - rowdiv : (VR, R) -> VF - vectProd : (VA, VA) -> VA - wmatrix : VA -> M - W2A : VF -> A - intmat : () -> M - invintmat : () -> M - getintmat : () -> Boolean - getinvintmat: () -> Boolean - 1 == ibasis + 1 : () -> % + 1 == ibasis - module(v:VA) == v + module : Vector(A) -> % + module(v:VA) == v - basis m == m pretend VA + basis : % -> Vector(A) + basis m == m pretend VA - rowdiv(r, f) == [r.i / f for i in minIndex r..maxIndex r] + rowdiv : (VR, R) -> VF + rowdiv(r, f) == [r.i / f for i in minIndex r..maxIndex r] + coerce : % -> OutputForm coerce(m:%):OutputForm == coerce(basis m)$VA - W2A v == represents(v * intmat()) + W2A : VF -> A + W2A v == represents(v * intmat()) - wmatrix v == coordinates(v) * invintmat() + wmatrix : VA -> M + wmatrix v == coordinates(v) * invintmat() + getinvintmat: () -> Boolean getinvintmat() == m := inverse(intmat())::M for i in minRowIndex m .. maxRowIndex m repeat @@ -74722,6 +76495,7 @@ FramedModule(R, F, UP, A, ibasis): Exports == Implementation where imat(i, j) := qelt(m, i, j) false + getintmat : () -> Boolean getintmat() == m := coordinates ibasis for i in minRowIndex m .. maxRowIndex m repeat @@ -74729,14 +76503,17 @@ FramedModule(R, F, UP, A, ibasis): Exports == Implementation where wmat(i, j) := qelt(m, i, j) false + invintmat : () -> M invintmat() == if iflag?() then iflag?() := getinvintmat() imat + intmat : () -> M intmat() == if wflag?() then wflag?() := getintmat() wmat + vectProd : (VA, VA) -> VA vectProd(v1, v2) == k := minIndex(v := new(#v1 * #v2, 0)$VA) for i in minIndex v1 .. maxIndex v1 repeat @@ -74745,10 +76522,12 @@ FramedModule(R, F, UP, A, ibasis): Exports == Implementation where k := k + 1 v pretend VA + norm : % -> F norm m == #(basis m) ^= #ibasis => error "Module not of rank n" determinant(coordinates(basis m) * invintmat()) + ?*? : (%,%) -> % m1 * m2 == m := rowEch((cd := splitDenominator wmatrix( vectProd(basis m1, basis m2))).num) @@ -74757,6 +76536,7 @@ FramedModule(R, F, UP, A, ibasis): Exports == Implementation where if A has RetractableTo F then + module : FractionalIdeal(R,F,UP,A) -> % module(i:FractionalIdeal(R, F, UP, A)) == module(basis i) * module(ibasis) @@ -74927,12 +76707,12 @@ FreeAbelianGroup(S:SetCategory): Exports == Implementation where (* InnerFreeAbelianMonoid(S, Integer, 1) add + -? : % -> % - f == mapCoef("-", f) if S has OrderedSet then inmax: List Record(gen: S, exp: Integer) -> Record(gen: S, exp:Integer) - inmax l == mx := first l for t in rest l repeat @@ -74940,6 +76720,7 @@ FreeAbelianGroup(S:SetCategory): Exports == Implementation where mx -- lexicographic order + ? Boolean a < b == zero? a => zero? b => false @@ -75263,26 +77044,37 @@ FreeGroup(S: SetCategory): Join(Group, RetractableTo S) with Rep := ListMonoidOps(S, Integer, 1) - 1 == makeUnit() + 1 : () -> % + 1 == makeUnit() - one? f == empty? listOfMonoms f + one? : % -> Boolean + one? f == empty? listOfMonoms f - s:S ** n:Integer == makeTerm(s, n) + ?**? : (S,Integer) -> % + s:S ** n:Integer == makeTerm(s, n) - f:$ * s:S == rightMult(f, s) + ?*? : (%,%) -> % + f:$ * s:S == rightMult(f, s) - s:S * f:$ == leftMult(s, f) + ?*? : (S,%) -> % + s:S * f:$ == leftMult(s, f) - inv f == reverse_! mapExpon("-", f) + inv : % -> % + inv f == reverse_! mapExpon("-", f) - factors f == copy listOfMonoms f + factors : % -> List(Record(gen: S,exp: Integer)) + factors f == copy listOfMonoms f - mapExpon(f, x) == mapExpon(f, x)$Rep + mapExpon : ((Integer -> Integer),%) -> % + mapExpon(f, x) == mapExpon(f, x)$Rep - mapGen(f, x) == mapGen(f, x)$Rep + mapGen : ((S -> S),%) -> % + mapGen(f, x) == mapGen(f, x)$Rep - coerce(f:$):OutputForm == outputForm(f, "*", "**", 1) + coerce : % -> OutputForm + coerce(f:$):OutputForm == outputForm(f, "*", "**", 1) + ?*? : (%,S) -> % f:$ * g:$ == one? f => g one? g => f @@ -75482,6 +77274,7 @@ FreeModule(R:Ring,S:OrderedSet): if R has EntireRing then + ?*? : (R,%) -> % r * x == zero? r => 0 (r = 1) => x @@ -75490,6 +77283,7 @@ FreeModule(R:Ring,S:OrderedSet): else + ?*? : (R,%) -> % r * x == zero? r => 0 (r = 1) => x @@ -75498,6 +77292,7 @@ FreeModule(R:Ring,S:OrderedSet): if R has EntireRing then + ?*? : (%,R) -> % x * r == zero? r => 0 (r = 1) => x @@ -75506,12 +77301,14 @@ FreeModule(R:Ring,S:OrderedSet): else + ?*? : (%,R) -> % x * r == zero? r => 0 (r = 1) => x --map(r*#1,x) [[u.k,a] for u in x | (a:=u.c*r) ^= 0$R] + coerce : % -> OutputForm coerce(x) : OutputForm == null x => (0$R) :: OutputForm le : List OutputForm := nil @@ -75745,68 +77542,88 @@ FreeModule1(R:Ring,S:OrderedSet): FMcat == FMdef where s : S -- define + + numberOfMonomials : % -> NonNegativeInteger numberOfMonomials p == # (p::Rep) + listOfTerms : % -> List(Record(k: S,c: R)) listOfTerms(x) == x:List TERM + leadingTerm : % -> Record(k: S,c: R) leadingTerm x == x.first + leadingMonomial : % -> S leadingMonomial x == x.first.k + coefficients : % -> List(R) coefficients x == [t.c for t in x] + monomials : % -> List(%) monomials x == [ monom (t.k, t.c) for t in x] + retractIfCan : % -> Union(S,"failed") retractIfCan x == numberOfMonomials(x) ^= 1 => "failed" x.first.c = 1 => x.first.k "failed" + coerce : S -> % coerce(s:S):% == [[s,1$R]] + retract : % -> S retract x == (rr := retractIfCan x) case "failed" => error "FM1.retract impossible" rr :: S if R has noZeroDivisors then + ?*? : (R,%) -> % r * x == r = 0 => 0 [[u.k,r * u.c]$TERM for u in x] + ?*? : (%,R) -> % x * r == r = 0 => 0 [[u.k,u.c * r]$TERM for u in x] else + ?*? : (R,%) -> % r * x == r = 0 => 0 [[u.k,a] for u in x | not (a:=r*u.c)= 0$R] + ?*? : (%,R) -> % x * r == r = 0 => 0 [[u.k,a] for u in x | not (a:=u.c*r)= 0$R] + ?*? : (R,S) -> % r * s == r = 0 => 0 [[s,r]$TERM] + ?*? : (S,R) -> % s * r == r = 0 => 0 [[s,r]$TERM] + monom : (S,R) -> % monom(b,r):% == [[b,r]$TERM] + outTerm : (R,S) -> EX outTerm(r:R, s:S):EX == r=1 => s::EX r::EX * s::EX + coerce : % -> OutputForm coerce(a:%):EX == empty? a => (0$R)::EX reduce(_+, reverse_! [outTerm(t.c, t.k) for t in a])$List(EX) + coefficient : (%,S) -> R coefficient(x,s) == null x => 0$R x.first.k > s => coefficient(rest x,s) @@ -76130,26 +77947,37 @@ FreeMonoid(S: SetCategory): FMcategory == FMdefinition where Rep := ListMonoidOps(S, NonNegativeInteger, 1) - 1 == makeUnit() + 1 : () -> % + 1 == makeUnit() - one? f == empty? listOfMonoms f + one? : % -> Boolean + one? f == empty? listOfMonoms f + coerce : % -> OutputForm coerce(f:$): Ex == outputForm(f, "*", "**", 1) - hcrf(f, g) == reverse_! hclf(reverse f, reverse g) + hcrf : (%,%) -> % + hcrf(f, g) == reverse_! hclf(reverse f, reverse g) - f:$ * s:S == rightMult(f, s) + ?*? : (%,S) -> % + f:$ * s:S == rightMult(f, s) - s:S * f:$ == leftMult(s, f) + ?*? : (S,%) -> % + s:S * f:$ == leftMult(s, f) - factors f == copy listOfMonoms f + factors : % -> List(Record(gen: S,exp: NonNegativeInteger)) + factors f == copy listOfMonoms f - mapExpon(f, x) == mapExpon(f, x)$Rep + mapExpon : ((NonNegativeInteger -> NonNegativeInteger),%) -> % + mapExpon(f, x) == mapExpon(f, x)$Rep - mapGen(f, x) == mapGen(f, x)$Rep + mapGen : ((S -> S),%) -> % + mapGen(f, x) == mapGen(f, x)$Rep + ?**? : (S,NonNegativeInteger) -> % s:S ** n:NonNegativeInteger == makeTerm(s, n) + ?*? : (%,%) -> % f:$ * g:$ == (f = 1) => g (g = 1) => f @@ -76160,6 +77988,7 @@ FreeMonoid(S: SetCategory): FMcategory == FMdefinition where makeMulti concat(h, rest lg) makeMulti concat(lf, lg) + overlap : (%,%) -> Record(lm: %,mm: %,rm: %) overlap(la, ar) == (la = 1) or (ar = 1) => [la, 1, ar] lla := la0 := listOfMonoms la @@ -76187,6 +78016,7 @@ FreeMonoid(S: SetCategory): FMcategory == FMdefinition where lla := rest lla [makeMulti la0, 1, makeMulti lar] + divide : (%,%) -> Union(Record(lm: %,rm: %),"failed") divide(lar, a) == (a = 1) => [lar, 1] Na : Integer := #(la := listOfMonoms a) @@ -76207,6 +78037,7 @@ FreeMonoid(S: SetCategory): FMcategory == FMdefinition where Nlar := Nlar - 1 "failed" + hclf : (%,%) -> % hclf(f, g) == h:List(REC) := empty() for f0 in listOfMonoms f for g0 in listOfMonoms g repeat @@ -76215,6 +78046,7 @@ FreeMonoid(S: SetCategory): FMcategory == FMdefinition where f0.exp ^= g0.exp => return makeMulti h makeMulti h + lquo : (%,%) -> Union(%,"failed") lquo(aq, a) == size a > #(laq := copy listOfMonoms aq) => "failed" for a0 in listOfMonoms a repeat @@ -76225,11 +78057,14 @@ FreeMonoid(S: SetCategory): FMcategory == FMdefinition where (laq.first.exp - a0.exp)::NNI]) makeMulti laq + rquo : (%,%) -> Union(%,"failed") rquo(qa, a) == (u := lquo(reverse qa, reverse a)) case "failed" => "failed" reverse_!(u::$) if S has OrderedSet then + + ? Boolean a < b == la := listOfMonoms a lb := listOfMonoms b @@ -76482,11 +78317,12 @@ FreeNilpotentLie(n:NNI,class:NNI,R: CommutativeRing): Export == Implement where coms:VLI coms := generate(n,class)$HB + dimension : () -> NonNegativeInteger dimension == #coms - -- have(left,right) is a lookup function for basic commutators - -- already generated; if the nth basic commutator is - -- [left,wt,right], then have(left,right) = n + -- have(left,right) is a lookup function for basic commutators + -- already generated; if the nth basic commutator is + -- [left,wt,right], then have(left,right) = n have : (I,I) -> % have(i,j) == wt:I := coms(i).2 + coms(j).2 @@ -76500,6 +78336,7 @@ FreeNilpotentLie(n:NNI,class:NNI,R: CommutativeRing): Export == Implement where while coms(hi).3 < j repeat hi := hi + 1 monomial(1,hi::OSI)$FM + generator : NonNegativeInteger -> % generator(i) == i > dimension => 0$Rep monomial(1,i::OSI)$FM @@ -76521,6 +78358,7 @@ FreeNilpotentLie(n:NNI,class:NNI,R: CommutativeRing): Export == Implement where brkt(k,putIn coms(dg).1) )) brkt(k,monomial(lC f,lS f)$FM)+brkt(k,reductum f) + ?*? : (%,%) -> % f*g == reductum(f) = 0 => lC(f)*brkt(value(lS f),g) @@ -76542,11 +78380,13 @@ FreeNilpotentLie(n:NNI,class:NNI,R: CommutativeRing): Export == Implement where k <= n => r::O * s::O r::O * mkcomm(mkcomm(coms(k).1)$Com,mkcomm(coms(k).3)$Com)$Com::O + shallowExpand : % -> OutputForm shallowExpand(f) == f = 0 => 0::O reductum(f) = 0 => shallowE(lC f,lS f) shallowE(lC f,lS f) + shallowExpand(reductum f) + deepExpand : % -> OutputForm deepExpand(f) == f = 0 => 0::O reductum(f) = 0 => @@ -77277,15 +79117,8 @@ FullPartialFractionExpansion(F, UP): Exports == Implementation where Rep := FPF - fullParFrac: (UP, UP, UP, N) -> List REC - outputexp : (O, N) -> O - output : (N, UP, UP) -> O - REC2RF : (UP, UP, N) -> RF - UP2SUP : UP -> SUP - diffrec : REC -> REC - FP2O : List REC -> O - -- create a differential variable + u := new()$Symbol u0 := makeVariable(u, 0)$ODV @@ -77298,39 +79131,53 @@ FullPartialFractionExpansion(F, UP): Exports == Implementation where zr := (0$N)::O - construct l == [0, l] + construct : + List(Record(exponent: NonNegativeInteger,center: UP,num: UP)) -> % + construct l == [0, l] - D r == differentiate r + D : % -> % + D r == differentiate r - D(r, n) == differentiate(r,n) + D : (%,NonNegativeInteger) -> % + D(r, n) == differentiate(r,n) - polyPart f == f.polyPart + polyPart : % -> UP + polyPart f == f.polyPart - fracPart f == f.fracPart + fracPart : + % -> List(Record(exponent: NonNegativeInteger,center: UP,num: UP)) + fracPart f == f.fracPart - p:UP + f:$ == [p + polyPart f, fracPart f] + ?+? : (UP,%) -> % + p:UP + f:$ == [p + polyPart f, fracPart f] + differentiate : % -> % differentiate f == differentiate(polyPart f) + construct [diffrec rec for rec in fracPart f] + differentiate : (%,NonNegativeInteger) -> % differentiate(r, n) == for i in 1..n repeat r := differentiate r r + diffrec : REC -> REC diffrec rec == e := rec.exponent [e + 1, rec.center, - e * rec.num] + convert : % -> Fraction(UP) convert(f:$):RF == ans := polyPart(f)::RF for rec in fracPart f repeat ans := ans + REC2RF(rec.center, rec.num, rec.exponent) ans + UP2SUP : UP -> SUP UP2SUP p == map((z1:F):RF +-> z1::UP::RF, p)_ $UnivariatePolynomialCategoryFunctions2(F, UP, RF, SUP) -- returns Trace_k^k(a) (h(a) / (x - a)^n) where d(a) = 0 + REC2RF : (UP, UP, N) -> RF REC2RF(d, h, n) == ((m := degree d) = 1) => a := - (leadingCoefficient reductum d) / (leadingCoefficient d) @@ -77347,12 +79194,14 @@ FullPartialFractionExpansion(F, UP): Exports == Implementation where ans := ans + coefficient(t, i) ans + fullPartialFraction : Fraction(UP) -> % fullPartialFraction f == qr := divide(numer f, d := denom f) qr.quotient + construct concat [fullParFrac(qr.remainder, d, rec.factor, rec.exponent::N) for rec in factors squareFree denom f] + fullParFrac: (UP, UP, UP, N) -> List REC fullParFrac(a, d, q, n) == ans:List REC := empty() em := e := d quo (q ** n) @@ -77383,6 +79232,7 @@ FullPartialFractionExpansion(F, UP): Exports == Implementation where bm := (b * bm) rem q0 -- bm = b**{m+1} modulo q now ans + coerce : % -> OutputForm coerce(f:$):O == ans := FP2O(l := fracPart f) zero?(p := polyPart f) => @@ -77390,6 +79240,7 @@ FullPartialFractionExpansion(F, UP): Exports == Implementation where ans p::O + ans + FP2O : List REC -> O FP2O l == empty? l => empty() rec := first l @@ -77398,6 +79249,7 @@ FullPartialFractionExpansion(F, UP): Exports == Implementation where ans := ans + output(rec.exponent, rec.center, rec.num) ans + output : (N, UP, UP) -> O output(n, d, h) == (degree d) = 1 => a := - leadingCoefficient(reductum d) / leadingCoefficient(d) @@ -77405,6 +79257,7 @@ FullPartialFractionExpansion(F, UP): Exports == Implementation where sum(outputForm(makeSUP h, alpha) / outputexp(xx - alpha, n), outputForm(makeSUP d, alpha) = zr) + outputexp : (O, N) -> O outputexp(f, n) == (n = 1) => f f ** (n::O) @@ -77498,13 +79351,17 @@ FunctionCalled(f:Symbol): SetCategory with (* domain FUNCTION *) (* - name r == f + name : % -> Symbol + name r == f + coerce : % -> OutputForm coerce(r:%):OutputForm == f::OutputForm - x = y == true + ?=? : (%,%) -> Boolean + x = y == true - latex(x:%):String == latex f + latex : % -> String + latex(x:%):String == latex f *) @@ -78187,23 +80044,29 @@ GeneralDistributedMultivariatePolynomial(vl,R,E): public == private where Vec ==> Vector(NonNegativeInteger) + zero? : % -> Boolean zero?(p : %): Boolean == null(p : Rep) + totalDegree : % -> NonNegativeInteger totalDegree p == zero? p => 0 "max"/[reduce("+",(t.k)::(Vector NNI), 0) for t in p] + monomial : (%,OrderedVariableList(vl),NonNegativeInteger) -> % monomial(p:%, v: OV,e: NonNegativeInteger):% == locv := lookup v p*monomial(1, directProduct [if z=locv then e else 0 for z in 1..n]$Vec) + coerce : OrderedVariableList(vl) -> % coerce(v: OV):% == monomial(1,v,1) + listCoef : % -> List R listCoef(p : %): List R == rec : Term [rec.c for rec in (p:Rep)] + mainVariable : % -> Union(OrderedVariableList(vl),"failed") mainVariable(p: %) == zero?(p) => "failed" for v in vl repeat @@ -78211,37 +80074,50 @@ GeneralDistributedMultivariatePolynomial(vl,R,E): public == private where if degree(p,vv)>0 then return vv "failed" + ground? : % -> Boolean ground?(p) == mainVariable(p) case "failed" + retract : % -> R retract(p : %): R == not ground? p => error "not a constant" leadingCoefficient p + retractIfCan : % -> Union(R,"failed") retractIfCan(p : %): Union(R,"failed") == ground?(p) => leadingCoefficient p "failed" + degree : (%,OrderedVariableList(vl)) -> NonNegativeInteger degree(p: %,v: OV) == degree(univariate(p,v)) + minimumDegree : (%,OrderedVariableList(vl)) -> NonNegativeInteger minimumDegree(p: %,v: OV) == minimumDegree(univariate(p,v)) + differentiate : (%,OrderedVariableList(vl)) -> % differentiate(p: %,v: OV) == multivariate(differentiate(univariate(p,v)),v) + degree : (%,List(OrderedVariableList(vl))) -> List(NonNegativeInteger) degree(p: %,lv: List OV) == [degree(p,v) for v in lv] + minimumDegree : (%,List(OrderedVariableList(vl))) -> + List(NonNegativeInteger) minimumDegree(p: %,lv: List OV) == [minimumDegree(p,v) for v in lv] + numberOfMonomials : % -> NonNegativeInteger numberOfMonomials(p:%) == l : Rep := p : Rep null(l) => 1 #l + monomial? : % -> Boolean monomial?(p : %): Boolean == l : Rep := p : Rep null(l) or null rest(l) if R has OrderedRing then + + maxNorm : % -> R maxNorm(p : %): R == l : List R := nil r,m : R @@ -78252,8 +80128,11 @@ GeneralDistributedMultivariatePolynomial(vl,R,E): public == private where m if R has Field then + + ?*? : (%,R) -> % (p : %) / (r : R) == inv(r) * p + variables : % -> List(OrderedVariableList(vl)) variables(p: %) == maxdeg:Vector(NonNegativeInteger) := new(n,0) while not zero?(p) repeat @@ -78263,12 +80142,14 @@ GeneralDistributedMultivariatePolynomial(vl,R,E): public == private where maxdeg.i := max(maxdeg.i, tdeg.i) [index(i:PositiveInteger) for i in 1..n | maxdeg.i^=0] + reorder : (%,List(Integer)) -> % reorder(p: %,perm: List Integer):% == #perm ^= n => error "must be a complete permutation of all vars" q := [[directProduct [term.k.j for j in perm]$Vec,term.c]$Term for term in p] sort((z1,z2) +-> z1.k > z2.k,q) + univariate : (%,OrderedVariableList(vl)) -> SparseUnivariatePolynomial(%) univariate(p: %,v: OV):SUP(%) == zero?(p) => 0 exp := degree p @@ -78279,15 +80160,19 @@ GeneralDistributedMultivariatePolynomial(vl,R,E): public == private where monomial(monomial(leadingCoefficient p,nexp),deg)+ univariate(reductum p,v) + eval : (%,OrderedVariableList(vl),%) -> % eval(p: %,v: OV,val:%):% == univariate(p,v)(val) + eval : (%,OrderedVariableList(vl),R) -> % eval(p: %,v: OV,val:R):% == eval(p,v,val::%)$% + eval : (%,List(OrderedVariableList(vl)),List(R)) -> % eval(p: %,lv: List OV,lval: List R):% == lv = [] => p eval(eval(p,first lv,(first lval)::%)$%, rest lv, rest lval)$% -- assume Lvar are sorted correctly + evalSortedVarlist : (%,List OV,List %) -> % evalSortedVarlist(p: %,Lvar: List OV,Lpval: List %):% == v := mainVariable p v case "failed" => p @@ -78300,6 +80185,7 @@ GeneralDistributedMultivariatePolynomial(vl,R,E): public == private where mvar=pv => pts(pval) multivariate(pts,pv) + eval : (%,List(OrderedVariableList(vl)),List(%)) -> % eval(p:%,Lvar:List OV,Lpval:List %) == nlvar:List OV := sort((x,y) +-> x > y,Lvar) nlpval := @@ -78307,12 +80193,14 @@ GeneralDistributedMultivariatePolynomial(vl,R,E): public == private where nlpval := [Lpval.position(mvar,Lvar) for mvar in nlvar] evalSortedVarlist(p,nlvar,nlpval) + multivariate:(SparseUnivariatePolynomial(%),OrderedVariableList(vl)) -> % multivariate(p1:SUP(%),v: OV):% == 0=p1 => 0 degree p1 = 0 => leadingCoefficient p1 leadingCoefficient(p1)*(v::%)**degree(p1) + multivariate(reductum p1,v) + univariate : % -> SparseUnivariatePolynomial(R) univariate(p: %):SUP(R) == (v := mainVariable p) case "failed" => monomial(leadingCoefficient p,0) @@ -78323,6 +80211,7 @@ GeneralDistributedMultivariatePolynomial(vl,R,E): public == private where q := reductum q ans + multivariate:(SparseUnivariatePolynomial(R),OrderedVariableList(vl)) -> % multivariate(p:SUP(R),v: OV):% == 0=p => 0 (leadingCoefficient p)*monomial(1,v,degree p) + @@ -78330,16 +80219,20 @@ GeneralDistributedMultivariatePolynomial(vl,R,E): public == private where if R has GcdDomain then + content : % -> R content(p: %):R == zero?(p) => 0 "gcd"/[t.c for t in p] if R has EuclideanDomain and not(R has FloatingPointSystem) then + gcd : (%,%) -> % gcd(p: %,q:%):% == gcd(p,q)$PolynomialGcdPackage(E,OV,R,%) else + + gcd : (%,%) -> % gcd(p: %,q:%):% == r : R (pv := mainVariable(p)) case "failed" => @@ -78352,6 +80245,7 @@ GeneralDistributedMultivariatePolynomial(vl,R,E): public == private where qv gcd(q,content univariate(p,pv)) multivariate(gcd(univariate(p,pv),univariate(q,qv)),pv) + coerce : % -> OutputForm coerce(p: %) : OutputForm == zero?(p) => (0$R) :: OutputForm l,lt : List OutputForm @@ -78540,22 +80434,29 @@ GeneralModulePolynomial(vl, R, IS, E, ff, P): public == private where Rep:= FreeModule(R, ModMonom) + leadingMonomial : % -> ModuleMonomial(IS,E,ff) leadingMonomial(p:$):ModMonom == leadingSupport(p)$Rep + leadingExponent : % -> E leadingExponent(p:$):E == exponent(leadingMonomial p) + leadingIndex : % -> IS leadingIndex(p:$):IS == index(leadingMonomial p) + unitVector : IS -> % unitVector(i:IS):$ == monomial(1,[i, 0$E]$ModMonom) + build : (R,IS,E) -> % build(c:R, i:IS, e:E):$ == monomial(c, construct(i, e)) - ---- WARNING: assumes c ^= 0 + ---- WARNING: assumes c ^= 0 + multMonom : (R,E,%) -> % multMonom(c:R, e:E, mp:$):$ == zero? mp => mp monomial(c * leadingCoefficient mp, [leadingIndex mp, e + leadingExponent mp]) + multMonom(c, e, reductum mp) + ?*? : (P,%) -> % ((p:P) * (mp:$)):$ == zero? p => 0 multMonom(leadingCoefficient p, degree p, mp) + @@ -79081,8 +80982,10 @@ GenericNonAssociativeAlgebra(R : CommutativeRing, n : PositiveInteger,_ coerce(gamma)$CoerceVectorMatrixPackage(R) ) add listOfNumbers : List String := [PRINC_-TO_-STRING(q)$Lisp for q in 1..n] + symbolsForCoef : V Symbol := [concat("%", concat("x", i))::Symbol for i in listOfNumbers] + genericElement : % := v : Vector PR := [monomial(1$PR, [symbolsForCoef.i],[1]) for i in 1..n] @@ -79138,22 +81041,31 @@ GenericNonAssociativeAlgebra(R : CommutativeRing, n : PositiveInteger,_ rightRankPoly := rightMinimalPolynomial genericElement void()$Void + leftRankPolynomial : () -> + SparseUnivariatePolynomial(Polynomial(Fraction(Polynomial(R)))) leftRankPolynomial() == if initLeft? then initializeLeft() leftRankPoly + rightRankPolynomial : () -> + SparseUnivariatePolynomial(Polynomial(Fraction(Polynomial(R)))) rightRankPolynomial() == if initRight? then initializeRight() rightRankPoly + genericLeftMinimalPolynomial : % -> + SparseUnivariatePolynomial(Fraction(Polynomial(R))) genericLeftMinimalPolynomial a == if initLeft? then initializeLeft() map(x+->eval(x,a),leftRankPoly)$SUP(FPR) + genericRightMinimalPolynomial : % -> + SparseUnivariatePolynomial(Fraction(Polynomial(R))) genericRightMinimalPolynomial a == if initRight? then initializeRight() map(x+->eval(x,a),rightRankPoly)$SUP(FPR) + genericLeftTrace : % -> Fraction(Polynomial(R)) genericLeftTrace a == if initLeft? then initializeLeft() d1 : NNI := (degree leftRankPoly - 1) :: NNI @@ -79161,6 +81073,7 @@ GenericNonAssociativeAlgebra(R : CommutativeRing, n : PositiveInteger,_ rf := eval(rf,a) - rf + genericRightTrace : % -> Fraction(Polynomial(R)) genericRightTrace a == if initRight? then initializeRight() d1 : NNI := (degree rightRankPoly - 1) :: NNI @@ -79168,28 +81081,34 @@ GenericNonAssociativeAlgebra(R : CommutativeRing, n : PositiveInteger,_ rf := eval(rf,a) - rf + genericLeftNorm : % -> Fraction(Polynomial(R)) genericLeftNorm a == if initLeft? then initializeLeft() rf : FPR := coefficient(leftRankPoly, 1) if odd? degree leftRankPoly then rf := - rf rf + genericRightNorm : % -> Fraction(Polynomial(R)) genericRightNorm a == if initRight? then initializeRight() rf : FPR := coefficient(rightRankPoly, 1) if odd? degree rightRankPoly then rf := - rf rf + conditionsForIdempotents : Vector(%) -> List(Polynomial(R)) if R has INTDOM conditionsForIdempotents(b: V %) : List Polynomial R == x : % := generic(b) map(numer,entries coordinates(x*x-x,b))$ListFunctions2(FPR,PR) + conditionsForIdempotents : () -> List(Polynomial(R)) conditionsForIdempotents(): List Polynomial R == x : % := genericElement map(numer,entries coordinates(x*x-x))$ListFunctions2(FPR,PR) + generic : () -> % generic() == genericElement + generic : (Vector(Symbol),Vector(%)) -> % generic(vs:V S, ve: V %): % == maxIndex v > maxIndex ve => error "generic: too little symbols" @@ -79197,12 +81116,14 @@ GenericNonAssociativeAlgebra(R : CommutativeRing, n : PositiveInteger,_ [monomial(1$PR, [vs.i],[1]) for i in 1..maxIndex ve] represents(map(coerce,v)$VectorFunctions2(PR,FPR),ve) + generic : (Symbol,Vector(%)) -> % generic(s: S, ve: V %): % == lON : List String := [PRINC_-TO_-STRING(q)$Lisp for q in 1..maxIndex ve] sFC : Vector Symbol := [concat(s pretend String, i)::Symbol for i in lON] generic(sFC, ve) + generic : Vector(%) -> % generic(ve : V %) == lON : List String := [PRINC_-TO_-STRING(q)$Lisp for q in 1..maxIndex ve] sFC : Vector Symbol := @@ -79211,8 +81132,10 @@ GenericNonAssociativeAlgebra(R : CommutativeRing, n : PositiveInteger,_ [monomial(1$PR, [sFC.i],[1]) for i in 1..maxIndex ve] represents(map(coerce,v)$VectorFunctions2(PR,FPR),ve) + generic : Vector(Symbol) -> % generic(vs:V S): % == generic(vs, basis()$%) + generic : Symbol -> % generic(s: S): % == generic(s, basis()$%) *) @@ -79450,34 +81373,44 @@ GeneralPolynomialSet(R,E,VarSet,P) : Exports == Implementation where Rep := List P + construct : List(P) -> % construct lp == (removeDuplicates(lp)$List(P))::$ + copy : % -> % copy ps == construct(copy(members(ps)$$)$LP)$$ + empty : () -> % empty() == [] + parts : % -> List(P) parts ps == ps pretend LP + map : ((P -> P),%) -> % map (f : PtoP, ps : $) : $ == construct(map(f,members(ps))$LP)$$ + map! : ((P -> P),%) -> % map! (f : PtoP, ps : $) : $ == construct(map!(f,members(ps))$LP)$$ + member? : (P,%) -> Boolean member? (p,ps) == member?(p,members(ps))$LP + ?=? : (%,%) -> Boolean ps1 = ps2 == {p for p in parts(ps1)} =$(Set P) {p for p in parts(ps2)} + coerce : % -> OutputForm coerce(ps:$) : OutputForm == lp : List(P) := sort(infRittWu?,members(ps))$(List P) brace([p::OutputForm for p in lp]$List(OutputForm))$OutputForm + mvar : % -> VarSet mvar ps == empty? ps => error"Error from GPOLSET in mvar : #1 is empty" lv : List VarSet := variables(ps) @@ -79485,12 +81418,15 @@ GeneralPolynomialSet(R,E,VarSet,P) : Exports == Implementation where error "Error from GPOLSET in mvar : every polynomial in #1 is constant" reduce(max,lv)$(List VarSet) + retractIfCan : List(P) -> Union(%,"failed") retractIfCan(lp) == (construct(lp))::Union($,"failed") + coerce : % -> List(P) coerce(ps:$) : (List P) == ps pretend (List P) + convert : List(P) -> % convert(lp:LP) : $ == construct lp @@ -79784,14 +81720,17 @@ GeneralSparseTable(Key, Entry, Tbl, dent): TableAggregate(Key, Entry) == Impl Rep := Tbl + ?.? : (%,Key) -> Entry elt(t:%, k:Key) == (u := search(k, t)$Rep) case "failed" => dent u::Entry + setelt : (%,Key,Entry) -> Entry setelt(t:%, k:Key, e:Entry) == e = dent => (remove_!(k, t); e) setelt(t, k, e)$Rep + search : (Key,%) -> Union(Entry,"failed") search(k:Key, t:%) == (u := search(k, t)$Rep) case "failed" => dent u @@ -80135,65 +82074,83 @@ GeneralTriangularSet(R,E,V,P) : Exports == Implementation where Rep ==> LP + rep : $ -> Rep rep(s:$):Rep == s pretend Rep + per : Rep -> $ per(l:Rep):$ == l pretend $ + copy : % -> % copy ts == per(copy(rep(ts))$LP) + empty : () -> % empty() == per([]) + empty? : % -> Boolean empty?(ts:$) == empty?(rep(ts)) + parts : % -> List(P) parts ts == rep(ts) + members : % -> List(P) members ts == rep(ts) + map : ((P -> P),%) -> % map (f : PtoP, ts : $) : $ == construct(map(f,rep(ts))$LP)$$ + map! : ((P -> P),%) -> % map! (f : PtoP, ts : $) : $ == construct(map!(f,rep(ts))$LP)$$ + member? : (P,%) -> Boolean member? (p,ts) == member?(p,rep(ts))$LP unitIdealIfCan() == "failed"::Union($,"failed") + roughUnitIdeal? : % -> Boolean roughUnitIdeal? ts == false -- the following assume that rep(ts) is decreasingly sorted -- w.r.t. the main variavles of the polynomials in rep(ts) + coerce : % -> OutputForm coerce(ts:$) : OutputForm == lp : List(P) := reverse(rep(ts)) brace([p::OutputForm for p in lp]$List(OutputForm))$OutputForm + mvar : % -> V mvar ts == empty? ts => error"failed in mvar : $ -> V from GTSET" mvar(first(rep(ts)))$P + first : % -> Union(P,"failed") first ts == empty? ts => "failed"::Union(P,"failed") first(rep(ts))::Union(P,"failed") + last : % -> Union(P,"failed") last ts == empty? ts => "failed"::Union(P,"failed") last(rep(ts))::Union(P,"failed") + rest : % -> Union(%,"failed") rest ts == empty? ts => "failed"::Union($,"failed") per(rest(rep(ts)))::Union($,"failed") + coerce : % -> List(P) coerce(ts:$) : (List P) == rep(ts) + collectUpper : (%,V) -> % collectUpper (ts,v) == empty? ts => ts lp := rep(ts) @@ -80203,6 +82160,7 @@ GeneralTriangularSet(R,E,V,P) : Exports == Implementation where lp := rest lp per(reverse(newlp)) + collectUnder : (%,V) -> % collectUnder (ts,v) == empty? ts => ts lp := rep(ts) @@ -80212,6 +82170,7 @@ GeneralTriangularSet(R,E,V,P) : Exports == Implementation where -- for another domain of TSETCAT build on this domain GTSET -- the following operations must be redefined + extendIfCan : (%,P) -> Union(%,"failed") extendIfCan(ts:$,p:P) == ground? p => "failed"::Union($,"failed") empty? ts => (per([unitCanonical(p)]$LP))::Union($,"failed") @@ -80610,14 +82569,18 @@ GeneralUnivariatePowerSeries(Coef,var,cen): Exports == Implementation where if Coef has Algebra Fraction Integer then + differentiate : % -> % differentiate f == str1 : String := "'differentiate' unavailable on this domain; " str2 : String := "use 'approximate' first" error concat(str1,str2) + differentiate : (%,Variable(var)) -> % differentiate(f:%,v:Variable(var)) == differentiate f if Coef has PartialDifferentialRing(Symbol) then + + differentiate : (%,Symbol) -> % differentiate(f:%,s:Symbol) == (s = variable(f)) => str1 : String := "'differentiate' unavailable on this domain; " @@ -80627,16 +82590,19 @@ GeneralUnivariatePowerSeries(Coef,var,cen): Exports == Implementation where deriv := differentiate(puiseux f) :: % map(x+->differentiate(x,s),f) - dcds * deriv + integrate : % -> % integrate f == str1 : String := "'integrate' unavailable on this domain; " str2 : String := "use 'approximate' first" error concat(str1,str2) + integrate : (%,Variable(var)) -> % integrate(f:%,v:Variable(var)) == integrate f if Coef has integrate: (Coef,Symbol) -> Coef and _ Coef has variables: Coef -> List Symbol then + integrate : (%,Symbol) -> % integrate(f:%,s:Symbol) == (s = variable(f)) => str1 : String := "'integrate' unavailable on this domain; " @@ -80655,6 +82621,7 @@ GeneralUnivariatePowerSeries(Coef,var,cen): Exports == Implementation where res case Coef => res :: Coef first(res :: List Coef) + integrate : (%,Symbol) -> % integrate(f:%,s:Symbol) == (s = variable(f)) => str1 : String := "'integrate' unavailable on this domain; " @@ -81204,12 +83171,7 @@ GraphImage (): Exports == Implementation where --%Internal Functions - graph : RANGEF -> $ - - scaleStep : SF -> SF - - makeGraph : $ -> $ - + numberCheck : Point SF -> Void numberCheck(nums:Point SF):Void == for i in minIndex(nums)..maxIndex(nums) repeat COMPLEXP(nums.(i::PositiveInteger))$Lisp => @@ -81217,6 +83179,7 @@ GraphImage (): Exports == Implementation where "An unexpected complex number was encountered in the calculations." + doOptions : Rep -> Void doOptions(g:Rep):Void == lr : RANGEF := ranges(g.optionsField,ranges g) if (#lr > 1$I) then @@ -81233,6 +83196,8 @@ GraphImage (): Exports == Implementation where g.unitsField := [] -- etc - graphimage specific stuff... + putColorInfo : (List(List(Point(DoubleFloat))),List(Palette)) -> + List(List(Point(DoubleFloat))) putColorInfo(llp,listOfPalettes) == llp2 : L L P := [] for lp in llp for pal in listOfPalettes repeat @@ -81250,6 +83215,7 @@ GraphImage (): Exports == Implementation where llp2 := cons(reverse_! lp2,llp2) reverse_! llp2 + graph : RANGEF -> $ graph demRanges == null demRanges => [ 0, [], [], [], [], [], [], [] ] demRangesSF : RANGESF := _ @@ -81259,6 +83225,7 @@ GraphImage (): Exports == Implementation where convert(hi demRanges.1)@SF)$(Segment(SF)) ] [ 0, demRangesSF, [], [], [], [], [], [] ] + scaleStep : SF -> SF scaleStep(range) == -- MGR adjust:NNI tryStep:SF @@ -81273,6 +83240,7 @@ GraphImage (): Exports == Implementation where scaleDown := (10@I **$I (((#(numerals)@I) - 1$I) pretend PI))::SF scaleDown*ceiling(tryStep/scaleDown - 0.5::SF)/((10 **$I adjust)::SF) + figureUnits : List(List(Point(DoubleFloat))) -> List(DoubleFloat) figureUnits(listOfListsOfPoints) == -- figure out the min/max and divide by 10 for unit markers xMin := xMax := xCoord first first listOfListsOfPoints @@ -81299,6 +83267,7 @@ GraphImage (): Exports == Implementation where yMax := yMax + convert(0.5)$Float [scaleStep(xMax-xMin),scaleStep(yMax-yMin)] + plotLists : (Rep,L L P,L PAL,L PAL,L PI) -> $ plotLists(graf:Rep,listOfListsOfPoints:L L P,listOfPointColors:L PAL,_ listOfLineColors:L PAL,listOfPointSizes:L PI):$ == givenLen := #listOfListsOfPoints @@ -81329,6 +83298,7 @@ GraphImage (): Exports == Implementation where else graf.pointSizes := first(listOfPointSizes, len) graf + makeGraph : $ -> $ makeGraph graf == doOptions(graf) (s := #(graf.llPoints)) = 0 => @@ -81374,12 +83344,16 @@ GraphImage (): Exports == Implementation where --%Exported Functions - makeGraphImage(graf:$) == makeGraph graf + makeGraphImage : % -> % + makeGraphImage(graf:$) == makeGraph graf - key graf == graf.key + key : % -> Integer + key graf == graf.key - pointLists graf == graf.llPoints + pointLists : % -> List(List(Point(DoubleFloat))) + pointLists graf == graf.llPoints + ranges : % -> List(Segment(Float)) ranges graf == null graf.rangesField => [] [segment(convert(lo graf.rangesField.1)@F,_ @@ -81387,31 +83361,40 @@ GraphImage (): Exports == Implementation where segment(convert(lo graf.rangesField.2)@F,_ convert(hi graf.rangesField.2)@F)] - ranges(graf,rangesList) == + ranges : (%,List(Segment(Float))) -> List(Segment(Float)) + ranges(graf,rangesList) == graf.rangesField := [segment(convert(lo rangesList.1)@SF,convert(hi rangesList.1)@SF), _ segment(convert(lo rangesList.2)@SF,convert(hi rangesList.2)@SF)] rangesList - units graf == + units : % -> List(Float) + units graf == null(graf.unitsField) => [] [convert(graf.unitsField.1)@F,convert(graf.unitsField.2)@F] - units (graf,unitsToBe) == + units : (%,List(Float)) -> List(Float) + units (graf,unitsToBe) == graf.unitsField := [convert(unitsToBe.1)@SF,convert(unitsToBe.2)@SF] unitsToBe - graphImage == graph [] + graphImage : () -> % + graphImage == graph [] + makeGraphImage : List(List(Point(DoubleFloat))) -> % makeGraphImage(llp) == makeGraphImage(llp, [pointColorDefault() for i in 1..(l:=#llp)], [lineColorDefault() for i in 1..l], [pointSizeDefault() for i in 1..l]) + makeGraphImage : (List(List(Point(DoubleFloat))),List(Palette), + List(Palette),List(PositiveInteger)) -> % makeGraphImage(llp,lpc,llc,lps) == makeGraphImage(llp,lpc,llc,lps,[]) + makeGraphImage : (List(List(Point(DoubleFloat))),List(Palette), + List(Palette),List(PositiveInteger),List(DrawOption)) -> % makeGraphImage(llp,lpc,llc,lps,opts) == graf := graph(ranges(opts,[])) graf.optionsField := opts @@ -81424,6 +83407,8 @@ GraphImage (): Exports == Implementation where numberCheck aPoint makeGraph graf + component:(%,List(Point(DoubleFloat)),Palette,Palette,PositiveInteger) -> + Void component (graf:$,ListOfPoints:L P,PointColor:PAL,_ LineColor:PAL,PointSize:PI) == graf.llPoints := append(graf.llPoints,[ListOfPoints]) @@ -81431,27 +83416,33 @@ GraphImage (): Exports == Implementation where graf.lineColors := append(graf.lineColors,[LineColor]) graf.pointSizes := append(graf.pointSizes,[PointSize]) + component : (%,Point(DoubleFloat)) -> Void component (graf,aPoint) == component(graf,aPoint,pointColorDefault(),_ lineColorDefault(),pointSizeDefault()) + component : (%,Point(DoubleFloat),Palette,Palette,PositiveInteger) -> Void component (graf:$,aPoint:P,PointColor:PAL,LineColor:PAL,PointSize:PI) == component (graf,[aPoint],PointColor,LineColor,PointSize) + appendPoint : (%,Point(DoubleFloat)) -> Void appendPoint (graf,aPoint) == num : I := #(graf.llPoints) - 1 num < 0 => error "No point lists to append to!" (graf.llPoints.num) := append((graf.llPoints.num),[aPoint]) + point : (%,Point(DoubleFloat),Palette) -> Void point (graf,aPoint,PointColor) == component(graf,aPoint,PointColor,lineColorDefault(),pointSizeDefault()) + coerce : List(List(Point(DoubleFloat))) -> % coerce (llp : L L P) : $ == makeGraphImage(llp, [pointColorDefault() for i in 1..(l:=#llp)], [lineColorDefault() for i in 1..l], [pointSizeDefault() for i in 1..l]) + coerce : % -> OutputForm coerce (graf : $) : E == hconcat( ["Graph with " :: E,(p := # pointLists graf) :: E, (p=1 => " point list"; " point lists") :: E]) @@ -81758,54 +83749,77 @@ GuessOption(): Exports == Implementation where Rep := Record(keyword: Symbol, value: Any) - maxLevel d == ['maxLevel, d::Any] + maxLevel : Union(NonNegativeInteger,arbitrary) -> % + maxLevel d == ['maxLevel, d::Any] - maxDerivative d == ['maxDerivative, d::Any] + maxDerivative : Union(NonNegativeInteger,arbitrary) -> % + maxDerivative d == ['maxDerivative, d::Any] - maxShift d == maxDerivative d + maxShift : Union(NonNegativeInteger,arbitrary) -> % + maxShift d == maxDerivative d - maxSubst d == + maxSubst : Union(PositiveInteger,arbitrary) -> % + maxSubst d == if d case PositiveInteger then maxDerivative((d::Integer-1)::NonNegativeInteger) else maxDerivative d - maxDegree d == ['maxDegree, d::Any] + maxDegree : Union(NonNegativeInteger,arbitrary) -> % + maxDegree d == ['maxDegree, d::Any] - maxMixedDegree d == ['maxMixedDegree, d::Any] + maxMixedDegree : NonNegativeInteger -> % + maxMixedDegree d == ['maxMixedDegree, d::Any] - allDegrees d == ['allDegrees, d::Any] + allDegrees : Boolean -> % + allDegrees d == ['allDegrees, d::Any] - maxPower d == ['maxPower, d::Any] + maxPower : Union(PositiveInteger,arbitrary) -> % + maxPower d == ['maxPower, d::Any] - safety d == ['safety, d::Any] + safety : NonNegativeInteger -> % + safety d == ['safety, d::Any] - homogeneous d == ['homogeneous, d::Any] + homogeneous : Union(PositiveInteger,Boolean) -> % + homogeneous d == ['homogeneous, d::Any] - Somos d == ['Somos, d::Any] + Somos : Union(PositiveInteger,Boolean) -> % + Somos d == ['Somos, d::Any] - debug d == ['debug, d::Any] + debug : Boolean -> % + debug d == ['debug, d::Any] - check d == ['check, d::Any] + check : Union(skip,MonteCarlo,deterministic) -> % + check d == ['check, d::Any] + checkExtraValues : Boolean -> % checkExtraValues d == ['checkExtraValues, d::Any] - one d == ['one, d::Any] + one : Boolean -> % + one d == ['one, d::Any] - functionName d == ['functionName, d::Any] + functionName : Symbol -> % + functionName d == ['functionName, d::Any] + functionNames : List(Symbol) -> % functionNames d == ['functionNames, coerce(d)$AnyFunctions1(List(Symbol))] - variableName d == ['variableName, d::Any] + variableName : Symbol -> % + variableName d == ['variableName, d::Any] - indexName d == ['indexName, d::Any] + indexName : Symbol -> % + indexName d == ['indexName, d::Any] - displayKind d == ['displayKind, d::Any] + displayKind : Symbol -> % + displayKind d == ['displayKind, d::Any] + coerce : % -> OutputForm coerce(x:%):OutputForm == x.keyword::OutputForm = x.value::OutputForm - x:% = y:% == x.keyword = y.keyword and x.value = y.value + ?=? : (%,%) -> Boolean + x:% = y:% == x.keyword = y.keyword and x.value = y.value + option : (List(%),Symbol) -> Union(Any,"failed") option(l, s) == for x in l repeat x.keyword = s => return(x.value) @@ -82184,56 +84198,66 @@ GuessOptionFunctions0(): Exports == Implementation where (* domain GOPT0 *) (* + maxLevel : List(GuessOption) -> Union(NonNegativeInteger,arbitrary) maxLevel l == if (opt := option(l, 'maxLevel)) case "failed" then "arbitrary" else retract(opt::Any)$AnyFunctions1(Union(NonNegativeInteger, "arbitrary")) + maxDerivative : List(GuessOption) -> Union(NonNegativeInteger,arbitrary) maxDerivative l == if (opt := option(l, 'maxDerivative)) case "failed" then "arbitrary" else retract(opt::Any)$AnyFunctions1(Union(NonNegativeInteger, "arbitrary")) + maxShift : List(GuessOption) -> Union(NonNegativeInteger,arbitrary) maxShift l == maxDerivative l + maxSubst : List(GuessOption) -> Union(PositiveInteger,arbitrary) maxSubst l == d := maxDerivative l if d case NonNegativeInteger then (d+1)::PositiveInteger else d + maxDegree : List(GuessOption) -> Union(NonNegativeInteger,arbitrary) maxDegree l == if (opt := option(l, 'maxDegree)) case "failed" then "arbitrary" else retract(opt::Any)$AnyFunctions1(Union(NonNegativeInteger, "arbitrary")) + maxMixedDegree : List(GuessOption) -> NonNegativeInteger maxMixedDegree l == if (opt := option(l, 'maxMixedDegree)) case "failed" then 0 else retract(opt :: Any)$AnyFunctions1(NonNegativeInteger) + allDegrees : List(GuessOption) -> Boolean allDegrees l == if (opt := option(l, 'allDegrees)) case "failed" then false else retract(opt :: Any)$AnyFunctions1(Boolean) + maxPower : List(GuessOption) -> Union(PositiveInteger,arbitrary) maxPower l == if (opt := option(l, 'maxPower)) case "failed" then "arbitrary" else retract(opt :: Any)$AnyFunctions1(Union(PositiveInteger, "arbitrary")) + safety : List(GuessOption) -> NonNegativeInteger safety l == if (opt := option(l, 'safety)) case "failed" then 1$NonNegativeInteger else retract(opt :: Any)$AnyFunctions1(NonNegativeInteger) + check : List(GuessOption) -> Union(skip,MonteCarlo,deterministic) check l == if (opt := option(l, 'check)) case "failed" then "deterministic" @@ -82241,54 +84265,63 @@ GuessOptionFunctions0(): Exports == Implementation where retract(opt::Any)$AnyFunctions1(_ Union("skip", "MonteCarlo", "deterministic")) + checkExtraValues : List(GuessOption) -> Boolean checkExtraValues l == if (opt := option(l, 'checkExtraValues)) case "failed" then true else retract(opt :: Any)$AnyFunctions1(Boolean) + one : List(GuessOption) -> Boolean one l == if (opt := option(l, 'one)) case "failed" then true else retract(opt :: Any)$AnyFunctions1(Boolean) + debug : List(GuessOption) -> Boolean debug l == if (opt := option(l, 'debug)) case "failed" then false else retract(opt :: Any)$AnyFunctions1(Boolean) + homogeneous : List(GuessOption) -> Union(PositiveInteger,Boolean) homogeneous l == if (opt := option(l, 'homogeneous)) case "failed" then false else retract(opt :: Any)$AnyFunctions1(Union(PositiveInteger, Boolean)) + Somos : List(GuessOption) -> Union(PositiveInteger,Boolean) Somos l == if (opt := option(l, 'Somos)) case "failed" then false else retract(opt :: Any)$AnyFunctions1(Union(PositiveInteger, Boolean)) + variableName : List(GuessOption) -> Symbol variableName l == if (opt := option(l, 'variableName)) case "failed" then 'x else retract(opt :: Any)$AnyFunctions1(Symbol) + functionName : List(GuessOption) -> Symbol functionName l == if (opt := option(l, 'functionName)) case "failed" then 'f else retract(opt :: Any)$AnyFunctions1(Symbol) + indexName : List(GuessOption) -> Symbol indexName l == if (opt := option(l, 'indexName)) case "failed" then 'n else retract(opt :: Any)$AnyFunctions1(Symbol) + displayAsGF : List(GuessOption) -> Boolean displayAsGF l == if (opt := option(l, 'displayAsGF)) case "failed" then error "GuessOption: displayAsGF not set" @@ -82299,19 +84332,17 @@ GuessOptionFunctions0(): Exports == Implementation where PI ==> PositiveInteger + checkOptions : List(GuessOption) -> Void checkOptions l == maxD := maxDerivative l maxP := maxPower l homo := homogeneous l Somo := Somos l - if Somo case PI then if one? Somo then error "Guess: Somos must be Boolean or at least two" - if maxP case PI and one? maxP then error "Guess: Somos requires that maxPower is at least two" - if maxD case NNI and maxD > Somo then err:String:=concat [_ "Guess: if Somos is an integer, it should be larger than ",_ @@ -82328,19 +84359,16 @@ GuessOptionFunctions0(): Exports == Implementation where " is an integer, at least two, or maxSubst is an ",_ "integer, at least three" ] error err - if not (maxP case PI) and homo case Boolean and not homo then err:String:= concat [_ "Guess: Somos requires that maxPower is set or ", _ "homogeneous is not false" ] error err - if homo case PI then if maxP case PI and maxP ~= homo then err:String:= _ "Guess: only one of homogeneous and maxPower may be an integer" error err - if maxD case NNI and zero? maxD then err:String:= concat [_ "Guess: homogeneous requires that maxShift/maxDerivative ",_ @@ -82353,7 +84381,6 @@ GuessOptionFunctions0(): Exports == Implementation where "Guess: homogeneous==true requires that maxPower is ", _ "an integer" ] error err - if maxD case NNI and zero? maxD then err:String:= concat [_ "Guess: homogeneous requires that maxShift/maxDerivative",_ @@ -82613,14 +84640,19 @@ HashTable(Key, Entry, hashfn): Exports == Implementation where failMsg := GENSYM()$Lisp - t1 = t2 == EQ(t1, t2)$Lisp + ?=? : (%,%) -> Boolean + t1 = t2 == EQ(t1, t2)$Lisp - keys t == HKEYS(t)$Lisp + keys : % -> List(Key) + keys t == HKEYS(t)$Lisp - # t == HASH_-TABLE_-COUNT(t)$Lisp + #? : % -> NonNegativeInteger + # t == HASH_-TABLE_-COUNT(t)$Lisp - setelt(t, k, e) == HPUT(t,k,e)$Lisp + setelt : (%,Key,Entry) -> Entry + setelt(t, k, e) == HPUT(t,k,e)$Lisp + remove! : (Key,%) -> Union(Entry,"failed") remove_!(k:Key, t:%) == r := HGET(t,k,failMsg)$Lisp not EQ(r,failMsg)$Lisp => @@ -82628,10 +84660,12 @@ HashTable(Key, Entry, hashfn): Exports == Implementation where r pretend Entry "failed" + empty : () -> % empty() == MAKE_-HASHTABLE(INTERN(hashfn)$Lisp, INTERN("STRONG")$Lisp)$Lisp + search : (Key,%) -> Union(Entry,"failed") search(k:Key, t:%) == r := HGET(t, k, failMsg)$Lisp not EQ(r, failMsg)$Lisp => r pretend Entry @@ -83524,8 +85558,10 @@ Heap(S:OrderedSet): Exports == Implementation where Rep := IndexedFlexibleArray( S,0) + empty : () -> % empty() == empty()$Rep + heap : List(S) -> % heap l == n := #l h := empty() @@ -83541,6 +85577,7 @@ Heap(S:OrderedSet): Exports == Implementation where if (k := j+1) < n and r.j < r.k then j := k if t < r.j then (r.i := r.j; r.j := t; i := j) else leave + extract! : % -> S extract_! r == -- extract the maximum from the heap O(log n) n := #r :: Integer @@ -83552,6 +85589,7 @@ Heap(S:OrderedSet): Exports == Implementation where siftUp(r,0,n-1) t + insert! : (S,%) -> % insert_!(x,r) == -- Williams' insertion algorithm O(log n) j := (#r) :: Integer @@ -83564,20 +85602,26 @@ Heap(S:OrderedSet): Exports == Implementation where r(j):=x r + max : % -> S max r == if #r = 0 then error "empty heap" else r.0 + inspect : % -> S inspect r == max r + makeHeap : % -> % makeHeap(r:%):% == -- Floyd's heap construction algorithm O(n) n := #r for k in n quo 2 -1 .. 0 by -1 repeat siftUp(r,k,n) r + bag : List(S) -> % bag l == makeHeap construct(l)$Rep + merge : (%,%) -> % merge(a,b) == makeHeap concat(a,b) + merge! : (%,%) -> % merge_!(a,b) == makeHeap concat_!(a,b) *) @@ -84024,12 +86068,15 @@ HexadecimalExpansion(): Exports == Implementation where (* RadixExpansion(16) add + hex : Fraction(Integer) -> % hex r == r :: % + coerce : % -> RadixExpansion(16) coerce(x:%):RadixExpansion(16) == x pretend RadixExpansion(16) + toint : String -> Integer toint(s) == dec:Integer := 0 for i in 1..#s repeat @@ -85292,25 +87339,35 @@ HTMLFormat(): public == private where expr: E prec,opPrec: I str: S - blank : S := " \ " - maxPrec : I := 1000000 - minPrec : I := 0 + blank : S := " \ " - unaryOps : L S := ["-"]$(L S) - unaryPrecs : L I := [700]$(L I) + maxPrec : I := 1000000 + + minPrec : I := 0 + + unaryOps : L S := ["-"]$(L S) + + unaryPrecs : L I := [700]$(L I) -- the precedence of / in the following is relatively low because -- the bar obviates the need for parentheses. binaryOps : L S := ["+->","|","^","/","<",">","=","OVER"]$(L S) + binaryPrecs : L I := [0,0,900,700,400,400,400,700]$(L I) + naryOps : L S := ["-","+","*",blank,",",";"," ","ROW","", " \cr ","&","/\","\/"]$(L S) + naryPrecs : L I := [700,700,800,800,110,110,0,0,0,0,0,600,600]$(L I) + naryNGOps : L S := ["ROW","&"]$(L S) + plexOps : L S := ["SIGMA","SIGMA2","PI","PI2","INTSIGN",_ "INDEFINTEGRAL"]$(L S) + plexPrecs : L I := [700,800,700,800,700,700]$(L I) + specialOps : L S := ["MATRIX","BRACKET","BRACE","CONCATB","VCONCAT",_ "AGGLST","CONCAT","OVERBAR","ROOT","SUB","TAG",_ "SUPERSUB","ZAG","AGGSET","SC","PAREN",_ @@ -85323,6 +87380,7 @@ HTMLFormat(): public == private where "cosh", "coth", "csch", "sech", "sinh", "tanh", _ "acos","asin","atan","erf","...","$","infinity","Gamma", _ "%pi","%e","%i"] + specialStringsInHTML : L S := ["cos","cot","csc","log","sec","sin","tan", _ "cosh","coth","csch","sech","sinh","tanh", _ @@ -85331,67 +87389,40 @@ HTMLFormat(): public == private where debug := false - atomize:E -> L E - - formatBinary:(S,L E, I) -> Tree S - - formatFunction:(Tree S,L E, I) -> Tree S - - formatMatrix:L E -> Tree S - - formatNary:(S,L E, I) -> Tree S - - formatNaryNoGroup:(S,L E, I) -> Tree S - - formatNullary:S -> Tree S - - formatPlex:(S,L E, I) -> Tree S - - formatSpecial:(S,L E, I) -> Tree S - - formatUnary:(S, E, I) -> Tree S - - formatHtml:(E,I) -> Tree S - - precondition:E -> E - -- this function is applied to the OutputForm expression before - -- doing anything else. - - outputTree:Tree S -> Void - -- This function traverses the tree and linierises it into a string. - -- To get the formatting we use a nested set of tables. It also checks - -- for +- and removes the +. it may also need to remove the outer - -- set of brackets. - - stringify:E -> S - + coerce : OutputForm -> String coerce(expr : E): S == outputTree formatHtml(precondition expr, minPrec) " " + coerceS : OutputForm -> String coerceS(expr : E): S == outputTree formatHtml(precondition expr, minPrec) " " + coerceL : OutputForm -> String coerceL(expr : E): S == outputTree formatHtml(precondition expr, minPrec) " " + display : String -> Void display(html : S): Void == sayTeX$Lisp html void()$Void + newNode : (S,Tree S) -> Tree S newNode(tag:S,node: Tree S): (Tree S) == t := tree(S,[node]) setvalue!(t,tag) t + newNodes : (S,L Tree S) -> Tree S newNodes(tag:S,nodes: L Tree S): (Tree S) == t := tree(S,nodes) setvalue!(t,tag) t -- returns true if this can be represented without a table + notTable? : Tree S -> Boolean notTable?(node: Tree S): Boolean == empty?(node) => true leaf?(node) => true @@ -85404,6 +87435,7 @@ HTMLFormat(): public == private where -- this retuns a string representation of OutputForm arguments -- it is used when debug is true to trace the calling of functions -- in this package + argsToString : L E -> S argsToString(args : L E): S == sop : S := exprex first args args := rest args @@ -85413,6 +87445,7 @@ HTMLFormat(): public == private where s := concat [s,s1] s := concat [s,"}"] + exprex : OutputForm -> String exprex(expr : E): S == -- This breaks down an expression into atoms and returns it as -- a string. It's for developmental purposes to help understand @@ -85433,6 +87466,7 @@ HTMLFormat(): public == private where s := concat [s,s1] s := concat [s,"}"] + atomize:E -> L E atomize(expr : E): L E == -- This breaks down an expression into a flat list of atomic -- expressions. @@ -85450,6 +87484,11 @@ HTMLFormat(): public == private where -- output html test using tables and -- remove unnecessary '+' at end of first string -- when second string starts with '-' + -- This function traverses the tree and linierises it into a string. + -- To get the formatting we use a nested set of tables. It also checks + -- for +- and removes the +. it may also need to remove the outer + -- set of brackets. + outputTree:Tree S -> Void outputTree(t: Tree S): Void == endWithPlus:Boolean := false -- if the last string ends with '+' -- and the next string starts with '-' then the '+' needs to be @@ -85495,12 +87534,17 @@ HTMLFormat(): public == private where if value(t) ~= "" then sayTeX$Lisp concat [""] void()$Void + stringify:E -> S stringify expr == (mathObject2String$Lisp expr)@S + -- this function is applied to the OutputForm expression before + -- doing anything else. + precondition:E -> E precondition expr == outputTran$Lisp expr -- I dont know what SC is so put it in a table for now + formatSC : (L E,I) -> Tree S formatSC(args : L E, prec : I) : Tree S == if debug then sayTeX$Lisp "formatSC: "concat [" args=",_ argsToString(args)," prec=",string(prec)$S] @@ -85513,6 +87557,7 @@ HTMLFormat(): public == private where -- to build an overbar we put it in a single column, -- single row table and set the top border to solid + buildOverbar : Tree S -> Tree S buildOverbar(content : Tree S) : Tree S == if debug then sayTeX$Lisp "buildOverbar" cell:Tree S := _ @@ -85523,6 +87568,7 @@ HTMLFormat(): public == private where -- to build an square root we put it in a double column, -- single row table and set the top border of the second column to -- solid + buildRoot : Tree S -> Tree S buildRoot(content : Tree S) : Tree S == if debug then sayTeX$Lisp "buildRoot" if leaf?(content) then @@ -85537,6 +87583,7 @@ HTMLFormat(): public == private where -- to build an 'n'th root we put it in a double column, -- single row table and set the top border of the second column to -- solid + buildNRoot : (Tree S,Tree S) -> Tree S buildNRoot(content : Tree S,nth: Tree S) : Tree S == if debug then sayTeX$Lisp "buildNRoot" power:Tree S := newNode("sup",nth) @@ -85553,6 +87600,7 @@ HTMLFormat(): public == private where -- "VCONCAT", "CONCATB","CONCAT","QUOTE","BRACKET","BRACE","PAREN", -- "OVERBAR","ROOT", "SEGMENT","SC","MATRIX","ZAG" -- note "SUB" and "SUPERSUB" are handled directly by formatHtml + formatSpecial:(S,L E, I) -> Tree S formatSpecial(op : S, args : L E, prec : I) : Tree S == if debug then sayTeX$Lisp _ "formatSpecial: " concat ["op=",op," args=",argsToString(args),_ @@ -85613,6 +87661,7 @@ HTMLFormat(): public == private where formatHtml(first rest args,minPrec),tree("}")]) tree("formatSpecial not implemented:"op) + formatSuperSub : (E,L E,I) -> Tree S formatSuperSub(expr : E, args : L E, opPrec : I) : Tree S == -- This one produces ordinary derivatives with differential notation, -- it needs a little more work yet. @@ -85645,6 +87694,7 @@ HTMLFormat(): public == private where res -- build structure such as integral as a table + buildPlex3 : (Tree S,Tree S,Tree S,Tree S) -> Tree S buildPlex3(main:Tree S,supsc:Tree S,op:Tree S,subsc:Tree S) : Tree S == if debug then sayTeX$Lisp "buildPlex" ssup:Tree S := newNode("td id='plex'",supsc) @@ -85656,6 +87706,7 @@ HTMLFormat(): public == private where newNodes("table border='0' id='plex'",rows) -- build structure such as integral as a table + buildPlex2 : (Tree S,Tree S,Tree S) -> Tree S buildPlex2(main : Tree S,supsc : Tree S,op : Tree S) : Tree S == if debug then sayTeX$Lisp "buildPlex" ssup:Tree S := newNode("td id='plex'",supsc) @@ -85673,6 +87724,7 @@ HTMLFormat(): public == private where -- axiom replaces the bound variable with somthing like -- %A and puts the original variable used -- in the input command as a superscript on the integral sign. + formatIntSign : (L E,I) -> Tree S formatIntSign(args : L E, opPrec : I) : Tree S == -- the original OutputForm expression looks something like this: -- {{INTSIGN}{NOTHING or lower limit?} @@ -85689,6 +87741,7 @@ HTMLFormat(): public == private where -- plex ops are "SIGMA","SIGMA2","PI","PI2","INTSIGN","INDEFINTEGRAL" -- expects 2 or 3 args + formatPlex:(S,L E, I) -> Tree S formatPlex(op : S, args : L E, prec : I) : Tree S == if debug then sayTeX$Lisp "formatPlex: " concat ["op=",op," args=",_ argsToString(args)," prec=",string(prec)$S] @@ -85731,6 +87784,7 @@ HTMLFormat(): public == private where s,formatHtml(args.3,minPrec)) -- an example is: op=ROW arg={{ROW}{1}{2}} + formatMatrixRow : (S,E,I,I,I) -> L Tree S formatMatrixRow(op : S, arg : E, prec : I,y:I,h:I) : L Tree S == if debug then sayTeX$Lisp "formatMatrixRow: " concat ["op=",op,_ " args=",stringify arg," prec=",string(prec)$S] @@ -85757,6 +87811,7 @@ HTMLFormat(): public == private where cells -- an example is: op=MATRIX args={{ROW}{1}{2}}{{ROW}{3}{4}} + formatMatrixContent : (S,L E,I) -> L Tree S formatMatrixContent(op : S, args : L E, prec : I) : L Tree S == if debug then sayTeX$Lisp "formatMatrixContent: " concat ["op=",op,_ " args=",argsToString(args)," prec=",string(prec)$S] @@ -85765,6 +87820,7 @@ HTMLFormat(): public == private where formatMatrixRow("ROW",e,prec,y:=y+1,#args)) for e in args] rows + formatMatrix:L E -> Tree S formatMatrix(args : L E) : Tree S == -- format for args is [[ROW ...],[ROW ...],[ROW ...]] -- generate string for formatting columns (centered) @@ -85774,6 +87830,7 @@ HTMLFormat(): public == private where formatMatrixContent("MATRIX",args,minPrec)) -- output arguments in column table + buildColumnTable : List Tree S -> Tree S buildColumnTable(elements : List Tree S) : Tree S == if debug then sayTeX$Lisp "buildColumnTable" cells:(List Tree S) := [newNode("td id='col'",j) for j in elements] @@ -85783,6 +87840,7 @@ HTMLFormat(): public == private where -- build superscript structure as either sup tag or -- if it contains anything that won't go into a -- sup tag then build it as a table + buildSuperscript : (Tree S,Tree S) -> Tree S buildSuperscript(main : Tree S,super : Tree S) : Tree S == if debug then sayTeX$Lisp "buildSuperscript" notTable?(super) => newNodes("",[main,newNode("sup",super)]) @@ -85796,6 +87854,7 @@ HTMLFormat(): public == private where -- build subscript structure as either sub tag or -- if it contains anything that won't go into a -- sub tag then build it as a table + buildSubscript : (Tree S,Tree S) -> Tree S buildSubscript(main : Tree S,subsc : Tree S) : Tree S == if debug then sayTeX$Lisp "buildSubscript" notTable?(subsc) => newNodes("",[main,newNode("sub",subsc)]) @@ -85806,6 +87865,7 @@ HTMLFormat(): public == private where newNode("tr id='sub'",su)] newNodes("table border='0' id='sub'",rows) + formatSub : (E,L E,I) -> Tree S formatSub(expr : E, args : L E, opPrec : I) : Tree S == -- format subscript -- this function expects expr to start with SUB @@ -85837,11 +87897,13 @@ HTMLFormat(): public == private where buildSubscript(formatHtml(first args,opPrec),_ formatHtml(args.2,opPrec)) + formatFunction:(Tree S,L E, I) -> Tree S formatFunction(op : Tree S, args : L E, prec : I) : Tree S == if debug then sayTeX$Lisp "formatFunction: " concat ["args=",_ argsToString(args)," prec=",string(prec)$S] newNodes("",[op,tree("("),formatNary(",",args,minPrec),tree(")")]) + formatNullary:S -> Tree S formatNullary(op : S) : Tree S == if debug then sayTeX$Lisp "formatNullary: " concat ["op=",op] op = "NOTHING" => empty()$Tree(S) @@ -85851,6 +87913,7 @@ HTMLFormat(): public == private where -- an example is minus '-' -- prec is precidence of operator, used to force brackets where -- more tightly bound operation is next to less tightly bound operation + formatUnary:(S, E, I) -> Tree S formatUnary(op : S, arg : E, prec : I) : Tree S == if debug then sayTeX$Lisp "formatUnary: " concat ["op=",op," arg=",_ stringify arg," prec=",string(prec)$S] @@ -85863,6 +87926,7 @@ HTMLFormat(): public == private where -- output division with numerator above the denominator -- implemented as a table + buildOver : (Tree S,Tree S) -> Tree S buildOver(top : Tree S,bottom : Tree S) : Tree S == if debug then sayTeX$Lisp "buildOver" topCell:Tree S := newNode("td",top) @@ -85874,6 +87938,7 @@ HTMLFormat(): public == private where -- op may be: "|","^","/","OVER","+->" -- note: "+" and "*" are n-ary ops + formatBinary:(S,L E, I) -> Tree S formatBinary(op : S, args : L E, prec : I) : Tree S == if debug then sayTeX$Lisp "formatBinary: " concat ["op=",op,_ " args=",argsToString(args)," prec=",string(prec)$S] @@ -85902,6 +87967,7 @@ HTMLFormat(): public == private where -- build a zag from a table with a right part and a -- upper and lower left part + buildZag : (Tree S,Tree S,Tree S) -> Tree S buildZag(top:Tree S,lowerLeft:Tree S,lowerRight:Tree S) : Tree S == if debug then sayTeX$Lisp "buildZag" cellTop:Tree S := _ @@ -85913,6 +87979,7 @@ HTMLFormat(): public == private where row2:Tree S := newNodes("tr id='zag'",[cellLowerLeft,cellLowerRight]) newNodes("table border='0' id='zag'",[row1,row2]) + formatZag : (L E,I) -> Tree S formatZag(args : L E,nestLevel:I) : Tree S == -- args will be a list of things like this {{ZAG}{1}{7}}, the ZAG -- must be there, the '1' and '7' could conceivably be more complex @@ -85975,6 +88042,7 @@ HTMLFormat(): public == private where -- returns true if this term starts with a minus '-' sign -- this is used so that we can suppress any plus '+' in front -- of the - so we dont get terms like +- + neg? : E -> Boolean neg?(arg : E) : Boolean == if debug then sayTeX$Lisp "neg?: " concat ["arg=",argsToString([arg])] ATOM(arg)$Lisp@Boolean => false @@ -85983,6 +88051,7 @@ HTMLFormat(): public == private where op = "-" => true false + formatNary:(S,L E, I) -> Tree S formatNary(op : S, args : L E, prec : I) : Tree S == if debug then sayTeX$Lisp "formatNary: " concat ["op=",op," args=",_ argsToString(args)," prec=",string(prec)$S] @@ -85998,6 +88067,7 @@ HTMLFormat(): public == private where -- format ZAG -- check for +- -- add brackets for sigma or pi or root ("SIGMA","SIGMA2","PI","PI2") + formatNaryNoGroup:(S,L E, I) -> Tree S formatNaryNoGroup(op : S, args : L E, prec : I) : Tree S == if debug then sayTeX$Lisp "formatNaryNoGroup: " concat ["op=",op,_ " args=",argsToString(args)," prec=",string(prec)$S] @@ -86036,6 +88106,7 @@ HTMLFormat(): public == private where -- prec is the precision of integers -- formatHtml returns a string for this node in the tree structure -- and calls recursivly to evaluate sub expressions + formatHtml:(E,I) -> Tree S formatHtml(arg : E,prec : I) : Tree S == if debug then sayTeX$Lisp "formatHtml: " concat ["arg=",_ argsToString([arg])," prec=",string(prec)$S] @@ -86082,7 +88153,6 @@ HTMLFormat(): public == private where -- nary case: including '+' and '*' member?(op,naryNGOps) => formatNaryNoGroup(op,args, prec) member?(op,naryOps) => formatNary(op,args, prec) - op1 := formatHtml(first l,minPrec) formatFunction(op1,args,prec) @@ -86364,6 +88434,7 @@ HomogeneousDirectProduct(dim,S) : T == C where Rep:=Vector(S) -- reverse lexicographical ordering + ? Boolean v1:% < v2:% == n1:S:=0 n2:S:=0 @@ -87139,35 +89210,41 @@ HyperellipticFiniteDivisor(F, UP, UPUP, R): Exports == Implementation where Rep := Record(center:UP, polyPart:UP, principalPart:R, reduced?:Boolean) hyper:UP := uhyper::UP + gen:Z := ((degree(hyper)::Z - 1) exquo 2)::Z -- genus of the curve + dvd:O := "div"::Symbol::O + zer:O := 0::Z::O - makeDivisor : (UP, UP, R) -> % intReduc : (R, UP) -> R - princ? : % -> Boolean - polyIfCan : R -> Union(UP, "failed") - redpolyIfCan : (R, UP) -> Union(UP, "failed") - intReduce : (R, UP) -> R - mkIdeal : (UP, UP) -> ID reducedTimes : (Z, UP, UP) -> % reducedDouble: (UP, UP) -> % - 0 == divisor(1$R) + 0 : () -> % + 0 == divisor(1$R) - divisor(g:R) == [1, 0, g, true] + divisor : R -> % + divisor(g:R) == [1, 0, g, true] + makeDivisor : (UP, UP, R) -> % makeDivisor(a, b, g) == [a, b, g, false] - princ? d == (d.center = 1) and zero?(d.polyPart) + princ? : % -> Boolean + princ? d == (d.center = 1) and zero?(d.polyPart) - ideal d == ideal([d.principalPart]) * mkIdeal(d.center, d.polyPart) + ideal : % -> FractionalIdeal(UP,Fraction(UP),UPUP,R) + ideal d == ideal([d.principalPart]) * mkIdeal(d.center, d.polyPart) + decompose : % -> Record(id: FractionalIdeal(UP,Fraction(UP),UPUP,R), + principalPart: R) decompose d == [ideal makeDivisor(d.center, d.polyPart, 1),d.principalPart] + mkIdeal : (UP, UP) -> ID mkIdeal(a, b) == ideal [a::RF::R, reduce(monomial(1, 1)$UPUP-b::RF::UPUP)] -- keep the sum reduced if d1 and d2 are both reduced at the start + ?+? : (%,%) -> % d1 + d2 == a1 := d1.center; a2 := d2.center b1 := d1.polyPart; b2 := d2.polyPart @@ -87185,11 +89262,13 @@ HyperellipticFiniteDivisor(F, UP, UPUP, R): Exports == Implementation where -- if is cheaper to keep on reducing as we exponentiate -- if d is already reduced + ?*? : (Integer,%) -> % n:Z * d:% == zero? n => 0 n < 0 => (-n) * (-d) divisor(d.principalPart ** n) + divisor(mkIdeal(d.center,d.polyPart)**n) + divisor : FractionalIdeal(UP,Fraction(UP),UPUP,R) -> % divisor(i:ID) == (n := #(v := basis minimize i)) = 1 => divisor v minIndex v n ^= 2 => ERR @@ -87203,11 +89282,13 @@ HyperellipticFiniteDivisor(F, UP, UPUP, R): Exports == Implementation where ERR ERR + polyIfCan : R -> Union(UP, "failed") polyIfCan a == (u := retractIfCan(a)@Union(RF, "failed")) case "failed" => "failed" (v := retractIfCan(u::RF)@Union(UP, "failed")) case "failed" => "failed" v::UP + redpolyIfCan : (R, UP) -> Union(UP, "failed") redpolyIfCan(h, a) == degree(p := lift h) ^= 1 => "failed" q := - coefficient(p, 0) / coefficient(p, 1) @@ -87215,6 +89296,7 @@ HyperellipticFiniteDivisor(F, UP, UPUP, R): Exports == Implementation where not ground?(rec.generator) => "failed" ((numer(q) * rec.coef1) exquo rec.generator)::UP rem a + coerce : % -> OutputForm coerce(d:%):O == r := bracket [d.center::O, d.polyPart::O] g := prefix(dvd, [d.principalPart::O]) @@ -87223,6 +89305,7 @@ HyperellipticFiniteDivisor(F, UP, UPUP, R): Exports == Implementation where z => r r + g + reduce : % -> % reduce d == d.reduced? => d degree(a := d.center) <= gen => (d.reduced? := true; d) @@ -87232,33 +89315,39 @@ HyperellipticFiniteDivisor(F, UP, UPUP, R): Exports == Implementation where g := d.principalPart * reduce(b::RF::UPUP-monomial(1,1)$UPUP)/a0::RF::R reduce makeDivisor(a0, b0, g) + generator : % -> Union(R,"failed") generator d == d := reduce d princ? d => d.principalPart "failed" + -? : % -> % - d == a := d.center makeDivisor(a, - d.polyPart, inv(a::RF * d.principalPart)) + ?=? : (%,%) -> Boolean d1 = d2 == d1 := reduce d1 d2 := reduce d2 d1.center = d2.center and d1.polyPart = d2.polyPart and d1.principalPart = d2.principalPart + divisor : (F,F) -> % divisor(a, b) == x := monomial(1, 1)$UP not ground? gcd(d := x - a::UP, retract(discriminant())@UP) => error "divisor: point is singular" makeDivisor(d, b::UP, 1) + intReduce : (R, UP) -> R intReduce(h, b) == v := integralCoordinates(h).num integralRepresents( [qelt(v, i) rem b for i in minIndex v .. maxIndex v], 1) -- with hyperelliptic curves, cheaper to keep divisors in reduced form + divisor : (R,UP,UP,UP,F) -> % divisor(h, a, dp, g, r) == h := h - (r * dp)::RF::R a := gcd(a, retract(norm h)@UP) @@ -87574,15 +89663,19 @@ IndexCard() : Exports == Implementation where (* domain ICARD *) (* + ? Boolean x Boolean x=y==(x pretend String) = (y pretend String) + display : % -> Void display(x) == name : OutputForm := dbName(x)$Lisp type : OutputForm := dbPart(x,4,1$Lisp)$Lisp output(hconcat(name,hconcat(" : ",type)))$OutputPackage + fullDisplay : % -> Void fullDisplay(x) == name : OutputForm := dbName(x)$Lisp type : OutputForm := dbPart(x,4,1$Lisp)$Lisp @@ -87601,10 +89694,13 @@ IndexCard() : Exports == Implementation where secondPart := hconcat(fromPart,hconcat(ifPart,exposedPart)) output(hconcat(firstPart,secondPart))$OutputPackage + coerce : String -> % coerce(s:String): % == (s pretend %) + coerce : % -> OutputForm coerce(x): OutputForm == (x pretend String)::OutputForm + ?.? : (%,Symbol) -> String elt(x,sel) == s := PNAME(sel)$Lisp pretend String s = "name" => dbName(x)$Lisp @@ -88043,15 +90139,17 @@ IndexedBits(mn:Integer): BitAggregate() with (* domain IBITS *) (* - range: (%, Integer) -> Integer --++ range(j,i) returnes the range i of the boolean j. + minIndex : % -> Integer minIndex u == mn + range: (%, Integer) -> Integer range(v, i) == i >= 0 and i < #v => i error "Index out of range" + coerce : % -> OutputForm coerce(v):OutputForm == t:Character := char "1" f:Character := char "0" @@ -88060,35 +90158,49 @@ IndexedBits(mn:Integer): BitAggregate() with s.i := if v.j then t else f s::OutputForm - new(n, b) == BVEC_-MAKE_-FULL(n,TRUTH_-TO_-BIT(b)$Lisp)$Lisp + new : (NonNegativeInteger,Boolean) -> % + new(n, b) == BVEC_-MAKE_-FULL(n,TRUTH_-TO_-BIT(b)$Lisp)$Lisp - empty() == BVEC_-MAKE_-FULL(0,0)$Lisp + empty : () -> % + empty() == BVEC_-MAKE_-FULL(0,0)$Lisp - copy v == BVEC_-COPY(v)$Lisp + copy : % -> % + copy v == BVEC_-COPY(v)$Lisp - #v == BVEC_-SIZE(v)$Lisp + #? : % -> NonNegativeInteger + #v == BVEC_-SIZE(v)$Lisp - v = u == BVEC_-EQUAL(v, u)$Lisp + ?=? : (%,%) -> Boolean + v = u == BVEC_-EQUAL(v, u)$Lisp - v < u == BVEC_-GREATER(u, v)$Lisp + ? Boolean + v < u == BVEC_-GREATER(u, v)$Lisp - _and(u, v) == (#v=#u => BVEC_-AND(v,u)$Lisp; map("and",v,u)) + ?and? : (%,%) -> % + _and(u, v) == (#v=#u => BVEC_-AND(v,u)$Lisp; map("and",v,u)) - _or(u, v) == (#v=#u => BVEC_-OR(v, u)$Lisp; map("or", v,u)) + ?or? : (%,%) -> % + _or(u, v) == (#v=#u => BVEC_-OR(v, u)$Lisp; map("or", v,u)) - xor(v,u) == (#v=#u => BVEC_-XOR(v,u)$Lisp; map("xor",v,u)) + xor : (%,%) -> % + xor(v,u) == (#v=#u => BVEC_-XOR(v,u)$Lisp; map("xor",v,u)) + setelt : (%,Integer,Boolean) -> Boolean setelt(v:%, i:Integer, f:Boolean) == BVEC_-SETELT(v, range(v, abs(i-mn)), TRUTH_-TO_-BIT(f)$Lisp)$Lisp + ?.? : (%,Integer) -> Boolean elt(v:%, i:Integer) == BIT_-TO_-TRUTH(BVEC_-ELT(v, range(v, abs(i-mn)))$Lisp)$Lisp - Not v == BVEC_-NOT(v)$Lisp + Not : % -> % + Not v == BVEC_-NOT(v)$Lisp - And(u, v) == (#v=#u => BVEC_-AND(v,u)$Lisp; map("and",v,u)) + And : (%,%) -> % + And(u, v) == (#v=#u => BVEC_-AND(v,u)$Lisp; map("and",v,u)) - Or(u, v) == (#v=#u => BVEC_-OR(v, u)$Lisp; map("or", v,u)) + Or : (%,%) -> % + Or(u, v) == (#v=#u => BVEC_-OR(v, u)$Lisp; map("or", v,u)) *) @@ -88258,8 +90370,10 @@ IndexedDirectProductAbelianGroup(A:AbelianGroup,S:OrderedSet): f: A -> A s: S + -? : % -> % -x == [[u.k,-u.c] for u in x] + ?*? : (Integer,%) -> % n * x == n = 0 => 0 n = 1 => x @@ -88268,6 +90382,7 @@ IndexedDirectProductAbelianGroup(A:AbelianGroup,S:OrderedSet): qsetrest!: (Rep, Rep) -> Rep qsetrest!(l: Rep, e: Rep): Rep == RPLACD(l, e)$Lisp + ?-? : (%,%) -> % x - y == null x => -y null y => x @@ -88480,8 +90595,10 @@ IndexedDirectProductAbelianMonoid(A:AbelianMonoid,S:OrderedSet): f: A -> A s: S + 0 : () -> % 0 == [] + zero? : % -> Boolean zero? x == null x -- PERFORMANCE CRITICAL; Should build list up @@ -88491,6 +90608,7 @@ IndexedDirectProductAbelianMonoid(A:AbelianMonoid,S:OrderedSet): qsetrest!: (Rep, Rep) -> Rep qsetrest!(l: Rep, e: Rep): Rep == RPLACD(l, e)$Lisp + ?+? : (%,%) -> % x + y == null x => y null y => x @@ -88523,17 +90641,22 @@ IndexedDirectProductAbelianMonoid(A:AbelianMonoid,S:OrderedSet): else qsetrest!(endcell, end) res + ?*? : (NonNegativeInteger,%) -> % n * x == n = 0 => 0 n = 1 => x [[u.k,a] for u in x | (a:=n*u.c) ^= 0$A] + monomial : (A,S) -> % monomial(r,s) == (r = 0 => 0; [[s,r]]) + map : ((A -> A),%) -> % map(f,x) == [[tm.k,a] for tm in x | (a:=f(tm.c)) ^= 0$A] - reductum x == (null x => 0; rest x) + reductum : % -> % + reductum x == (null x => 0; rest x) + leadingCoefficient : % -> A leadingCoefficient x == (null x => 0; x.first.c) *) @@ -88683,6 +90806,7 @@ IndexedDirectProductObject(A:SetCategory,S:OrderedSet): _ --define + ?=? : (%,%) -> Boolean x = y == while not null x and _^ null y repeat x.first.k ^= y.first.k => return false @@ -88691,23 +90815,27 @@ IndexedDirectProductObject(A:SetCategory,S:OrderedSet): _ y:=y.rest null x and null y + coerce : % -> OutputForm coerce(x:%):OutputForm == bracket [rarrow(t.k :: OutputForm, t.c :: OutputForm) for t in x] - -- sample():% == [[sample()$S,sample()$A]$Term]$Rep - + monomial : (A,S) -> % monomial(r,s) == [[s,r]] + map : ((A -> A),%) -> % map(f,x) == [[tm.k,f(tm.c)] for tm in x] - reductum x == + reductum : % -> % + reductum x == rest x + leadingCoefficient : % -> A leadingCoefficient x == null x => _ error "Can't take leadingCoefficient of empty product element" x.first.c + leadingSupport : % -> S leadingSupport x == null x => _ error "Can't take leadingCoefficient of empty product element" @@ -88850,6 +90978,7 @@ IndexedDirectProductOrderedAbelianMonoid(A:OrderedAbelianMonoid,S:OrderedSet): Rep:= List Term x,y: % + ? Boolean x false empty? x => true -- note careful order of these two lines @@ -89011,6 +91140,7 @@ IndexedDirectProductOrderedAbelianMonoidSup(A:OrderedAbelianMonoidSup,S:OrderedS r: A s: S + subtractIfCan : (%,%) -> Union(%,"failed") subtractIfCan(x,y) == empty? y => x empty? x => "failed" @@ -89026,6 +91156,7 @@ IndexedDirectProductOrderedAbelianMonoidSup(A:OrderedAbelianMonoidSup,S:OrderedS t case "failed" => "failed" cons([x.first.k,u],t) + sup : (%,%) -> % sup(x,y) == empty? y => x empty? x => y @@ -89170,10 +91301,12 @@ IndexedExponents(Varset:OrderedSet): C == T where x:% t:Term + coerceOF : Term -> OutputForm coerceOF(t):OutputForm == --++ converts term to OutputForm t.c = 1 => (t.k)::OutputForm (t.k)::OutputForm ** (t.c)::OutputForm + coerce : % -> OutputForm coerce(x):OutputForm == ++ converts entire exponents to OutputForm null x => 1::Integer::OutputForm null rest x => coerceOF(first x) @@ -89660,35 +91793,40 @@ IndexedFlexibleArray(S:Type, mn: Integer): Exports == Implementation where (* Rep := Record(physLen:I, logLen:I, f:A) shrinkable? : Boolean := true - growAndFill : (%, I, S) -> % - growWith : (%, I, S) -> % - growAdding : (%, I, %) -> % - shrink: (%, I) -> % - newa : (N, A) -> A + physicalLength : % -> NonNegativeInteger physicalLength(r) == (r.physLen) pretend NonNegativeInteger + physicalLength! : (%,Integer) -> % physicalLength_!(r, n) == r.physLen = 0 => error "flexible array must be non-empty" growWith(r, n, r.f.0) - empty() == [0, 0, empty()] + empty : () -> % + empty() == [0, 0, empty()] - #r == (r.logLen)::N + #? : % -> NonNegativeInteger + #r == (r.logLen)::N + fill! : (%,S) -> % fill_!(r, x) == (fill_!(r.f, x); r) + maxIndex : % -> Integer maxIndex r == r.logLen - 1 + mn - minIndex r == mn + minIndex : % -> Integer + minIndex r == mn + new : (NonNegativeInteger,S) -> % new(n, a) == [n, n, new(n, a)] + shrinkable : Boolean -> Boolean shrinkable(b) == oldval := shrinkable? shrinkable? := b oldval + flexibleArray : List(S) -> % flexibleArray l == n := #l n = 0 => empty() @@ -89698,16 +91836,19 @@ IndexedFlexibleArray(S:Type, mn: Integer): Exports == Implementation where a -- local utility operations + newa : (N, A) -> A newa(n, a) == zero? n => empty() new(n, a.0) + growAdding : (%, I, %) -> % growAdding(r, b, s) == b = 0 => r #r > 0 => growAndFill(r, b, (r.f).0) #s > 0 => growAndFill(r, b, (s.f).0) error "no default filler element" + growAndFill : (%, I, S) -> % growAndFill(r, b, x) == (r.logLen := r.logLen + b) <= r.physLen => r -- enlarge by 50% + b @@ -89715,6 +91856,7 @@ IndexedFlexibleArray(S:Type, mn: Integer): Exports == Implementation where if r.logLen > n then n := r.logLen growWith(r, n, x) + growWith : (%, I, S) -> % growWith(r, n, x) == y := new(n::N, x)$PrimitiveArray(S) a := r.f @@ -89723,6 +91865,7 @@ IndexedFlexibleArray(S:Type, mn: Integer): Exports == Implementation where r.f := y r + shrink: (%, I) -> % shrink(r, i) == r.logLen := r.logLen - i negative?(n := r.logLen) => error "internal bug in flexible array" @@ -89737,6 +91880,7 @@ IndexedFlexibleArray(S:Type, mn: Integer): Exports == Implementation where r.f := y r + copy : % -> % copy r == n := #r a := r.f @@ -89745,11 +91889,13 @@ IndexedFlexibleArray(S:Type, mn: Integer): Exports == Implementation where [n, n, v] + ?.? : (%,Integer) -> S elt(r:%, i:I) == i < mn or i >= r.logLen + mn => error "index out of range" r.f.(i-mn) + setelt : (%,Integer,S) -> S setelt(r:%, i:I, x:S) == i < mn or i >= r.logLen + mn => error "index out of range" @@ -89757,33 +91903,40 @@ IndexedFlexibleArray(S:Type, mn: Integer): Exports == Implementation where -- operations inherited from extensible aggregate + merge : (((S,S) -> Boolean),%,%) -> % merge(g, a, b) == merge_!(g, copy a, b) + concat : (S,%) -> % concat(x:S, r:%) == insert_!(x, r, mn) + concat! : (%,S) -> % concat_!(r:%, x:S) == growAndFill(r, 1, x) r.f.(r.logLen-1) := x r + concat! : (%,%) -> % concat_!(a:%, b:%) == if eq?(a, b) then b := copy b n := #a growAdding(a, #b, b) copyInto_!(a, b, n + mn) + remove! : ((S -> Boolean),%) -> % remove_!(g:(S->Boolean), a:%) == k:I := 0 for i in 0..maxIndex a - mn repeat if not g(a.i) then (a.k := a.i; k := k+1) shrink(a, #a - k) + delete! : (%,Integer) -> % delete_!(r:%, i1:I) == i := i1 - mn i < 0 or i > r.logLen => error "index out of range" for k in i..r.logLen-2 repeat r.f.k := r.f.(k+1) shrink(r, 1) + delete! : (%,UniversalSegment(Integer)) -> % delete_!(r:%, i:U) == l := lo i - mn; m := maxIndex r - mn h := (hasHi i => hi i - mn; m) @@ -89791,6 +91944,7 @@ IndexedFlexibleArray(S:Type, mn: Integer): Exports == Implementation where for j in l.. for k in h+1..m repeat r.f.j := r.f.k shrink(r, max(0,h-l+1)) + insert! : (S,%,Integer) -> % insert_!(x:S, r:%, i1:I):% == i := i1 - mn n := r.logLen @@ -89800,6 +91954,7 @@ IndexedFlexibleArray(S:Type, mn: Integer): Exports == Implementation where r.f.i := x r + insert! : (%,%,Integer) -> % insert_!(a:%, b:%, i1:I):% == i := i1 - mn if eq?(a, b) then b := copy b @@ -89810,6 +91965,7 @@ IndexedFlexibleArray(S:Type, mn: Integer): Exports == Implementation where for k in m-1 .. 0 by -1 repeat b.f.(i+k) := a.f.k b + merge! : (((S,S) -> Boolean),%,%) -> % merge_!(g, a, b) == m := #a; n := #b; growAdding(a, n, b) for i in m-1..0 by -1 for j in m+n-1.. by -1 repeat a.f.j := a.f.i @@ -89820,6 +91976,7 @@ IndexedFlexibleArray(S:Type, mn: Integer): Exports == Implementation where for k in k.. for j in j..n-1 repeat a.f.k := b.f.j a + select! : ((S -> Boolean),%) -> % select_!(g:(S->Boolean), a:%) == k:I := 0 for i in 0..maxIndex a - mn repeat_ @@ -89828,6 +91985,7 @@ IndexedFlexibleArray(S:Type, mn: Integer): Exports == Implementation where if S has SetCategory then + removeDuplicates! : % -> % removeDuplicates_! a == ct := #a ct < 2 => a @@ -90317,7 +92475,8 @@ IndexedList(S:Type, mn:Integer): Exports == Implementation where (* domain ILIST *) (* - #? : % -> NonNegativeInteger if $ has finiteAggregate + + #? : % -> NonNegativeInteger #x == LENGTH(x)$Lisp concat : (S,%) -> % @@ -90781,6 +92940,7 @@ IndexedMatrix(R,mnRow,mnCol): Exports == Implementation where (* InnerIndexedTwoDimensionalArray(R,mnRow,mnCol,Row,Col) add + swapRows! : (%,Integer,Integer) -> % swapRows_!(x,i1,i2) == (i1 < minRowIndex(x)) or (i1 > maxRowIndex(x)) or _ (i2 < minRowIndex(x)) or (i2 > maxRowIndex(x)) => @@ -90796,25 +92956,32 @@ IndexedMatrix(R,mnRow,mnCol): Exports == Implementation where if R has commutative("*") then + determinant : % -> R determinant x == determinant(x)$MATLIN - minordet x == minordet(x)$MATLIN + minordet : % -> R + minordet x == minordet(x)$MATLIN if R has EuclideanDomain then + rowEchelon : % -> % rowEchelon x == rowEchelon(x)$MATLIN if R has IntegralDomain then - rank x == rank(x)$MATLIN + rank : % -> NonNegativeInteger + rank x == rank(x)$MATLIN - nullity x == nullity(x)$MATLIN + nullity : % -> NonNegativeInteger + nullity x == nullity(x)$MATLIN - nullSpace x == nullSpace(x)$MATLIN + nullSpace : % -> List(IndexedVector(R,mnRow)) + nullSpace x == nullSpace(x)$MATLIN if R has Field then - inverse x == inverse(x)$MATLIN + inverse : % -> Union(%,"failed") + inverse x == inverse(x)$MATLIN *) @@ -91131,29 +93298,37 @@ IndexedOneDimensionalArray(S:Type, mn:Integer): Qnew ==> MAKE_-ARRAY$Lisp I ==> Integer - #x == Qsize x + #? : % -> NonNegativeInteger + #x == Qsize x - fill_!(x, s) == (for i in 0..Qmax x repeat Qsetelt(x, i, s); x) + fill! : (%,S) -> % + fill_!(x, s) == (for i in 0..Qmax x repeat Qsetelt(x, i, s); x) - minIndex x == mn + minIndex : % -> Integer + minIndex x == mn - empty() == Qnew(0$Lisp) + empty : () -> % + empty() == Qnew(0$Lisp) - new(n, s) == fill_!(Qnew n,s) + new : (NonNegativeInteger,S) -> % + new(n, s) == fill_!(Qnew n,s) + map! : ((S -> S),%) -> % map_!(f, s1) == n:Integer := Qmax(s1) n < 0 => s1 for i in 0..n repeat Qsetelt(s1, i, f(Qelt(s1,i))) s1 - map(f, s1) == + map : ((S -> S),%) -> % + map(f, s1) == n:Integer := Qmax(s1) n < 0 => s1 ss2:% := Qnew(n+1) for i in 0..n repeat Qsetelt(ss2, i, f(Qelt(s1,i))) ss2 + map : (((S,S) -> S),%,%) -> % map(f, a, b) == maxind:Integer := min(Qmax a, Qmax b) maxind < 0 => empty() @@ -91164,31 +93339,40 @@ IndexedOneDimensionalArray(S:Type, mn:Integer): if zero? mn then - qelt(x, i) == Qelt(x, i) + qelt : (%,Integer) -> S + qelt(x, i) == Qelt(x, i) + qsetelt! : (%,Integer,S) -> S qsetelt_!(x, i, s) == Qsetelt(x, i, s) + ?.? : (%,Integer) -> S elt(x:%, i:I) == negative? i or i > maxIndex(x) => error "index out of range" qelt(x, i) + setelt : (%,Integer,S) -> S setelt(x:%, i:I, s:S) == negative? i or i > maxIndex(x) => error "index out of range" qsetelt_!(x, i, s) else if (mn = 1) then - maxIndex x == Qsize x + maxIndex : % -> Integer + maxIndex x == Qsize x - qelt(x, i) == Qelt(x, i-1) + qelt : (%,Integer) -> S + qelt(x, i) == Qelt(x, i-1) + qsetelt! : (%,Integer,S) -> S qsetelt_!(x, i, s) == Qsetelt(x, i-1, s) + ?.? : (%,Integer) -> S elt(x:%, i:I) == QSLESSP(i,1$Lisp)$Lisp or QSLESSP(Qsize x,i)$Lisp => error "index out of range" Qelt(x, i-1) + setelt : (%,Integer,S) -> S setelt(x:%, i:I, s:S) == QSLESSP(i,1$Lisp)$Lisp or QSLESSP(Qsize x,i)$Lisp => error "index out of range" @@ -91196,14 +93380,18 @@ IndexedOneDimensionalArray(S:Type, mn:Integer): else - qelt(x, i) == Qelt(x, i - mn) + qelt : (%,Integer) -> S + qelt(x, i) == Qelt(x, i - mn) + qsetelt! : (%,Integer,S) -> S qsetelt_!(x, i, s) == Qsetelt(x, i - mn, s) + ?.? : (%,Integer) -> S elt(x:%, i:I) == i < mn or i > maxIndex(x) => error "index out of range" qelt(x, i) + setelt : (%,Integer,S) -> S setelt(x:%, i:I, s:S) == i < mn or i > maxIndex(x) => error "index out of range" qsetelt_!(x, i, s) @@ -91651,34 +93839,49 @@ IndexedString(mn:Integer): Export == Implementation where c: Character cc: CharacterClass - new(n, c) == MAKE_-FULL_-CVEC(n, c)$Lisp + new : (NonNegativeInteger,Character) -> % + new(n, c) == MAKE_-FULL_-CVEC(n, c)$Lisp - empty() == MAKE_-FULL_-CVEC(0$Lisp)$Lisp + empty : () -> % + empty() == MAKE_-FULL_-CVEC(0$Lisp)$Lisp - empty?(s) == Qsize(s) = 0 + empty? : % -> Boolean + empty?(s) == Qsize(s) = 0 - #s == Qsize(s) + #? : % -> NonNegativeInteger + #s == Qsize(s) - s = t == Qequal(s, t) + ?=? : (%,%) -> Boolean + s = t == Qequal(s, t) - s < t == CGREATERP(t,s)$Lisp + ? Boolean + s < t == CGREATERP(t,s)$Lisp - concat(s:%,t:%) == STRCONC(s,t)$Lisp + concat : (%,%) -> % + concat(s:%,t:%) == STRCONC(s,t)$Lisp - copy s == COPY_-SEQ(s)$Lisp + copy : % -> % + copy s == COPY_-SEQ(s)$Lisp - insert(s:%, t:%, i:I) == concat(concat(s(mn..i-1), t), s(i..)) + insert : (%,%,Integer) -> % + insert(s:%, t:%, i:I) == concat(concat(s(mn..i-1), t), s(i..)) + coerce : % -> OutputForm coerce(s:%):OutputForm == outputForm(s pretend String) - minIndex s == mn + minIndex : % -> Integer + minIndex s == mn - upperCase_! s == map_!(upperCase, s) + upperCase : % -> % + upperCase_! s == map_!(upperCase, s) - lowerCase_! s == map_!(lowerCase, s) + lowerCase! : % -> % + lowerCase_! s == map_!(lowerCase, s) - latex s == concat("\mbox{``", concat(s pretend String, "''}")) + latex : % -> String + latex s == concat("\mbox{``", concat(s pretend String, "''}")) + replace : (%,UniversalSegment(Integer),%) -> % replace(s, sg, t) == l := lo(sg) - mn m := #s @@ -91691,11 +93894,13 @@ IndexedString(mn:Integer): Export == Implementation where for k in k.. for i in h+1..m-1 repeat Qsetelt(r, k, Qelt(s, i)) r + setelt : (%,Integer,Character) -> Character setelt(s:%, i:I, c:C) == i < mn or i > maxIndex(s) => error "index out of range" Qsetelt(s, i - mn, c) c + substring? : (%,%,Integer) -> Boolean substring?(part, whole, startpos) == np:I := Qsize part nw:I := Qsize whole @@ -91705,6 +93910,7 @@ IndexedString(mn:Integer): Export == Implementation where not Cheq(Qelt(part, ip), Qelt(whole, iw)) => return false true + position : (%,%,Integer) -> Integer position(s:%, t:%, startpos:I) == (startpos := startpos - mn) < 0 => error "index out of bounds" startpos >= Qsize t => mn - 1 @@ -91712,6 +93918,7 @@ IndexedString(mn:Integer): Export == Implementation where EQ(r, NIL$Lisp)$Lisp => mn - 1 r + mn + position : (Character,%,Integer) -> Integer position(c: Character, t: %, startpos: I) == (startpos := startpos - mn) < 0 => error "index out of bounds" startpos >= Qsize t => mn - 1 @@ -91719,6 +93926,7 @@ IndexedString(mn:Integer): Export == Implementation where if Cheq(Qelt(t, r), c) then return r + mn mn - 1 + position : (CharacterClass,%,Integer) -> Integer position(cc: CharacterClass, t: %, startpos: I) == (startpos := startpos - mn) < 0 => error "index out of bounds" startpos >= Qsize t => mn - 1 @@ -91726,10 +93934,12 @@ IndexedString(mn:Integer): Export == Implementation where if member?(Qelt(t,r), cc) then return r + mn mn - 1 + suffix? : (%,%) -> Boolean suffix?(s, t) == (m := maxIndex s) > (n := maxIndex t) => false substring?(s, t, mn + n - m) + split : (%,Character) -> List(%) split(s, c) == n := maxIndex s for i in mn..n while s.i = c repeat 0 @@ -91741,6 +93951,7 @@ IndexedString(mn:Integer): Export == Implementation where if i <= n then l := concat(s(i..n), l) reverse_! l + split : (%,CharacterClass) -> List(%) split(s, cc) == n := maxIndex s for i in mn..n while member?(s.i,cc) repeat 0 @@ -91752,24 +93963,29 @@ IndexedString(mn:Integer): Export == Implementation where if i <= n then l := concat(s(i..n), l) reverse_! l + leftTrim : (%,Character) -> % leftTrim(s, c) == n := maxIndex s for i in mn .. n while s.i = c repeat 0 s(i..n) + leftTrim : (%,CharacterClass) -> % leftTrim(s, cc) == n := maxIndex s for i in mn .. n while member?(s.i,cc) repeat 0 s(i..n) + rightTrim : (%,Character) -> % rightTrim(s, c) == for j in maxIndex s .. mn by -1 while s.j = c repeat 0 s(minIndex(s)..j) + rightTrim : (%,CharacterClass) -> % rightTrim(s, cc) == for j in maxIndex s .. mn by -1 while member?(s.j, cc) repeat 0 s(minIndex(s)..j) + concat : List(%) -> % concat l == t := new(+/[#s for s in l], space$C) i := mn @@ -91778,6 +93994,7 @@ IndexedString(mn:Integer): Export == Implementation where i := i + #s t + copyInto! : (%,%,Integer) -> % copyInto_!(y, x, s) == m := #x n := #y @@ -91786,25 +94003,30 @@ IndexedString(mn:Integer): Export == Implementation where RPLACSTR(y, s, m, x, 0, m)$Lisp y + ?.? : (%,Integer) -> Character elt(s:%, i:I) == i < mn or i > maxIndex(s) => error "index out of range" Qelt(s, i - mn) + ?.? : (%,UniversalSegment(Integer)) -> % elt(s:%, sg:U) == l := lo(sg) - mn h := if hasHi sg then hi(sg) - mn else maxIndex s - mn l < 0 or h >= #s => error "index out of bound" SUBSTRING(s, l, max(0, h-l+1))$Lisp + hash : % -> Integer hash(s:$):Integer == n:I := Qsize s zero? n => 0 (n = 1) => ord(s.mn) ord(s.mn) * ord s(mn+n-1) * ord s(mn + n quo 2) + match : (%,%,Character) -> NonNegativeInteger match(pattern,target,wildcard) == stringMatch(pattern,target,CHARACTER(wildcard)$Lisp)$Lisp + match? : (%,%,Character) -> Boolean match?(pattern, target, dontcare) == n := maxIndex pattern p := position(dontcare, pattern, m := minIndex pattern)::N @@ -92323,14 +94545,19 @@ InfiniteTuple(S:Type): Exports == Implementation where (* Stream S add + generate : ((S -> S),S) -> % generate(f,x) == generate(f,x)$Stream(S) pretend % + filterWhile : ((S -> Boolean),%) -> % filterWhile(f, x) == filterWhile(f,x pretend Stream(S))$Stream(S) pretend % + filterUntil : ((S -> Boolean),%) -> % filterUntil(f, x) == filterUntil(f,x pretend Stream(S))$Stream(S) pretend % + select : ((S -> Boolean),%) -> % select(f, x) == select(f,x pretend Stream(S))$Stream(S) pretend % + construct : % -> Stream(S) construct x == x pretend Stream(S) *) @@ -92634,6 +94861,7 @@ InfinitlyClosePoint(K,symb,PolyRing,E,ProjPt,PCS,Plc,DIVISOR,BLMET):Exports == I l:= [ ll.i for i in 1..#ll | ^(i = nV )] affinePoint( l) + fullOut : % -> OutputForm fullOut(a)== oo: bigoutRecBLQT oo2: bigoutRecHN @@ -92648,24 +94876,32 @@ InfinitlyClosePoint(K,symb,PolyRing,E,ProjPt,PCS,Plc,DIVISOR,BLMET):Exports == I fullOutputFlag:Boolean:=false() + fullOutput : Boolean -> Boolean fullOutput(f)== fullOutputFlag:=f + fullOutput : () -> Boolean fullOutput == fullOutputFlag + coerce : % -> OutputForm coerce(a:%):OutputForm== fullOutput() => fullOut(a) oo:outRec:= [ symbNameV(a) , multV(a) ]$outRec oo :: OutputForm + degree : % -> PositiveInteger degree(a)== K has PseudoAlgebraicClosureOfPerfectFieldCategory => _ extDegree actualExtensionV a 1 + create : (ProjPt,DistributedMultivariatePolynomial( + [construct,QUOTEX,QUOTEY],K),AffinePlane(K),NonNegativeInteger,BLMET, + NonNegativeInteger,DIVISOR,K,Symbol) -> % create(pointA,curveA,localPointA,multA,chartA,subM,excpDivA,atcL,aName)== ([pointA,curveA,localPointA,multA,chartA,subM,_ excpDivA,empty()$List(PCS),atcL,aName]$Rep)::% + create : (ProjPt,PolyRing) -> % create(pointA,curveA)== nV := lastNonNul pointA localPointA := projPt2affPt(pointA,nV) @@ -92682,42 +94918,63 @@ InfinitlyClosePoint(K,symb,PolyRing,E,ProjPt,PCS,Plc,DIVISOR,BLMET):Exports == I create(pointA,affCurvA,localPointA,multA,chartA,_ 0$NonNegativeInteger,excpDivA,actL,aName) + subMultV : % -> NonNegativeInteger subMultV(a:%)== (a:Rep)(subMultiplicity) + setsubmult! : (%,NonNegativeInteger) -> NonNegativeInteger setsubmult_!(a:%,sm:NonNegativeInteger)== (a:Rep)(subMultiplicity) := sm - pointV(a:%) ==(a:Rep)(point) + pointV : % -> ProjPt + pointV(a:%) == (a:Rep)(point) - symbNameV(a:%) ==(a:Rep)(symbName) + symbNameV : % -> Symbol + symbNameV(a:%) == (a:Rep)(symbName) + curveV: % -> DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K) curveV(a:%) ==(a:Rep)(curve) - localPointV(a:%) ==(a:Rep)(localPoint) + localPointV : % -> AffinePlane(K) + localPointV(a:%) == (a:Rep)(localPoint) - multV(a:%) ==(a:Rep)(mult) + multV : % -> NonNegativeInteger + multV(a:%) == (a:Rep)(mult) - chartV(a:%) ==(a:Rep)(chrt) -- CHH + chartV : % -> BLMET + chartV(a:%) == (a:Rep)(chrt) -- CHH - excpDivV(a:%) ==(a:Rep)(excpDiv) + excpDivV : % -> DIVISOR + excpDivV(a:%) == (a:Rep)(excpDiv) - localParamV(a:%) ==(a:Rep)(localParam) + localParamV : % -> List(PCS) + localParamV(a:%) == (a:Rep)(localParam) + actualExtensionV : % -> K actualExtensionV(a:%) == (a:Rep)(actualExtension) - setpoint_!(a:%,n:ProjPt) ==(a:Rep)(point):=n + setpoint! : (%,ProjPt) -> ProjPt + setpoint_!(a:%,n:ProjPt) == (a:Rep)(point):=n - setcurve_!(a:%,n:BlUpRing) ==(a:Rep)(curve):=n + setcurve! : (%,DistributedMultivariatePolynomial( + [construct,QUOTEX,QUOTEY],K)) -> + DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K) + setcurve_!(a:%,n:BlUpRing) ==(a:Rep)(curve):=n + setlocalPoint! : (%,AffinePlane(K)) -> AffinePlane(K) setlocalPoint_!(a:%,n:AFP) ==(a:Rep)(localPoint):=n + setmult! : (%,NonNegativeInteger) -> NonNegativeInteger setmult_!(a:%,n:NonNegativeInteger) ==(a:Rep)(mult):=n - setchart_!(a:%,n:BLMET) ==(a:Rep)(chrt):=n -- CHH + setchart! : (%,BLMET) -> BLMET + setchart_!(a:%,n:BLMET) == (a:Rep)(chrt):=n -- CHH + setlocalParam! : (%,List(PCS)) -> List(PCS) setlocalParam_!(a:%,n:List(PCS)) ==(a:Rep)(localParam):=n + setexcpDiv! : (%,DIVISOR) -> DIVISOR setexcpDiv_!(a:%,n:DIVISOR) ==(a:Rep)(excpDiv):=n + setsymbName! : (%,Symbol) -> Symbol setsymbName_!(a:%,n:Symbol) ==(a:Rep)(symbName):=n *) @@ -93273,9 +95530,11 @@ InnerAlgebraicNumber(): Exports == Implementation where Rep := FE -- private + mainRatDenom : % -> % mainRatDenom(f:%):% == ratDenom(f::Rep::FE)$AlgebraicManipulations(Integer, FE)::Rep::% + findDenominator : SUP % -> Record(num:SUP %,den:%) findDenominator(z:SUP %):Record(num:SUP %,den:%) == zz:=z while not(zz=0) repeat @@ -93286,24 +95545,31 @@ InnerAlgebraicNumber(): Exports == Implementation where zz:=reductum zz [z,1] + makeUnivariate : (P,Kernel %) -> SUP % makeUnivariate(p:P,k:Kernel %):SUP % == map(x+->x::%,univariate(p,k))$SparseUnivariatePolynomialFunctions2(P,%) -- public a,b:% + differentiate : % -> % differentiate(x:%):% == 0 + zero? : % -> Boolean zero? a == zero? numer a + one? : % -> Boolean one? a == (numer a = 1) and (denom a = 1) - x:% / y:% == mainRatDenom(x /$Rep y) + ?/? : (%,%) -> % + x:% / y:% == mainRatDenom(x /$Rep y) + ?**? : (%,Integer) -> % x:% ** n:Integer == n < 0 => mainRatDenom (x **$Rep n) x **$Rep n + trueEqual : (%,%) -> Boolean trueEqual(a,b) == -- if two algebraic numbers have the same norm (after deleting repeated -- roots, then they are certainly conjugates. Note that we start with a @@ -93329,17 +95595,21 @@ InnerAlgebraicNumber(): Exports == Implementation where dg = degree sa or dg = degree sb => true false + norm : (%,Kernel(%)) -> % norm(z:%,k:Kernel %): % == p:=minPoly k n:=makeUnivariate(numer z,k) d:=makeUnivariate(denom z,k) resultant(n,p)/resultant(d,p) + norm : (%,List(Kernel(%))) -> % norm(z:%,l:List Kernel %): % == for k in l repeat z:=norm(z,k) z + norm : (SparseUnivariatePolynomial(%),Kernel(%)) -> + SparseUnivariatePolynomial(%) norm(z:SUP %,k:Kernel %):SUP % == p:=map(x +-> x::SUP %,minPoly k)_ $SparseUnivariatePolynomialFunctions2(%,SUP %) @@ -93349,19 +95619,26 @@ InnerAlgebraicNumber(): Exports == Implementation where zz:=swap(zz)$CommuteUnivariatePolynomialCategory(%,SUP %,SUP SUP %) resultant(p,zz)/norm(f.den,k) + norm : (SparseUnivariatePolynomial(%),List(Kernel(%))) -> + SparseUnivariatePolynomial(%) norm(z:SUP %,l:List Kernel %): SUP % == for k in l repeat z:=norm(z,k) z - belong? op == belong?(op)$ExpressionSpace_&(%) or has?(op, ALGOP) + belong? : BasicOperator -> Boolean + belong? op == belong?(op)$ExpressionSpace_&(%) or has?(op, ALGOP) + + convert : % -> Float convert(x:%):Float == retract map(y +-> y::Float, x pretend FE)$ExpressionFunctions2(Z,Float) + convert : % -> DoubleFloat convert(x:%):DoubleFloat == retract map(y +-> y::DoubleFloat,x pretend FE)_ $ExpressionFunctions2(Z, DoubleFloat) + convert : % -> Complex(Float) convert(x:%):Complex(Float) == retract map(y +-> y::Complex(Float),x pretend FE)_ $ExpressionFunctions2(Z, Complex Float) @@ -93786,32 +96063,46 @@ InnerFreeAbelianMonoid(S: SetCategory, E:CancellationAbelianMonoid, un:E): Rep := ListMonoidOps(S, E, un) - 0 == makeUnit() + 0 : () -> % + 0 == makeUnit() - zero? f == empty? listOfMonoms f + zero? : % -> Boolean + zero? f == empty? listOfMonoms f - terms f == copy listOfMonoms f + terms : % -> List(Record(gen: S,exp: E)) + terms f == copy listOfMonoms f - nthCoef(f, i) == nthExpon(f, i) + nthCoef : (%,Integer) -> E + nthCoef(f, i) == nthExpon(f, i) - nthFactor(f, i) == nthFactor(f, i)$Rep + nthFactor : (%,Integer) -> S + nthFactor(f, i) == nthFactor(f, i)$Rep - s:S + f:$ == plus(s, un, f) + ?+? : (S,%) -> % + s:S + f:$ == plus(s, un, f) - f:$ + g:$ == plus(f, g) + ?+? : (%,%) -> % + f:$ + g:$ == plus(f, g) - (f:$ = g:$):Boolean == commutativeEquality(f,g) + ?=? : (%,%) -> Boolean + (f:$ = g:$):Boolean == commutativeEquality(f,g) - n:E * s:S == makeTerm(s, n) + ?*? : (E,S) -> % + n:E * s:S == makeTerm(s, n) + ?*? : (NonNegativeInteger,%) -> % n:NonNegativeInteger * f:$ == mapExpon(x +-> n*x, f) - coerce(f:$):OutputForm == outputForm(f, "+", (x,y) +-> y*x, 0) + coerce : % -> OutputForm + coerce(f:$):OutputForm == outputForm(f, "+", (x,y) +-> y*x, 0) - mapCoef(f, x) == mapExpon(f, x) + mapCoef : ((E -> E),%) -> % + mapCoef(f, x) == mapExpon(f, x) - mapGen(f, x) == mapGen(f, x)$Rep + mapGen : ((S -> S),%) -> % + mapGen(f, x) == mapGen(f, x)$Rep + coefficient : (S,%) -> E coefficient(s, f) == for x in terms f repeat x.gen = s => return(x.exp) @@ -93819,6 +96110,7 @@ InnerFreeAbelianMonoid(S: SetCategory, E:CancellationAbelianMonoid, un:E): if E has OrderedAbelianMonoid then + highCommonTerms : (%,%) -> % highCommonTerms(f, g) == makeMulti [[x.gen, min(x.exp, n)] for x in listOfMonoms f | (n := coefficient(x.gen, g)) > 0] @@ -94054,12 +96346,15 @@ InnerIndexedTwoDimensionalArray(R,mnRow,mnCol,Row,Col):_ --% Predicates + empty? : % -> Boolean empty? m == empty?(m)$Rep --% Primitive array creation + empty : () -> % empty() == empty()$Rep + new : (NonNegativeInteger,NonNegativeInteger,R) -> % new(rows,cols,a) == rows = 0 => error "new: arrays with zero rows are not supported" @@ -94070,25 +96365,33 @@ InnerIndexedTwoDimensionalArray(R,mnRow,mnCol,Row,Col):_ --% Size inquiries + minRowIndex : % -> Integer minRowIndex m == mnRow + minColIndex : % -> Integer minColIndex m == mnCol + maxRowIndex : % -> Integer maxRowIndex m == nrows m + mnRow - 1 + maxColIndex : % -> Integer maxColIndex m == ncols m + mnCol - 1 + nrows : % -> NonNegativeInteger nrows m == (# m)$Rep + ncols : % -> NonNegativeInteger ncols m == empty? m => 0 # m(minIndex(m)$Rep) --% Part selection/assignment + qelt : (%,Integer,Integer) -> R qelt(m,i,j) == qelt(qelt(m,i - minRowIndex m)$Rep,j - minColIndex m) + elt : (%,Integer,Integer) -> R elt(m:%,i:Integer,j:Integer) == i < minRowIndex(m) or i > maxRowIndex(m) => error "elt: index out of range" @@ -94096,9 +96399,11 @@ InnerIndexedTwoDimensionalArray(R,mnRow,mnCol,Row,Col):_ error "elt: index out of range" qelt(m,i,j) + qsetelt! : (%,Integer,Integer,R) -> R qsetelt_!(m,i,j,r) == setelt(qelt(m,i - minRowIndex m)$Rep,j - minColIndex m,r) + setelt : (%,Integer,Integer,R) -> R setelt(m:%,i:Integer,j:Integer,r:R) == i < minRowIndex(m) or i > maxRowIndex(m) => error "setelt: index out of range" @@ -94107,6 +96412,8 @@ InnerIndexedTwoDimensionalArray(R,mnRow,mnCol,Row,Col):_ qsetelt_!(m,i,j,r) if R has SetCategory then + + latex : % -> String latex(m : %) : String == s : String := "\left[ \begin{array}{" j : Integer @@ -94520,11 +96827,19 @@ InnerPAdicInteger(p,unBalanced?): Exports == Implementation where characteristic() == 0 euclideanSize(x) == order(x) + stream : % -> ST I stream(x:%):ST I == x pretend ST(I) + + padic : ST I -> % padic(x:ST I):% == x pretend % + + digits : % -> Stream(Integer) digits x == stream x + extend : (%,Integer) -> % extend(x,n) == extend(x,n + 1)$Rep + + complete : % -> % complete x == complete(x)$Rep modP:I -> I @@ -94542,16 +96857,21 @@ InnerPAdicInteger(p,unBalanced?): Exports == Implementation where invModP: I -> I invModP n == invmod(n,p) - modulus() == p + modulus : () -> Integer + modulus() == p - moduloP x == (empty? x => 0; frst x) + moduloP : % -> Integer + moduloP x == (empty? x => 0; frst x) + quotientByP : % -> % quotientByP x == (empty? x => x; rst x) + approximate : (%,Integer) -> Integer approximate(x,n) == n <= 0 or empty? x => 0 frst x + p * approximate(rst x,n - 1) + ?=? : (%,%) -> Boolean x = y == st : ST I := stream(x - y) n : I := _$streamCount$Lisp @@ -94561,6 +96881,7 @@ InnerPAdicInteger(p,unBalanced?): Exports == Implementation where st := rst st empty? st + order : % -> NonNegativeInteger order x == st := stream x for i in 0..1000 repeat @@ -94569,8 +96890,10 @@ InnerPAdicInteger(p,unBalanced?): Exports == Implementation where st := rst st error "order: series has more than 1000 leading zero coefs" + 0 : () -> % 0 == padic concat(0$I,empty()) + 1 : () -> % 1 == padic concat(1$I,empty()) intToPAdic: I -> ST I @@ -94630,6 +96953,7 @@ InnerPAdicInteger(p,unBalanced?): Exports == Implementation where cdr := plusAux(modp.carry,intMult(frst x,rst y),timesAux(rst x,y)) concat(car,cdr) + ?*? : (%,%) -> % (x:%) * (y:%) == padic timesAux(stream x,stream y) quotientAux:(ST I,ST I) -> ST I @@ -94644,6 +96968,7 @@ InnerPAdicInteger(p,unBalanced?): Exports == Implementation where yy := rest minusAux(0,y,intMult(z0,x)) concat(z0,quotientAux(x,yy)) + recip : % -> Union(%,"failed") recip x == empty? x or modP frst x = 0 => "failed" padic quotientAux(stream x,concat(1,empty())) @@ -94660,8 +96985,10 @@ InnerPAdicInteger(p,unBalanced?): Exports == Implementation where (rec := recip yy) case "failed" => "failed" xx * (rec :: %) + exquo : (%,%) -> Union(%,"failed") x exquo y == iExquo(stream x,stream y,0) + divide : (%,%) -> Record(quotient: %,remainder: %) divide(x,y) == (z:=x exquo y) case "failed" => [0,x] [z, 0] @@ -94674,6 +97001,7 @@ InnerPAdicInteger(p,unBalanced?): Exports == Implementation where nSt := (empty? bSt => bSt; rst bSt) concat(aa,iSqrt(pn*p,an + pn*aa,bn1,nSt)) + sqrt : (%,Integer) -> % sqrt(b,a) == p = 2 => error "sqrt: no square roots in Z2 yet" @@ -94689,6 +97017,7 @@ InnerPAdicInteger(p,unBalanced?): Exports == Implementation where digit := modP(num * invFpx0) concat(digit,iRoot(f,alpha + digit * pPow,invFpx0,p * pPow)) + root : (SparseUnivariatePolynomial(Integer),Integer) -> % root(f,x0) == x0 := modP x0 not zero? modP f(x0) => @@ -94707,10 +97036,11 @@ InnerPAdicInteger(p,unBalanced?): Exports == Implementation where c = -1 => -mon (c :: OUT) * mon - showAll?:() -> Boolean -- check a global Lisp variable + showAll?:() -> Boolean showAll?() == true + coerce : % -> OutputForm coerce(x:%):OUT == empty?(st := stream x) => 0 :: OUT n : NNI ; count : NNI := _$streamCount$Lisp @@ -95143,11 +97473,6 @@ InnerPrimeField(p:PositiveInteger): Exports == Implementation where (* domain IPF *) (* - initializeElt:() -> Void - initializeLog:() -> Void - --- global variables ==================================================== - primitiveElt:PI:=1 -- for the lookup the primitive Element -- computed by createPrimitiveElement() @@ -95164,7 +97489,6 @@ InnerPrimeField(p:PositiveInteger): Exports == Implementation where initelt?:Boolean:=true -- gets false after initialization of the primitive Element - discLogTable:Table(PI,TBL):=table()$Table(PI,TBL) -- tables indexed by the factors of the size q of the cyclic group -- discLogTable.factor is a table of with keys @@ -95172,11 +97496,11 @@ InnerPrimeField(p:PositiveInteger): Exports == Implementation where -- i in 0..n-1, n computed in initialize() in order to use -- the minimal size limit 'limit' optimal. --- functions =========================================================== - + generator : () -> % generator() == 1 -- This uses x**(p-1)=1 (mod p), so x**(q(p-1)+r) = x**r (mod p) + ?**? : (%,Integer) -> % x:$ ** n:Integer == zero?(n) => 1 zero?(x) => 0 @@ -95184,26 +97508,35 @@ InnerPrimeField(p:PositiveInteger): Exports == Implementation where ((x pretend IntegerMod p) **$IntegerMod(p) r) pretend $ if p <= convert(max()$SingleInteger)@Integer then + q := p::SingleInteger + recip : % -> Union(%,"failed") recip x == zero?(y := convert(x)@Integer :: SingleInteger) => "failed" invmod(y, q)::Integer::$ else + recip : % -> Union(%,"failed") recip x == zero?(y := convert(x)@Integer) => "failed" invmod(y, p)::$ + convert : % -> Integer convert(x:$) == x pretend I + normalElement : () -> % normalElement() == 1 + createNormalElement : () -> % createNormalElement() == 1 + characteristic : () -> NonNegativeInteger characteristic() == p + factorsOfCyclicGroupSize : () -> + List(Record(factor: Integer,exponent: Integer)) factorsOfCyclicGroupSize() == p=2 => facOfGroupSize -- this fixes an infinite loop of functions -- calls, problem was that factors factor(1) @@ -95211,8 +97544,11 @@ InnerPrimeField(p:PositiveInteger): Exports == Implementation where if empty? facOfGroupSize then initializeElt() facOfGroupSize + representationType : () -> Union("prime",polynomial,normal,cyclic) representationType() == "prime" + tableForDiscreteLogarithm : Integer -> + Table(PositiveInteger,NonNegativeInteger) tableForDiscreteLogarithm(fac) == if initlog? then initializeLog() tbl:=search(fac::PI,discLogTable)$Table(PI,TBL) @@ -95221,10 +97557,12 @@ InnerPrimeField(p:PositiveInteger): Exports == Implementation where of the order of the multiplicative group" tbl pretend TBL + primitiveElement : () -> % primitiveElement() == if initelt? then initializeElt() index(primitiveElt) + initializeElt:() -> Void initializeElt() == facOfGroupSize:=factors(factor(sizeCG)$I)$(Factored I) -- get a primitive element @@ -95233,6 +97571,7 @@ InnerPrimeField(p:PositiveInteger): Exports == Implementation where initelt? := false void$Void + initializeLog:() -> Void initializeLog() == if initelt? then initializeElt() -- set up tables for discrete logarithm @@ -95261,33 +97600,44 @@ InnerPrimeField(p:PositiveInteger): Exports == Implementation where initlog? := false void$Void + degree : % -> PositiveInteger degree(x):PI == 1::PositiveInteger + extensionDegree : () -> PositiveInteger extensionDegree():PI == 1::PositiveInteger + inGroundField? : % -> Boolean inGroundField?(x) == true + coordinates : % -> Vector(%) coordinates(x) == new(1,x)$(Vector $) + represents : Vector(%) -> % represents(v) == v.1 + retract : % -> % retract(x) == x + retractIfCan : % -> Union(%,"failed") retractIfCan(x) == x + basis : () -> Vector(%) basis() == new(1,1::$)$(Vector $) + basis : PositiveInteger -> Vector(%) basis(n:PI) == n = 1 => basis() error("basis: argument must divide extension degree") + definingPolynomial : () -> SparseUnivariatePolynomial(%) definingPolynomial() == monomial(1,1)$(SUP $) - monomial(1,0)$(SUP $) - + minimalPolynomial : % -> SparseUnivariatePolynomial(%) minimalPolynomial(x) == monomial(1,1)$(SUP $) - monomial(x,0)$(SUP $) + charthRoot : % -> % charthRoot x == x *) @@ -96628,47 +98978,26 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where -- lazy evaluation of 'str' has the side-effect of modifying the value -- of 'ord' ---% Local functions - - makeTerm: (Integer,Coef) -> Term - getCoef: Term -> Coef - getExpon: Term -> Integer - iSeries: (ST,REF) -> ST - iExtend: (ST,COM,REF) -> ST - iTruncate0: (ST,REF,REF,COM,I,I) -> ST - iTruncate: (%,COM,I) -> % - iCoefficient: (ST,Integer) -> Coef - iOrder: (ST,COM,REF) -> I - iMap1: ((Coef,I) -> Coef,I -> I,B,ST,REF,REF,Integer) -> ST - iMap2: ((Coef,I) -> Coef,I -> I,B,%) -> % - iPlus1: ((Coef,Coef) -> Coef,ST,REF,ST,REF,REF,I) -> ST - iPlus2: ((Coef,Coef) -> Coef,%,%) -> % - productByTerm: (Coef,I,ST,REF,REF,I) -> ST - productLazyEval: (ST,REF,ST,REF,COM) -> Void - iTimes: (ST,REF,ST,REF,REF,I) -> ST - iDivide: (ST,REF,ST,REF,Coef,I,REF,I) -> ST - divide: (%,I,%,I,Coef) -> % - compose0: (ST,REF,ST,REF,I,%,%,I,REF,I) -> ST - factorials?: () -> Boolean - termOutput: (RN,Coef,OUT) -> OUT - showAll?: () -> Boolean - ---% macros - + makeTerm: (Integer,Coef) -> Term makeTerm(exp,coef) == [exp,coef] + getCoef: Term -> Coef getCoef term == term.c + getExpon: Term -> Integer getExpon term == term.k + makeSeries : (Reference(OrderedCompletion(Integer)), + Stream(Record(k: Integer,c: Coef))) -> % makeSeries(refer,x) == [refer,x] + getRef : % -> Reference(OrderedCompletion(Integer)) getRef ups == ups.%ord + getStream : % -> Stream(Record(k: Integer,c: Coef)) getStream ups == ups.%str ---% creation and destruction of series - + monomial : (Coef,Integer) -> % monomial(coef,expon) == nix : ST := empty() st := @@ -96676,30 +99005,37 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where concat(makeTerm(expon,coef),nix) makeSeries(ref plusInfinity(),st) + monomial? : % -> Boolean monomial? ups == (not empty? getStream ups) and (empty? rst getStream ups) - coerce(n:I) == n :: Coef :: % + coerce : Integer -> % + coerce(n:I) == n :: Coef :: % + coerce : Coef -> % coerce(r:Coef) == monomial(r,0) + iSeries: (ST,REF) -> ST iSeries(x,refer) == empty? x => (setelt(refer,plusInfinity()); empty()) setelt(refer,(getExpon frst x) :: COM) concat(frst x,iSeries(rst x,refer)) + series : Stream(Record(k: Integer,c: Coef)) -> % series(x:ST) == empty? x => 0 n := getExpon frst x; refer := ref(n :: COM) makeSeries(refer,iSeries(x,refer)) ---% values - + characteristic : () -> NonNegativeInteger characteristic() == characteristic()$Coef + 0 : () -> % 0 == monomial(0,0) + 1 : () -> % 1 == monomial(1,0) + iExtend: (ST,COM,REF) -> ST iExtend(st,n,refer) == (elt refer) < n => explicitlyEmpty? st => (setelt(refer,plusInfinity()); st) @@ -96707,10 +99043,13 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where iExtend(lazyEvaluate st,n,refer) st + extend : (%,Integer) -> % extend(x,n) == (iExtend(getStream x,n :: COM,getRef x); x) + complete : % -> % complete x == (iExtend(getStream x,plusInfinity(),getRef x); x) + iTruncate0: (ST,REF,REF,COM,I,I) -> ST iTruncate0(x,xRefer,refer,minExp,maxExp,n) == delay explicitlyEmpty? x => (setelt(refer,plusInfinity()); empty()) nn := n :: COM @@ -96728,6 +99067,7 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where setelt(refer,degr :: COM) iTruncate0(x,xRefer,refer,minExp,maxExp,degr + 1) + iTruncate: (%,COM,I) -> % iTruncate(ups,minExp,maxExp) == x := getStream ups; xRefer := getRef ups explicitlyEmpty? x => 0 @@ -96740,12 +99080,15 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where refer := ref(degr :: COM) makeSeries(refer,iTruncate0(x,xRefer,refer,minExp,maxExp,degr + 1)) + truncate : (%,Integer) -> % truncate(ups,n) == iTruncate(ups,minusInfinity(),n) + truncate : (%,Integer,Integer) -> % truncate(ups,n1,n2) == if n1 > n2 then (n1,n2) := (n2,n1) iTruncate(ups,n1 :: COM,n2) + iCoefficient: (ST,Integer) -> Coef iCoefficient(st,n) == explicitEntries? st => term := frst st @@ -96754,10 +99097,13 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where iCoefficient(rst st,n) 0 + coefficient : (%,Integer) -> Coef coefficient(x,n) == (extend(x,n); iCoefficient(getStream x,n)) + ?.? : (%,Integer) -> Coef elt(x:%,n:Integer) == coefficient(x,n) + iOrder: (ST,COM,REF) -> I iOrder(st,n,refer) == explicitlyEmpty? st => finite?(n) => retract(n)@Integer @@ -96770,14 +99116,18 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where (degr :: COM) >= n => retract(n)@Integer iOrder(lazyEvaluate st,n,refer) - order x == iOrder(getStream x,plusInfinity(),getRef x) + order : % -> Integer + order x == iOrder(getStream x,plusInfinity(),getRef x) + order : (%,Integer) -> Integer order(x,n) == iOrder(getStream x,n :: COM,getRef x) - terms x == getStream x + terms : % -> Stream(Record(k: Integer,c: Coef)) + terms x == getStream x --% predicates + zero? : % -> Boolean zero? ups == x := getStream ups; ref := getRef ups whatInfinity(n := elt ref) = 1 => explicitlyEmpty? x @@ -96788,10 +99138,12 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where lazyEvaluate x false + ?=? : (%,%) -> Boolean ups1 = ups2 == zero?(ups1 - ups2) --% arithmetic + iMap1: ((Coef,I) -> Coef,I -> I,B,ST,REF,REF,Integer) -> ST iMap1(cFcn,eFcn,check?,x,xRefer,refer,n) == delay -- when this function is called, all terms in 'x' of order < n have been -- computed and we compute the eFcn(n)th order coefficient of the result @@ -96818,6 +99170,7 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where setelt(refer,eFcn(degr) :: COM) iMap1(cFcn,eFcn,check?,x,xRefer,refer,degr + 1) + iMap2: ((Coef,I) -> Coef,I -> I,B,%) -> % iMap2(cFcn,eFcn,check?,ups) == -- 'eFcn' must be a strictly increasing function, -- i.e. i < j => eFcn(i) < eFcn(j) @@ -96832,14 +99185,19 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where refer := ref(eFcn(degr) :: COM) makeSeries(refer,iMap1(cFcn,eFcn,check?,x,xRefer,refer,degr + 1)) - map(fcn,x) == iMap2((y,n) +-> fcn(y), z +->z, true, x) + map : ((Coef -> Coef),%) -> % + map(fcn,x) == iMap2((y,n) +-> fcn(y), z +->z, true, x) - differentiate x == iMap2((y,n) +-> n*y, z +-> z - 1, true, x) + differentiate : % -> % + differentiate x == iMap2((y,n) +-> n*y, z +-> z - 1, true, x) - multiplyCoefficients(f,x) == iMap2((y,n) +-> f(n)*y, z +-> z, true, x) + multiplyCoefficients : ((Integer -> Coef),%) -> % + multiplyCoefficients(f,x) == iMap2((y,n) +-> f(n)*y, z +-> z, true, x) - multiplyExponents(x,n) == iMap2((y,m) +-> y, z +-> n*z, false, x) + multiplyExponents : (%,PositiveInteger) -> % + multiplyExponents(x,n) == iMap2((y,m) +-> y, z +-> n*z, false, x) + iPlus1: ((Coef,Coef) -> Coef,ST,REF,ST,REF,REF,I) -> ST iPlus1(op,x,xRefer,y,yRefer,refer,n) == delay -- when this function is called, all terms in 'x' and 'y' of order < n -- have been computed and we are computing the nth order coefficient of @@ -96901,6 +99259,7 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where -- can't have xyRef = infty unless all terms have been computed iPlus1(op,x,xRefer,y,yRefer,refer,retract(xyRef)@I + 1) + iPlus2: ((Coef,Coef) -> Coef,%,%) -> % iPlus2(op,ups1,ups2) == xRefer := getRef ups1; x := getStream ups1 xDeg := @@ -96917,22 +99276,30 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where deg := min(xDeg,yDeg); refer := ref(deg :: COM) makeSeries(refer,iPlus1(op,x,xRefer,y,yRefer,refer,deg + 1)) + ?+? : (%,%) -> % x + y == iPlus2((xi,yi) +-> xi + yi, x, y) + ?-? : (%,%) -> % x - y == iPlus2((xi,yi) +-> xi - yi, x, y) + -? : % -> % - y == iMap2((x,n) +-> -x, z +-> z, false, y) -- gives correct defaults for I, NNI and PI - n:I * x:% == (zero? n => 0; map(z +-> n*z, x)) + ?*? : (Integer,%) -> % + n:I * x:% == (zero? n => 0; map(z +-> n*z, x)) + ?*? : (NonNegativeInteger,%) -> % n:NNI * x:% == (zero? n => 0; map(z +-> n*z, x)) + ?*? : (PositiveInteger,%) -> % n:PI * x:% == (zero? n => 0; map(z +-> n*z, x)) + productByTerm: (Coef,I,ST,REF,REF,I) -> ST productByTerm(coef,expon,x,xRefer,refer,n) == iMap1((y,m) +-> coef*y, z +-> z+expon, true, x, xRefer, refer, n) + productLazyEval: (ST,REF,ST,REF,COM) -> Void productLazyEval(x,xRefer,y,yRefer,nn) == explicitlyEmpty?(x) or explicitlyEmpty?(y) => void() explicitEntries? x => @@ -96949,6 +99316,7 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where if lazy? y then lazyEvaluate y productLazyEval(x,xRefer,y,yRefer,nn) + iTimes: (ST,REF,ST,REF,REF,I) -> ST iTimes(x,xRefer,y,yRefer,refer,n) == delay -- when this function is called, we are computing the nth order -- coefficient of the product @@ -96986,6 +99354,7 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where setelt(refer,(xDegr + yDegr) :: COM) iTimes(x,xRefer,y,yRefer,refer,xDegr + yDegr + 1) + ?*? : (%,%) -> % ups1:% * ups2:% == xRefer := getRef ups1; x := getStream ups1 xDeg := @@ -97002,6 +99371,7 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where deg := xDeg + yDeg + 1; refer := ref(deg :: COM) makeSeries(refer,iTimes(x,xRefer,y,yRefer,refer,deg + 1)) + iDivide: (ST,REF,ST,REF,Coef,I,REF,I) -> ST iDivide(x,xRefer,y,yRefer,rym,m,refer,n) == delay -- when this function is called, we are computing the nth order -- coefficient of the result @@ -97026,12 +99396,14 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where setelt(refer,(degr - m) :: COM) iDivide(x,xRefer,y,yRefer,rym,m,refer,degr - m + 1) + divide: (%,I,%,I,Coef) -> % divide(ups1,deg1,ups2,deg2,r) == xRefer := getRef ups1; x := getStream ups1 yRefer := getRef ups2; y := getStream ups2 refer := ref((deg1 - deg2) :: COM) makeSeries(refer,iDivide(x,xRefer,y,yRefer,r,deg2,refer,deg1 - deg2 + 1)) + iExquo : (%,%,Boolean) -> Union(%,"failed") iExquo(ups1,ups2,taylor?) == xRefer := getRef ups1; x := getStream ups1 yRefer := getRef ups2; y := getStream ups2 @@ -97061,9 +99433,11 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where retract(elt xRefer)@I divide(ups1,nx,ups2,ny,ry :: Coef) + taylorQuoByVar : % -> % taylorQuoByVar ups == iMap2((y,n) +-> y, z +-> z-1,false,ups - monomial(coefficient(ups,0),0)) + compose0: (ST,REF,ST,REF,I,%,%,I,REF,I) -> ST compose0(x,xRefer,y,yRefer,yOrd,y1,yn0,n0,refer,n) == delay -- when this function is called, we are computing the nth order -- coefficient of the composite @@ -97091,6 +99465,7 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where setelt(refer,(degr - 1) :: COM) compose0(x,xRefer,y,yRefer,yOrd,y1,yn0,n0,refer,degr) + iCompose : (%,%) -> % iCompose(ups1,ups2) == x := getStream ups1; xRefer := getRef ups1 y := getStream ups2; yRefer := getRef ups2 @@ -97109,6 +99484,7 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where if Coef has Algebra Fraction Integer then + integrate : % -> % integrate x == iMap2((y,n) +-> 1/(n+1)*y, z +-> z+1, true, x) --% Fixed point computations @@ -97137,6 +99513,7 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where ansStr : ST := integ1(delay xf,intRef,ansRef) concat(makeTerm(0,a),ansStr) + cPower : (%,Coef) -> % cPower(f,r) == -- computes f^r. f should have constant coefficient 1. fp := differentiate f @@ -97228,6 +99605,7 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where RATPOWERS : Boolean := Coef has "**": (Coef,RN) -> Coef TRANSFCN : Boolean := Coef has TranscendentalFunctionCategory + cRationalPower : (%,Fraction(Integer)) -> % cRationalPower(uts,r) == (ord0 := orderOrFailed uts) case "failed" => error "**: series with many leading zero coefficients" @@ -97247,11 +99625,13 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where uts2 := uts1 * monomial(1,-order) monomial(ccPow,(n :: I) * numer(r)) * cPower(uts2,r :: Coef) + cExp : % -> % cExp uts == zero?(cc := coefficient(uts,0)) => iExp(uts,1) TRANSFCN => iExp(uts,exp cc) error concat("exp: ",TRCONST) + cLog : % -> % cLog uts == zero?(cc := coefficient(uts,0)) => error "log: constant coefficient should not be 0" @@ -97267,21 +99647,26 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where TRANSFCN => iSincos(uts,sin cc,cos cc,-1) error concat("sincos: ",TRCONST) + cSin : % -> % cSin uts == sincos(uts).%sin + cCos : % -> % cCos uts == sincos(uts).%cos + cTan : % -> % cTan uts == zero?(cc := coefficient(uts,0)) => iTan(uts,differentiate uts,0,1) TRANSFCN => iTan(uts,differentiate uts,tan cc,1) error concat("tan: ",TRCONST) + cCot : % -> % cCot uts == zero? uts => error "cot: cot(0) is undefined" zero?(cc := coefficient(uts,0)) => error error concat("cot: ",NPOWERS) TRANSFCN => iTan(uts,-differentiate uts,cot cc,1) error concat("cot: ",TRCONST) + cSec : % -> % cSec uts == zero?(cc := coefficient(uts,0)) => iExquo(1,cCos uts,true) :: % TRANSFCN => @@ -97290,6 +99675,7 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where iExquo(1,cosUts,true) :: % error concat("sec: ",TRCONST) + cCsc : % -> % cCsc uts == zero? uts => error "csc: csc(0) is undefined" TRANSFCN => @@ -97298,6 +99684,7 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where iExquo(1,sinUts,true) :: % error concat("csc: ",TRCONST) + cAsin : % -> % cAsin uts == zero?(cc := coefficient(uts,0)) => integrate(cRationalPower(1 - uts*uts,-1/2) * differentiate(uts)) @@ -97315,6 +99702,7 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where c0 + integrate(cRationalPower(x,-1/2) * differentiate(uts)) error concat("asin: ",TRCONST) + cAcos : % -> % cAcos uts == zero? uts => TRANSFCN => acos(0)$Coef :: % @@ -97334,6 +99722,7 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where c0 + integrate(-cRationalPower(x,-1/2) * differentiate(uts)) error concat("acos: ",TRCONST) + cAtan : % -> % cAtan uts == zero?(cc := coefficient(uts,0)) => y := iExquo(1,(1 :: %) + uts*uts,true) :: % @@ -97344,6 +99733,7 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where (atan(cc) :: %) + integrate((y :: %) * (differentiate uts)) error concat("atan: ",TRCONST) + cAcot : % -> % cAcot uts == TRANSFCN => (y := iExquo(1,(1 :: %) + uts*uts,true)) case "failed" => @@ -97352,6 +99742,7 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where (acot(cc) :: %) + integrate(-(y :: %) * (differentiate uts)) error concat("acot: ",TRCONST) + cAsec : % -> % cAsec uts == zero?(cc := coefficient(uts,0)) => error "asec: constant coefficient should not be 0" @@ -97371,6 +99762,7 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where (asec(cc) :: %) + integrate(z :: %) error concat("asec: ",TRCONST) + cAcsc : % -> % cAcsc uts == zero?(cc := coefficient(uts,0)) => error "acsc: constant coefficient should not be 0" @@ -97403,27 +99795,32 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where cSinh uts == sinhcosh(uts).%sinh cCosh uts == sinhcosh(uts).%cosh + cTanh : % -> % cTanh uts == zero?(cc := coefficient(uts,0)) => iTan(uts,differentiate uts,0,-1) TRANSFCN => iTan(uts,differentiate uts,tanh cc,-1) error concat("tanh: ",TRCONST) + cCoth : % -> % cCoth uts == tanhUts := cTanh uts zero? tanhUts => error "coth: coth(0) is undefined" zero? coefficient(tanhUts,0) => error concat("coth: ",NPOWERS) iExquo(1,tanhUts,true) :: % + cSech : % -> % cSech uts == coshUts := cCosh uts zero? coefficient(coshUts,0) => error concat("sech: ",NPOWERS) iExquo(1,coshUts,true) :: % + cCsch : % -> % cCsch uts == sinhUts := cSinh uts zero? coefficient(sinhUts,0) => error concat("csch: ",NPOWERS) iExquo(1,sinhUts,true) :: % + cAsinh : % -> % cAsinh uts == x := 1 + uts * uts zero?(cc := coefficient(uts,0)) => cLog(uts + cRationalPower(x,1/2)) @@ -97436,6 +99833,7 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where cLog(uts + cRationalPower(x,1/2)) error concat("asinh: ",TRCONST) + cAcosh : % -> % cAcosh uts == zero? uts => TRANSFCN => acosh(0)$Coef :: % @@ -97453,6 +99851,7 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where cLog(uts + cRationalPower(x,1/2)) error concat("acosh: ",TRCONST) + cAtanh : % -> % cAtanh uts == half := inv(2 :: RN) :: Coef zero?(cc := coefficient(uts,0)) => @@ -97462,6 +99861,7 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where half * (cLog(1 + uts) - cLog(1 - uts)) error concat("atanh: ",TRCONST) + cAcoth : % -> % cAcoth uts == zero? uts => TRANSFCN => acoth(0)$Coef :: % @@ -97472,6 +99872,7 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where half * (cLog(uts + 1) - cLog(uts - 1)) error concat("acoth: ",TRCONST) + cAsech : % -> % cAsech uts == zero? uts => error "asech: asech(0) is undefined" TRANSFCN => @@ -97492,6 +99893,7 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where cLog((1 + cRationalPower(x,1/2)) * (utsInv :: %)) error concat("asech: ",TRCONST) + cAcsch : % -> % cAcsch uts == zero? uts => error "acsch: acsch(0) is undefined" TRANSFCN => @@ -97510,8 +99912,10 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where --% Output forms -- check a global Lisp variable + factorials?: () -> Boolean factorials?() == false + termOutput: (RN,Coef,OUT) -> OUT termOutput(k,c,vv) == -- creates a term c * vv ** k k = 0 => c :: OUT @@ -97521,8 +99925,12 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where (c :: OUT) * mon -- check a global Lisp variable + showAll?: () -> Boolean showAll?() == true + seriesToOutputForm : (Stream(Record(k: Integer,c: Coef)), + Reference(OrderedCompletion(Integer)),Symbol,Coef,Fraction(Integer)) -> + OutputForm seriesToOutputForm(st,refer,var,cen,r) == vv := zero? cen => var :: OUT @@ -98027,15 +100435,18 @@ InnerTaylorSeries(Coef): Exports == Implementation where -- This will be done using the functions 'stream' and 'series'. stream : % -> Stream Coef - stream x == x pretend Stream(Coef) + series : Stream(Coef) -> % series st == st @ % + 0 : () -> % 0 == coerce(0)$STT + 1 : () -> % 1 == coerce(1)$STT + ?=? : (%,%) -> Boolean x = y == -- tests if two power series are equal -- difference must be a finite stream of zeroes of length <= n + 1, @@ -98048,40 +100459,54 @@ InnerTaylorSeries(Coef): Exports == Implementation where st := rst st empty? st + coefficients : % -> Stream(Coef) coefficients x == stream x - x + y == stream(x) +$STT stream(y) + ?+? : (%,%) -> % + x + y == stream(x) +$STT stream(y) - x - y == stream(x) -$STT stream(y) + ?-? : (%,%) -> % + x - y == stream(x) -$STT stream(y) - (x:%) * (y:%) == stream(x) *$STT stream(y) + ?*? : (%,%) -> % + (x:%) * (y:%) == stream(x) *$STT stream(y) - - x == -$STT (stream x) + -? : % -> % + - x == -$STT (stream x) + ?*? : (Integer,%) -> % (i:I) * (x:%) == (i::Coef) *$STT stream x + ?*? : (%,Integer) -> % (x:%) * (i:I) == stream(x) *$STT (i::Coef) + ?*? : (Coef,%) -> % (c:Coef) * (x:%) == c *$STT stream x + ?*? : (%,Coef) -> % (x:%) * (c:Coef) == stream(x) *$STT c + recip : % -> Union(%,"failed") recip x == (rec := recip$STT stream x) case "failed" => "failed" series(rec :: ST) if Coef has IntegralDomain then + exquo : (%,%) -> Union(%,"failed") x exquo y == (quot := stream(x) exquo$STT stream(y)) case "failed" => "failed" series(quot :: ST) + ?**? : (%,NonNegativeInteger) -> % x:% ** n:NNI == n = 0 => 1 expt(x,n :: PositiveInteger)$RepeatedSquaring(%) + characteristic : () -> NonNegativeInteger characteristic() == characteristic()$Coef + pole? : % -> Boolean pole? x == false iOrder: (ST,NNI,NNI) -> NNI @@ -98090,6 +100515,7 @@ InnerTaylorSeries(Coef): Exports == Implementation where zero? frst st => iOrder(rst st,n + 1,n0) n + order : (%,NonNegativeInteger) -> NonNegativeInteger order(x,n) == iOrder(stream x,0,n) iOrder2: (ST,NNI) -> NNI @@ -98098,6 +100524,7 @@ InnerTaylorSeries(Coef): Exports == Implementation where zero? frst st => iOrder2(rst st,n + 1) n + order : % -> NonNegativeInteger order x == iOrder2(stream x,0) *) @@ -98418,35 +100845,38 @@ InputForm(): (* Rep := SExpression + + 0 : () -> % + 0 == convert(0::Integer) - mkProperOp: Symbol -> % - strsym : % -> String - tuplify : List Symbol -> % - flatten0 : (%, Symbol, NonNegativeInteger) -> - Record(lst: List %, symb:%) - - 0 == convert(0::Integer) - - 1 == convert(1::Integer) + 1 : () -> % + 1 == convert(1::Integer) + convert : % -> SExpression convert(x:%):SExpression == x pretend SExpression + convert : SExpression -> % convert(x:SExpression):% == x + conv : List % -> % conv(ll : List %): % == convert(ll pretend List SExpression)$SExpression pretend % + lambda : (%,List(Symbol)) -> % lambda(f,l) == conv([convert("+->"::Symbol),tuplify l,f]$List(%)) + interpret : % -> Any interpret x == v := interpret(x)$Lisp mkObjFn(unwrap(objValFn(v)$Lisp)$Lisp, objModeFn(v)$Lisp)$Lisp + convert : DoubleFloat -> % convert(x:DoubleFloat):% == zero? x => 0 (x = 1) => 1 convert(x)$Rep + flatten : % -> % flatten s == -- will not compile if I use 'or' atom? s => s @@ -98459,6 +100889,7 @@ InputForm(): [convert("exit"::Symbol)@%, 1$%, conv(concat(first l, [u.symb for u in l2]))@%]$List(%))@%)))@% + flatten0 : (%, Symbol, NonNegativeInteger) -> Record(lst: List %, symb:%) flatten0(s, sy, n) == atom? s => [nil(), s] a := convert(concat(string sy, convert(n)@String)::Symbol)@% @@ -98467,67 +100898,81 @@ InputForm(): "LET"::Symbol)@%, a, conv(concat(first l, [u.symb for u in l2]))@%]$List(%))@%), a] + strsym : % -> String strsym s == string? s => string s symbol? s => string symbol s error "strsym: form is neither a string or symbol" -- given a function this will attempt to recreate the input string + unparse : % -> String unparse x == atom?(s:% := unparseInputForm(x)$Lisp) => strsym s concat [strsym a for a in destruct s] + parse : String -> % parse(s:String):% == ncParseFromString(s)$Lisp + declare : List(%) -> Symbol declare signature == declare(name := new()$Symbol, signature)$Lisp name + compile : (Symbol,List(%)) -> Symbol compile(name, types) == symbol car cdr car selectLocalMms(mkProperOp name, convert(name)@%, types, nil$List(%))$Lisp + mkProperOp: Symbol -> % mkProperOp name == op := mkAtree(nme := convert(name)@%)$Lisp transferPropsToNode(nme, op)$Lisp convert op + binary : (%,List(%)) -> % binary(op, args) == (n := #args) < 2 => error "Need at least 2 arguments" n = 2 => convert([op, first args, last args]$List(%)) convert([op, first args, binary(op, rest args)]$List(%)) + tuplify : List Symbol -> % tuplify l == empty? rest l => convert first l conv concat(convert("Tuple"::Symbol), [convert x for x in l]$List(%)) + function : (%,List(Symbol),Symbol) -> % function(f, l, name) == nn := convert(new(1 + #l, convert(nil()$List(%)))$List(%))@% conv([convert("DEF"::Symbol), conv(cons(convert(name)@%, [convert(x)@% for x in l])), nn, nn, f]$List(%)) + ?+? : (%,%) -> % s1 + s2 == s1 = 0 => s2 s2 = 0 => s1 conv [convert("+"::Symbol), s1, s2]$List(%) + ?*? : (%,%) -> % s1 * s2 == s1 = 0 or s2 = 0 => 0 s1 = 1 => s2 s2 = 1 => s1 conv [convert("*"::Symbol), s1, s2]$List(%) + ?**? : (%,Integer) -> % s1:% ** n:Integer == s1 = 0 and n > 0 => 0 s1 = 1 or zero? n => 1 (n = 1) => s1 conv [convert("**"::Symbol), s1, convert n]$List(%) + ?**? : (%,NonNegativeInteger) -> % s1:% ** n:NonNegativeInteger == s1 ** (n::Integer) + ?/? : (%,%) -> % s1 / s2 == s2 = 1 => s1 conv [convert("/"::Symbol), s1, s2]$List(%) @@ -99666,6 +102111,7 @@ Integer: Join(IntegerNumberSystem, ConvertibleTo String, OpenMath) with n: NonNegativeInteger + writeOMInt : (OpenMathDevice,%) -> Void writeOMInt(dev: OpenMathDevice, x: %): Void == if x < 0 then OMputApp(dev) @@ -99675,6 +102121,7 @@ Integer: Join(IntegerNumberSystem, ConvertibleTo String, OpenMath) with else OMputInteger(dev, x pretend Integer) + OMwrite : % -> String OMwrite(x: %): String == s: String := "" sp := OM_-STRINGTOSTRINGPTR(s)$Lisp @@ -99686,6 +102133,7 @@ Integer: Join(IntegerNumberSystem, ConvertibleTo String, OpenMath) with s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String s + OMwrite : (%,Boolean) -> String OMwrite(x: %, wholeObj: Boolean): String == s: String := "" sp := OM_-STRINGTOSTRINGPTR(s)$Lisp @@ -99699,11 +102147,13 @@ Integer: Join(IntegerNumberSystem, ConvertibleTo String, OpenMath) with s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String s + OMwrite : (OpenMathDevice,%) -> Void OMwrite(dev: OpenMathDevice, x: %): Void == OMputObject(dev) writeOMInt(dev, x) OMputEndObject(dev) + OMwrite : (OpenMathDevice,%,Boolean) -> Void OMwrite(dev: OpenMathDevice, x: %, wholeObj: Boolean): Void == if wholeObj then OMputObject(dev) @@ -99711,171 +102161,223 @@ Integer: Join(IntegerNumberSystem, ConvertibleTo String, OpenMath) with if wholeObj then OMputEndObject(dev) + zero? : % -> Boolean zero? x == ZEROP(x)$Lisp + one? : % -> Boolean one? x == x = 1 + 0 : () -> % 0 == 0$Lisp + 1 : () -> % 1 == 1$Lisp + base : () -> % base() == 2$Lisp + copy : % -> % copy x == x + inc : % -> % inc x == x + 1 + dec : % -> % dec x == x - 1 + hash : % -> SingleInteger hash x == SXHASH(x)$Lisp + negative? : % -> Boolean negative? x == MINUSP(x)$Lisp + coerce : % -> OutputForm coerce(x):OutputForm == outputForm(x pretend Integer) + coerce : Integer -> % coerce(m:Integer):% == m pretend % + convert : % -> Integer convert(x:%):Integer == x pretend Integer + length : % -> % length a == INTEGER_-LENGTH(a)$Lisp + addmod : (%,%,%) -> % addmod(a, b, p) == (c:=a + b) >= p => c - p c + submod : (%,%,%) -> % submod(a, b, p) == (c:=a - b) < 0 => c + p c + mulmod : (%,%,%) -> % mulmod(a, b, p) == (a * b) rem p + convert : % -> Float convert(x:%):Float == coerce(x pretend Integer)$Float + convert : % -> DoubleFloat convert(x:%):DoubleFloat == coerce(x pretend Integer)$DoubleFloat + convert : % -> InputForm convert(x:%):InputForm == convert(x pretend Integer)$InputForm + convert : % -> String convert(x:%):String == string(x pretend Integer)$String + latex : % -> String latex(x:%):String == s : String := string(x pretend Integer)$String (-1 < (x pretend Integer)) and ((x pretend Integer) < 10) => s concat("{", concat(s, "}")$String)$String + positiveRemainder : (%,%) -> % positiveRemainder(a, b) == negative?(r := a rem b) => negative? b => r - b r + b r + reducedSystem : Matrix(%) -> Matrix(Integer) reducedSystem(m:Matrix %):Matrix(Integer) == m pretend Matrix(Integer) + reducedSystem : (Matrix(%),Vector(%)) -> + Record(mat: Matrix(Integer),vec: Vector(Integer)) reducedSystem(m:Matrix %, v:Vector %): Record(mat:Matrix(Integer), vec:Vector(Integer)) == [m pretend Matrix(Integer), vec pretend Vector(Integer)] + abs : % -> % abs(x) == ABS(x)$Lisp + random : () -> % random() == random()$Lisp + random : % -> % random(x) == RANDOM(x)$Lisp + ?=? : (%,%) -> Boolean x = y == EQL(x,y)$Lisp + ? Boolean x < y == (x % - x == (-x)$Lisp + ?+? : (%,%) -> % x + y == (x+y)$Lisp + ?-? : (%,%) -> % x - y == (x-y)$Lisp + ?*? : (%,%) -> % x * y == (x*y)$Lisp + ?*? : (Integer,%) -> % (m:Integer) * (y:%) == (m*y)$Lisp -- for subsumption problem + ?**? : (%,NonNegativeInteger) -> % x ** n == EXPT(x,n)$Lisp + odd? : % -> Boolean odd? x == ODDP(x)$Lisp + max : (%,%) -> % max(x,y) == MAX(x,y)$Lisp + min : (%,%) -> % min(x,y) == MIN(x,y)$Lisp + divide : (%,%) -> Record(quotient: %,remainder: %) divide(x,y) == DIVIDE2(x,y)$Lisp + ?quo? : (%,%) -> % x quo y == QUOTIENT2(x,y)$Lisp + ?rem? : (%,%) -> % x rem y == REMAINDER2(x,y)$Lisp + shift : (%,%) -> % shift(x, y) == ASH(x,y)$Lisp + exquo : (%,%) -> Union(%,"failed") x exquo y == zero? y => "failed" zero?(x rem y) => x quo y "failed" + recip : % -> Union(%,"failed") recip(x) == if (x = 1) or x=-1 then x else "failed" + gcd : (%,%) -> % gcd(x,y) == GCD(x,y)$Lisp UCA ==> Record(unit:%,canonical:%,associate:%) + unitNormal : % -> Record(unit: %,canonical: %,associate: %) unitNormal x == x < 0 => [-1,-x,-1]$UCA [1,x,1]$UCA + unitCanonical : % -> % unitCanonical x == abs x + solveLinearPolynomialEquation : (List ZP,ZP) -> Union(List ZP,"failed") solveLinearPolynomialEquation(lp:List ZP,p:ZP):Union(List ZP,"failed") == solveLinearPolynomialEquation(lp pretend List ZZP, p pretend ZZP)$IntegerSolveLinearPolynomialEquation pretend Union(List ZP,"failed") + squareFreePolynomial : ZP -> Factored ZP squareFreePolynomial(p:ZP):Factored ZP == squareFree(p)$UnivariatePolynomialSquareFree(%,ZP) + factorPolynomial : ZP -> Factored ZP factorPolynomial(p:ZP):Factored ZP == -- GaloisGroupFactorizer doesn't factor the content -- so we have to do this by hand @@ -99889,9 +102391,13 @@ Integer: Join(IntegerNumberSystem, ConvertibleTo String, OpenMath) with ::%))$FactoredFunctions2(%,ZP) )$FactoredFunctionUtilities(ZP) + factorSquareFreePolynomial : ZP -> Factored ZP factorSquareFreePolynomial(p:ZP):Factored ZP == factorSquareFree(p)$GaloisGroupFactorizer(ZP) + gcdPolynomial : (SparseUnivariatePolynomial(%), + SparseUnivariatePolynomial(%)) -> + SparseUnivariatePolynomial(%) gcdPolynomial(p:ZP, q:ZP):ZP == zero? p => unitCanonical q zero? q => unitCanonical p @@ -100118,60 +102624,77 @@ IntegerMod(p:PositiveInteger): (* Join(CommutativeRing, Finite, ConvertibleTo Integer, StepThrough) == add - size() == p + size : () -> NonNegativeInteger + size() == p + characteristic : () -> NonNegativeInteger characteristic() == p + lookup : % -> PositiveInteger lookup x == (zero? x => p; (convert(x)@Integer) :: PositiveInteger) --- Code is duplicated for the optimizer to kick in. - if p <= convert(max()$SingleInteger)@Integer then Rep:= SingleInteger q := p::SingleInteger bloodyCompiler: Integer -> % - bloodyCompiler n == positiveRemainder(n, p)$Integer :: Rep + convert : % -> Integer convert(x:%):Integer == convert(x)$Rep + coerce : % -> OutputForm coerce(x):OutputForm == coerce(x)$Rep + coerce : Integer -> % coerce(n:Integer):% == bloodyCompiler n - 0 == 0$Rep + 0 : () -> % + 0 == 0$Rep - 1 == 1$Rep + 1 : () -> % + 1 == 1$Rep - init == 0$Rep + init : () -> % + init == 0$Rep - nextItem(n) == - m:=n+1 - m=0 => "failed" - m + nextItem : % -> Union(%,"failed") + nextItem(n) == + m:=n+1 + m=0 => "failed" + m - x = y == x =$Rep y + ?=? : (%,%) -> Boolean + x = y == x =$Rep y - x:% * y:% == mulmod(x, y, q) + ?*? : (%,%) -> % + x:% * y:% == mulmod(x, y, q) - n:Integer * x:% == mulmod(bloodyCompiler n, x, q) + ?*? : (Integer,%) -> % + n:Integer * x:% == mulmod(bloodyCompiler n, x, q) - x + y == addmod(x, y, q) + ?+? : (%,%) -> % + x + y == addmod(x, y, q) - x - y == submod(x, y, q) + ?-? : (%,%) -> % + x - y == submod(x, y, q) - random() == random(q)$Rep + random : () -> % + random() == random(q)$Rep - index a == positiveRemainder(a::%, q) + index : PositiveInteger -> % + index a == positiveRemainder(a::%, q) - - x == (zero? x => 0; q -$Rep x) + -? : % -> % + - x == (zero? x => 0; q -$Rep x) + ?**? : (%,NonNegativeInteger) -> % x:% ** n:NonNegativeInteger == n < p => powmod(x, n::Rep, q) powmod(convert(x)@Integer, n, p)$Integer :: Rep + recip : % -> Union(%,"failed") recip x == (c1, c2, g) := extendedEuclidean(x, q)$Rep not (g = 1) => "failed" @@ -100181,41 +102704,58 @@ IntegerMod(p:PositiveInteger): Rep:= Integer + convert : % -> Integer convert(x:%):Integer == convert(x)$Rep + coerce : Integer -> % coerce(n:Integer):% == positiveRemainder(n::Rep, p) + coerce : % -> OutputForm coerce(x):OutputForm == coerce(x)$Rep - 0 == 0$Rep + 0 : () -> % + 0 == 0$Rep - 1 == 1$Rep + 1 : () -> % + 1 == 1$Rep - init == 0$Rep + init : () -> % + init == 0$Rep - nextItem(n) == - m:=n+1 - m=0 => "failed" - m + nextItem : % -> Union(%,"failed") + nextItem(n) == + m:=n+1 + m=0 => "failed" + m - x = y == x =$Rep y + ?=? : (%,%) -> Boolean + x = y == x =$Rep y - x:% * y:% == mulmod(x, y, p) + ?*? : (%,%) -> % + x:% * y:% == mulmod(x, y, p) - n:Integer * x:% == mulmod(positiveRemainder(n::Rep, p), x, p) + ?*? : (Integer,%) -> % + n:Integer * x:% == mulmod(positiveRemainder(n::Rep, p), x, p) - x + y == addmod(x, y, p) + ?+? : (%,%) -> % + x + y == addmod(x, y, p) - x - y == submod(x, y, p) + ?-? : (%,%) -> % + x - y == submod(x, y, p) - random() == random(p)$Rep + random : () -> % + random() == random(p)$Rep - index a == positiveRemainder(a::Rep, p) + index : PositiveInteger -> % + index a == positiveRemainder(a::Rep, p) - - x == (zero? x => 0; p -$Rep x) + -? : % -> % + - x == (zero? x => 0; p -$Rep x) + ?**? : (%,NonNegativeInteger) -> % x:% ** n:NonNegativeInteger == powmod(x, n::Rep, p) + recip : % -> Union(%,"failed") recip x == (c1, c2, g) := extendedEuclidean(x, p)$Rep not (g = 1) => "failed" @@ -100400,28 +102940,109 @@ IntegrationFunctionsTable(): E == I where theFTable:$ := empty()$Rep + showTheFTable : () -> % showTheFTable():$ == theFTable + clearTheFTable : () -> Void clearTheFTable():Void == theFTable := empty()$Rep void()$Void + fTable : List(Record(key: Record(var: Symbol,fn: Expression(DoubleFloat), + range: Segment(OrderedCompletion(DoubleFloat)),abserr: DoubleFloat, + relerr: DoubleFloat),entry: Record(endPointContinuity: + Union(continuous: Continuous at the end points, + lowerSingular: There is a singularity at the lower end point, + upperSingular: There is a singularity at the upper end point, + bothSingular: There are singularities at both end points, + notEvaluated: End point continuity not yet evaluated), + singularitiesStream: Union(str: Stream(DoubleFloat), + notEvaluated: Internal singularities not yet evaluated), + range: Union(finite: The range is finite, + lowerInfinite: The bottom of range is infinite, + upperInfinite: The top of range is infinite, + bothInfinite: Both top and bottom points are infinite, + notEvaluated: Range not yet evaluated)))) -> % fTable(l:List Record(key:NIA,entry:ATT)):$ == theFTable := table(l)$Rep + insert! : Record(key: Record(var: Symbol,fn: Expression(DoubleFloat), + range: Segment(OrderedCompletion(DoubleFloat)),abserr: DoubleFloat, + relerr: DoubleFloat),entry: Record(endPointContinuity: + Union(continuous: Continuous at the end points, + lowerSingular: There is a singularity at the lower end point, + upperSingular: There is a singularity at the upper end point, + bothSingular: There are singularities at both end points, + notEvaluated: End point continuity not yet evaluated), + singularitiesStream: Union(str: Stream(DoubleFloat), + notEvaluated: Internal singularities not yet evaluated), + range: Union(finite: The range is finite, + lowerInfinite: The bottom of range is infinite, + upperInfinite: The top of range is infinite, + bothInfinite: Both top and bottom points are infinite, + notEvaluated: Range not yet evaluated)))) -> % insert!(r:Record(key:NIA,entry:ATT)):$ == insert!(r,theFTable)$Rep + keys : % -> List(Record(var: Symbol,fn: Expression(DoubleFloat), + range: Segment(OrderedCompletion(DoubleFloat)),abserr: DoubleFloat, + relerr: DoubleFloat)) keys(t:$):List NIA == keys(t)$Rep + showAttributes : Record(var: Symbol,fn: Expression(DoubleFloat), + range: Segment(OrderedCompletion(DoubleFloat)),abserr: DoubleFloat, + relerr: DoubleFloat),entry: Record(endPointContinuity: + Union(continuous: Continuous at the end points, + lowerSingular: There is a singularity at the lower end point, + upperSingular: There is a singularity at the upper end point, + bothSingular: There are singularities at both end points, + notEvaluated: End point continuity not yet evaluated), + singularitiesStream: Union(str: Stream(DoubleFloat), + notEvaluated: Internal singularities not yet evaluated), + range: Union(finite: The range is finite, + lowerInfinite: The bottom of range is infinite, + upperInfinite: The top of range is infinite, + bothInfinite: Both top and bottom points are infinite, + notEvaluated: Range not yet evaluated)))) -> % showAttributes(k:NIA):Union(ATT,"failed") == search(k,theFTable)$Rep + entries : % -> List(Record(key: Record(var: Symbol, + fn: Expression(DoubleFloat),range: + Segment(OrderedCompletion(DoubleFloat)),abserr: DoubleFloat, + relerr: DoubleFloat),entry: Record(endPointContinuity: + Union(continuous: Continuous at the end points, + lowerSingular: There is a singularity at the lower end point, + upperSingular: There is a singularity at the upper end point, + bothSingular: There are singularities at both end points, + notEvaluated: End point continuity not yet evaluated), + singularitiesStream: Union(str: Stream(DoubleFloat), + notEvaluated: Internal singularities not yet evaluated), + range: Union(finite: The range is finite, + lowerInfinite: The bottom of range is infinite, + upperInfinite: The top of range is infinite, + bothInfinite: Both top and bottom points are infinite, + notEvaluated: Range not yet evaluated)))) entries(t:$):List Record(key:NIA,entry:ATT) == members(t)$Rep + entry : Record(var: Symbol,fn: Expression(DoubleFloat), + range: Segment(OrderedCompletion(DoubleFloat)),abserr: DoubleFloat, + relerr: DoubleFloat) -> Record(endPointContinuity: + Union(continuous: Continuous at the end points, + lowerSingular: There is a singularity at the lower end point, + upperSingular: There is a singularity at the upper end point, + bothSingular: There are singularities at both end points, + notEvaluated: End point continuity not yet evaluated), + singularitiesStream: Union(str: Stream(DoubleFloat), + notEvaluated: Internal singularities not yet evaluated), + range: Union(finite: The range is finite, + lowerInfinite: The bottom of range is infinite, + upperInfinite: The top of range is infinite, + bothInfinite: Both top and bottom points are infinite, + notEvaluated: Range not yet evaluated)) entry(k:NIA):ATT == qelt(theFTable,k)$Rep @@ -100722,49 +103343,61 @@ IntegrationResult(F:Field): Exports == Implementation where Rep := Record(ratp: F, logp: List LOG, nelem: List NE) - timelog : (Q, LOG) -> LOG - timene : (Q, NE) -> NE - LOG2O : LOG -> O - NE2O : NE -> O - Q2F : Q -> F - nesimp : List NE -> List NE - neselect: (List NE, F) -> F - pLogDeriv: (LOG, F -> F) -> F - pNeDeriv : (NE, F -> F) -> F - alpha:O := new()$Symbol :: O - - u == (-1$Z) * u + -? : % -> % + - u == (-1$Z) * u - 0 == mkAnswer(0, empty(), empty()) + 0 : () -> % + 0 == mkAnswer(0, empty(), empty()) - coerce(x:F):% == mkAnswer(x, empty(), empty()) + coerce : F -> % + coerce(x:F):% == mkAnswer(x, empty(), empty()) - ratpart u == u.ratp + ratpart : % -> F + ratpart u == u.ratp - logpart u == u.logp + logpart : % -> List(Record(scalar: Fraction(Integer), + coeff: SparseUnivariatePolynomial(F), + logand: SparseUnivariatePolynomial(F))) + logpart u == u.logp - notelem u == u.nelem + notelem : % -> List(Record(integrand: F,intvar: F)) + notelem u == u.nelem - elem? u == empty? notelem u + elem? : % -> Boolean + elem? u == empty? notelem u + mkAnswer : (F,List(Record(scalar: Fraction(Integer), + coeff: SparseUnivariatePolynomial(F), + logand: SparseUnivariatePolynomial(F))), + List(Record(integrand: F,intvar: F))) -> % mkAnswer(x, l, n) == [x, l, nesimp n] - timelog(r, lg) == [r * lg.scalar, lg.coeff, lg.logand] + timelog : (Q, LOG) -> LOG + timelog(r, lg) == [r * lg.scalar, lg.coeff, lg.logand] + integral : (F,F) -> % integral(f:F,x:F) == (zero? f => 0; mkAnswer(0, empty(), [[f, x]])) - timene(r, ne) == [Q2F(r) * ne.integrand, ne.intvar] + timene : (Q, NE) -> NE + timene(r, ne) == [Q2F(r) * ne.integrand, ne.intvar] - n:Z * u:% == (n::Q) * u + ?*? : (Integer,%) -> % + n:Z * u:% == (n::Q) * u - Q2F r == numer(r)::F / denom(r)::F + Q2F : Q -> F + Q2F r == numer(r)::F / denom(r)::F - neselect(l, x) == _+/[ne.integrand for ne in l | ne.intvar = x] + neselect: (List NE, F) -> F + neselect(l, x) == _+/[ne.integrand for ne in l | ne.intvar = x] if F has RetractableTo Symbol then + + integral : (F,Symbol) -> % integral(f:F, x:Symbol):% == integral(f, x::F) + LOG2O : LOG -> O LOG2O rec == (degree rec.coeff) = 1 => -- deg 1 minimal poly doesn't get sigma @@ -100781,6 +103414,7 @@ IntegrationResult(F:Field): Exports == Implementation where logandp := cc::O * logandp sum(logandp, coeffp) + nesimp : List NE -> List NE nesimp l == [[u,x] for x in removeDuplicates_!([ne.intvar for ne in l]$List(F)) | (u := neselect(l, x)) ^= 0] @@ -100788,6 +103422,7 @@ IntegrationResult(F:Field): Exports == Implementation where if (F has LiouvillianFunctionCategory) _ and (F has RetractableTo Symbol) then + retractIfCan : % -> Union(F,"failed") retractIfCan u == empty? logpart u => ratpart u + @@ -100797,34 +103432,42 @@ IntegrationResult(F:Field): Exports == Implementation where else + retractIfCan : % -> Union(F,"failed") retractIfCan u == elem? u and empty? logpart u => ratpart u "failed" + ?*? : (Fraction(Integer),%) -> % r:Q * u:% == r = 0 => 0 mkAnswer(Q2F(r) * ratpart u, map(x1+->timelog(r, x1), logpart u), map(x2+->timene(r, x2), notelem u)) -- Initial attempt, quick and dirty, no simplification + ?+? : (%,%) -> % u + v == mkAnswer(ratpart u + ratpart v, concat(logpart u, logpart v), nesimp concat(notelem u, notelem v)) if F has PartialDifferentialRing(Symbol) then + + differentiate : (%,Symbol) -> F differentiate(u:%, x:Symbol):F == differentiate(u, x1+->differentiate(x1, x)) + differentiate : (%,(F -> F)) -> F differentiate(u:%, derivation:F -> F):F == derivation ratpart u + _+/[pLogDeriv(log, derivation) for log in logpart u] + _+/[pNeDeriv(ne, derivation) for ne in notelem u] + pNeDeriv : (NE, F -> F) -> F pNeDeriv(ne, derivation) == (derivation(ne.intvar) = 1) => ne.integrand zero? derivation(ne.integrand) => 0 error "pNeDeriv: cannot differentiate not elementary part into F" + pLogDeriv: (LOG, F -> F) -> F pLogDeriv(log, derivation) == map(derivation, log.coeff) ^= 0 => error "pLogDeriv: can only handle logs with constant coefficients" @@ -100843,6 +103486,7 @@ IntegrationResult(F:Field): Exports == Implementation where ans := ans + coefficient(algans, i) Q2F(log.scalar) * ans + coerce : % -> OutputForm coerce(u:%):O == (r := retractIfCan u) case F => r::F::O l := reverse_! [LOG2O f for f in logpart u]$List(O) @@ -100851,6 +103495,7 @@ IntegrationResult(F:Field): Exports == Implementation where null l => 0::O reduce("+", l) + NE2O : NE -> O NE2O ne == int((ne.integrand)::O * hconcat ["d"::Symbol::O, (ne.intvar)::O]) @@ -101591,11 +104236,13 @@ Interval(R:Join(FloatingPointSystem,TranscendentalFunctionCategory)):_ Rep := Record(Inf:R, Sup:R) + roundDown : R -> R roundDown(u:R):R == if zero?(u) then float(-1,-(bits()@Integer)) else float(mantissa(u) - 1,exponent(u)) - roundUp(u:R):R == + roundUp : R -> R + roundUp(u:R):R == if zero?(u) then float(1, -(bits())@Integer) else float(mantissa(u) + 1,exponent(u)) @@ -101604,6 +104251,7 @@ Interval(R:Join(FloatingPointSystem,TranscendentalFunctionCategory)):_ -- your mantissa it is convenient to keep them exact). This function -- normalises things so that rounding etc. works as expected. It is only -- called when creating new intervals. + normaliseFloat : R -> R normaliseFloat(u:R):R == zero? u => u m : Integer := mantissa u @@ -101615,10 +104263,12 @@ Interval(R:Join(FloatingPointSystem,TranscendentalFunctionCategory)):_ else u + interval : (R,R) -> % interval(i:R,s:R):% == i > s => [roundDown normaliseFloat s,roundUp normaliseFloat i] [roundDown normaliseFloat i,roundUp normaliseFloat s] + interval : R -> % interval(f:R):% == zero?(f) => 0 one?(f) => 1 @@ -101630,27 +104280,38 @@ Interval(R:Join(FloatingPointSystem,TranscendentalFunctionCategory)):_ [roundDown fnew, roundUp fnew] [fnew,fnew] + qinterval : (R,R) -> % qinterval(i:R,s:R):% == [roundDown normaliseFloat i,roundUp normaliseFloat s] + exactInterval : (R,R) -> % exactInterval(i:R,s:R):% == [i,s] + exactSupInterval : (R,R) -> % exactSupInterval(i:R,s:R):% == [roundDown i,s] + exactInfInterval : (R,R) -> % exactInfInterval(i:R,s:R):% == [i,roundUp s] + inf : % -> R inf(u:%):R == u.Inf + sup : % -> R sup(u:%):R == u.Sup + width : % -> R width(u:%):R == u.Sup - u.Inf + contains? : (%,R) -> Boolean contains?(u:%,f:R):Boolean == (f > inf(u)) and (f < sup(u)) + positive? : % -> Boolean positive?(u:%):Boolean == inf(u) > 0 + negative? : % -> Boolean negative?(u:%):Boolean == sup(u) < 0 + ? Boolean _< (a:%,b:%):Boolean == if inf(a) < inf(b) then true @@ -101659,18 +104320,19 @@ Interval(R:Join(FloatingPointSystem,TranscendentalFunctionCategory)):_ else sup(a) < sup(b) + ?+? : (%,%) -> % _+ (a:%,b:%):% == -- A couple of blatent hacks to preserve the Ring Axioms! if zero?(a) then return(b) else if zero?(b) then return(a) if a = b then return qinterval(2*inf(a),2*sup(a)) qinterval(inf(a) + inf(b), sup(a) + sup(b)) - + ?-? : (%,%) -> % _- (a:%,b:%):% == if zero?(a) then return(-b) else if zero?(b) then return(a) if a = b then 0 else qinterval(inf(a) - sup(b), sup(a) - inf(b)) - + ?*? : (%,%) -> % _* (a:%,b:%):% == -- A couple of blatent hacks to preserve the Ring Axioms! if one?(a) then return(b) else if one?(b) then return(a) @@ -101679,6 +104341,7 @@ Interval(R:Join(FloatingPointSystem,TranscendentalFunctionCategory)):_ inf(a)*sup(b),sup(a)*inf(b)] qinterval(first prods, last prods) + ?*? : (Integer,%) -> % _* (a:Integer,b:%):% == if (a > 0) then qinterval(a*inf(b),a*sup(b)) @@ -101687,37 +104350,48 @@ Interval(R:Join(FloatingPointSystem,TranscendentalFunctionCategory)):_ else 0 + ?*? : (PositiveInteger,%) -> % _* (a:PositiveInteger,b:%):% == qinterval(a*inf(b),a*sup(b)) + ?**? : (%,PositiveInteger) -> % _*_* (a:%,n:PositiveInteger):% == contains?(a,0) and zero?((n@Integer) rem 2) => interval(0,max(inf(a)**n,sup(a)**n)) interval(inf(a)**n,sup(a)**n) + ?^? : (%,PositiveInteger) -> % _^ (a:%,n:PositiveInteger):% == contains?(a,0) and zero?((n@Integer) rem 2) => interval(0,max(inf(a)**n,sup(a)**n)) interval(inf(a)**n,sup(a)**n) + -? : % -> % _- (a:%):% == exactInterval(-sup(a),-inf(a)) + ?=? : (%,%) -> Boolean _= (a:%,b:%):Boolean == (inf(a)=inf(b)) and (sup(a)=sup(b)) + ?~=? : (%,%) -> Boolean _~_= (a:%,b:%):Boolean == (inf(a)~=inf(b)) or (sup(a)~=sup(b)) + 1 : () -> % 1 == one : R := normaliseFloat 1 [one,one] + 0 : () -> % 0 == [0,0] + recip : % -> Union(%,"failed") recip(u:%):Union(%,"failed") == contains?(u,0) => "failed" vals:List R := sort [1/inf(u),1/sup(u)]$List(R) qinterval(first vals, last vals) + unit? : % -> Boolean unit?(u:%):Boolean == contains?(u,0) + exquo : (%,%) -> Union(%,"failed") _exquo(u:%,v:%):Union(%,"failed") == contains?(v,0) => "failed" one?(v) => u @@ -101727,49 +104401,57 @@ Interval(R:Join(FloatingPointSystem,TranscendentalFunctionCategory)):_ sort [inf(u)/inf(v),inf(u)/sup(v),sup(u)/inf(v),sup(u)/sup(v)]$List(R) qinterval(first vals, last vals) + gcd : (%,%) -> % gcd(u:%,v:%):% == 1 + coerce : Integer -> % coerce(u:Integer):% == ur := normaliseFloat(u::R) exactInterval(ur,ur) - + interval : Fraction(Integer) -> % interval(u:Fraction Integer):% == flt := u::R - -- Test if the representation in R is exact --den := denom(u)::Float bin : Union(Integer,"failed") := retractIfCan(log2(denom(u)::Float)) bin case Integer and length(numer u)$Integer < (bits()@Integer) => flt := normaliseFloat flt exactInterval(flt,flt) - qinterval(flt,flt) + retractIfCan : % -> Union(Integer,"failed") retractIfCan(u:%):Union(Integer,"failed") == not zero? width(u) => "failed" retractIfCan inf u + retract : % -> Integer retract(u:%):Integer == not zero? width(u) => error "attempt to retract a non-Integer interval to an Integer" retract inf u + coerce : % -> OutputForm coerce(u:%):OutputForm == bracket([coerce inf(u), coerce sup(u)]$List(OutputForm)) + characteristic : () -> NonNegativeInteger characteristic():NonNegativeInteger == 0 -- Explicit export from TranscendentalFunctionCategory + pi : () -> % pi():% == qinterval(pi(),pi()) -- From ElementaryFunctionCategory + log : % -> % log(u:%):% == positive?(u) => qinterval(log inf u, log sup u) error "negative logs in interval" + exp : % -> % exp(u:%):% == qinterval(exp inf u, exp sup u) + ?**? : (%,%) -> % _*_* (u:%,v:%):% == zero?(v) => if zero?(u) then error "0**0 is undefined" else 1 one?(u) => 1 @@ -101781,21 +104463,23 @@ Interval(R:Join(FloatingPointSystem,TranscendentalFunctionCategory)):_ -- This function checks whether an interval contains a value of the form -- `offset + 2 n pi'. + hasTwoPiMultiple : (R,R,%) -> Boolean hasTwoPiMultiple(offset:R,ipi:R,i:%):Boolean == next : Integer := retract ceiling( (inf(i) - offset)/(2*ipi) ) contains?(i,offset+2*next*ipi) -- This function checks whether an interval contains a value of the form -- `offset + n pi'. + hasPiMultiple : (R,R,%) -> Boolean hasPiMultiple(offset:R,ipi:R,i:%):Boolean == next : Integer := retract ceiling( (inf(i) - offset)/ipi ) contains?(i,offset+next*ipi) + sin : % -> % sin(u:%):% == ipi : R := pi()$R hasOne? : Boolean := hasTwoPiMultiple(ipi/(2::R),ipi,u) hasMinusOne? : Boolean := hasTwoPiMultiple(3*ipi/(2::R),ipi,u) - if hasOne? and hasMinusOne? then exactInterval(-1,1) else @@ -101807,11 +104491,11 @@ Interval(R:Join(FloatingPointSystem,TranscendentalFunctionCategory)):_ else qinterval(first vals, last vals) + cos : % -> % cos(u:%):% == ipi : R := pi() hasOne? : Boolean := hasTwoPiMultiple(0,ipi,u) hasMinusOne? : Boolean := hasTwoPiMultiple(ipi,ipi,u) - if hasOne? and hasMinusOne? then exactInterval(-1,1) else @@ -101823,6 +104507,7 @@ Interval(R:Join(FloatingPointSystem,TranscendentalFunctionCategory)):_ else qinterval(first vals, last vals) + tan : % -> % tan(u:%):% == ipi : R := pi() if width(u) > ipi then @@ -101837,6 +104522,7 @@ Interval(R:Join(FloatingPointSystem,TranscendentalFunctionCategory)):_ lo > hi => error "Interval contains a singularity" qinterval(lo,hi) + csc : % -> % csc(u:%):% == ipi : R := pi() if width(u) > ipi then @@ -101853,6 +104539,7 @@ Interval(R:Join(FloatingPointSystem,TranscendentalFunctionCategory)):_ else qinterval(first vals, last vals) + sec : % -> % sec(u:%):% == ipi : R := pi() if width(u) > ipi then @@ -101870,6 +104557,7 @@ Interval(R:Join(FloatingPointSystem,TranscendentalFunctionCategory)):_ else qinterval(first vals, last vals) + cot : % -> % cot(u:%):% == ipi : R := pi() if width(u) > ipi then @@ -101880,30 +104568,32 @@ Interval(R:Join(FloatingPointSystem,TranscendentalFunctionCategory)):_ -- of the interval the user will see the error generated by R. hi : R := cot inf u lo : R := cot sup u - lo > hi => error "Interval contains a singularity" qinterval(lo,hi) -- From ArcTrigonometricFunctionCategory + asin : % -> % asin(u:%):% == lo : R := inf(u) hi : R := sup(u) if (lo < -1) or (hi > 1) then error "asin only defined on the region -1..1" qinterval(asin lo,asin hi) - + acos : % -> % acos(u:%):% == lo : R := inf(u) hi : R := sup(u) if (lo < -1) or (hi > 1) then error "acos only defined on the region -1..1" qinterval(acos hi,acos lo) - + atan : % -> % atan(u:%):% == qinterval(atan inf u, atan sup u) + acot : % -> % acot(u:%):% == qinterval(acot sup u, acot inf u) + acsc : % -> % acsc(u:%):% == lo : R := inf(u) hi : R := sup(u) @@ -101911,7 +104601,7 @@ Interval(R:Join(FloatingPointSystem,TranscendentalFunctionCategory)):_ error "acsc not defined on the region -1..1" qinterval(acsc hi, acsc lo) - + asec : % -> % asec(u:%):% == lo : R := inf(u) hi : R := sup(u) @@ -101919,44 +104609,46 @@ Interval(R:Join(FloatingPointSystem,TranscendentalFunctionCategory)):_ error "asec not defined on the region -1..1" qinterval(asec lo, asec hi) - -- From HyperbolicFunctionCategory + tanh : % -> % tanh(u:%):% == qinterval(tanh inf u, tanh sup u) + sinh : % -> % sinh(u:%):% == qinterval(sinh inf u, sinh sup u) + sech : % -> % sech(u:%):% == negative? u => qinterval(sech inf u, sech sup u) positive? u => qinterval(sech sup u, sech inf u) vals : List R := sort [sech inf u, sech sup u] exactSupInterval(first vals,1) - + cosh : % -> % cosh(u:%):% == negative? u => qinterval(cosh sup u, cosh inf u) positive? u => qinterval(cosh inf u, cosh sup u) vals : List R := sort [cosh inf u, cosh sup u] exactInfInterval(1,last vals) - + csch : % -> % csch(u:%):% == contains?(u,0) => error "csch: singularity at zero" qinterval(csch sup u, csch inf u) - + coth : % -> % coth(u:%):% == contains?(u,0) => error "coth: singularity at zero" qinterval(coth sup u, coth inf u) - -- From ArcHyperbolicFunctionCategory + acosh : % -> % acosh(u:%):% == inf(u)<1 => error "invalid argument: acosh only defined on the region 1.." qinterval(acosh inf u, acosh sup u) - + acoth : % -> % acoth(u:%):% == lo : R := inf(u) hi : R := sup(u) @@ -101964,12 +104656,12 @@ Interval(R:Join(FloatingPointSystem,TranscendentalFunctionCategory)):_ error "acoth not defined on the region -1..1" qinterval(acoth hi, acoth lo) - + acsch : % -> % acsch(u:%):% == contains?(u,0) => error "acsch: singularity at zero" qinterval(acsch sup u, acsch inf u) - + asech : % -> % asech(u:%):% == lo : R := inf(u) hi : R := sup(u) @@ -101977,18 +104669,19 @@ Interval(R:Join(FloatingPointSystem,TranscendentalFunctionCategory)):_ error "asech only defined on the region 0 < x <= 1" qinterval(asech hi, asech lo) - + asinh : % -> % asinh(u:%):% == qinterval(asinh inf u, asinh sup u) + atanh : % -> % atanh(u:%):% == lo : R := inf(u) hi : R := sup(u) if (lo <= -1) or (hi >= 1) then error "atanh only defined on the region -1 < x < 1" qinterval(atanh lo, atanh hi) - -- From RadicalCategory + ?**? : (%,Fraction(Integer)) -> % _*_* (u:%,n:Fraction Integer):% == interval(inf(u)**n,sup(u)**n) *) @@ -102538,49 +105231,60 @@ Kernel(S:OrderedSet): Exports == Implementation where Rep := Record(op:OP, arg:List S, nest:N, posit:N) clearCache() - - B2Z : Boolean -> Integer - triage: (%, %) -> Integer - preds : OP -> List Any - + + is? : (%,Symbol) -> Boolean is?(k:%, s:Symbol) == is?(operator k, s) - is?(k:%, o:OP) == (operator k) = o + is? : (%,BasicOperator) -> Boolean + is?(k:%, o:OP) == (operator k) = o - name k == name operator k + name : % -> Symbol + name k == name operator k - height k == k.nest + height : % -> NonNegativeInteger + height k == k.nest - operator k == k.op + operator : % -> BasicOperator + operator k == k.op - argument k == k.arg + argument : % -> List(S) + argument k == k.arg - position k == k.posit + position : % -> NonNegativeInteger + position k == k.posit + setPosition : (%,NonNegativeInteger) -> Void setPosition(k, n) == k.posit := n - B2Z flag == (flag => -1; 1) + B2Z : Boolean -> Integer + B2Z flag == (flag => -1; 1) - kernel s == kernel(assert(operator(s,0),SYMBOL), nil(), 1) + kernel : Symbol -> % + kernel s == kernel(assert(operator(s,0),SYMBOL), nil(), 1) + preds : OP -> List Any preds o == (u := property(o, PMPRED)) case "failed" => nil() (u::None) pretend List(Any) + symbolIfCan : % -> Union(Symbol,"failed") symbolIfCan k == has?(operator k, SYMBOL) => name operator k "failed" + ?=? : (%,%) -> Boolean k1 = k2 == if k1.posit = 0 then enterInCache(k1, triage) if k2.posit = 0 then enterInCache(k2, triage) k1.posit = k2.posit + ? Boolean k1 < k2 == if k1.posit = 0 then enterInCache(k1, triage) if k2.posit = 0 then enterInCache(k2, triage) k1.posit < k2.posit + kernel : (BasicOperator,List(S),NonNegativeInteger) -> % kernel(fn, x, n) == ((u := arity fn) case N) and (#x ^= u::N) => error "Wrong number of arguments" @@ -102589,6 +105293,7 @@ Kernel(S:OrderedSet): Exports == Implementation where -- SPECIALDISP contains a map List S -> OutputForm -- it is used when the converting the arguments first is not good, -- for instance with formal derivatives. + coerce : % -> OutputForm coerce(k:%):OutputForm == (v := symbolIfCan k) case Symbol => v::Symbol::OutputForm (f := property(o := operator k, SPECIALDISP)) case None => @@ -102597,6 +105302,7 @@ Kernel(S:OrderedSet): Exports == Implementation where (u := display o) case "failed" => prefix(name(o)::OutputForm, l) (u::(List OutputForm -> OutputForm)) l + triage: (%, %) -> Integer triage(k1, k2) == k1.nest ^= k2.nest => B2Z(k1.nest < k2.nest) k1.op ^= k2.op => B2Z(k1.op < k2.op) @@ -102608,6 +105314,8 @@ Kernel(S:OrderedSet): Exports == Implementation where 0 if S has ConvertibleTo InputForm then + + convert : % -> InputForm convert(k:%):InputForm == (v := symbolIfCan k) case Symbol => convert(v::Symbol)@InputForm (f := property(o := operator k, SPECIALINPUT)) case None => @@ -102618,6 +105326,8 @@ Kernel(S:OrderedSet): Exports == Implementation where (u::(List InputForm -> InputForm)) l if S has ConvertibleTo Pattern Integer then + + convert : % -> Pattern(Integer) convert(k:%):Pattern(Integer) == o := operator k (v := symbolIfCan k) case Symbol => @@ -102628,6 +105338,8 @@ Kernel(S:OrderedSet): Exports == Implementation where o [convert x for x in k.arg]$List(Pattern Integer) if S has ConvertibleTo Pattern Float then + + convert : % -> Pattern(Float) convert(k:%):Pattern(Float) == o := operator k (v := symbolIfCan k) case Symbol => @@ -103241,14 +105953,14 @@ KeyedAccessFile(Entry): KAFcategory == KAFcapsule where CLASS ==> 131 -- an arbitrary no. greater than 127 FileState ==> SExpression IOMode ==> String - - + Cons:= Record(car: SExpression, cdr: SExpression) Rep := Record(fileName: Name, _ fileState: FileState, _ fileIOmode: IOMode) - defstream(fn: Name, mode: IOMode): FileState == + defstream : (Name,IOMode) -> FileState + defstream(fn: Name, mode: IOMode): FileState == kafstring:=concat(fn::String,"/index.kaf")::FileName mode = "input" => not readable? kafstring => error ["File is not readable", fn] @@ -103260,17 +105972,21 @@ KeyedAccessFile(Entry): KAFcategory == KAFcapsule where ---- From Set ---- + ?=? : (%,%) -> Boolean f1 = f2 == f1.fileName = f2.fileName + coerce : % -> OutputForm coerce(f: %): OutputForm == f.fileName::OutputForm ---- From FileCategory ---- + open : FileName -> % open fname == open(fname, "either") + open : (FileName,String) -> % open(fname, mode) == mode = "either" => exists? fname => @@ -103280,6 +105996,7 @@ KeyedAccessFile(Entry): KAFcategory == KAFcapsule where error "File does not exist and cannot be created" [fname, defstream(fname, mode), mode] + reopen! : (%,String) -> % reopen_!(f, mode) == close_! f if mode ^= "closed" then @@ -103287,12 +106004,14 @@ KeyedAccessFile(Entry): KAFcategory == KAFcapsule where f.fileIOmode := mode f + close! : % -> % close_! f == if f.fileIOmode ^= "closed" then RSHUT(f.fileState)$Lisp f.fileIOmode := "closed" f + read! : % -> Record(key: String,entry: Entry) read_! f == f.fileIOmode ^= "input" => error ["File not in read state",f] ks: List Symbol := RKEYIDS(f.fileName)$Lisp @@ -103301,35 +106020,44 @@ KeyedAccessFile(Entry): KAFcategory == KAFcapsule where k: String := PNAME(ks.ix)$Lisp [k, SPADRREAD(k, f.fileState)$Lisp] + write! : (%,Record(key: String,entry: Entry)) -> + Record(key: String,entry: Entry) write_!(f, pr) == f.fileIOmode ^= "output" => error ["File not in write state",f] SPADRWRITE(pr.key, pr.entry, f.fileState)$Lisp pr + name : % -> FileName name f == f.fileName + iomode : % -> String iomode f == f.fileIOmode ---- From TableAggregate ---- + empty : () -> % empty() == fn := new("", "kaf", "sdata")$Name open fn + keys : % -> List(String) keys f == close_! f l: List SExpression := RKEYIDS(f.fileName)$Lisp [PNAME(n)$Lisp for n in l] + #? : % -> NonNegativeInteger # f == # keys f + ?.? : (%,String) -> Entry elt(f,k) == reopen_!(f, "input") SPADRREAD(k, f.fileState)$Lisp + setelt : (%,String,Entry) -> Entry setelt(f,k,e) == -- Leaves f in a safe, closed state. For speed use "write". reopen_!(f, "output") @@ -103337,11 +106065,13 @@ KeyedAccessFile(Entry): KAFcategory == KAFcapsule where close_! f e + search : (String,%) -> Union(Entry,"failed") search(k,f) == not member?(k, keys f) => "failed" -- can't trap RREAD error reopen_!(f, "input") (SPADRREAD(k, f.fileState)$Lisp)@Entry + remove! : (String,%) -> Union(Entry,"failed") remove_!(k:String,f:%) == result := search(k,f) result case "failed" => result @@ -103349,6 +106079,7 @@ KeyedAccessFile(Entry): KAFcategory == KAFcapsule where RDROPITEMS(NAMESTRING(f.fileName)$Lisp, LIST(k)$Lisp)$Lisp result + pack! : % -> % pack_! f == close_! f RPACKFILE(f.fileName)$Lisp @@ -103727,55 +106458,70 @@ LaurentPolynomial(R, UP): Exports == Implementation where Rep := Record(polypart: UP, order0: Z) - poly : % -> UP - check0 : (Z, UP) -> % - mkgpol : (Z, UP) -> % - gpol : (UP, Z) -> % - toutput: (R, Z, O) -> O - monTerm: (R, Z, O) -> O - - 0 == [0, 0] + 0 : () -> % + 0 == [0, 0] - 1 == [1, 0] + 1 : () -> % + 1 == [1, 0] - p = q == p.order0 = q.order0 and p.polypart = q.polypart + ?=? : (%,%) -> Boolean + p = q == p.order0 = q.order0 and p.polypart = q.polypart - poly p == p.polypart + poly : % -> UP + poly p == p.polypart - order p == p.order0 + order : % -> Integer + order p == p.order0 - gpol(p, n) == [p, n] + gpol : (UP, Z) -> % + gpol(p, n) == [p, n] - monomial(r, n) == check0(n, r::UP) + monomial : (R,Integer) -> % + monomial(r, n) == check0(n, r::UP) - coerce(p:UP):% == mkgpol(0, p) + coerce : UP -> % + coerce(p:UP):% == mkgpol(0, p) - reductum p == check0(order p, reductum poly p) + reductum : % -> % + reductum p == check0(order p, reductum poly p) - n:Z * p:% == check0(order p, n * poly p) + ?*? : (Integer,%) -> % + n:Z * p:% == check0(order p, n * poly p) + characteristic : () -> NonNegativeInteger characteristic() == characteristic()$R - coerce(n:Z):% == n::R::% + coerce : Integer -> % + coerce(n:Z):% == n::R::% - degree p == degree(poly p)::Z + order p + degree : % -> Integer + degree p == degree(poly p)::Z + order p - monomial? p == monomial? poly p + monomial? : % -> Boolean + monomial? p == monomial? poly p - coerce(r:R):% == gpol(r::UP, 0) + coerce : R -> % + coerce(r:R):% == gpol(r::UP, 0) + convert : % -> Fraction(UP) convert(p:%):RF == poly(p) * (monomial(1, 1)$UP)::RF ** order p - p:% * q:% == check0(order p + order q, poly p * poly q) + ?*? : (%,%) -> % + p:% * q:% == check0(order p + order q, poly p * poly q) - - p == gpol(- poly p, order p) + -? : % -> % + - p == gpol(- poly p, order p) - check0(n, p) == (zero? p => 0; gpol(p, n)) + check0 : (Z, UP) -> % + check0(n, p) == (zero? p => 0; gpol(p, n)) - trailingCoefficient p == coefficient(poly p, 0) + trailingCoefficient : % -> R + trailingCoefficient p == coefficient(poly p, 0) - leadingCoefficient p == leadingCoefficient poly p + leadingCoefficient : % -> R + leadingCoefficient p == leadingCoefficient poly p + coerce : % -> OutputForm coerce(p:%):O == zero? p => 0::Z::O l := nil()$List(O) @@ -103785,30 +106531,36 @@ LaurentPolynomial(R, UP): Exports == Implementation where p := reductum p reduce("+", l) + coefficient : (%,Integer) -> R coefficient(p, n) == (m := n - order p) < 0 => 0 coefficient(poly p, m::N) + differentiate : (%,(UP -> UP)) -> % differentiate(p:%, derivation:UP -> UP) == t := monomial(1, 1)$UP mkgpol(order(p) - 1, derivation(poly p) * t + order(p) * poly(p) * derivation t) + monTerm: (R, Z, O) -> O monTerm(r, n, v) == zero? n => r::O (n = 1) => v v ** (n::O) + toutput: (R, Z, O) -> O toutput(r, n, v) == mon := monTerm(r, n, v) zero? n or (r = 1) => mon r = -1 => - mon r::O * mon + recip : % -> Union(%,"failed") recip p == (q := recip poly p) case "failed" => "failed" gpol(q::UP, - order p) + ?+? : (%,%) -> % p + q == zero? q => p zero? p => q @@ -103817,27 +106569,33 @@ LaurentPolynomial(R, UP): Exports == Implementation where d < 0 => gpol(poly(p) + poly(q) * monomial(1, (-d)::N), order p) mkgpol(order p, poly(p) + poly q) + mkgpol : (Z, UP) -> % mkgpol(n, p) == zero? p => 0 d := order(p, monomial(1, 1)$UP) gpol((p exquo monomial(1, d))::UP, n + d::Z) + exquo : (%,%) -> Union(%,"failed") p exquo q == (r := poly(p) exquo poly q) case "failed" => "failed" check0(order p - order q, r::UP) + retractIfCan : % -> Union(UP,"failed") retractIfCan(p:%):Union(UP, "failed") == order(p) < 0 => error "Not retractable" poly(p) * monomial(1, order(p)::N)$UP + retractIfCan : % -> Union(R,"failed") retractIfCan(p:%):Union(R, "failed") == order(p) ^= 0 => "failed" retractIfCan poly p if R has Field then + gcd : (%,%) -> % gcd(p, q) == gcd(poly p, poly q)::% + separate : Fraction(UP) -> Record(polyPart: %,fracPart: Fraction(UP)) separate f == n := order(q := denom f, monomial(1, 1)) q := (q exquo (tn := monomial(1, n)$UP))::UP @@ -103847,13 +106605,16 @@ LaurentPolynomial(R, UP): Exports == Implementation where -- returns (z, r) s.t. p = q z + r, -- and degree(r) < degree(q), order(r) >= min(order(p), order(q)) + divide : (%,%) -> Record(quotient: %,remainder: %) divide(p, q) == c := min(order p, order q) qr := divide(poly(p) * monomial(1, (order p - c)::N)$UP, poly q) [mkgpol(c - order q, qr.quotient), mkgpol(c, qr.remainder)] + euclideanSize : % -> NonNegativeInteger euclideanSize p == degree poly p + extendedEuclidean : (%,%,%) -> Union(Record(coef1: %,coef2: %),"failed") extendedEuclidean(a, b, c) == (bc := extendedEuclidean(poly a, poly b, poly c)) case "failed" => "failed" @@ -104193,10 +106954,13 @@ Library(): TableAggregate(String, Any) with Rep := KeyedAccessFile(Any) + library : FileName -> % library f == open f + ?.? : (%,Symbol) -> Any elt(f:%,v:Symbol) == elt(f, string v) + setelt : (%,Symbol,Any) -> Any setelt(f:%, v:Symbol, val:Any) == setelt(f, string v, val) *) @@ -104638,11 +107402,9 @@ LieExponentials(VarSet, R, Order): XDPcat == XDPdef where Rep := PBWPOLY -- local functions - compareTerm1s: (TERM1, TERM1) -> Boolean - out: TERM1 -> EX - ident: (List TERM1, List TERM1) -> List EQ -- functions locales + ident: (List TERM1, List TERM1) -> List EQ ident(l1, l2) == import(TERM1) null l1 => [equation(0$R,t.c)$EQ for t in l2] @@ -104658,41 +107420,51 @@ LieExponentials(VarSet, R, Order): XDPcat == XDPdef where cons(equation(c1,0$R)$EQ , ident(rest l1, l2)) -- ordre lexico decroissant + compareTerm1s: (TERM1, TERM1) -> Boolean compareTerm1s(u:TERM1, v:TERM1):Boolean == lexico(v.k, u.k)$LWORD + out: TERM1 -> EX out(t:TERM1):EX == t.c =$R 1 => char("e")$Character :: EX ** t.k ::EX char("e")$Character :: EX ** (t.c::EX * t.k::EX) -- definitions + identification : (%,%) -> List(Equation(R)) identification(x,y) == l1: List TERM1 := LyndonCoordinates x l2: List TERM1 := LyndonCoordinates y ident(l1, l2) + LyndonCoordinates : % -> List(Record(k: LyndonWord(VarSet),c: R)) LyndonCoordinates x == lt: List TERM1 := [[l::LWORD, t.c]$TERM1 for t in listOfTerms x | _ (l := retractIfCan(t.k)$BASIS) case LWORD ] lt := sort(compareTerm1s,lt) + ?*? : (%,%) -> % x:$ * y:$ == product(x::Rep, y::Rep, Order::I::NNI)$Rep + exp : LiePolynomial(VarSet,R) -> % exp p == exp(p::Rep , Order::I::NNI)$Rep + log : % -> LiePolynomial(VarSet,R) log p == LiePolyIfCan(log(p,Order::I::NNI))$Rep :: LPOLY + coerce : % -> OutputForm coerce(p:$):EX == p = 1$$ => 1$R :: EX lt : List TERM1 := LyndonCoordinates p reduce(_*, [out t for t in lt])$List(EX) - + LyndonBasis : List(VarSet) -> List(LiePolynomial(VarSet,R)) LyndonBasis(lv) == [LiePoly(l)$LPOLY for l in LyndonWordsList(lv,Order)$LWORD] + coerce : % -> XPBWPolynomial(VarSet,R) coerce(p:$):PBWPOLY == p::Rep + inv : % -> % inv x == x = 1 => 1 lt:LTERMS := listOfTerms mirror x @@ -105403,21 +108175,8 @@ LiePolynomial(VarSet:OrderedSet, R:CommutativeRing) : Public == Private where --representation Rep := List TERM - -- fonctions locales - cr1 : (LWORD, $ ) -> $ - cr2 : ($, LWORD ) -> $ - crw : (LWORD, LWORD) -> $ -- crochet de 2 mots de Lyndon - DPoly: LWORD -> XDPOLY - lquo1: (XRPOLY , LWORD) -> XRPOLY - lyndon: (LWORD, LWORD) -> $ - makeLyndon: (LWORD, LWORD) -> LWORD - rquo1: (XRPOLY , LWORD) -> XRPOLY - RPoly: LWORD -> XRPOLY - eval1: (LWORD, VarSet, $) -> $ -- 08/03/98 - eval2: (LWORD, List VarSet, List $) -> $ -- 08/03/98 - - -- Evaluation + eval1: (LWORD, VarSet, $) -> $ -- 08/03/98 eval1(lw,v,nv) == -- 08/03/98 not member?(v, varList(lw)$LWORD) => LiePoly lw (s := retractIfCan(lw)$LWORD) case VarSet => @@ -105426,6 +108185,7 @@ LiePolynomial(VarSet:OrderedSet, R:CommutativeRing) : Public == Private where r: LWORD := right lw construct(eval1(l,v,nv), eval1(r,v,nv)) + eval2: (LWORD, List VarSet, List $) -> $ -- 08/03/98 eval2(lw,lv,lnv) == -- 08/03/98 p: Integer (s := retractIfCan(lw)$LWORD) case VarSet => @@ -105435,31 +108195,41 @@ LiePolynomial(VarSet:OrderedSet, R:CommutativeRing) : Public == Private where r: LWORD := right lw construct(eval2(l,lv,lnv), eval2(r,lv,lnv)) + eval : (%,VarSet,%) -> % eval(p:$, v: VarSet, nv: $): $ == -- 08/03/98 +/ [t.c * eval1(t.k, v, nv) for t in p] + eval : (%,List(VarSet),List(%)) -> % eval(p:$, lv: List(VarSet), lnv: List($)): $ == -- 08/03/98 +/ [t.c * eval2(t.k, lv, lnv) for t in p] + lquo1: (XRPOLY , LWORD) -> XRPOLY lquo1(p,lw) == constant? p => 0$XRPOLY retractable? lw => lquo(p, retract lw)$XRPOLY lquo1(lquo1(p, left lw),right lw) - lquo1(lquo1(p, right lw),left lw) + rquo1: (XRPOLY , LWORD) -> XRPOLY rquo1(p,lw) == constant? p => 0$XRPOLY retractable? lw => rquo(p, retract lw)$XRPOLY rquo1(rquo1(p, left lw),right lw) - rquo1(rquo1(p, right lw),left lw) + coef : (XRecursivePolynomial(VarSet,R),%) -> R coef(p, lp) == coef(p, lp::XRPOLY)$XRPOLY + lquo : (XRecursivePolynomial(VarSet,R),%) -> + XRecursivePolynomial(VarSet,R) lquo(p, lp) == lp = 0 => 0$XRPOLY +/ [t.c * lquo1(p,t.k) for t in lp] + rquo : (XRecursivePolynomial(VarSet,R),%) -> + XRecursivePolynomial(VarSet,R) rquo(p, lp) == lp = 0 => 0$XRPOLY +/ [t.c * rquo1(p,t.k) for t in lp] + LiePolyIfCan : XDistributedPolynomial(VarSet,R) -> Union(%,"failed") LiePolyIfCan p == -- inefficace a cause de la rep. de XDPOLY not quasiRegular? p => "failed" p1: XDPOLY := p ; r:$ := 0 @@ -105474,13 +108244,16 @@ LiePolynomial(VarSet:OrderedSet, R:CommutativeRing) : Public == Private where --definitions locales + makeLyndon: (LWORD, LWORD) -> LWORD makeLyndon(u,v) == (u::MAGMA * v::MAGMA) pretend LWORD + crw : (LWORD, LWORD) -> $ -- crochet de 2 mots de Lyndon crw(u,v) == -- u et v sont des mots de Lyndon u = v => 0 lexico(u,v) => lyndon(u,v) - lyndon (v,u) + lyndon: (LWORD, LWORD) -> $ lyndon(u,v) == -- u et v sont des mots de Lyndon tq u < v retractable? u => monom(makeLyndon(u,v),1) u1: LWORD := left u @@ -105488,18 +108261,22 @@ LiePolynomial(VarSet:OrderedSet, R:CommutativeRing) : Public == Private where lexico(u2,v) => cr1(u1, lyndon(u2,v)) + cr2(lyndon(u1,v), u2) monom(makeLyndon(u,v),1) + cr1 : (LWORD, $ ) -> $ cr1 (l, p) == +/[t.c * crw(l, t.k) for t in p] + cr2 : ($, LWORD ) -> $ cr2 (p, l) == +/[t.c * crw(t.k, l) for t in p] + DPoly: LWORD -> XDPOLY DPoly w == retractable? w => retract(w) :: XDPOLY l:XDPOLY := DPoly left w r:XDPOLY := DPoly right w l*r - r*l + RPoly: LWORD -> XRPOLY RPoly w == retractable? w => retract(w) :: XRPOLY l:XRPOLY := RPoly left w @@ -105508,36 +108285,48 @@ LiePolynomial(VarSet:OrderedSet, R:CommutativeRing) : Public == Private where -- definitions + coerce : VarSet -> % coerce(v:VarSet) == monom(v::LWORD , 1) + construct : (%,%) -> % construct(x:$ , y:$):$ == +/[t.c * cr1(t.k, y) for t in x] + construct : (LyndonWord(VarSet),%) -> % construct(l:LWORD , p:$):$ == cr1(l,p) + construct : (%,LyndonWord(VarSet)) -> % construct(p:$ , l:LWORD):$ == cr2(p,l) + construct : (LyndonWord(VarSet),LyndonWord(VarSet)) -> % construct(u:LWORD , v:LWORD):$ == crw(u,v) + coerce : % -> XDistributedPolynomial(VarSet,R) coerce(p:$):XDPOLY == +/ [t.c * DPoly(t.k) for t in p] + coerce : % -> XRecursivePolynomial(VarSet,R) coerce(p:$):XRPOLY == +/ [t.c * RPoly(t.k) for t in p] + LiePoly : LyndonWord(VarSet) -> % LiePoly(l) == monom(l,1) + varList : % -> List(VarSet) varList p == le : List VarSet := "setUnion"/[varList(t.k)$LWORD for t in p] sort(le)$List(VarSet) + mirror : % -> % mirror p == [[t.k, (odd? length t.k => t.c; -t.c)]$TERM for t in p] + trunc : (%,NonNegativeInteger) -> % trunc(p, n) == degree(p) > n => trunc( reductum p , n) p + degree : % -> NonNegativeInteger degree p == null p => 0 length( p.first.k)$LWORD @@ -105944,7 +108733,6 @@ LieSquareMatrix(n,R): Exports == Implementation where -- local functions n2 : PositiveInteger := n*n - convDM : DirectProduct(n2,R) -> % --++ converts n2-vector to (n,n)-matrix row by row conv : DirectProduct(n2,R) -> SquareMatrix(n,R) @@ -105957,6 +108745,7 @@ LieSquareMatrix(n,R): Exports == Implementation where setelt(cond,i,j,v.z) squareMatrix(cond)$SquareMatrix(n, R) + coordinates : (%,Vector(%)) -> Vector(R) coordinates(a:%,b:Vector(%)):Vector(R) == -- only valid for b canonicalBasis res : Vector R := new(n2,0$R) @@ -105967,10 +108756,12 @@ LieSquareMatrix(n,R): Exports == Implementation where res.z := elt(a,i,j)$% res + convDM : DirectProduct(n2,R) -> % convDM v == sq := conv v coerce(sq)$Rep :: % + basis : () -> Vector(%) basis() == n2 : PositiveInteger := n*n ldp : List DirectProduct(n2,R) := @@ -105978,8 +108769,10 @@ LieSquareMatrix(n,R): Exports == Implementation where res:Vector % := vector map(convDM,_ ldp)$ListFunctions2(DirectProduct(n2,R), %) + someBasis : () -> Vector(%) someBasis() == basis() + rank : () -> PositiveInteger rank() == n*n @@ -106658,19 +109451,24 @@ LinearOrdinaryDifferentialOperator(A:Ring, diff: A -> A): outputD := "D"@String :: Symbol :: OutputForm + coerce : % -> OutputForm coerce(l:%):OutputForm == outputForm(l, outputD) - elt(p:%, a:A):A == apply(p, 0, a) + ?*? : (%,A) -> % + elt(p:%, a:A):A == apply(p, 0, a) if A has Field then import LinearOrdinaryDifferentialOperatorsOps(A, %) + symmetricProduct : (%,%) -> % symmetricProduct(a, b) == symmetricProduct(a, b, diff) + symmetricPower : (%,NonNegativeInteger) -> % symmetricPower(a, n) == symmetricPower(a, n, diff) - directSum(a, b) == directSum(a, b, diff) + directSum : (%,%) -> % + directSum(a, b) == directSum(a, b, diff) *) @@ -107924,6 +110722,7 @@ LinearOrdinaryDifferentialOperator2(A, M): Exports == Implementation where (* domain LODO2 *) (* + ?.? : (%,M) -> M elt(p:%, m:M):M == apply(p, differentiate, m)$ApplyUnivariateSkewPolynomial(A, M, %) @@ -109256,66 +112055,85 @@ ListMonoidOps(S, E, un): Exports == Implementation where Rep := List REC - localplus: ($, $) -> $ - - makeUnit() == empty()$Rep + makeUnit : () -> % + makeUnit() == empty()$Rep - size l == # listOfMonoms l + size : % -> NonNegativeInteger + size l == # listOfMonoms l - coerce(s:S):$ == [[s, un]] + coerce : S -> % + coerce(s:S):$ == [[s, un]] - coerce(l:$):O == coerce(l)$Rep + coerce : % -> OutputForm + coerce(l:$):O == coerce(l)$Rep - makeTerm(s, e) == (zero? e => makeUnit(); [[s, e]]) + makeTerm : (S,E) -> % + makeTerm(s, e) == (zero? e => makeUnit(); [[s, e]]) - makeMulti l == l + makeMulti : List(Record(gen: S,exp: E)) -> % + makeMulti l == l - f = g == f =$Rep g + ?=? : (%,%) -> Boolean + f = g == f =$Rep g + listOfMonoms : % -> List(Record(gen: S,exp: E)) listOfMonoms l == l pretend List(REC) + nthExpon : (%,Integer) -> E nthExpon(f, i) == f.(i-1+minIndex f).exp + nthFactor : (%,Integer) -> S nthFactor(f, i) == f.(i-1+minIndex f).gen - reverse l == reverse(l)$Rep + reverse : % -> % + reverse l == reverse(l)$Rep - reverse_! l == reverse_!(l)$Rep + reverse! : % -> % + reverse_! l == reverse_!(l)$Rep - mapGen(f, l) == [[f(x.gen), x.exp] for x in l] + mapGen : ((S -> S),%) -> % + mapGen(f, l) == [[f(x.gen), x.exp] for x in l] + mapExpon : ((E -> E),%) -> % mapExpon(f, l) == ans:List(REC) := empty() for x in l repeat if (a := f(x.exp)) ^= 0 then ans := concat([x.gen, a], ans) reverse_! ans + outputForm : (%,((OutputForm,OutputForm) -> OutputForm), + ((OutputForm,OutputForm) -> OutputForm),Integer) -> OutputForm outputForm(l, op, opexp, id) == empty? l => id::OutputForm l:List(O) := [(p.exp = un => p.gen::O; opexp(p.gen::O, p.exp::O)) for p in l] reduce(op, l) + retractIfCan : % -> Union(S,"failed") retractIfCan(l:$):Union(S, "failed") == not empty? l and empty? rest l and l.first.exp = un => l.first.gen "failed" + rightMult : (%,S) -> % rightMult(f, s) == empty? f => s::$ s = f.last.gen => (setlast_!(h := copy f, [s, f.last.exp + un]); h) concat(f, [s, un]) + leftMult : (S,%) -> % leftMult(s, f) == empty? f => s::$ s = f.first.gen => concat([s, f.first.exp + un], rest f) concat([s, un], f) + commutativeEquality : (%,%) -> Boolean commutativeEquality(s1:$, s2:$):Boolean == #s1 ^= #s2 => false for t1 in s1 repeat if not member?(t1,s2) then return false true + plus_! : (S,E,$) -> $ plus_!(s:S, n:E, f:$):$ == h := g := concat([s, n], f) h1 := rest h @@ -109330,12 +112148,15 @@ ListMonoidOps(S, E, un): Exports == Implementation where h1 := rest h1 g + plus : (S,E,%) -> % plus(s, n, f) == plus_!(s,n,copy f) + plus : (%,%) -> % plus(f, g) == #f < #g => localplus(f, g) localplus(g, f) + localplus: ($, $) -> $ localplus(f, g) == g := copy g for x in f repeat @@ -109646,23 +112467,29 @@ ListMultiDictionary(S:SetCategory): EE == II where Rep := Reference List S - sub: (S, S, S) -> S - + coerce : % -> OutputForm coerce(s:%):OutputForm == prefix("dictionary"::OutputForm, [x::OutputForm for x in parts s]) - #s == # parts s + #? : % -> NonNegativeInteger + #s == # parts s - copy s == dictionary copy parts s + copy : % -> % + copy s == dictionary copy parts s - empty? s == empty? parts s + empty? : % -> Boolean + empty? s == empty? parts s - bag l == dictionary l + bag : List(S) -> % + bag l == dictionary l - dictionary() == dictionary empty() + dictionary : () -> % + dictionary() == dictionary empty() + empty : () -> % empty():% == ref empty() + dictionary : List(S) -> % dictionary(ls:List S):% == empty? ls => empty() lmd := empty() @@ -109670,34 +112497,46 @@ ListMultiDictionary(S:SetCategory): EE == II where lmd if S has ConvertibleTo InputForm then + + convert : % -> InputForm convert(lmd:%):InputForm == convert [convert("dictionary"::Symbol)@InputForm, convert(parts lmd)@InputForm] - map(f, s) == dictionary map(f, parts s) + map : ((S -> S),%) -> % + map(f, s) == dictionary map(f, parts s) - map_!(f, s) == dictionary map_!(f, parts s) + map! : ((S -> S),%) -> % + map_!(f, s) == dictionary map_!(f, parts s) - parts s == deref s + parts : % -> List(S) + parts s == deref s + sub: (S, S, S) -> S sub(x, y, z) == (z = x => y; z) + insert! : (S,%,NonNegativeInteger) -> % insert_!(x, s, n) == (for i in 1..n repeat insert_!(x, s); s) + substitute : (S,S,%) -> % substitute(x, y, s) == dictionary map(z1 +-> sub(x, y, z1), parts s) + removeDuplicates! : % -> % removeDuplicates_! s == dictionary removeDuplicates_! parts s + inspect : % -> S inspect s == empty? s => error "empty dictionary" first parts s + extract! : % -> S extract_! s == empty? s => error "empty dictionary" x := first(p := parts s) setref(s, rest p) x + duplicates? : % -> Boolean duplicates? s == empty?(p := parts s) => false q := rest p @@ -109707,12 +112546,15 @@ ListMultiDictionary(S:SetCategory): EE == II where q := rest q false + remove! : ((S -> Boolean),%) -> % remove_!(p: S->Boolean, lmd:%):% == for x in removeDuplicates parts lmd | p(x) repeat remove_!(x,lmd) lmd + select! : ((S -> Boolean),%) -> % select_!(p: S->Boolean, lmd:%):% == remove_!((z:S):Boolean+->not p(z), lmd) + duplicates : % -> List(Record(entry: S,count: NonNegativeInteger)) duplicates(lmd:%):List D == ld: List D := empty() for x in removeDuplicates parts lmd | (n := count(x, lmd)) > @@ -109722,8 +112564,10 @@ ListMultiDictionary(S:SetCategory): EE == II where if S has OrderedSet then + ?=? : (%,%) -> Boolean s = t == parts s = parts t + remove! : (S,%) -> % remove_!(x:S, s:%) == p := deref s while not empty? p and x = first p repeat p := rest p @@ -109735,6 +112579,7 @@ ListMultiDictionary(S:SetCategory): EE == II where p.rest := q s + insert! : (S,%) -> % insert_!(x, s) == p := deref s empty? p or x < first p => @@ -109747,8 +112592,10 @@ ListMultiDictionary(S:SetCategory): EE == II where else + remove! : (S,%) -> % remove_!(x:S, s:%) == (setref(s, remove_!(x, parts s)); s) + ?=? : (%,%) -> Boolean s = t == a := copy s while not empty? a repeat @@ -109757,6 +112604,7 @@ ListMultiDictionary(S:SetCategory): EE == II where remove_!(x, a) true + insert! : (S,%) -> % insert_!(x, s) == p := deref s while not empty? p repeat @@ -109918,10 +112766,13 @@ LocalAlgebra(A: Algebra R, (* Localize(A, R, S) add + 1 : () -> % 1 == 1$A / 1$S + ?*? : (%,%) -> % x:% * y:% == (numer(x) * numer(y)) / (denom(x) * denom(y)) + characteristic : () -> NonNegativeInteger characteristic() == characteristic()$A *) @@ -110115,39 +112966,53 @@ Localize(M:Module R, --definitions + 0 : () -> % 0 == [0,1] + zero? : % -> Boolean zero? x == zero? (x.num) + -? : % -> % -x== [-x.num,x.den] + ?=? : (%,%) -> Boolean x=y == y.den*x.num = x.den*y.num + numer : % -> M numer x == x.num + denom : % -> S denom x == x.den if M has OrderedAbelianGroup then + ? Boolean x < y == y.den*x.num < x.den*y.num + ?+? : (%,%) -> % x+y == [y.den*x.num+x.den*y.num, x.den*y.den] + ?*? : (Integer,%) -> % n*x == [n*x.num,x.den] + ?*? : (R,%) -> % r*x == if r=x.den then [x.num,1] else [r*x.num,x.den] + ?/? : (%,S) -> % x/d == zero?(u:S:=d*x.den) => error "division by zero" [x.num,u] + ?/? : (M,S) -> % m/d == if zero? d then error "division by zero" else [m,d] + coerce : % -> OutputForm coerce(x:%):OutputForm == ((xd:=x.den) = 1) => (x.num)::OutputForm (x.num)::OutputForm / (xd::OutputForm) + latex : % -> String latex(x:%): String == ((xd:=x.den) = 1) => latex(x.num) nl : String := concat("{", concat(latex(x.num), "}")$String)$String @@ -110740,17 +113605,9 @@ LyndonWord(VarSet:OrderedSet):Public == Private where (* Magma(VarSet) add - -- Representation - Rep:= Magma(VarSet) - -- Fonctions locales - - LetterList : OFMON -> List VarSet - factor1 : (List $, $, List $) -> List $ - - -- Definitions - + lyndon? : OrderedFreeMonoid(VarSet) -> Boolean lyndon? w == w = 1$OFMON => false f: OFMON := rest w @@ -110759,20 +113616,24 @@ LyndonWord(VarSet:OrderedSet):Public == Private where f := rest f true + lyndonIfCan : OrderedFreeMonoid(VarSet) -> Union(%,"failed") lyndonIfCan w == l: List $ := factor w # l = 1 => first l "failed" + lyndon : OrderedFreeMonoid(VarSet) -> % lyndon w == l: List $ := factor w # l = 1 => first l error "This word is not a Lyndon word" + LetterList : OFMON -> List VarSet LetterList w == w = 1 => [] cons(first w , LetterList rest w) + factor1 : (List $, $, List $) -> List $ factor1 (gauche, x, droite) == g: List $ := gauche; d: List $ := droite while not null g repeat ++ (l in g or l=x) et u in d @@ -110787,36 +113648,39 @@ LyndonWord(VarSet:OrderedSet):Public == Private where g := rest g return cons(x, d) + factor : OrderedFreeMonoid(VarSet) -> List(%) factor w == w = 1 => [] l : List $ := reverse [ u::$ for u in LetterList w] factor1( rest l, first l , [] ) + ? Boolean x < y == -- lexicographique par longueur lx,ly: PI lx:= length x ; ly:= length y lx = ly => lexico(x,y) lx < ly + coerce : % -> OutputForm coerce(x:$):OF == bracket(x::OFMON::OF) + coerce : % -> Magma(VarSet) coerce(x:$):Magma VarSet == x::Rep + LyndonWordsList1 : (List(VarSet),PositiveInteger) -> + OneDimensionalArray(List(%)) LyndonWordsList1 (vl,n) == -- a ameliorer !!!!!!!!!!! null vl => error "empty list" base: ARRAY1 List $ := new(n::I::NNI ,[]) - -- mots de longueur 1 lbase1:List $ := [w::$ for w in sort(vl)] base.1 := lbase1 - -- calcul des mots de longueur ll for ll in 2..n:I repeat lbase1 := [] for a in base(1) repeat -- lettre + mot for b in base(ll-1) repeat if lexico(a,b) then lbase1:=cons(a*b,lbase1) - for i in 2..ll-1 repeat -- mot + mot for a in base(i) repeat for b in base(ll-i) repeat @@ -110826,6 +113690,7 @@ LyndonWord(VarSet:OrderedSet):Public == Private where base(ll):= sort_!(lexico, lbase1) return base + LyndonWordsList : (List(VarSet),PositiveInteger) -> List(%) LyndonWordsList (vl,n) == v:ARRAY1 List $ := LyndonWordsList1(vl,n) "append"/ [v.i for i in 1..n] @@ -111257,18 +114122,23 @@ MachineComplex():Exports == Implementation where (* Complex MachineFloat add + coerce : Complex(Float) -> % coerce(u:Complex Float):$ == complex(real(u)::MachineFloat,imag(u)::MachineFloat) + coerce : Complex(Integer) -> % coerce(u:Complex Integer):$ == complex(real(u)::MachineFloat,imag(u)::MachineFloat) + coerce : Complex(MachineInteger) -> % coerce(u:Complex MachineInteger):$ == complex(real(u)::MachineFloat,imag(u)::MachineFloat) + coerce : Complex(MachineFloat) -> % coerce(u:Complex MachineFloat):$ == complex(real(u),imag(u)) + coerce : % -> Complex(Float) coerce(u:$):Complex Float == complex(real(u)::Float,imag(u)::Float) @@ -111793,20 +114663,15 @@ MachineFloat(): Exports == Implementation where EMIN : I := -1021 -- Minimum Exponent EMAX : I := 1024 -- Maximum Exponent - -- Useful constants POWER : PI := 53 -- The maximum power of B which will yield P -- decimal digits. MMAX : PI := B**POWER - -- locals - locRound:(FI)->I - checkExponent:($)->$ - normalise:($)->$ - newPower:(PI,PI)->Void - + retractIfCan : % -> Union(Fraction(Integer),"failed") retractIfCan(u:$):Union(FI,"failed") == mantissa(u)*(B/1)**(exponent(u)) + wholePart : % -> Integer wholePart(u:$):Integer == man:I:=mantissa u exp:I:=exponent u @@ -111815,6 +114680,7 @@ MachineFloat(): Exports == Implementation where zero? exp => man wholePart(man/B**((-exp) pretend PI)) + normalise:($)->$ normalise(u:$):$ == -- We want the largest possible mantissa, to ensure a canonical -- representation. @@ -111837,10 +114703,13 @@ MachineFloat(): Exports == Implementation where positive?(sgn) => checkExponent [man,exp]$Rep checkExponent [-man,exp]$Rep + mantissa : % -> Integer mantissa(u:$):I == elt(u,mantissa)$Rep + exponent : % -> Integer exponent(u:$):I == elt(u,exponent)$Rep + newPower:(PI,PI)->Void newPower(base:PI,prec:PI):Void == power : PI := 1 target : PI := 10**prec @@ -111850,6 +114719,7 @@ MachineFloat(): Exports == Implementation where MMAX := B**POWER void() + changeBase : (Integer,Integer,PositiveInteger) -> % changeBase(exp:I,man:I,base:PI):$ == newExp : I := 0 f : FI := man*(base @ I)::FI**exp @@ -111870,6 +114740,7 @@ MachineFloat(): Exports == Implementation where newMan := wholePart f [sign*newMan,newExp]$Rep + checkExponent:($)->$ checkExponent(u:$):$ == exponent(u) < EMIN or exponent(u) > EMAX => message :S := concat(["Exponent out of range: ", @@ -111877,100 +114748,127 @@ MachineFloat(): Exports == Implementation where error message u + coerce : % -> OutputForm coerce(u:$):OutputForm == coerce(u::F) + coerce : MachineInteger -> % coerce(u:MachineInteger):$ == checkExponent changeBase(0,retract(u)@Integer,10) + coerce : % -> Float coerce(u:$):F == oldDigits : PI := digits(P)$F r : F := float(mantissa u,exponent u,B)$Float digits(oldDigits)$F r + coerce : Float -> % coerce(u:F):$ == checkExponent changeBase(exponent(u)$F,mantissa(u)$F,base()$F) + coerce : Integer -> % coerce(u:I):$ == checkExponent changeBase(0,u,10) + coerce : Fraction(Integer) -> % coerce(u:FI):$ == (numer u)::$/(denom u)::$ + retract : % -> Fraction(Integer) retract(u:$):FI == value : Union(FI,"failed") := retractIfCan(u) value case "failed" => error "Cannot retract to a Fraction Integer" value::FI + retract : % -> Float retract(u:$):F == u::F + retractIfCan : % -> Union(Float,"failed") retractIfCan(u:$):Union(F,"failed") == u::F::Union(F,"failed") + retractIfCan : % -> Union(Integer,"failed") retractIfCan(u:$):Union(I,"failed") == value:FI := mantissa(u)*(B @ I)::FI**exponent(u) zero? fractionPart(value) => wholePart(value)::Union(I,"failed") "failed"::Union(I,"failed") + retract : % -> Integer retract(u:$):I == result : Union(I,"failed") := retractIfCan u result = "failed" => error "Not an Integer" result::I + precision : PositiveInteger -> PositiveInteger precision(p: PI):PI == old : PI := P newPower(B,p) P := p old + precision : () -> PositiveInteger precision():PI == P + base : PositiveInteger -> PositiveInteger base(b:PI):PI == old : PI := b newPower(b,P) B := b old + base : () -> PositiveInteger base():PI == B + maximumExponent : Integer -> Integer maximumExponent(u:I):I == old : I := EMAX EMAX := u old + maximumExponent : () -> Integer maximumExponent():I == EMAX + minimumExponent : Integer -> Integer minimumExponent(u:I):I == old : I := EMIN EMIN := u old + minimumExponent : () -> Integer minimumExponent():I == EMIN + 0 : () -> % 0 == [0,0]$Rep + 1 : () -> % 1 == changeBase(0,1,10) + zero? : % -> Boolean zero?(u:$):Boolean == u=[0,0]$Rep f1:$ f2:$ + locRound:(FI)->I locRound(x:FI):I == abs(fractionPart(x)) >= 1/2 => wholePart(x)+sign(x) wholePart(x) + recip : % -> Union(%,"failed") recip f1 == zero? f1 => "failed" normalise [ locRound(B**(2*POWER)/mantissa f1),-(exponent f1 + 2*POWER)] + ?*? : (%,%) -> % f1 * f2 == normalise [mantissa(f1)*mantissa(f2),exponent(f1)+exponent(f2)]$Rep + ?**? : (%,PositiveInteger) -> % f1 **(p:FI) == ((f1::F)**p)::% --inline + ?/? : (%,%) -> % f1 / f2 == zero? f2 => error "division by zero" zero? f1 => 0 @@ -111978,21 +114876,29 @@ MachineFloat(): Exports == Implementation where normalise [locRound(mantissa(f1)*B**(2*POWER)/mantissa(f2)), exponent(f1)-(exponent f2 + 2*POWER)] + inv : % -> % inv(f1) == 1/f1 + exquo : (%,%) -> Union(%,"failed") f1 exquo f2 == f1/f2 + divide : (%,%) -> Record(quotient: %,remainder: %) divide(f1,f2) == [ f1/f2,0] + ?quo? : (%,%) -> % f1 quo f2 == f1/f2 + ?rem? : (%,%) -> % f1 rem f2 == 0 + ?*? : (Integer,%) -> % u:I * f1 == normalise [u*mantissa(f1),exponent(f1)]$Rep + ?=? : (%,%) -> Boolean f1 = f2 == mantissa(f1)=mantissa(f2) and exponent(f1)=exponent(f2) + ?+? : (%,%) -> % f1 + f2 == m1 : I := mantissa f1 m2 : I := mantissa f2 @@ -112009,10 +114915,13 @@ MachineFloat(): Exports == Implementation where f2 normalise [m2*(B @ I)**((e2-e1) pretend NNI)+m1,e1]$Rep + -? : % -> % - f1 == [- mantissa f1,exponent f1]$Rep + ?-? : (%,%) -> % f1 - f2 == f1 + (-f2) + ? Boolean f1 < f2 == m1 : I := mantissa f1 m2 : I := mantissa f2 @@ -112026,6 +114935,7 @@ MachineFloat(): Exports == Implementation where sign(m1) = 0 and sign(m2) = -1 => false true + characteristic : () -> NonNegativeInteger characteristic():NNI == 0 *) @@ -112288,16 +115198,20 @@ MachineInteger(): Exports == Implementation where MAXINT : PositiveInteger := 2**32 + maxint : () -> PositiveInteger maxint():PositiveInteger == MAXINT + maxint : PositiveInteger -> PositiveInteger maxint(new:PositiveInteger):PositiveInteger == old := MAXINT MAXINT := new old + coerce : Expression(Integer) -> Expression(%) coerce(u:Expression Integer):Expression($) == map(coerce,u)$ExpressionFunctions2(Integer,$) + coerce : Integer -> % coerce(u:Integer):$ == import S abs(u) > MAXINT => @@ -112305,8 +115219,10 @@ MachineInteger(): Exports == Implementation where error message u pretend $ + retract : % -> Integer retract(u:$):Integer == u pretend Integer + rationalIfCan : % -> Union(Fraction(Integer),"failed") retractIfCan(u:$):Union(Integer,"failed") == u pretend Integer *) @@ -112825,14 +115741,10 @@ Magma(VarSet:OrderedSet):Public == Private where (* domain MAGMA *) (* - -- representation - VWORD := Record(left:$ ,right:$) Rep:= Union(VarSet,VWORD) - recursif: ($,$) -> Boolean - - -- define + ?=? : (%,%) -> Boolean x:$ = y:$ == x case VarSet => y case VarSet => x::VarSet = y::VarSet @@ -112840,56 +115752,72 @@ Magma(VarSet:OrderedSet):Public == Private where y case VWORD => x::VWORD = y::VWORD false + varList : % -> List(VarSet) varList x == x case VarSet => [x::VarSet] lv: List VarSet := setUnion(varList x.left, varList x.right) sort_!(lv) + left : % -> % left x == x case VarSet => error "x has only one entry" x.left + right : % -> % right x == x case VarSet => error "x has only one entry" x.right + + retractable? : % -> Boolean retractable? x == (x case VarSet) + retract : % -> VarSet retract x == x case VarSet => x::VarSet error "Not retractable" + retractIfCan : % -> Union(VarSet,"failed") retractIfCan x == (retractable? x => x::VarSet ; "failed") + coerce : VarSet -> % coerce(l:VarSet):$ == l + mirror : % -> % mirror x == x case VarSet => x [mirror x.right, mirror x.left]$VWORD + coerce : % -> OrderedFreeMonoid(VarSet) coerce(x:$): WORD == x case VarSet => x::VarSet::WORD x.left::WORD * x.right::WORD + coerce : % -> OutputForm coerce(x:$):EX == x case VarSet => x::VarSet::EX bracket [x.left::EX, x.right::EX] + ?*? : (%,%) -> % x * y == [x,y]$VWORD + first : % -> VarSet first x == x case VarSet => x::VarSet first x.left + rest : % -> % rest x == x case VarSet => error "rest$Magma: inexistant rest" lx:$ := x.left lx case VarSet => x.right [rest lx , x.right]$VWORD + length : % -> PositiveInteger length x == x case VarSet => 1 length(x.left) + length(x.right) + recursif: ($,$) -> Boolean recursif(x,y) == x case VarSet => y case VarSet => x::VarSet < y::VarSet @@ -112898,6 +115826,7 @@ Magma(VarSet:OrderedSet):Public == Private where x.left = y.left => x.right < y.right x.left < y.left + lexico : (%,%) -> Boolean lexico(x,y) == -- peut etre amelioree !!!!!!!!!!! x case VarSet => y case VarSet => x::VarSet < y::VarSet @@ -112907,6 +115836,7 @@ Magma(VarSet:OrderedSet):Public == Private where fx = fy => lexico(rest x , rest y) fx < fy + ? Boolean x < y == -- recursif par longueur lx,ly: PositiveInteger lx:= length x ; ly:= length y @@ -113046,21 +115976,28 @@ MakeCachableSet(S:SetCategory): Exports == Implementation where clearCache() - position x == x.pos + position : % -> NonNegativeInteger + position x == x.pos - setPosition(x, n) == (x.pos := n; void) + setPosition : (%,NonNegativeInteger) -> Void + setPosition(x, n) == (x.pos := n; void) - coerce(x:%):S == x.setpart + coerce : % -> S + coerce(x:%):S == x.setpart + coerce : % -> OutputForm coerce(x:%):OutputForm == x::S::OutputForm - coerce(s:S):% == enterInCache([s, 0]$Rep, x+->(s = x::S)) + coerce : S -> % + coerce(s:S):% == enterInCache([s, 0]$Rep, x+->(s = x::S)) + ? Boolean x < y == if position(x) = 0 then enterInCache(x, x1+->(x::S = x1::S)) if position(y) = 0 then enterInCache(y, x1+->(y::S = x1::S)) position(x) < position(y) + ?=? : (%,%) -> Boolean x = y == if position(x) = 0 then enterInCache(x, x1+->(x::S = x1::S)) if position(y) = 0 then enterInCache(y, x1+->(y::S = x1::S)) @@ -114736,37 +117673,22 @@ o )show MathMLFormat (* domain MMLFORM *) (* - displayElt(mathml:S):Void - - eltName(pos:I,mathml:S):S - - eltLimit(name:S,pos:I,mathml:S):I - - tagEnd(name:S,pos:I,mathml:S):I - + displayElt : S -> Void displayElt(mathML:S): Void == -- Takes a string of syntactically complete mathML -- and formats it for display. --- sayTeX$Lisp "****displayElt1****" --- sayTeX$Lisp mathML enT:I -- marks end of tag, e.g. "" enE:I -- marks end of element, e.g. " ... " end:I -- marks end of mathML string u:US end := #mathML length:I := 60 --- sayTeX$Lisp "****displayElt1.1****" name:S := eltName(1,mathML) --- sayTeX$Lisp name --- sayTeX$Lisp concat("****displayElt1.2****",name) enE := eltLimit(name,2+#name,mathML) --- sayTeX$Lisp "****displayElt2****" if enE < length then --- sayTeX$Lisp "****displayElt3****" u := segment(1,enE)$US sayTeX$Lisp mathML.u else --- sayTeX$Lisp "****displayElt4****" enT := tagEnd(name,1,mathML) u := segment(1,enT)$US sayTeX$Lisp mathML.u @@ -114775,12 +117697,11 @@ o )show MathMLFormat u := segment(enE-#name-2,enE)$US sayTeX$Lisp mathML.u if end > enE then --- sayTeX$Lisp "****displayElt5****" u := segment(enE+1,end)$US displayElt(mathML.u) - void()$Void + eltName : (I,S) -> S eltName(pos:I,mathML:S): S == -- Assuming pos is the position of "<" for a start tag of a mathML -- element finds and returns the element's name. @@ -114791,6 +117712,7 @@ o )show MathMLFormat u:US := segment(pos+1,i-1) name:S := mathML.u + eltLimit : (S,I,S) -> I eltLimit(name:S,pos:I,mathML:S): I == -- Finds the end of a mathML element like " ... " -- where pos is the position of the space after name in the start tag @@ -114802,12 +117724,9 @@ o )show MathMLFormat startS:S := concat ["<",name] endS:S := concat [""] level:I := 1 - --sayTeX$Lisp "eltLimit: element name: "name while (level > 0) repeat startI := position(startS,mathML,pI)$String - endI := position(endS,mathML,pI)$String - if (startI = 0) then level := level-1 --sayTeX$Lisp "****eltLimit 1******" @@ -114821,7 +117740,7 @@ o )show MathMLFormat pI := tagEnd(name,endI,mathML) pI - + tagEnd : (S,I,S) -> I tagEnd(name:S,pos:I,mathML:S):I == -- Finds the closing ">" for either a start or end tag of a mathML -- element, so the return value is the position of ">" in mathML. @@ -114832,6 +117751,7 @@ o )show MathMLFormat --sayTeX$Lisp "tagEnd: "mathML.u pI + atomize : E -> L E atomize(expr : E): L E == -- This breaks down an expression into a flat list of atomic expressions. -- expr should be preconditioned. @@ -114845,6 +117765,7 @@ o )show MathMLFormat le := append(le,atomize a) le + ungroup : S -> S ungroup(str: S): S == len : I := #str len < 14 => str @@ -114858,6 +117779,7 @@ o )show MathMLFormat str := str.u str + postcondition : S -> S postcondition(str: S): S == len : I := #str plusminus : S := "+-" @@ -115312,6 +118234,7 @@ o )show MathMLFormat op = "-" => s group s + formatBinary : (S,L E,I) -> S formatBinary(op : S, args : L E, prec : I) : S == p : I := position(op,binaryOps) p < 1 => error "unknown binary op" @@ -115344,6 +118267,7 @@ o )show MathMLFormat formatNary(op : S, args : L E, prec : I) : S == group formatNaryNoGroup(op, args, prec) + formatNaryNoGroup : (S,L E,I) -> S formatNaryNoGroup(op : S, args : L E, prec : I) : S == checkargs:Boolean := false null args => "" @@ -115429,6 +118353,7 @@ o )show MathMLFormat opPrec < prec => parenthesize s s + formatZag : L E -> S formatZag(args : L E) : S == -- args will be a list of things like this {{ZAG}{1}{7}}, the ZAG -- must be there, the '1' and '7' could conceivably be more complex @@ -115442,7 +118367,7 @@ o )show MathMLFormat ""formatMml(first rest tmpZag,minPrec)formatMml(first rest rest tmpZag,minPrec)"" "formatZag: Unexpected kind of ZAG" - + formatZag1 : L E -> S formatZag1(args : L E) : S == -- make alternative ZAG format without diminishing fonts, maybe -- use a table @@ -115452,7 +118377,6 @@ o )show MathMLFormat (first args = "...":: E)@Boolean => "…" error "formatZag1: Unexpected kind of ZAG" - formatMml(expr : E,prec : I) == i,len : Integer intSplitLen : Integer := 20 @@ -115511,26 +118435,20 @@ o )show MathMLFormat -- now test for SUB position("SUB",op,1) > 0 => formatSub1(first l,args,minPrec) - -- special cases member?(op, specialOps) => formatSpecial(op,args,prec) member?(op, plexOps) => formatPlex(op,args,prec) - -- nullary case 0 = nargs => formatNullary op - -- unary case (1 = nargs) and member?(op, unaryOps) => formatUnary(op, first args, prec) - -- binary case (2 = nargs) and member?(op, binaryOps) => formatBinary(op, args, prec) - -- nary case member?(op,naryNGOps) => formatNaryNoGroup(op,args, prec) member?(op,naryOps) => formatNary(op,args, prec) - op := formatMml(first l,minPrec) formatFunction(op,args,prec) @@ -116759,6 +119677,7 @@ Matrix(R): Exports == Implementation where minRowIndex x == mnRow minColIndex x == mnCol + swapRows! : (%,Integer,Integer) -> % swapRows_!(x,i1,i2) == (i1 < minRowIndex(x)) or (i1 > maxRowIndex(x)) or _ (i2 < minRowIndex(x)) or (i2 > maxRowIndex(x)) => @@ -116785,6 +119704,7 @@ Matrix(R): Exports == Implementation where xx := x pretend Matrix(R) power_!(a,b,c,xx,n :: NonNegativeInteger)$MATSTOR pretend $ + ?**? : (%,NonNegativeInteger) -> % x:$ ** n:NonNegativeInteger == not((nn := nrows x) = ncols x) => error "**: matrix must be square" @@ -116793,26 +119713,34 @@ Matrix(R): Exports == Implementation where if R has commutative("*") then + determinant : % -> R determinant x == determinant(x)$MATLIN - minordet x == minordet(x)$MATLIN + minordet : % -> R + minordet x == minordet(x)$MATLIN if R has EuclideanDomain then + rowEchelon : % -> % rowEchelon x == rowEchelon(x)$MATLIN if R has IntegralDomain then - rank x == rank(x)$MATLIN + rank : % -> NonNegativeInteger + rank x == rank(x)$MATLIN - nullity x == nullity(x)$MATLIN + nullity : % -> NonNegativeInteger + nullity x == nullity(x)$MATLIN - nullSpace x == nullSpace(x)$MATLIN + nullSpace : % -> List(Vector(R)) + nullSpace x == nullSpace(x)$MATLIN if R has Field then - inverse x == inverse(x)$MATLIN + inverse : % -> Union(%,"failed") + inverse x == inverse(x)$MATLIN + ?**? : (%,Integer) -> % x:$ ** n:Integer == nn := nrows x not(nn = ncols x) => @@ -116823,6 +119751,7 @@ Matrix(R): Exports == Implementation where error "**: matrix must be invertible" positivePower(xInv :: $,-n,nn) + diagonalMatrix : Vector(R) -> % diagonalMatrix(v: Vector R) == n := #v; ans := zero(n,n) for i in minr(ans)..maxr(ans) for j in minc(ans)..maxc(ans) _ @@ -116831,6 +119760,7 @@ Matrix(R): Exports == Implementation where if R has ConvertibleTo InputForm then + convert : % -> InputForm convert(x:$):InputForm == convert [convert("matrix"::Symbol)@InputForm, convert listOfLists x]$List(InputForm) @@ -117390,8 +120320,7 @@ ModMonic(R,Rep): C == T d1 := (d-1):NonNegativeInteger twod := 2*d1+1 frobenius?:Boolean := R has FiniteFieldCategory - --VectorRep:= DirectProduct(d:NonNegativeInteger,R) - --declarations + x,y: % p: Rep d,n: Integer @@ -117400,14 +120329,12 @@ ModMonic(R,Rep): C == T --vect: Vector(R) power:PrimitiveArray(%) frobeniusPower:PrimitiveArray(%) - computeFrobeniusPowers : () -> PrimitiveArray(%) - - --representations power := new(0,0) frobeniusPower := new(0,0) + setPoly : Rep -> Rep setPoly (mon : Rep) == mon =$Rep m => mon oldm := m @@ -117429,46 +120356,66 @@ ModMonic(R,Rep): C == T frobeniusPower := computeFrobeniusPowers() m + modulus : () -> Rep modulus == m if R has Finite then + size : () -> NonNegativeInteger size == d * size$R + random : () -> % random == UnVectorise([random()$R for i in 0..d1]) + 0 : () -> % 0 == 0$Rep + 1 : () -> % 1 == 1$Rep + ?*? : (R,%) -> % c * x == c *$Rep x + ?*? : (Integer,%) -> % n * x == (n::R) *$Rep x + coerce : R -> % coerce(c:R):% == monomial(c,0)$Rep + coerce : % -> OutputForm coerce(x:%):OutputForm == coerce(x)$Rep + coefficient : (%,NonNegativeInteger) -> R coefficient(x,e):R == coefficient(x,e)$Rep + reductum : % -> % reductum(x) == reductum(x)$Rep + leadingCoefficient : % -> R leadingCoefficient x == (leadingCoefficient x)$Rep + degree : % -> NonNegativeInteger degree x == (degree x)$Rep + lift : % -> Rep lift(x) == x pretend Rep + reduce : Rep -> % reduce(p) == (monicDivide(p,m)$Rep).remainder + coerce : Rep -> % coerce(p) == reduce(p) + ?=? : (%,%) -> Boolean x = y == x =$Rep y + ?+? : (%,%) -> % x + y == x +$Rep y + -? : % -> % - x == -$Rep x + ?*? : (%,%) -> % x * y == p := x *$Rep y ans:=0$Rep @@ -117477,11 +120424,14 @@ ModMonic(R,Rep): C == T p := reductum p ans+p + Vectorise : % -> Vector(R) Vectorise(x) == [coefficient(lift(x),i) for i in 0..d1] + unvectorise : Vector(R) -> % UnVectorise(vect) == reduce(+/[monomial(vect.(i+1),i) for i in 0..d1]) + computePowers : () -> PrimitiveArray(%) computePowers == mat : PrimitiveArray(%):= new(d,0) mat.0:= reductum(-m)$Rep @@ -117494,6 +120444,7 @@ ModMonic(R,Rep): C == T if frobenius? then + computeFrobeniusPowers : () -> PrimitiveArray(%) computeFrobeniusPowers() == mat : PrimitiveArray(%):= new(d,1) mat.1:= mult := monomial(1, size$R)$% @@ -117501,6 +120452,7 @@ ModMonic(R,Rep): C == T mat.i := mult * mat.(i-1) mat + frobenius : % -> % frobenius(a:%):% == aq:% := 0 while a^=0 repeat @@ -117508,8 +120460,10 @@ ModMonic(R,Rep): C == T a := reductum a aq + pow : () -> PrimitiveArray(%) pow == power + monomial : (R,NonNegativeInteger) -> % monomial(c,e)== if e Union(%,"failed") (x:% exquo y:%):Union(%, "failed") == uv := extendedEuclidean(y, modulus(), x)$Rep uv case "failed" => "failed" return reduce(uv.coef1) + recip : % -> Union(%,"failed") recip(y:%):Union(%, "failed") == 1 exquo y + divide : (%,%) -> Record(quotient: %,remainder: %) divide(x:%, y:%) == (q := (x exquo y)) case "failed" => error "not divisible" [q, 0] @@ -117926,46 +120883,64 @@ ModularRing(R,Mod,reduction:(R,Mod) -> R, --define - modulus(x) == x.modulo + modulus : % -> Mod + modulus(x) == x.modulo - coerce(x) == x.val + coerce : % -> R + coerce(x) == x.val + coerce : Integer -> % coerce(i:Integer):% == [i::R,0]$Rep + ?*? : (Integer,%) -> % i:Integer * x:% == (i::%)*x + coerce : % -> OutputForm coerce(x):OutputForm == (x.val)::OutputForm + reduce : (R,Mod) -> % reduce (a:R,m:Mod) == [reduction(a,m),m]$Rep + characteristic : () -> NonNegativeInteger characteristic():NonNegativeInteger == characteristic()$R + 0 : () -> % 0 == [0$R,0$Mod]$Rep + 1 : () -> % 1 == [1$R,0$Mod]$Rep + zero? : % -> Boolean zero? x == zero? x.val + one? : % -> Boolean one? x == (x.val = 1) + newmodulo : (Mod,Mod) -> Mod newmodulo(m1:Mod,m2:Mod) : Mod == r:=merge(m1,m2) r case "failed" => error "incompatible moduli" r::Mod + ?=? : (%,%) -> Boolean x=y == x.val = y.val => true x.modulo = y.modulo => false (x-y).val = 0 + ?+? : (%,%) -> % x+y == reduce((x.val +$R y.val),newmodulo(x.modulo,y.modulo)) + ?-? : (%,%) -> % x-y == reduce((x.val -$R y.val),newmodulo(x.modulo,y.modulo)) + -? : % -> % -x == reduce ((-$R x.val),x.modulo) + ?*? : (%,%) -> % x*y == reduce((x.val *$R y.val),newmodulo(x.modulo,y.modulo)) + exQuo : (%,%) -> Union(%,"failed") exQuo(x,y) == xm:=x.modulo if xm ^=$Mod y.modulo then xm:=newmodulo(xm,y.modulo) @@ -117974,11 +120949,13 @@ ModularRing(R,Mod,reduction:(R,Mod) -> R, [r::R,xm]$Rep --if R has EuclideanDomain then + recip : % -> Union(%,"failed") recip x == r:=exactQuo(1$R,x.val,x.modulo) r case "failed" => "failed" [r,x.modulo]$Rep + inv : % -> % inv x == if (u:=recip x) case "failed" then error("not invertible") else u::% @@ -118110,16 +121087,22 @@ ModuleMonomial(IS: OrderedSet, Rep:= MM + ? Boolean x:$ < y:$ == ff(x::Rep, y::Rep) + exponent : % -> E exponent(x:$):E == x.exponent + index : % -> IS index(x:$): IS == x.index + coerce : % -> Record(index: IS,exponent: E) coerce(x:$):MM == x::Rep::MM + coerce : Record(index: IS,exponent: E) -> % coerce(x:MM):$ == x::Rep::$ + construct : (IS,E) -> % construct(i:IS, e:E):$ == [i, e]$MM::Rep::$ *) @@ -118486,89 +121469,98 @@ ModuleOperator(R: Ring, M:LeftModule(R)): Exports == Implementation where Rep := FAB - inv : TERM -> $ - termeval : (TERM, M) -> M - rmeval : (RM, M) -> M - monomeval: (FG, M) -> M - opInvEval: (OP, M) -> M - mkop : (R, FG) -> $ - termprod0: (Integer, TERM, TERM) -> $ - termprod : (Integer, TERM, TERM) -> TERM - termcopy : TERM -> TERM - trm2O : (Integer, TERM) -> O - term2O : TERM -> O - rm2O : (R, FG) -> O - nocopy : OP -> $ - - 1 == makeop(1, 1) + 1 : () -> % + 1 == makeop(1, 1) + coerce : Integer -> % coerce(n:Integer):$ == n::R::$ - coerce(r:R):$ == (zero? r => 0; makeop(r, 1)) + coerce : R -> % + coerce(r:R):$ == (zero? r => 0; makeop(r, 1)) + coerce : BasicOperator -> % coerce(op:OP):$ == nocopy copy op - nocopy(op:OP):$ == makeop(1, op::FG) + nocopy : OP -> $ + nocopy(op:OP):$ == makeop(1, op::FG) - elt(x:$, r:M) == +/[t.exp * termeval(t.gen, r) for t in terms x] + ?.? : (%,M) -> M + elt(x:$, r:M) == +/[t.exp * termeval(t.gen, r) for t in terms x] - rmeval(t, r) == t.coef * monomeval(t.monom, r) + rmeval : (RM, M) -> M + rmeval(t, r) == t.coef * monomeval(t.monom, r) - termcopy t == [[rm.coef, rm.monom] for rm in t] + termcopy : TERM -> TERM + termcopy t == [[rm.coef, rm.monom] for rm in t] + characteristic : () -> NonNegativeInteger characteristic() == characteristic()$R - mkop(r, fg) == [[r, fg]$RM]$TERM :: $ + mkop : (R, FG) -> $ + mkop(r, fg) == [[r, fg]$RM]$TERM :: $ - evaluate(f, g) == nocopy setProperty(retract(f)@OP,OPEVAL,g pretend None) + evaluate : (%,(M -> M)) -> % + evaluate(f, g) == nocopy setProperty(retract(f)@OP,OPEVAL,g pretend None) if R has OrderedSet then + makeop : (R,FreeGroup(BasicOperator)) -> % makeop(r, fg) == (r >= 0 => mkop(r, fg); - mkop(-r, fg)) else + makeop : (R,FreeGroup(BasicOperator)) -> % makeop(r, fg) == mkop(r, fg) + inv : TERM -> $ inv(t:TERM):$ == empty? t => 1 c := first(t).coef m := first(t).monom inv(rest t) * makeop(1, inv m) * (recip(c)::R::$) + ?**? : (%,Integer) -> % x:$ ** i:Integer == i = 0 => 1 i > 0 => expt(x,i pretend PositiveInteger)$RepeatedSquaring($) (inv(retract(x)@TERM)) ** (-i) + evaluateInverse : (%,(M -> M)) -> % evaluateInverse(f, g) == nocopy setProperty(retract(f)@OP, INVEVAL, g pretend None) + coerce : % -> OutputForm coerce(x:$):O == zero? x => (0$R)::O reduce(_+, [trm2O(t.exp, t.gen) for t in terms x])$List(O) + trm2O : (Integer, TERM) -> O trm2O(c, t) == (c = 1) => term2O t c = -1 => - term2O t c::O * term2O t + term2O : TERM -> O term2O t == reduce(_*, [rm2O(rm.coef, rm.monom) for rm in t])$List(O) + rm2O : (R, FG) -> O rm2O(c, m) == (c = 1) => m::O (m = 1) => c::O c::O * m::O + ?*? : (%,%) -> % x:$ * y:$ == +/[ +/[termprod0(t.exp * s.exp, t.gen, s.gen) for s in terms y] for t in terms x] + termprod0: (Integer, TERM, TERM) -> $ termprod0(n, x, y) == n >= 0 => termprod(n, x, y)::$ - (termprod(-n, x, y)::$) + termprod : (Integer, TERM, TERM) -> TERM termprod(n, x, y) == lc := first(xx := termcopy x) lc.coef := n * lc.coef @@ -118584,26 +121576,31 @@ ModuleOperator(R: Ring, M:LeftModule(R)): Exports == Implementation where if M has ExpressionSpace then + opeval : (BasicOperator,M) -> M opeval(op, r) == (func := property(op, OPEVAL)) case "failed" => kernel(op, r) ((func::None) pretend (M -> M)) r else + opeval : (BasicOperator,M) -> M opeval(op, r) == (func := property(op, OPEVAL)) case "failed" => error "eval: operator has no evaluation function" ((func::None) pretend (M -> M)) r + opInvEval: (OP, M) -> M opInvEval(op, r) == (func := property(op, INVEVAL)) case "failed" => error "eval: operator has no inverse evaluation function" ((func::None) pretend (M -> M)) r + termeval : (TERM, M) -> M termeval(t, r) == for rm in reverse t repeat r := rmeval(rm, r) r + monomeval: (FG, M) -> M monomeval(m, r) == for rec in reverse_! factors m repeat e := rec.exp @@ -118614,11 +121611,13 @@ ModuleOperator(R: Ring, M:LeftModule(R)): Exports == Implementation where for i in 1..(-e) repeat r := opInvEval(g, r) r + recip : % -> Union(%,"failed") recip x == (r := retractIfCan(x)@Union(R, "failed")) case "failed" => "failed" (r1 := recip(r::R)) case "failed" => "failed" r1::R::$ + retractIfCan : % -> Union(R,"failed") retractIfCan(x:$):Union(R, "failed") == (r:= retractIfCan(x)@Union(TERM,"failed")) case "failed" => "failed" empty?(t := r::TERM) => 0$R @@ -118628,6 +121627,7 @@ ModuleOperator(R: Ring, M:LeftModule(R)): Exports == Implementation where "failed" "failed" + retractIfCan : % -> Union(BasicOperator,"failed") retractIfCan(x:$):Union(OP, "failed") == (r:= retractIfCan(x)@Union(TERM,"failed")) case "failed" => "failed" empty?(t := r::TERM) => "failed" @@ -118638,31 +121638,35 @@ ModuleOperator(R: Ring, M:LeftModule(R)): Exports == Implementation where "failed" if R has CommutativeRing then - termadj : TERM -> $ - rmadj : RM -> $ - monomadj : FG -> $ - opadj : OP -> $ - r:R * x:$ == r::$ * x + ?*? : (R,%) -> % + r:R * x:$ == r::$ * x - x:$ * r:R == x * (r::$) + ?*? : (%,R) -> % + x:$ * r:R == x * (r::$) - adjoint x == +/[t.exp * termadj(t.gen) for t in terms x] + adjoint : % -> % + adjoint x == +/[t.exp * termadj(t.gen) for t in terms x] - rmadj t == conjug(t.coef) * monomadj(t.monom) + rmadj : RM -> $ + rmadj t == conjug(t.coef) * monomadj(t.monom) + adjoint : (%,%) -> % adjoint(op, adj) == nocopy setProperty(retract(op)@OP, OPADJ, adj::None) + termadj : TERM -> $ termadj t == ans:$ := 1 for rm in t repeat ans := rmadj(rm) * ans ans + monomadj : FG -> $ monomadj m == ans:$ := 1 for rec in factors m repeat ans := (opadj(rec.gen) ** rec.exp) * ans ans + opadj : OP -> $ opadj op == (adj := property(op, OPADJ)) case "failed" => error "adjoint: operator does not have a defined adjoint" @@ -118670,6 +121674,7 @@ ModuleOperator(R: Ring, M:LeftModule(R)): Exports == Implementation where if R has conjugate:R -> R then + conjug : R -> R conjug r == conjugate r else conjug r == r *) @@ -118879,34 +121884,48 @@ MoebiusTransform(F): Exports == Implementation where Rep := Record(a: F,b: F,c: F,d: F) + moebius : (F,F,F,F) -> % moebius(aa,bb,cc,dd) == [aa,bb,cc,dd] + a : % -> F a(t:%):F == t.a + b : % -> F b(t:%):F == t.b + c : % -> F c(t:%):F == t.c + d : % -> F d(t:%):F == t.d + 1 : () -> % 1 == moebius(1,0,0,1) + ?*? : (%,%) -> % t * s == moebius(b(t)*c(s) + a(t)*a(s), b(t)*d(s) + a(t)*b(s), _ d(t)*c(s) + c(t)*a(s), d(t)*d(s) + c(t)*b(s)) + inv : % -> % inv t == moebius(d(t),-b(t),-c(t),a(t)) + shift : F -> % shift f == moebius(1,f,0,1) + scale : F -> % scale f == moebius(f,0,0,1) + recip : () -> % recip() == moebius(0,1,1,0) + shift : (%,F) -> % shift(t,f) == moebius(a(t) + f*c(t), b(t) + f*d(t), c(t), d(t)) + scale : (%,F) -> % scale(t,f) == moebius(f*a(t),f*b(t),c(t),d(t)) + recip : % -> % recip t == moebius(c(t),d(t),a(t),b(t)) eval(t:%,f:F) == (a(t)*f + b(t))/(c(t)*f + d(t)) @@ -118916,6 +121935,7 @@ MoebiusTransform(F): Exports == Implementation where zero?(den := c(t) * (fff := ff :: F) + d(t)) => infinity() ((a(t) * fff + b(t))/den) :: P1F + coerce : % -> OutputForm coerce t == var := "%x" :: OUT num := (a(t) :: OUT) * var + (b(t) :: OUT) @@ -118931,6 +121951,7 @@ MoebiusTransform(F): Exports == Implementation where zero? (x2 := first list2) => false map((f1:F):F +-> f1/x1, list1) = map((g1:F):F +-> g1/x2, list2) + ?=? : (%,%) -> Boolean t = s == list1 : List F := [a(t),b(t),c(t),d(t)] list2 : List F := [a(s),b(s),c(s),d(s)] @@ -119420,16 +122441,20 @@ MonoidRing(R: Ring, M: Monoid): MRcategory == MRdefinition where Rep := List Term + coerce : List(Record(coef: R,monom: M)) -> % coerce(x: List Term): % == x :: % + monomial : (R,M) -> % monomial(r:R, m:M) == r = 0 => empty() [[r, m]] if (R has Finite and M has Finite) then + size : () -> NonNegativeInteger size() == size()$R ** size()$M + index : PositiveInteger -> % index k == -- use p-adic decomposition of k -- coefficient of p**j determines coefficient of index(i+p)$M @@ -119448,6 +122473,7 @@ MonoidRing(R: Ring, M: Monoid): MRcategory == MRdefinition where i := i quo p ans + lookup : % -> PositiveInteger lookup(z : %) : PositiveInteger == -- could be improved, if M has OrderedSet -- z = index lookup z, n = lookup index n @@ -119466,42 +122492,54 @@ MonoidRing(R: Ring, M: Monoid): MRcategory == MRdefinition where res := res + co * p ** ex res pretend PositiveInteger + random : () -> % random() == index( (1+(random()$Integer rem size()$%) )_ pretend PositiveInteger)$% - 0 == empty() + 0 : () -> % + 0 == empty() - 1 == [[1, 1]] + 1 : () -> % + 1 == [[1, 1]] - terms a == (copy a) pretend List(Term) + terms : % -> List(Record(coef: R,monom: M)) + terms a == (copy a) pretend List(Term) - monomials a == [[t] for t in a] + monomials : % -> List(%) + monomials a == [[t] for t in a] - coefficients a == [t.Cf for t in a] + coefficients : % -> List(R) + coefficients a == [t.Cf for t in a] - coerce(m:M):% == [[1, m]] + coerce : M -> % + coerce(m:M):% == [[1, m]] + coerce : R -> % coerce(r:R): % == -- coerce of ring r = 0 => 0 [[r, 1]] + coerce : Integer -> % coerce(n:Integer): % == -- coerce of integers n = 0 => 0 [[n::R, 1]] - - a == [[ -t.Cf, t.Mn] for t in a] + -? : % -> % + - a == [[ -t.Cf, t.Mn] for t in a] if R has noZeroDivisors then + ?*? : (R,%) -> % (r:R) * (a:%) == r = 0 => 0 [[r*t.Cf, t.Mn] for t in a] else + ?*? : (R,%) -> % (r:R) * (a:%) == r = 0 => 0 [[rt, t.Mn] for t in a | (rt:=r*t.Cf) ^= 0] @@ -119509,24 +122547,30 @@ MonoidRing(R: Ring, M: Monoid): MRcategory == MRdefinition where if R has noZeroDivisors then + ?*? : (Integer,%) -> % (n:Integer) * (a:%) == n = 0 => 0 [[n*t.Cf, t.Mn] for t in a] else + ?*? : (Integer,%) -> % (n:Integer) * (a:%) == n = 0 => 0 [[nt, t.Mn] for t in a | (nt:=n*t.Cf) ^= 0] - map(f, a) == [[ft, t.Mn] for t in a | (ft:=f(t.Cf)) ^= 0] + map : ((R -> R),%) -> % + map(f, a) == [[ft, t.Mn] for t in a | (ft:=f(t.Cf)) ^= 0] + numberOfMonomials : % -> NonNegativeInteger numberOfMonomials a == #a + retractIfCan : % -> Union(M,"failed") retractIfCan(a:%):Union(M, "failed") == ((#a) = 1) and ((a.first.Cf) = 1) => a.first.Mn "failed" + retractIfCan : % -> Union(R,"failed") retractIfCan(a:%):Union(R, "failed") == ((#a) = 1) and ((a.first.Mn) = 1) => a.first.Cf "failed" @@ -119534,6 +122578,7 @@ MonoidRing(R: Ring, M: Monoid): MRcategory == MRdefinition where if R has noZeroDivisors then if M has Group then + recip : % -> Union(%,"failed") recip a == lt := terms a #lt ^= 1 => "failed" @@ -119543,16 +122588,19 @@ MonoidRing(R: Ring, M: Monoid): MRcategory == MRdefinition where else + recip : % -> Union(%,"failed") recip a == #a ^= 1 or a.first.Mn ^= 1 => "failed" (u := recip a.first.Cf) case "failed" => "failed" u::R::% + mkTerm : (R,M) -> Ex mkTerm(r:R, m:M):Ex == r=1 => m::Ex r=0 or m=1 => r::Ex r::Ex * m::Ex + coerce : % -> OutputForm coerce(a:%):Ex == empty? a => (0$Integer)::Ex empty? rest a => mkTerm(a.first.Cf, a.first.Mn) @@ -119560,16 +122608,24 @@ MonoidRing(R: Ring, M: Monoid): MRcategory == MRdefinition where if M has OrderedSet then -- we mean totally ordered -- Terms are stored in decending order. + + leadingCoefficient : % -> R leadingCoefficient a == (empty? a => 0; a.first.Cf) - leadingMonomial a == (empty? a => 1; a.first.Mn) - reductum a == (empty? a => a; rest a) + leadingMonomial : % -> M + leadingMonomial a == (empty? a => 1; a.first.Mn) + + reductum : % -> % + reductum a == (empty? a => a; rest a) + + ?=? : (%,%) -> Boolean a = b == #a ^= #b => false for ta in a for tb in b repeat ta.Cf ^= tb.Cf or ta.Mn ^= tb.Mn => return false true + ?+? : (%,%) -> % a + b == c:% := empty() while not empty? a and not empty? b repeat @@ -119584,6 +122640,7 @@ MonoidRing(R: Ring, M: Monoid): MRcategory == MRdefinition where c concat_!(c, concat(a, b)) + coefficient : (%,M) -> R coefficient(a, m) == for t in a repeat if t.Mn = m then return t.Cf @@ -119597,19 +122654,25 @@ MonoidRing(R: Ring, M: Monoid): MRcategory == MRdefinition where -- by a single element respects the ordering if R has noZeroDivisors then + + ?*? : (%,%) -> % a:% * b:% == +/[[[ta.Cf*tb.Cf, ta.Mn*tb.Mn]$Term for tb in b ] for ta in reverse a] else + + ?*? : (%,%) -> % a:% * b:% == +/[[[r, ta.Mn*tb.Mn]$Term for tb in b | not zero?(r := ta.Cf*tb.Cf)] for ta in reverse a] + else -- M hasn't OrderedMonoid -- we cannot assume that mutiplying an ordered list of -- monoid elements by a single element respects the ordering: -- we have to order and to collect equal terms + ge : (Term,Term) -> Boolean ge(s,t) == t.Mn <= s.Mn @@ -119629,9 +122692,9 @@ MonoidRing(R: Ring, M: Monoid): MRcategory == MRdefinition where if not zero? cf then res := cons([cf,m]$Term, res) reverse res - if R has noZeroDivisors then + ?*? : (%,%) -> % a:% * b:% == zero? a => a zero? b => b -- avoid calling sortAndAdd with [] @@ -119640,6 +122703,7 @@ MonoidRing(R: Ring, M: Monoid): MRcategory == MRdefinition where else + ?*? : (%,%) -> % a:% * b:% == zero? a => a zero? b => b -- avoid calling sortAndAdd with [] @@ -119651,20 +122715,24 @@ MonoidRing(R: Ring, M: Monoid): MRcategory == MRdefinition where else -- M hasn't OrderedSet -- Terms are stored in random order. + ?=? : (%,%) -> Boolean a = b == #a ^= #b => false brace(a pretend List(Term)) =$Set(Term) brace(b pretend List(Term)) + coefficient : (%,M) -> R coefficient(a, m) == for t in a repeat t.Mn = m => return t.Cf 0 + addterm : (AssociationList(M,R),R,M) -> R addterm(Tabl: AssociationList(M,R), r:R, m:M):R == (u := search(m, Tabl)) case "failed" => Tabl.m := r zero?(r := r + u::R) => (remove_!(m, Tabl); 0) Tabl.m := r + ?+? : (%,%) -> % a + b == Tabl := table()$AssociationList(M,R) for t in a repeat @@ -119673,6 +122741,7 @@ MonoidRing(R: Ring, M: Monoid): MRcategory == MRdefinition where addterm(Tabl, t.Cf, t.Mn) [[Tabl m, m]$Term for m in keys Tabl] + ?*? : (%,%) -> % a:% * b:% == Tabl := table()$AssociationList(M,R) for ta in a repeat @@ -120330,21 +123399,28 @@ Multiset(S: SetCategory): MultisetAggregate S with D ==> Record(entry: S, count: NonNegativeInteger) K ==> Record(key: S, entry: Integer) + elt : (Tbl,S) -> Integer elt(t:Tbl, s:S):Integer == a := search(s,t)$Tbl a case "failed" => 0 a::Integer + empty : () -> % empty():% == [0,tbl()] + multiset : () -> % multiset():% == empty() + dictionary : () -> % dictionary():% == empty() -- DictionaryOperations + set : () -> % set():% == empty() + brace : () -> % brace():% == empty() + construct : List(S) -> % construct(l:List S):% == t := tbl() n := 0 @@ -120353,25 +123429,35 @@ Multiset(S: SetCategory): MultisetAggregate S with n := inc n [n, t] + multiset : List(S) -> % multiset(l:List S):% == construct l + bag : List(S) -> % bag(l:List S):% == construct l -- BagAggregate + dictionary : List(S) -> % dictionary(l:List S):% == construct l -- DictionaryOperations + set : List(S) -> % set(l:List S):% == construct l + brace : List(S) -> % brace(l:List S):% == construct l + multiset : S -> % multiset(s:S):% == construct [s] if S has ConvertibleTo InputForm then + + convert : % -> InputForm convert(ms:%):InputForm == convert [convert("multiset"::Symbol)@InputForm, convert(parts ms)@InputForm] + members : % -> List(S) members(ms:%):List S == keys ms.table + coerce : % -> OutputForm coerce(ms:%):OutputForm == l: List OutputForm := empty() t := ms.table @@ -120385,6 +123471,7 @@ Multiset(S: SetCategory): MultisetAggregate S with l := cons(item,l) brace l + duplicates : % -> List(Record(entry: S,count: NonNegativeInteger)) duplicates(ms:%):List D == -- MultiDictionary ld : List D := empty() t := ms.table @@ -120392,6 +123479,7 @@ Multiset(S: SetCategory): MultisetAggregate S with ld := cons([e,n::NonNegativeInteger],ld) ld + extract! : % -> S extract_!(ms:%):S == -- BagAggregate empty? ms => error "extract: Empty multiset" ms.count := dec ms.count @@ -120401,21 +123489,28 @@ Multiset(S: SetCategory): MultisetAggregate S with else remove_!(e,t) e + inspect : % -> S inspect(ms:%):S == inspect(ms.table).key -- BagAggregate + insert! : (S,%) -> % insert_!(e:S,ms:%):% == -- BagAggregate ms.count := inc ms.count ms.table.e := inc ms.table.e ms + member? : (S,%) -> Boolean member?(e:S,ms:%):Boolean == member?(e,keys ms.table) + empty? : % -> Boolean empty?(ms:%):Boolean == ms.count = 0 + #? : % -> NonNegativeInteger #(ms:%):NonNegativeInteger == ms.count::NonNegativeInteger + count : (S,%) -> NonNegativeInteger count(e:S, ms:%):NonNegativeInteger == ms.table.e::NonNegativeInteger + remove! : (S,%,Integer) -> % remove_!(e:S, ms:%, max:Integer):% == zero? max => remove_!(e,ms) t := ms.table @@ -120431,6 +123526,7 @@ Multiset(S: SetCategory): MultisetAggregate S with ms.count := ms.count-n ms + remove! : ((S -> Boolean),%,Integer) -> % remove_!(p: S -> Boolean, ms:%, max:Integer):% == zero? max => remove_!(p,ms) t := ms.table @@ -120446,10 +123542,13 @@ Multiset(S: SetCategory): MultisetAggregate S with ms.count := ms.count-n ms + remove : (S,%,Integer) -> % remove(e:S, ms:%, max:Integer):% == remove_!(e, copy ms, max) + remove : ((S -> Boolean),%,Integer) -> % remove(p: S -> Boolean,ms:%,max:Integer):% == remove_!(p, copy ms, max) + remove! : (S,%) -> % remove_!(e:S, ms:%):% == -- DictionaryOperations t := ms.table if member?(e, keys t) then @@ -120457,6 +123556,7 @@ Multiset(S: SetCategory): MultisetAggregate S with remove_!(e, t) ms + remove! : ((S -> Boolean),%) -> % remove_!(p:S ->Boolean, ms:%):% == -- DictionaryOperations t := ms.table for e in keys t | p(e) repeat @@ -120464,9 +123564,11 @@ Multiset(S: SetCategory): MultisetAggregate S with remove_!(e, t) ms + select! : ((S -> Boolean),%) -> % select_!(p: S -> Boolean, ms:%):% == -- DictionaryOperations remove_!((s1:S):Boolean+->not p(s1), ms) + removeDuplicates! : % -> % removeDuplicates_!(ms:%):% == -- MultiDictionary t := ms.table l := keys t @@ -120474,11 +123576,13 @@ Multiset(S: SetCategory): MultisetAggregate S with ms.count := #l ms + insert! : (S,%,NonNegativeInteger) -> % insert_!(e:S,ms:%,more:NonNegativeInteger):% == -- MultiDictionary ms.count := ms.count+more ms.table.e := ms.table.e+more ms + map! : ((S -> S),%) -> % map_!(f: S->S, ms:%):% == -- HomogeneousAggregate t := ms.table t1 := tbl() @@ -120488,8 +123592,10 @@ Multiset(S: SetCategory): MultisetAggregate S with ms.table := t1 ms + map : ((S -> S),%) -> % map(f: S -> S, ms:%):% == map_!(f, copy ms) -- HomogeneousAggregate + parts : % -> List(S) parts(m:%):List S == l := empty()$List(S) t := m.table @@ -120498,6 +123604,7 @@ Multiset(S: SetCategory): MultisetAggregate S with l := cons(e,l) l + union : (%,%) -> % union(m1:%, m2:%):% == t := tbl() t1:= m1.table @@ -120506,6 +123613,7 @@ Multiset(S: SetCategory): MultisetAggregate S with for e in keys t2 repeat t.e := t2.e + t.e [m1.count + m2.count, t] + intersect : (%,%) -> % intersect(m1:%, m2:%):% == t := tbl() t1:= m1.table @@ -120519,6 +123627,7 @@ Multiset(S: SetCategory): MultisetAggregate S with n := n + m [n, t] + difference : (%,%) -> % difference(m1:%, m2:%):% == t := tbl() t1:= m1.table @@ -120533,9 +123642,11 @@ Multiset(S: SetCategory): MultisetAggregate S with n = 0 => empty() [n, t] + symmetricDifference : (%,%) -> % symmetricDifference(m1:%, m2:%):% == union(difference(m1,m2), difference(m2,m1)) + ?=? : (%,%) -> Boolean m1 = m2 == m1.count ^= m2.count => false t1 := m1.table @@ -120546,6 +123657,7 @@ Multiset(S: SetCategory): MultisetAggregate S with t1.e ^= t2.e => return false true + ? Boolean m1 < m2 == m1.count >= m2.count => false t1 := m1.table @@ -120554,6 +123666,7 @@ Multiset(S: SetCategory): MultisetAggregate S with t1.e > t2.e => return false m1.count < m2.count + subset? : (%,%) -> Boolean subset?(m1:%, m2:%):Boolean == m1.count > m2.count => false t1 := m1.table @@ -121388,6 +124501,7 @@ MyExpression(q: Symbol, R): Exports == Implementation where Rep := Expression R + iunivariate : Polynomial R -> UP iunivariate(p: Polynomial R): UP == poly: SparseUnivariatePolynomial(Polynomial R) := univariate(p, q)$(Polynomial R) @@ -121396,6 +124510,7 @@ MyExpression(q: Symbol, R): Exports == Implementation where SparseUnivariatePolynomial Polynomial R, R, UP) + retract : % -> Fraction(Integer) retract(p: %): Fraction UP == poly: Fraction Polynomial R := retract p upoly: UP := iunivariate numer poly @@ -121403,8 +124518,10 @@ MyExpression(q: Symbol, R): Exports == Implementation where upoly / vpoly + retract : % -> MyUnivariatePolynomial(q,R) retract(p: %): UP == iunivariate retract p + coerce : Fraction(MyUnivariatePolynomial(q,R)) -> % coerce(r: Fraction UP): % == num: SparseUnivariatePolynomial R := makeSUP numer r den: SparseUnivariatePolynomial R := makeSUP denom r @@ -121801,20 +124918,26 @@ MyUnivariatePolynomial(x:Symbol, R:Ring): Rep := SparseUnivariatePolynomial(R) + coerce : % -> OutputForm coerce(p: %):OutputForm == outputForm(p, outputForm x) + coerce : Symbol -> % coerce(x: Symbol): % == monomial(1, 1) + coerce : Variable(x) -> % coerce(v: Variable(x)):% == monomial(1, 1) + retract : % -> Symbol retract(p: %): Symbol == retract(p)@SingletonAsOrderedSet x if R has univariate: (R, Symbol) -> SparseUnivariatePolynomial R then + coerce : R -> % coerce(p: R): % == univariate(p, x)$R + coerce : Polynomial(R) -> % coerce(p: Polynomial R): % == poly: SparseUnivariatePolynomial(Polynomial R) := univariate(p, x)$(Polynomial R) @@ -122444,9 +125567,8 @@ NeitherSparseOrDensePowerSeries(K):Exports == Implementation where Rep:=SER var : Symbol := 't - - multC: (K,INT,%) -> % + orderIfNegative : % -> Union(Integer,"failed") orderIfNegative(s:%)== zero?(s) => "failed" f:=frst(s) @@ -122454,12 +125576,14 @@ NeitherSparseOrDensePowerSeries(K):Exports == Implementation where zero?(f.c) => orderIfNegative(rest(s)) f.k + posExpnPart : % -> % posExpnPart(s)== zero?(s) => 0 o:=order s (o >= 0) => s posExpnPart(rst s) + findTerm : (%,Integer) -> Record(k: Integer,c: K) findTerm(s,n)== empty?(s) => [n,0]$TERM f:=frst(s) @@ -122467,26 +125591,31 @@ NeitherSparseOrDensePowerSeries(K):Exports == Implementation where f.k = n => f findTerm(rst(s),n) + findCoef : (%,Integer) -> K findCoef(s,i)==findTerm(s,i).c + coerce : % -> Stream(Record(k: Integer,c: K)) coerce(s:%):SER == s::Rep - coerce(s:SER):%==s + coerce : Stream(Record(k: Integer,c: K)) -> % + coerce(s:SER):% == s localVarForPrintInfo:Boolean:=false() - printInfo==localVarForPrintInfo - - printInfo(flag)==localVarForPrintInfo:=flag + printInfo : () -> Boolean + printInfo == localVarForPrintInfo - outTerm: TERM -> OutputForm + printInfo : Boolean -> Boolean + printInfo(flag) == localVarForPrintInfo:=flag + removeZeroes : % -> % removeZeroes(s)== delay zero?(s) => 0 f:=frst(s) zero?(f.c) => removeZeroes(rst(s)) concat(f,removeZeroes(rst(s))) + inv : % -> % inv(ra)== a:=removeFirstZeroes ra o:=-order(a) @@ -122505,6 +125634,7 @@ NeitherSparseOrDensePowerSeries(K):Exports == Implementation where tc0:%:=series(sx.k,c0,0$%) concat(nT,iDiv(rst x - tc0 * rst y,y,ry0)) + recip : % -> Union(%,"failed") recip x == empty? x => "failed" rh1:TERM:=frst x @@ -122513,12 +125643,14 @@ NeitherSparseOrDensePowerSeries(K):Exports == Implementation where delay concat([0,ic]$TERM,iDiv(- ic * rst x,x,ic)) + removeFirstZeroes : % -> % removeFirstZeroes(s)== zero?(s) => 0 f:=frst(s) zero?(f.c) => removeFirstZeroes(rst(s)) s + sbt : (%,%) -> % sbt(sa,sbb)== delay sb:=removeFirstZeroes(sbb) o:=order sb @@ -122531,6 +125663,7 @@ NeitherSparseOrDensePowerSeries(K):Exports == Implementation where zero?(fa.c) => sbt(rst(sa),sb) concat(firstElem, rest((fa.c) * sb ** (fa.k)) + sbt(rst(sa),sb) ) + coerce : % -> OutputForm coerce(s:%):OutputForm== zero?(s) => "0" :: OutputForm count:SI:= _$streamCount$Lisp @@ -122550,6 +125683,7 @@ NeitherSparseOrDensePowerSeries(K):Exports == Implementation where empty?(rs) => out out + ("..." :: OutputForm) + outTerm: TERM -> OutputForm outTerm(t)== ee:=t.k cc:=t.c @@ -122562,6 +125696,7 @@ NeitherSparseOrDensePowerSeries(K):Exports == Implementation where one?(ee) => oc * symb oc * symb ** oe + removeZeroes : (Integer,%) -> % removeZeroes(n,s)== delay n < 0 => s zero?(s) => 0 @@ -122569,6 +125704,7 @@ NeitherSparseOrDensePowerSeries(K):Exports == Implementation where zero?(f.c) => removeZeroes(n-1, rst(s)) concat(f,removeZeroes(n-1, rst(s))) + order : % -> Integer order(s:%)== zero?(s) => error _ "From order (PlaneCurveLocalPowerSeries): cannot compute the order of 0" @@ -122576,9 +125712,11 @@ NeitherSparseOrDensePowerSeries(K):Exports == Implementation where zero?(f.c) => order(rest(s)) f.k + monomial2series : (List(%),List(NonNegativeInteger),Integer) -> % monomial2series(lpar,lexp,sh)== shift(reduce("*",[s**e for s in lpar for e in lexp]),sh) + coefOfFirstNonZeroTerm : % -> K coefOfFirstNonZeroTerm(s:%)== zero?(s) => error _ "From order (PlaneCurveLocalPowerSeries): cannot find the coefOfFirstNonZeroTerm" @@ -122589,26 +125727,34 @@ NeitherSparseOrDensePowerSeries(K):Exports == Implementation where degreeOfTermLower?: (TERM,INT) -> Boolean degreeOfTermLower?(t,n)== t.k < n + filterUpTo : (%,Integer) -> % filterUpTo(s,n)==filterWhile(degreeOfTermLower?(#1,n),s) + series : (Integer,K,%) -> % series(exp,coef,s)==cons([exp,coef]$TERM,s) + ?**? : (%,NonNegativeInteger) -> % a:% ** n:NNI == -- delay zero?(n) => 1 expt(a,n :: PositiveInteger)$RepeatedSquaring(%) + 0 : () -> % 0 == empty() + 1 : () -> % 1 == construct([[0,1]$TERM]) + zero? : % -> Boolean zero?(a)==empty?(a::Rep) + shift : (%,Integer) -> % shift(s,n)== delay zero?(s) => 0 fs:=frst(s) es:=fs.k concat([es+n,fs.c]$TERM,shift(rest(s),n)) + ?*? : (%,%) -> % a:% + b:% == delay zero?(a) => b zero?(b) => a @@ -122621,26 +125767,32 @@ NeitherSparseOrDensePowerSeries(K):Exports == Implementation where ea > eb => concat([eb,fb.c]$TERM,a + rest(b)) eb > ea => concat([ea,fa.c]$TERM,rest(a) + b) + -? : % -> % - a:% == --delay multC( (-1) :: K , 0 , a) + ?-? : (%,%) -> % a:% - b:% == --delay a+(-b) + multC: (K,INT,%) -> % multC(coef,n,s)== delay zero?(coef) => 0 zero?(s) => 0 f:=frst(s) concat([f.k+n,coef*f.c]$TERM,multC(coef,n,rest(s))) + ?*? : (K,%) -> % coef:K * s:% == delay zero?(coef) => 0 zero?(s) => 0 f:=frst(s) concat([f.k,coef*f.c]$TERM, coef *$% rest(s)) + ?*? : (%,K) -> % s:% * coef:K == coef * s + ?*? : (%,%) -> % s1:% * s2:%== delay zero?(s1) or zero?(s2) => 0 f1:TERM:=frst(s1) @@ -123421,81 +126573,96 @@ NewSparseMultivariatePolynomial(R,VarSet) : Exports == Implementation where VPoly:= Record(v:VarSet,ts:D) Rep:= Union(R,VPoly) - --local function + --local function PSimp: (D,VarSet) -> % - PSimp(up,mv) == if degree(up) = 0 then leadingCoefficient(up) else [mv,up]$VPoly + coerce : % -> SparseMultivariatePolynomial(R,VarSet) coerce (p:$):SMPR == p pretend SMPR + coerce : SparseMultivariatePolynomial(R,VarSet) -> % coerce (p:SMPR):$ == p pretend $ + retractIfCan : % -> Union(SparseMultivariatePolynomial(R,VarSet),"failed") retractIfCan (p:$) : Union(SMPR,"failed") == (p pretend SMPR)::Union(SMPR,"failed") + mvar : % -> VarSet mvar p == p case R => error" Error in mvar from NSMP : #1 has no variables." p.v + mdeg : % -> NonNegativeInteger mdeg p == p case R => 0$N degree(p.ts)$D + init : % -> % init p == p case R => error" Error in init from NSMP : #1 has no variables." leadingCoefficient(p.ts)$D + head : % -> % head p == p case R => p ([p.v,leadingMonomial(p.ts)$D]$VPoly)::Rep + tail : % -> % tail p == p case R => 0$$ red := reductum(p.ts)$D ground?(red)$D => (ground(red)$D)::Rep ([p.v,red]$VPoly)::Rep + iteratedInitials : % -> List(%) iteratedInitials p == p case R => [] p := leadingCoefficient(p.ts)$D cons(p,iteratedInitials(p)) + localDeepestInitial : $ -> $ localDeepestInitial (p : $) : $ == p case R => p localDeepestInitial leadingCoefficient(p.ts)$D + deepestInitial : % -> % deepestInitial p == p case R => error"Error in deepestInitial from NSMP : #1 has no variables." localDeepestInitial leadingCoefficient(p.ts)$D + mainMonomial : % -> % mainMonomial p == zero? p => error"Error in mainMonomial from NSMP : the argument is zero" p case R => 1$$ monomial(1$$,p.v,degree(p.ts)$D) + leastMonomial : % -> % leastMonomial p == zero? p => error"Error in leastMonomial from NSMP : the argument is zero" p case R => 1$$ monomial(1$$,p.v,minimumDegree(p.ts)$D) + mainCoefficients : % -> List(%) mainCoefficients p == zero? p => error"Error in mainCoefficients from NSMP : the argument is zero" p case R => [p] coefficients(p.ts)$D + leadingCoefficient : % -> R leadingCoefficient(p:$,x:VarSet):$ == (p case R) => p p.v = x => leadingCoefficient(p.ts)$D zero? (d := degree(p,x)) => p coefficient(p,x,d) + localMonicModulo : ($,$) -> $ localMonicModulo(a:$,b:$):$ == -- b is assumed to have initial 1 a case R => a @@ -123513,6 +126680,7 @@ NewSparseMultivariatePolynomial(R,VarSet) : Exports == Implementation where mM := ([a.v,m]$VPoly)::Rep mM + monicModulo : (%,%) -> % monicModulo (a,b) == b case R => error"Error in monicModulo from NSMP : #2 is constant" ib : $ := init(b)@$ @@ -123533,6 +126701,7 @@ NewSparseMultivariatePolynomial(R,VarSet) : Exports == Implementation where mM := localMonicModulo (a,b) mM + prem : (%,%) -> % prem(a:$, b:$): $ == -- with pseudoRemainder$NSUP b case R => @@ -123553,17 +126722,20 @@ NewSparseMultivariatePolynomial(R,VarSet) : Exports == Implementation where test := degree(a,b.v)::Z - db lcb ** (delta::N) * a + pquo : (%,%) -> % pquo (a:$, b:$) : $ == cPS := lazyPseudoDivide (a,b) c := (cPS.coef) ** (cPS.gap) c * cPS.quotient + pseudoDivide : (%,%) -> Record(quotient: %,remainder: %) pseudoDivide(a:$, b:$): Record (quotient : $, remainder : $) == -- from RPOLCAT cPS := lazyPseudoDivide(a,b) c := (cPS.coef) ** (cPS.gap) [c * cPS.quotient, c * cPS.remainder] + lazyPrem : (%,%) -> % lazyPrem(a:$, b:$): $ == -- with lazyPseudoRemainder$NSUP -- Uses leadingCoefficient: ($, V) -> $ @@ -123580,6 +126752,7 @@ NewSparseMultivariatePolynomial(R,VarSet) : Exports == Implementation where test := degree(a,b.v)::Z - db a + lazyPquo : (%,%) -> % lazyPquo (a:$, b:$) : $ == -- with lazyPseudoQuotient$NSUP b case R => @@ -123598,6 +126771,8 @@ NewSparseMultivariatePolynomial(R,VarSet) : Exports == Implementation where test := degree(a,b.v)::Z - db q + lazyPseudoDivide : (%,%) -> + Record(coef: %,gap: NonNegativeInteger,quotient: %,remainder: %) lazyPseudoDivide(a:$, b:$): _ Record(coef:$, gap: N,quotient:$, remainder:$) == -- with lazyPseudoDivide$NSUP @@ -123621,6 +126796,8 @@ NewSparseMultivariatePolynomial(R,VarSet) : Exports == Implementation where test := degree(a,b.v)::Z - db [lcb, (delta::N), q, a] + lazyResidueClass : (%,%) -> + Record(polnum: %,polden: %,power: NonNegativeInteger) lazyResidueClass(a:$, b:$): Record(polnum:$, polden:$, power:N) == -- with lazyResidueClass$NSUP b case R => @@ -123645,11 +126822,13 @@ NewSparseMultivariatePolynomial(R,VarSet) : Exports == Implementation where packD := PseudoRemainderSequence($,D) + exactQuo : ($,$) -> $ exactQuo(x:$, y:$):$ == ex: Union($,"failed") := x exquo$$ y (ex case $) => ex::$ error "in exactQuotient$NSMP: bad args" + LazardQuotient : (%,%,NonNegativeInteger) -> % LazardQuotient(x:$, y:$, n: N):$ == zero?(n) => error("LazardQuotient$NSMP : n = 0") (n = 1) => x @@ -123663,15 +126842,18 @@ NewSparseMultivariatePolynomial(R,VarSet) : Exports == Implementation where c := exactQuo(c*c,y) if n >= a then ( c := exactQuo(c*x,y) ; n := (n - a)::N ) + LazardQuotient2 : (%,%,%,NonNegativeInteger) -> % LazardQuotient2(p:$, a:$, b:$, n: N) == zero?(n) => error " in LazardQuotient2$NSMP: bad #4" (n = 1) => p c: $ := LazardQuotient(a,b,(n-1)::N) exactQuo(c*p,b) + nextsubResultant2 : (%,%,%,%) -> % next_subResultant2(p:$, q:$, z:$, s:$) == PSimp(next_sousResultant2(p.ts,q.ts,z.ts,s)$packD,p.v) + subResultantGcd : (%,%) -> % subResultantGcd(a:$, b:$): $ == (a case R) or (b case R) => error "subResultantGcd$NSMP: one arg is constant" @@ -123679,6 +126861,7 @@ NewSparseMultivariatePolynomial(R,VarSet) : Exports == Implementation where error "subResultantGcd$NSMP: mvar(#1) ~= mvar(#2)" PSimp(subResultantGcd(a.ts,b.ts),a.v) + halfExtendedSubResultantGcd1 : (%,%) -> Record(gcd: %,coef1: %) halfExtendedSubResultantGcd1(a:$,b:$): Record (gcd: $, coef1: $) == (a case R) or (b case R) => error "halfExtendedSubResultantGcd1$NSMP: one arg is constant" @@ -123687,6 +126870,7 @@ NewSparseMultivariatePolynomial(R,VarSet) : Exports == Implementation where hesrg := halfExtendedSubResultantGcd1(a.ts,b.ts)$D [PSimp(hesrg.gcd,a.v), PSimp(hesrg.coef1,a.v)] + halfExtendedSubResultantGcd2 : (%,%) -> Record(gcd: %,coef2: %) halfExtendedSubResultantGcd2(a:$,b:$): Record (gcd: $, coef2: $) == (a case R) or (b case R) => error "halfExtendedSubResultantGcd2$NSMP: one arg is constant" @@ -123695,6 +126879,7 @@ NewSparseMultivariatePolynomial(R,VarSet) : Exports == Implementation where hesrg := halfExtendedSubResultantGcd2(a.ts,b.ts)$D [PSimp(hesrg.gcd,a.v), PSimp(hesrg.coef2,a.v)] + extendedSubResultantGcd : (%,%) -> Record(gcd: %,coef1: %,coef2: %) extendedSubResultantGcd(a:$,b:$): Record (gcd: $, coef1: $, coef2: $) == (a case R) or (b case R) => error "extendedSubResultantGcd$NSMP: one arg is constant" @@ -123703,6 +126888,7 @@ NewSparseMultivariatePolynomial(R,VarSet) : Exports == Implementation where esrg := extendedSubResultantGcd(a.ts,b.ts)$D [PSimp(esrg.gcd,a.v),PSimp(esrg.coef1,a.v),PSimp(esrg.coef2,a.v)] + resultant : (%,%) -> % resultant(a:$, b:$): $ == (a case R) or (b case R) => error "resultant$NSMP: one arg is constant" @@ -123710,6 +126896,7 @@ NewSparseMultivariatePolynomial(R,VarSet) : Exports == Implementation where error "resultant$NSMP: mvar(#1) ~= mvar(#2)" resultant(a.ts,b.ts)$D + subResultantChain : (%,%) -> List(%) subResultantChain(a:$, b:$): List $ == (a case R) or (b case R) => error "subResultantChain$NSMP: one arg is constant" @@ -123717,6 +126904,7 @@ NewSparseMultivariatePolynomial(R,VarSet) : Exports == Implementation where error "subResultantChain$NSMP: mvar(#1) ~= mvar(#2)" [PSimp(up,a.v) for up in subResultantsChain(a.ts,b.ts)] + lastSubResultant : (%,%) -> % lastSubResultant(a:$, b:$): $ == (a case R) or (b case R) => error "lastSubResultant$NSMP: one arg is constant" @@ -123727,11 +126915,13 @@ NewSparseMultivariatePolynomial(R,VarSet) : Exports == Implementation where if R has EuclideanDomain then + exactQuotient : (%,R) -> % exactQuotient (a:$,b:R) == (b = 1) => a a case R => (a::R quo$R b)::$ ([a.v, map((a1:%):% +-> exactQuotient(a1,b),a.ts)$SUP2]$VPoly)::Rep + exactQuotient! : (%,R) -> % exactQuotient! (a:$,b:R) == (b = 1) => a a case R => (a::R quo$R b)::$ @@ -123740,11 +126930,13 @@ NewSparseMultivariatePolynomial(R,VarSet) : Exports == Implementation where else + exactQuotient : (%,R) -> % exactQuotient (a:$,b:R) == (b = 1) => a a case R => ((a::R exquo$R b)::R)::$ ([a.v, map((a1:%):% +-> exactQuotient(a1,b),a.ts)$SUP2]$VPoly)::Rep + exactQuotient! : (%,R) -> % exactQuotient! (a:$,b:R) == (b = 1) => a a case R => ((a::R exquo$R b)::R)::$ @@ -123754,15 +126946,18 @@ NewSparseMultivariatePolynomial(R,VarSet) : Exports == Implementation where if R has GcdDomain then + localGcd : (R,$) -> R localGcd(r:R,p:$):R == p case R => gcd(r,p::R)$R gcd(r,content(p))$R + gcd : (R,%) -> R gcd(r:R,p:$):R == (r = 1) => r zero? p => r localGcd(r,p) + content : % -> R content p == p case R => p up : D := p.ts @@ -123772,6 +126967,7 @@ NewSparseMultivariatePolynomial(R,VarSet) : Exports == Implementation where up := reductum up r + primitivePart! : % -> % primitivePart! p == zero? p => p p case R => 1$$ @@ -124417,19 +127613,25 @@ NewSparseUnivariatePolynomial(R): Exports == Implementation where Rep ==> List Term + rep : $ -> Rep rep(s:$):Rep == s pretend Rep + per : Rep -> $ per(l:Rep):$ == l pretend $ + coerce : % -> SparseUnivariatePolynomial(R) coerce (p:$):SUPR == p pretend SUPR + coerce : SparseUnivariatePolynomial(R) -> % coerce (p:SUPR):$ == p pretend $ + retractIfCan : % -> Union(SparseUnivariatePolynomial(R),"failed") retractIfCan (p:$) : Union(SUPR,"failed") == (p pretend SUPR)::Union(SUPR,"failed") + monicModulo : (%,%) -> % monicModulo(x,y) == zero? y => error "in monicModulo$NSUP: division by 0" @@ -124446,6 +127648,8 @@ NewSparseUnivariatePolynomial(R): Exports == Implementation where if empty? xx then break per xx + lazyResidueClass : (%,%) -> + Record(polnum: %,polden: R,power: NonNegativeInteger) lazyResidueClass(x,y) == zero? y => error "in lazyResidueClass$NSUP: division by 0" @@ -124461,6 +127665,7 @@ NewSparseUnivariatePolynomial(R): Exports == Implementation where if empty? xx then break [per xx, co, pow] + lazyPseudoRemainder : (%,%) -> % lazyPseudoRemainder(x,y) == zero? y => error "in lazyPseudoRemainder$NSUP: division by 0" @@ -124477,6 +127682,8 @@ NewSparseUnivariatePolynomial(R): Exports == Implementation where if empty? xx then break per xx + lazyPseudoDivide : (%,%) -> + Record(coef: R,gap: NonNegativeInteger,quotient: %,remainder: %) lazyPseudoDivide(x,y) == zero? y => error "in lazyPseudoDivide$NSUP: division by 0" @@ -124495,6 +127702,7 @@ NewSparseUnivariatePolynomial(R): Exports == Implementation where if empty? xx then break [co, pow, per reverse qq, per xx] + lazyPseudoQuotient : (%,%) -> % lazyPseudoQuotient(x,y) == zero? y => error "in lazyPseudoQuotient$NSUP: division by 0" @@ -124515,44 +127723,55 @@ NewSparseUnivariatePolynomial(R): Exports == Implementation where pack ==> PseudoRemainderSequence(R, %) + subResultantGcd : (%,%) -> % subResultantGcd(p1,p2) == subResultantGcd(p1,p2)$pack + subResultantsChain : (%,%) -> List(%) subResultantsChain(p1,p2) == chainSubResultants(p1,p2)$pack + lastSubResultant : (%,%) -> % lastSubResultant(p1,p2) == lastSubResultant(p1,p2)$pack + resultant : (%,%) -> R resultant(p1,p2) == resultant(p1,p2)$pack + extendedResultant : (%,%) -> Record(resultant: R,coef1: %,coef2: %) extendedResultant(p1,p2) == re: Record(coef1: $, coef2: $, resultant: R) := _ resultantEuclidean(p1,p2)$pack [re.resultant, re.coef1, re.coef2] + halfExtendedResultant1 : (%,%) -> Record(resultant: R,coef1: %) halfExtendedResultant1(p1:$, p2: $): Record(resultant: R, coef1: $) == re: Record(coef1: $, resultant: R) := _ semiResultantEuclidean1(p1, p2)$pack [re.resultant, re.coef1] + halfExtendedResultant2 : (%,%) -> Record(resultant: R,coef2: %) halfExtendedResultant2(p1:$, p2: $): Record(resultant: R, coef2: $) == re: Record(coef2: $, resultant: R) := _ semiResultantEuclidean2(p1, p2)$pack [re.resultant, re.coef2] + extendedSubResultantGcd : (%,%) -> Record(gcd: %,coef1: %,coef2: %) extendedSubResultantGcd(p1,p2) == re: Record(coef1: $, coef2: $, gcd: $) := _ subResultantGcdEuclidean(p1,p2)$pack [re.gcd, re.coef1, re.coef2] + halfExtendedSubResultantGcd1 : (%,%) -> Record(gcd: %,coef1: %) halfExtendedSubResultantGcd1(p1:$, p2: $): Record(gcd: $, coef1: $) == re: Record(coef1: $, gcd: $) := _ semiSubResultantGcdEuclidean1(p1, p2)$pack [re.gcd, re.coef1] + halfExtendedSubResultantGcd2 : (%,%) -> Record(gcd: %,coef2: %) halfExtendedSubResultantGcd2(p1:$, p2: $): Record(gcd: $, coef2: $) == re: Record(coef2: $, gcd: $) := _ semiSubResultantGcdEuclidean2(p1, p2)$pack [re.gcd, re.coef2] + pseudoDivide : (%,%) -> Record(coef: R,quotient: %,remainder: %) pseudoDivide(x,y) == zero? y => error "in pseudoDivide$NSUP: division by 0" @@ -124575,6 +127794,7 @@ NewSparseUnivariatePolynomial(R): Exports == Implementation where x := default * (per xx) [co, q, x] + pseudoQuotient : (%,%) -> % pseudoQuotient(x,y) == zero? y => error "in pseudoDivide$NSUP: division by 0" @@ -124722,8 +127942,10 @@ None():SetCategory == add (* domain NONE *) (* + coerce : % -> OutputForm coerce(none:%):OutputForm == "NONE" :: OutputForm + ?=? : (%,%) -> Boolean x:% = y:% == EQ(x,y)$Lisp *) @@ -124888,10 +128110,13 @@ SubDomain(Integer,#1 >= 0) add x,y:% + sup : (%,%) -> % sup(x,y) == MAX(x,y)$Lisp + shift : (%,Integer) -> % shift(x:%, n:Integer):% == ASH(x,n)$Lisp + subtractIfCan : (%,%) -> Union(%,"failed") subtractIfCan(x, y) == c:Integer := (x pretend Integer) - (y pretend Integer) c < 0 => "failed" @@ -125104,17 +128329,22 @@ NottinghamGroup(F:FiniteFieldCategory): Group with (* Rep:=UnivariateFormalPowerSeries F + coerce : % -> OutputForm coerce f == coerce(f::Rep)$UnivariateFormalPowerSeries(F) + retract : UnivariateFormalPowerSeries(F) -> % retract f == if zero? coefficient(f,0) and one? coefficient(f,1) then f::Rep else error"The leading term must be x" + 1 : () -> % 1 == monomial(1,1) + ?*? : (%,%) -> % f*g == f.g + inv : % -> % inv f == revert f *) @@ -125276,16 +128506,37 @@ NumericalIntegrationProblem(): EE == II where Rep := Union(nia:NIAA,mdnia:MDNIAA) + coerce : Record(var: Symbol,fn: Expression(DoubleFloat), + range: Segment(OrderedCompletion(DoubleFloat)), + abserr: DoubleFloat,relerr: DoubleFloat) -> % coerce(s:NIAA) == [s] + coerce : Record(fn: Expression(DoubleFloat), + range: List(Segment(OrderedCompletion(DoubleFloat))), + abserr: DoubleFloat,relerr: DoubleFloat) -> % coerce(s:MDNIAA) == [s] + coerce : Union( + nia: Record(var: Symbol,fn: Expression(DoubleFloat), + range: Segment(OrderedCompletion(DoubleFloat)), + abserr: DoubleFloat,relerr: DoubleFloat), + mdnia: Record(fn: Expression(DoubleFloat), + range: List(Segment(OrderedCompletion(DoubleFloat))), + abserr: DoubleFloat,relerr: DoubleFloat)) -> % coerce(s:Union(nia:NIAA,mdnia:MDNIAA)) == s + coerce : % -> OutputForm coerce(x:%):OutputForm == (x) case nia => (x.nia)::OutputForm (x.mdnia)::OutputForm + retract : % -> Union( + nia: Record(var: Symbol,fn: Expression(DoubleFloat), + range: Segment(OrderedCompletion(DoubleFloat)), + abserr: DoubleFloat,relerr: DoubleFloat), + mdnia: Record(fn: Expression(DoubleFloat), + range: List(Segment(OrderedCompletion(DoubleFloat))), + abserr: DoubleFloat,relerr: DoubleFloat)) retract(x:%):Union(nia:NIAA,mdnia:MDNIAA) == (x) case nia => [x.nia] [x.mdnia] @@ -125426,11 +128677,20 @@ NumericalODEProblem(): EE == II where Rep := ODEAB + coerce : Record(xinit: DoubleFloat,xend: DoubleFloat, + fn: Vector(Expression(DoubleFloat)),yinit: List(DoubleFloat), + intvals: List(DoubleFloat),g: Expression(DoubleFloat), + abserr: DoubleFloat,relerr: DoubleFloat) -> % coerce(s:ODEAB) == s + coerce : % -> OutputForm coerce(x:%):OutputForm == (retract(x))::OutputForm + retract : % -> Record(xinit: DoubleFloat,xend: DoubleFloat, + fn: Vector(Expression(DoubleFloat)),yinit: List(DoubleFloat), + intvals: List(DoubleFloat),g: Expression(DoubleFloat), + abserr: DoubleFloat,relerr: DoubleFloat) retract(x:%):ODEAB == x :: Rep *) @@ -125593,16 +128853,35 @@ NumericalOptimizationProblem(): EE == II where Rep := UNOALSAD + coerce : Record(fn: Expression(DoubleFloat),init: List(DoubleFloat), + lb: List(OrderedCompletion(DoubleFloat)), + cf: List(Expression(DoubleFloat)), + ub: List(OrderedCompletion(DoubleFloat))) -> % coerce(s:NOAD) == [s] - + + coerce : + Record(lfn: List(Expression(DoubleFloat)),init: List(DoubleFloat)) -> % coerce(s:LSAD) == [s] + coerce : Union( + noa: Record(fn: Expression(DoubleFloat),init: List(DoubleFloat), + lb: List(OrderedCompletion(DoubleFloat)), + cf: List(Expression(DoubleFloat)), + ub: List(OrderedCompletion(DoubleFloat))), + lsa: Record(lfn: List(Expression(DoubleFloat)),init: List(DoubleFloat))) + -> % coerce(x:UNOALSAD) == x coerce(x:%):OutputForm == (x) case noa => (x.noa)::OutputForm (x.lsa)::OutputForm + retract : % -> Union( + noa: Record(fn: Expression(DoubleFloat),init: List(DoubleFloat), + lb: List(OrderedCompletion(DoubleFloat)), + cf: List(Expression(DoubleFloat)), + ub: List(OrderedCompletion(DoubleFloat))), + lsa: Record(lfn: List(Expression(DoubleFloat)),init: List(DoubleFloat))) retract(x:%):UNOALSAD == (x) case noa => [x.noa] [x.lsa] @@ -125759,11 +129038,22 @@ NumericalPDEProblem(): EE == II where Rep := PDEBC + coerce : Record(pde: List(Expression(DoubleFloat)), + constraints: List(Record(start: DoubleFloat,finish: DoubleFloat, + grid: NonNegativeInteger,boundaryType: Integer, + dStart: Matrix(DoubleFloat),dFinish: Matrix(DoubleFloat))), + f: List(List(Expression(DoubleFloat))),st: String,tol: DoubleFloat) -> % coerce(s:PDEBC) == s + coerce : % -> OutputForm coerce(x:%):OutputForm == (retract(x))::OutputForm + retract : % -> Record(pde: List(Expression(DoubleFloat)), + constraints: List(Record(start: DoubleFloat,finish: DoubleFloat, + grid: NonNegativeInteger,boundaryType: Integer, + dStart: Matrix(DoubleFloat),dFinish: Matrix(DoubleFloat))), + f: List(List(Expression(DoubleFloat))),st: String,tol: DoubleFloat) retract(x:%):PDEBC == x :: Rep *) @@ -126270,8 +129560,10 @@ Octonion(R:CommutativeRing): export == impl where Rep := Record(e: QR,E: QR) + 0 : () -> % 0 == [0,0] + 1 : () -> % 1 == [1,0] a,b,c,d,f,g,h,i : R @@ -126280,38 +129572,52 @@ Octonion(R:CommutativeRing): export == impl where x,y : % + real : % -> R real x == real (x.e) + imagi : % -> R imagi x == imagI (x.e) + imagj : % -> R imagj x == imagJ (x.e) + imagk : % -> R imagk x == imagK (x.e) + imagE : % -> R imagE x == real (x.E) + imagI : % -> R imagI x == imagI (x.E) + imagJ : % -> R imagJ x == imagJ (x.E) + imagK : % -> R imagK x == imagK (x.E) + octon : (R,R,R,R,R,R,R,R) -> % octon(a,b,c,d,f,g,h,i) == [quatern(a,b,c,d)$QR,quatern(f,g,h,i)$QR] + octon : (Quaternion(R),Quaternion(R)) -> % octon(p,q) == [p,q] + coerce : Quaternion(R) -> % coerce(q) == [q,0$QR] + retract : % -> Quaternion(R) retract(x):QR == not(zero? imagE x and zero? imagI x and zero? imagJ x and zero? imagK x)=> error "Cannot retract octonion to quaternion." quatern(real x, imagi x,imagj x, imagk x)$QR + retractIfCan : % -> Union(Quaternion(R),"failed") retractIfCan(x):Union(QR,"failed") == not(zero? imagE x and zero? imagI x and zero? imagJ x and zero? imagK x)=> "failed" quatern(real x, imagi x,imagj x, imagk x)$QR + ?*? : (%,%) -> % x * y == [x.e*y.e-(conjugate y.E)*x.E, y.E*x.e + x.E*(conjugate y.e)] *) @@ -126471,22 +129777,46 @@ ODEIntensityFunctionsTable(): E == I where theIFTable:$ := empty()$Rep + showTheIFTable : () -> % showTheIFTable():$ == theIFTable + clearTheIFTable : () -> Void clearTheIFTable():Void == theIFTable := empty()$Rep void()$Void + iFTable : List(Record(key: Record(xinit: DoubleFloat,xend: DoubleFloat, + fn: Vector(Expression(DoubleFloat)),yinit: List(DoubleFloat), + intvals: List(DoubleFloat),g: Expression(DoubleFloat), + abserr: DoubleFloat,relerr: DoubleFloat), + entry: Record(stiffness: Float,stability: Float,expense: Float, + accuracy: Float,intermediateResults: Float))) -> % iFTable(l:List Record(key:ODEA,entry:ATT)):$ == theIFTable := table(l)$Rep + insert! : Record(key: Record(xinit: DoubleFloat,xend: DoubleFloat, + fn: Vector(Expression(DoubleFloat)),yinit: List(DoubleFloat), + intvals: List(DoubleFloat),g: Expression(DoubleFloat), + abserr: DoubleFloat,relerr: DoubleFloat), + entry: Record(stiffness: Float,stability: Float,expense: Float, + accuracy: Float,intermediateResults: Float)) -> % insert!(r:Record(key:ODEA,entry:ATT)):$ == insert!(r,theIFTable)$Rep + keys : % -> List(Record(xinit: DoubleFloat,xend: DoubleFloat, + fn: Vector(Expression(DoubleFloat)),yinit: List(DoubleFloat), + intvals: List(DoubleFloat),g: Expression(DoubleFloat), + abserr: DoubleFloat,relerr: DoubleFloat)) keys(t:$):List ODEA == keys(t)$Rep + showIntensityFunctions : Record(xinit: DoubleFloat,xend: DoubleFloat, + fn: Vector(Expression(DoubleFloat)),yinit: List(DoubleFloat), + intvals: List(DoubleFloat),g: Expression(DoubleFloat), + abserr: DoubleFloat,relerr: DoubleFloat) -> + Union(Record(stiffness: Float,stability: Float,expense: Float, + accuracy: Float,intermediateResults: Float),"failed") showIntensityFunctions(k:ODEA):Union(ATT,"failed") == search(k,theIFTable)$Rep @@ -126857,6 +130187,7 @@ OneDimensionalArray(S:Type): Exports == Implementation where (* IndexedOneDimensionalArray(S, ARRAYMININDEX) add + oneDimensionalArray : List(S) -> % oneDimensionalArray(u) == n := #u n = 0 => empty() @@ -126864,6 +130195,7 @@ OneDimensionalArray(S:Type): Exports == Implementation where for i in 2..n for x in rest u repeat a.i := x a + oneDimensionalArray : (NonNegativeInteger,S) -> % oneDimensionalArray(n,s) == new(n,s) *) @@ -127123,22 +130455,30 @@ OnePointCompletion(R:SetCategory): Exports == Implementation where Rep := Union(R, "infinity") - coerce(r:R):% == r + coerce : R -> % + coerce(r:R):% == r - retract(x:%):R == (x case R => x::R; error "Not finite") + retract : % -> R + retract(x:%):R == (x case R => x::R; error "Not finite") - finite? x == x case R + finite? : % -> Boolean + finite? x == x case R - infinite? x == x case "infinity" + infinite? : % -> Boolean + infinite? x == x case "infinity" - infinity() == "infinity" + infinity : () -> % + infinity() == "infinity" + rationalIfCan : % -> Union(Fraction(Integer),"failed") retractIfCan(x:%):Union(R, "failed") == (x case R => x::R; "failed") + coerce : % -> OutputForm coerce(x:%):OutputForm == x case "infinity" => "infinity"::OutputForm x::R::OutputForm + ?=? : (%,%) -> Boolean x = y == x case "infinity" => y case "infinity" y case "infinity" => false @@ -127146,18 +130486,22 @@ OnePointCompletion(R:SetCategory): Exports == Implementation where if R has AbelianGroup then + 0 : () -> % 0 == 0$R + ?*? : (Integer,%) -> % n:Integer * x:% == x case "infinity" => zero? n => error "Undefined product" infinity() n * x::R + -? : % -> % - x == x case "infinity" => error "Undefined inverse" - (x::R) + ?+? : (%,%) -> % x + y == x case "infinity" => x y case "infinity" => y @@ -127165,16 +130509,18 @@ OnePointCompletion(R:SetCategory): Exports == Implementation where if R has OrderedRing then - fininf: R -> % - - 1 == 1$R + 1 : () -> % + 1 == 1$R + characteristic : () -> NonNegativeInteger characteristic() == characteristic()$R + fininf: R -> % fininf r == zero? r => error "Undefined product" infinity() + ?*? : (%,%) -> % x:% * y:% == x case "infinity" => y case "infinity" => y @@ -127182,12 +130528,14 @@ OnePointCompletion(R:SetCategory): Exports == Implementation where y case "infinity" => fininf(x::R) x::R * y::R + recip : % -> Union(%,"failed") recip x == x case "infinity" => 0 zero?(x::R) => infinity() (u := recip(x::R)) case "failed" => "failed" u::R::% + ? Boolean x < y == x case "infinity" => false -- do not change the order y case "infinity" => true -- of those two tests @@ -127195,10 +130543,13 @@ OnePointCompletion(R:SetCategory): Exports == Implementation where if R has IntegerNumberSystem then + rational? : % -> Boolean rational? x == finite? x + rational : % -> Fraction(Integer) rational x == rational(retract(x)@R) + rationalIfCan : % -> Union(Fraction(Integer),"failed") rationalIfCan x == (r:= retractIfCan(x)@Union(R,"failed")) case "failed" =>"failed" rational(r::R) @@ -127312,19 +130663,25 @@ OpenMathConnection(): with (* domain OMCONN *) (* + OMmakeConn : SingleInteger -> % OMmakeConn(timeout: SingleInteger): % == OM_-MAKECONN(timeout)$Lisp + OMcloseConn : % -> Void OMcloseConn(conn: %): Void == OM_-CLOSECONN(conn)$Lisp + OMconnInDevice : % -> OpenMathDevice OMconnInDevice(conn: %): OpenMathDevice == OM_-GETCONNINDEV(conn)$Lisp + OMconnOutDevice : % -> OpenMathDevice OMconnOutDevice(conn: %): OpenMathDevice == OM_-GETCONNOUTDEV(conn)$Lisp + OMconnectTCP : (%,String,SingleInteger) -> Boolean OMconnectTCP(conn: %, host: String, port: SingleInteger): Boolean == OM_-CONNECTTCP(conn, host, port)$Lisp + OMbindTCP : (%,SingleInteger) -> Boolean OMbindTCP(conn: %, port: SingleInteger): Boolean == OM_-BINDTCP(conn, port)$Lisp @@ -127660,96 +131017,139 @@ OpenMathDevice(): with (* domain OMDEV *) (* + OMopenFile : (String,String,OpenMathEncoding) -> % OMopenFile(fname: String, fmode: String, enc: OpenMathEncoding): % == OM_-OPENFILEDEV(fname, fmode, enc)$Lisp + OMopenString : (String,OpenMathEncoding) -> % OMopenString(str: String, enc: OpenMathEncoding): % == OM_-OPENSTRINGDEV(str, enc)$Lisp + OMclose : % -> Void OMclose(dev: %): Void == OM_-CLOSEDEV(dev)$Lisp + OMsetEncoding : (%,OpenMathEncoding) -> Void OMsetEncoding(dev: %, enc: OpenMathEncoding): Void == OM_-SETDEVENCODING(dev, enc)$Lisp + OMputApp : % -> Void OMputApp(dev: %): Void == OM_-PUTAPP(dev)$Lisp + OMputAtp : % -> Void OMputAtp(dev: %): Void == OM_-PUTATP(dev)$Lisp + OMputAttr : % -> Void OMputAttr(dev: %): Void == OM_-PUTATTR(dev)$Lisp + OMputBind : % -> Void OMputBind(dev: %): Void == OM_-PUTBIND(dev)$Lisp + OMputBVar : % -> Void OMputBVar(dev: %): Void == OM_-PUTBVAR(dev)$Lisp + OMputError : % -> Void OMputError(dev: %): Void == OM_-PUTERROR(dev)$Lisp + OMputObject : % -> Void OMputObject(dev: %): Void == OM_-PUTOBJECT(dev)$Lisp + OMputEndApp : % -> Void OMputEndApp(dev: %): Void == OM_-PUTENDAPP(dev)$Lisp + OMputEndAtp : % -> Void OMputEndAtp(dev: %): Void == OM_-PUTENDATP(dev)$Lisp + OMputEndAttr : % -> Void OMputEndAttr(dev: %): Void == OM_-PUTENDATTR(dev)$Lisp + OMputEndBind : % -> Void OMputEndBind(dev: %): Void == OM_-PUTENDBIND(dev)$Lisp + OMputEndBVar : % -> Void OMputEndBVar(dev: %): Void == OM_-PUTENDBVAR(dev)$Lisp + OMputEndError : % -> Void OMputEndError(dev: %): Void == OM_-PUTENDERROR(dev)$Lisp + OMputEndObject : % -> Void OMputEndObject(dev: %): Void == OM_-PUTENDOBJECT(dev)$Lisp + OMputInteger : (%,Integer) -> Void OMputInteger(dev: %, i: Integer): Void == OM_-PUTINT(dev, i)$Lisp + OMputFloat : (%,DoubleFloat) -> Void OMputFloat(dev: %, f: DoubleFloat): Void == OM_-PUTFLOAT(dev, f)$Lisp + OMputVariable : (%,Symbol) -> Void OMputVariable(dev: %, v: Symbol): Void == OM_-PUTVAR(dev, v)$Lisp + OMputString : (%,String) -> Void OMputString(dev: %, s: String): Void == OM_-PUTSTRING(dev, s)$Lisp + OMputSymbol : (%,String,String) -> Void OMputSymbol(dev: %, cd: String, nm: String): Void == OM_-PUTSYMBOL(dev, cd, nm)$Lisp + OMgetApp : % -> Void OMgetApp(dev: %): Void == OM_-GETAPP(dev)$Lisp + OMgetAtp : % -> Void OMgetAtp(dev: %): Void == OM_-GETATP(dev)$Lisp + OMgetAttr : % -> Void OMgetAttr(dev: %): Void == OM_-GETATTR(dev)$Lisp + OMgetBind : % -> Void OMgetBind(dev: %): Void == OM_-GETBIND(dev)$Lisp + OMgetBVar : % -> Void OMgetBVar(dev: %): Void == OM_-GETBVAR(dev)$Lisp + OMgetError : % -> Void OMgetError(dev: %): Void == OM_-GETERROR(dev)$Lisp + OMgetObject : % -> Void OMgetObject(dev: %): Void == OM_-GETOBJECT(dev)$Lisp + OMgetEndApp : % -> Void OMgetEndApp(dev: %): Void == OM_-GETENDAPP(dev)$Lisp + OMgetEndAtp : % -> Void OMgetEndAtp(dev: %): Void == OM_-GETENDATP(dev)$Lisp + OMgetEndAttr : % -> Void OMgetEndAttr(dev: %): Void == OM_-GETENDATTR(dev)$Lisp + OMgetEndBind : % -> Void OMgetEndBind(dev: %): Void == OM_-GETENDBIND(dev)$Lisp + OMgetEndBVar : % -> Void OMgetEndBVar(dev: %): Void == OM_-GETENDBVAR(dev)$Lisp + OMgetEndError : % -> Void OMgetEndError(dev: %): Void == OM_-GETENDERROR(dev)$Lisp + OMgetEndObject : % -> Void OMgetEndObject(dev: %): Void == OM_-GETENDOBJECT(dev)$Lisp + OMgetInteger : % -> Integer OMgetInteger(dev: %): Integer == OM_-GETINT(dev)$Lisp + OMgetFloat : % -> DoubleFloat OMgetFloat(dev: %): DoubleFloat == OM_-GETFLOAT(dev)$Lisp + OMgetVariable : % -> Symbol OMgetVariable(dev: %): Symbol == OM_-GETVAR(dev)$Lisp + OMgetString : % -> String OMgetString(dev: %): String == OM_-GETSTRING(dev)$Lisp + OMgetSymbol : % -> Record(cd: String,name: String) OMgetSymbol(dev: %): Record(cd:String, name:String) == OM_-GETSYMBOL(dev)$Lisp + OMgetType : % -> Symbol OMgetType(dev: %): Symbol == OM_-GETTYPE(dev)$Lisp *) @@ -127872,10 +131272,12 @@ OpenMathEncoding(): SetCategory with Rep := SingleInteger + ?=? : (%,%) -> Boolean =(u,v) == (u=v)$Rep import Rep + coerce : % -> OutputForm coerce(u) == u::Rep = 0$Rep => "Unknown"::OutputForm u::Rep = 1$Rep => "Binary"::OutputForm @@ -127883,12 +131285,16 @@ OpenMathEncoding(): SetCategory with u::Rep = 3::Rep => "SGML"::OutputForm error "Bogus OpenMath Encoding Type" + OMencodingUnknown : () -> % OMencodingUnknown(): % == 0::Rep + OMencodingBinary : () -> % OMencodingBinary(): % == 1::Rep + OMencodingXML : () -> % OMencodingXML(): % == 2::Rep + OMencodingSGML : () -> % OMencodingSGML(): % == 3::Rep *) @@ -128012,6 +131418,7 @@ OpenMathError() : SetCategory with import List String + coerce : % -> OutputForm coerce(e:%):OutputForm == OMParseError? e.err => message "Error parsing OpenMath object" infoSize := #(e.info) @@ -128026,10 +131433,13 @@ OpenMathError() : SetCategory with message "OpenMath read error" error "Malformed OpenMath Error" + omError : (OpenMathErrorKind,List(Symbol)) -> % omError(e:OpenMathErrorKind,i:List Symbol):% == [e,i]$Rep + errorKind : % -> OpenMathErrorKind errorKind(e:%):OpenMathErrorKind == e.err + errorInfo : % -> List(Symbol) errorInfo(e:%):List Symbol == e.info *) @@ -128159,14 +131569,19 @@ OpenMathErrorKind() : SetCategory with Rep := Union(parseError:"OMParseError", unknownCD:"OMUnknownCD", unknownSymbol:"OMUnknownSymbol",readError:"OMReadError") + OMParseError? : % -> Boolean OMParseError?(u) == (u case parseError)$Rep + OMUnknownCD? : % -> Boolean OMUnknownCD?(u) == (u case unknownCD)$Rep + OMUnknownSymbol? : % -> Boolean OMUnknownSymbol?(u) == (u case unknownSymbol)$Rep + OMReadError? : % -> Boolean OMReadError?(u) == (u case readError)$Rep + coerce : Symbol -> % coerce(s:Symbol):% == s = OMParseError => ["OMParseError"]$Rep s = OMUnknownCD => ["OMUnknownCD"]$Rep @@ -128174,8 +131589,10 @@ OpenMathErrorKind() : SetCategory with s = OMReadError => ["OMReadError"]$Rep error concat(string s, " is not a valid OpenMathErrorKind.") + ?=? : (%,%) -> Boolean a = b == (a=b)$Rep + coerce : % -> OutputForm coerce(e:%):OutputForm == coerce(e)$Rep *) @@ -128832,12 +132249,16 @@ OppositeMonogenicLinearOperator(P, R): OPRcat == OPRdef where a: P + op : P -> % op a == a: $ + po : % -> P po x == x: P + ?*? : (%,%) -> % x*y == (y:P) *$P (x:P) + coerce : % -> OutputForm coerce(x): OutputForm == prefix(op::OutputForm, [coerce(x:P)$P]) *) @@ -129126,33 +132547,43 @@ OrderedCompletion(R:SetCategory): Exports == Implementation where Rep := Union(fin:R, inf:B) -- true = +infinity, false = -infinity - coerce(r:R):% == [r] + coerce : R -> % + coerce(r:R):% == [r] - retract(x:%):R == (x case fin => x.fin; error "Not finite") + retract : % -> R + retract(x:%):R == (x case fin => x.fin; error "Not finite") - finite? x == x case fin + finite? : % -> Boolean + finite? x == x case fin - infinite? x == x case inf + infinite? : % -> Boolean + infinite? x == x case inf - plusInfinity() == [true] + plusInfinity : () -> % + plusInfinity() == [true] - minusInfinity() == [false] + minusInfinity : () -> % + minusInfinity() == [false] + rationalIfCan : % -> Union(Fraction(Integer),"failed") retractIfCan(x:%):Union(R, "failed") == x case fin => x.fin "failed" + coerce : % -> OutputForm coerce(x:%):OutputForm == x case fin => (x.fin)::OutputForm e := "infinity"::OutputForm x.inf => empty() + e - e + whatInfinity : % -> SingleInteger whatInfinity x == x case fin => 0 x.inf => 1 -1 + ?=? : (%,%) -> Boolean x = y == x case inf => y case inf => not xor(x.inf, y.inf) @@ -129162,8 +132593,10 @@ OrderedCompletion(R:SetCategory): Exports == Implementation where if R has AbelianGroup then + 0 : () -> % 0 == [0$R] + ?*? : (Integer,%) -> % n:Integer * x:% == x case inf => n > 0 => x @@ -129171,10 +132604,12 @@ OrderedCompletion(R:SetCategory): Exports == Implementation where error "Undefined product" [n * x.fin] + -? : % -> % - x == x case inf => [not(x.inf)] [- (x.fin)] + ?+? : (%,%) -> % x + y == x case inf => y case fin => x @@ -129185,17 +132620,19 @@ OrderedCompletion(R:SetCategory): Exports == Implementation where if R has OrderedRing then - fininf: (B, R) -> % - - 1 == [1$R] + 1 : () -> % + 1 == [1$R] + characteristic : () -> NonNegativeInteger characteristic() == characteristic()$R + fininf: (B, R) -> % fininf(b, r) == r > 0 => [b] r < 0 => [not b] error "Undefined product" + ?*? : (%,%) -> % x:% * y:% == x case inf => y case inf => @@ -129205,11 +132642,13 @@ OrderedCompletion(R:SetCategory): Exports == Implementation where y case inf => fininf(y.inf, x.fin) [x.fin * y.fin] + recip : % -> Union(%,"failed") recip x == x case inf => 0 (u := recip(x.fin)) case "failed" => "failed" [u::R] + ? Boolean x < y == x case inf => y case inf => @@ -129221,10 +132660,13 @@ OrderedCompletion(R:SetCategory): Exports == Implementation where if R has IntegerNumberSystem then + rational? : % -> Boolean rational? x == finite? x - rational x == rational(retract(x)@R) + rational : % -> Fraction(Integer) + rational x == rational(retract(x)@R) + retractIfCan : % -> Union(R,"failed") rationalIfCan x == (r:= retractIfCan(x)@Union(R,"failed")) case "failed" =>"failed" rational(r::R) @@ -129505,6 +132947,7 @@ OrderedDirectProduct(dim:NonNegativeInteger, Rep:=Vector(S) + ? Boolean x:% < y:% == f(x::Rep,y::Rep) *) @@ -130353,6 +133796,7 @@ OrderedFreeMonoid(S: OrderedSet): OFMcategory == OFMdefinition where Rep := ListMonoidOps(S, NNI, 1) -- definitions + lquo : (%,S) -> Union(%,"failed") lquo(w:%, l:S) == x: List REC := listOfMonoms(w)$Rep null x => "failed" @@ -130361,27 +133805,34 @@ OrderedFreeMonoid(S: OrderedSet): OFMcategory == OFMdefinition where fx.exp = 1 => makeMulti rest(x) makeMulti [[fx.gen, (fx.exp - 1)::NNI ]$REC, :rest x] + rquo : (%,%) -> Union(%,"failed") rquo(w:%, l:S) == u:% := reverse w (r := lquo (u,l)) case "failed" => "failed" reverse_! (r::%) + divide : (%,%) -> + Union(Record(lm: Union(%,"failed"),rm: Union(%,"failed")),"failed") divide(left:%,right:%) == a:=lquo(left,right) b:=rquo(left,right) [a,b] + length : % -> NonNegativeInteger length x == reduce("+" ,[f.exp for f in listOfMonoms x], 0) + varList : % -> List(S) varList x == le: List S := [t.gen for t in listOfMonoms x] sort_! removeDuplicates(le) + first : % -> S first w == x: List REC := listOfMonoms w null x => error "empty word !!!" x.first.gen + rest : % -> % rest w == x: List REC := listOfMonoms w null x => error "empty word !!!" @@ -130389,6 +133840,7 @@ OrderedFreeMonoid(S: OrderedSet): OFMcategory == OFMdefinition where fx.exp = 1 => makeMulti rest x makeMulti [[fx.gen , (fx.exp - 1)::NNI ]$REC , :rest x] + lexico : (%,%) -> Boolean lexico(a,b) == -- ordre lexicographique la := listOfMonoms a lb := listOfMonoms b @@ -130408,11 +133860,13 @@ OrderedFreeMonoid(S: OrderedSet): OFMcategory == OFMdefinition where la:=rest la empty? la and not empty? lb + ? Boolean a < b == -- ordre lexicographique par longueur la:NNI := length a; lb:NNI := length b la = lb => lexico(a,b) la < lb + mirror : % -> % mirror x == reverse(x)$Rep *) @@ -130632,32 +134086,44 @@ OrderedVariableList(VariableList:List Symbol): s1,s2:% + convert : % -> Symbol convert(s1):Symbol == VariableList.((s1::Rep)::PositiveInteger) + coerce : % -> OutputForm coerce(s1):OutputForm == (convert(s1)@Symbol)::OutputForm + convert : % -> InputForm convert(s1):InputForm == convert(convert(s1)@Symbol) + convert : % -> Pattern(Integer) convert(s1):Pattern(Integer) == convert(convert(s1)@Symbol) + convert : % -> Pattern(Float) convert(s1):Pattern(Float) == convert(convert(s1)@Symbol) - index i == i::% + index : PositiveInteger -> % + index i == i::% - lookup j == j :: Rep + lookup : % -> PositiveInteger + lookup j == j :: Rep + size : () -> NonNegativeInteger size () == #VariableList + variable : Symbol -> Union(%,"failed") variable(exp:Symbol) == for i in 1.. for exp2 in VariableList repeat if exp=exp2 then return i::PositiveInteger::% "failed" + ? Boolean s1 < s2 == s2 <$Rep s1 + ?=? : (%,%) -> Boolean s1 = s2 == s1 =$Rep s2 - latex(x:%):String == latex(convert(x)@Symbol) + latex : % -> String + latex(x:%):String == latex(convert(x)@Symbol) *) @@ -131761,11 +135227,14 @@ OrderlyDifferentialVariable(S:OrderedSet):DifferentialVariableCategory(S) Rep := Record(var:S, ord:NonNegativeInteger) + makeVariable : (S,NonNegativeInteger) -> % makeVariable(s,n) == [s, n] - variable v == v.var + variable : % -> S + variable v == v.var - order v == v.ord + order : % -> NonNegativeInteger + order v == v.ord *) @@ -131968,19 +135437,25 @@ OrdinaryDifferentialRing(Kernels,R,var): DRcategory == DRcapsule where Rep := R + coerce : R -> % coerce(u:R):$ == u::Rep::$ + coerce : % -> R coerce(p:$):R == p::Rep::R - differentiate p == differentiate(p, var) + differentiate : % -> % + differentiate p == differentiate(p, var) if R has Field then - p / q == ((p::R) /$R (q::R))::$ + ?/? : (%,%) -> % + p / q == ((p::R) /$R (q::R))::$ - p ** n == ((p::R) **$R n)::$ + ?**? : (%,Integer) -> % + p ** n == ((p::R) **$R n)::$ - inv(p) == (inv(p::R)$R)::$ + inv : % -> % + inv(p) == (inv(p::R)$R)::$ *) @@ -132244,14 +135719,19 @@ OrdSetInts: Export == Implement where x,y: % + ?=? : (%,%) -> Boolean x = y == x =$Rep y + ? Boolean x < y == x <$Rep y + coerce : Integer -> % coerce(i:Integer):% == i + value : % -> Integer value(x) == x:Rep + coerce : % -> OutputForm coerce(x):O == sub(e::Symbol::O, coerce(x)$Rep)$O @@ -133025,87 +136505,113 @@ OutputForm(): SetCategory with n: Integer nn:NonNegativeInteger + print : % -> Void + print x == mathprint(x)$Lisp - sform: String -> $ + message : String -> % + message s == (empty? s => empty(); s pretend $) - eform: Symbol -> $ + messagePrint : String -> Void + messagePrint s == print message s - iform: Integer -> $ + ?=? : (%,%) -> Boolean + (a:$ = b:$):Boolean == EQUAL(a, b)$Lisp - print x == mathprint(x)$Lisp + ?=? : (%,%) -> % + (a:$ = b:$):$ == [sform "=", a, b] - message s == (empty? s => empty(); s pretend $) + coerce : % -> OutputForm + coerce(a):OutputForm == a pretend OutputForm - messagePrint s == print message s + outputForm : Integer -> % + outputForm n == n pretend $ - (a:$ = b:$):Boolean == EQUAL(a, b)$Lisp - - (a:$ = b:$):$ == [sform "=", a, b] - - coerce(a):OutputForm == a pretend OutputForm - - outputForm n == n pretend $ - - outputForm e == e pretend $ + outputForm : Symbol -> % + outputForm e == e pretend $ + outputForm : DoubleFloat -> % outputForm(f:DoubleFloat) == f pretend $ - sform s == s pretend $ + sform: String -> $ + sform s == s pretend $ - eform e == e pretend $ + eform: Symbol -> $ + eform e == e pretend $ - iform n == n pretend $ + iform: Integer -> $ + iform n == n pretend $ + outputForm : String -> % outputForm s == sform concat(quote()$Character, concat(s, quote()$Character)) + width : % -> Integer width(a) == outformWidth(a)$Lisp + height : % -> Integer height(a) == height(a)$Lisp + subHeight : % -> Integer subHeight(a) == subspan(a)$Lisp + superHeight : % -> Integer superHeight(a) == superspan(a)$Lisp + height : () -> Integer height() == 20 + width : () -> Integer width() == 66 - center(a,w) == hconcat(hspace((w - width(a)) quo 2),a) + center : (%,Integer) -> % + center(a,w) == hconcat(hspace((w - width(a)) quo 2),a) - left(a,w) == hconcat(a,hspace((w - width(a)))) + left : (%,Integer) -> % + left(a,w) == hconcat(a,hspace((w - width(a)))) - right(a,w) == hconcat(hspace(w - width(a)),a) + right : (%,Integer) -> % + right(a,w) == hconcat(hspace(w - width(a)),a) - center(a) == center(a,width()) + center : % -> % + center(a) == center(a,width()) - left(a) == left(a,width()) + left : % -> % + left(a) == left(a,width()) - right(a) == right(a,width()) + right : % -> % + right(a) == right(a,width()) + vspace : Integer -> % vspace(n) == n = 0 => empty() vconcat(sform " ",vspace(n - 1)) + hspace : Integer -> % hspace(n) == n = 0 => empty() sform(fillerSpaces(n)$Lisp) + rspace : (Integer,Integer) -> % rspace(n, m) == n = 0 or m = 0 => empty() vconcat(hspace n, rspace(n, m - 1)) + matrix : List(List(%)) -> % matrix ll == lv:$ := [LIST2VEC$Lisp l for l in ll] CONS(eform MATRIX, LIST2VEC$Lisp lv)$Lisp - pile l == cons(eform SC, l) + pile : List(%) -> % + pile l == cons(eform SC, l) - commaSeparate l == cons(eform AGGLST, l) + commaSeparate : List(%) -> % + commaSeparate l == cons(eform AGGLST, l) + semicolonSeparate : List(%) -> % semicolonSeparate l == cons(eform AGGSET, l) - blankSeparate l == + blankSeparate : List(%) -> % + blankSeparate l == c:=eform CONCATB l1:$:=[] for u in reverse l repeat @@ -133114,87 +136620,126 @@ OutputForm(): SetCategory with else l1:=[u,:l1] cons(c, l1) - brace a == [eform BRACE, a] + brace : % -> % + brace a == [eform BRACE, a] - brace l == brace commaSeparate l + brace : List(%) -> % + brace l == brace commaSeparate l - bracket a == [eform BRACKET, a] + bracket : % -> % + bracket a == [eform BRACKET, a] - bracket l == bracket commaSeparate l + bracket : List(%) -> % + bracket l == bracket commaSeparate l - paren a == [eform PAREN, a] + paren : % -> % + paren a == [eform PAREN, a] - paren l == paren commaSeparate l + paren : List(%) -> % + paren l == paren commaSeparate l - sub (a,b) == [eform SUB, a, b] + sub : (%,%) -> % + sub (a,b) == [eform SUB, a, b] - super (a, b) == [eform SUPERSUB,a,sform " ",b] + super : (%,%) -> % + super (a, b) == [eform SUPERSUB,a,sform " ",b] + presub : (%,%) -> % presub(a,b) == [eform SUPERSUB,a,sform " ",sform " ",sform " ",b] + presuper : (%,%) -> % presuper(a, b) == [eform SUPERSUB,a,sform " ",sform " ",b] + scripts : (%,List(%)) -> % scripts (a, l) == null l => a null rest l => sub(a, first l) cons(eform SUPERSUB, cons(a, l)) + supersub : (%,List(%)) -> % supersub(a, l) == if odd?(#l) then l := append(l, [empty()]) cons(eform ALTSUPERSUB, cons(a, l)) + hconcat : (%,%) -> % hconcat(a,b) == [eform CONCAT, a, b] - hconcat l == cons(eform CONCAT, l) + hconcat : List(%) -> % + hconcat l == cons(eform CONCAT, l) + vconcat : (%,%) -> % vconcat(a,b) == [eform VCONCAT, a, b] - vconcat l == cons(eform VCONCAT, l) + vconcat : List(%) -> % + vconcat l == cons(eform VCONCAT, l) - a ^= b == [sform "^=", a, b] + ?^=? : (%,%) -> % + a ^= b == [sform "^=", a, b] - a < b == [sform "<", a, b] + ? % + a < b == [sform "<", a, b] - a > b == [sform ">", a, b] + ?>? : (%,%) -> % + a > b == [sform ">", a, b] - a <= b == [sform "<=", a, b] + ?<=? : (%,%) -> % + a <= b == [sform "<=", a, b] - a >= b == [sform ">=", a, b] + ?>=? : (%,%) -> % + a >= b == [sform ">=", a, b] + + ?+? : (%,%) -> % + a + b == [sform "+", a, b] - a + b == [sform "+", a, b] + ?-? : (%,%) -> % + a - b == [sform "-", a, b] - a - b == [sform "-", a, b] + -? : % -> % + - a == [sform "-", a] - - a == [sform "-", a] + ?*? : (%,%) -> % + a * b == [sform "*", a, b] - a * b == [sform "*", a, b] + ?/? : (%,%) -> % + a / b == [sform "/", a, b] - a / b == [sform "/", a, b] - - a ** b == [sform "**", a, b] + ?**? : (%,%) -> % + a ** b == [sform "**", a, b] - a div b == [sform "div", a, b] + ?div? : (%,%) -> % + a div b == [sform "div", a, b] - a rem b == [sform "rem", a, b] + ?rem? : (%,%) -> % + a rem b == [sform "rem", a, b] - a quo b == [sform "quo", a, b] + ?quo? : (%,%) -> % + a quo b == [sform "quo", a, b] - a exquo b == [sform "exquo", a, b] + exquo : (%,%) -> % + a exquo b == [sform "exquo", a, b] - a and b == [sform "and", a, b] + ?and? : (%,%) -> % + a and b == [sform "and", a, b] - a or b == [sform "or", a, b] + ?or? : (%,%) -> % + a or b == [sform "or", a, b] - not a == [sform "not", a] + not? : % -> % + not a == [sform "not", a] + ?..? : (%,%) -> % SEGMENT(a,b)== [eform SEGMENT, a, b] + ?SEGMENT : % -> % SEGMENT(a) == [eform SEGMENT, a] + binomial : (%,%) -> % binomial(a,b)==[eform BINOMIAL, a, b] + empty : () -> % empty() == [eform NOTHING] + infix? : % -> Boolean infix? a == e:$ := IDENTP$Lisp a => a @@ -133202,60 +136747,83 @@ OutputForm(): SetCategory with return false if GET(e,QUOTE(INFIXOP$Lisp)$Lisp)$Lisp then true else false + ?.? : (%,List(%)) -> % elt(a, l) == cons(a, l) + prefix : (%,List(%)) -> % prefix(a,l) == not infix? a => cons(a, l) hconcat(a, paren commaSeparate l) + infix : (%,List(%)) -> % infix(a, l) == null l => empty() null rest l => first l infix? a => cons(a, l) hconcat [first l, a, infix(a, rest l)] + infix : (%,%,%) -> % infix(a,b,c) == infix? a => [a, b, c] hconcat [b, a, c] + postfix : (%,%) -> % postfix(a, b) == hconcat(b, a) - string a == [eform STRING, a] + string : % -> % + string a == [eform STRING, a] - quote a == [eform QUOTE, a] + quote : % -> % + quote a == [eform QUOTE, a] + overbar : % -> % overbar a == [eform OVERBAR, a] - dot a == super(a, sform ".") + dot : % -> % + dot a == super(a, sform ".") - prime a == super(a, sform ",") + prime : % -> % + prime a == super(a, sform ",") + dot : (%,NonNegativeInteger) -> % dot(a,nn) == (s := new(nn, char "."); super(a, sform s)) + prime : (%,NonNegativeInteger) -> % prime(a,nn) == (s := new(nn, char ","); super(a, sform s)) + overlabel : (%,%) -> % overlabel(a,b) == [eform OVERLABEL, a, b] - box a == [eform BOX, a] + box : % -> % + box a == [eform BOX, a] - zag(a,b) == [eform ZAG, a, b] + zag : (%,%) -> % + zag(a,b) == [eform ZAG, a, b] - root a == [eform ROOT, a] + root : % -> % + root a == [eform ROOT, a] - root(a,b) == [eform ROOT, a, b] + root : (%,%) -> % + root(a,b) == [eform ROOT, a, b] - over(a,b) == [eform OVER, a, b] + over : (%,%) -> % + over(a,b) == [eform OVER, a, b] - slash(a,b) == [eform SLASH, a, b] + slash : (%,%) -> % + slash(a,b) == [eform SLASH, a, b] - assign(a,b)== [eform LET, a, b] + assign : (%,%) -> % + assign(a,b)== [eform LET, a, b] + label : (%,%) -> % label(a,b) == [eform EQUATNUM, a, b] + rarrow : (%,%) -> % rarrow(a,b)== [eform TAG, a, b] + differentiate : (%,NonNegativeInteger) -> % differentiate(a, nn)== zero? nn => a nn < 4 => prime(a, nn) @@ -133263,22 +136831,31 @@ OutputForm(): SetCategory with s := lowerCase(r::String) super(a, paren sform s) - sum(a) == [eform SIGMA, empty(), a] + sum : % -> % + sum(a) == [eform SIGMA, empty(), a] - sum(a,b) == [eform SIGMA, b, a] + sum : (%,%) -> % + sum(a,b) == [eform SIGMA, b, a] + sum : (%,%,%) -> % sum(a,b,c) == [eform SIGMA2, b, c, a] - prod(a) == [eform PI, empty(), a] + prod : % -> % + prod(a) == [eform PI, empty(), a] - prod(a,b) == [eform PI, b, a] + prod : (%,%) -> % + prod(a,b) == [eform PI, b, a] - prod(a,b,c)== [eform PI2, b, c, a] + prod : (%,%,%) -> % + prod(a,b,c)== [eform PI2, b, c, a] - int(a) == [eform INTSIGN,empty(), empty(), a] + int : % -> % + int(a) == [eform INTSIGN,empty(), empty(), a] - int(a,b) == [eform INTSIGN,b, empty(), a] + int : (%,%) -> % + int(a,b) == [eform INTSIGN,b, empty(), a] + int : (%,%,%) -> % int(a,b,c) == [eform INTSIGN,b, c, a] *) @@ -134161,42 +137738,42 @@ PAdicRationalConstructor(p,PADIC): Exports == Implementation where PEXPR := p :: OUT ---% representation - Rep := Record(expon:I,pint:PADIC) getExpon: % -> I + getExpon x == x.expon - getZp : % -> PADIC - - makeQp : (I,PADIC) -> % - - getExpon x == x.expon - - getZp x == x.pint + getZp : % -> PADIC + getZp x == x.pint + makeQp : (I,PADIC) -> % makeQp(r,int) == [r,int] ---% creation - + 0 : () -> % 0 == makeQp(0,0) + 1 : () -> % 1 == makeQp(0,1) - coerce(x:I) == x :: PADIC :: % + coerce : Integer -> % + coerce(x:I) == x :: PADIC :: % - coerce(r:RN) == (numer(r) :: %)/(denom(r) :: %) + coerce : Fraction(Integer) -> % + coerce(r:RN) == (numer(r) :: %)/(denom(r) :: %) + coerce : PADIC -> % coerce(x:PADIC) == makeQp(0,x) --% normalizations + removeZeroes : % -> % removeZeroes x == empty? digits(xx := getZp x) => 0 zero? moduloP xx => removeZeroes makeQp(getExpon x + 1,quotientByP xx) x + removeZeroes : (Integer,%) -> % removeZeroes(n,x) == n <= 0 => x empty? digits(xx := getZp x) => 0 @@ -134206,6 +137783,7 @@ PAdicRationalConstructor(p,PADIC): Exports == Implementation where --% arithmetic + ?=? : (%,%) -> Boolean x = y == EQ(x,y)$Lisp => true n := getExpon(x) - getExpon(y) @@ -134213,45 +137791,57 @@ PAdicRationalConstructor(p,PADIC): Exports == Implementation where (p**(n :: NNI) * getZp(x)) = getZp(y) (p**((- n) :: NNI) * getZp(y)) = getZp(x) + ?+? : (%,%) -> % x + y == n := getExpon(x) - getExpon(y) n >= 0 => makeQp(getExpon y,getZp(y) + p**(n :: NNI) * getZp(x)) makeQp(getExpon x,getZp(x) + p**((-n) :: NNI) * getZp(y)) + -? : % -> % -x == makeQp(getExpon x,-getZp(x)) + ?-? : (%,%) -> % x - y == n := getExpon(x) - getExpon(y) n >= 0 => makeQp(getExpon y,p**(n :: NNI) * getZp(x) - getZp(y)) makeQp(getExpon x,getZp(x) - p**((-n) :: NNI) * getZp(y)) + ?*? : (Integer,%) -> % n:I * x:% == makeQp(getExpon x,n * getZp x) + ?*? : (%,%) -> % x:% * y:% == makeQp(getExpon x + getExpon y,getZp x * getZp y) + ?**? : (%,Integer) -> % x:% ** n:I == zero? n => 1 positive? n => expt(x,n :: PositiveInteger)$RepeatedSquaring(%) inv expt(x,(-n) :: PositiveInteger)$RepeatedSquaring(%) + recip : % -> Union(%,"failed") recip x == x := removeZeroes(1000,x) zero? moduloP(xx := getZp x) => "failed" (inv := recip xx) case "failed" => "failed" makeQp(- getExpon x,inv :: PADIC) + inv : % -> % inv x == (inv := recip x) case "failed" => error "inv: no inverse" inv :: % + ?/? : (%,%) -> % x:% / y:% == x * inv y + ?/? : (PADIC,PADIC) -> % x:PADIC / y:PADIC == (x :: %) / (y :: %) + ?*? : (PADIC,%) -> % x:PADIC * y:% == makeQp(getExpon y,x * getZp y) + approximate : (%,Integer) -> Fraction(Integer) approximate(x,n) == k := getExpon x (p :: RN) ** k * approximate(getZp x,n - k) @@ -134261,6 +137851,7 @@ PAdicRationalConstructor(p,PADIC): Exports == Implementation where invx := inv x; x0 := approximate(invx,1) concat(x0,cfStream(invx - (x0 :: %))) + continuedFraction : % -> ContinuedFraction(Fraction(Integer)) continuedFraction x == x0 := approximate(x,1) reducedContinuedFraction(x0,cfStream(x - (x0 :: %))) @@ -134273,11 +137864,12 @@ PAdicRationalConstructor(p,PADIC): Exports == Implementation where c = -1 => -mon (c :: OUT) * mon - showAll?:() -> Boolean -- check a global Lisp variable + showAll?:() -> Boolean showAll?() == true + coerce : % -> OutputForm coerce(x:%):OUT == x := removeZeroes(_$streamCount$Lisp,x) m := getExpon x; zp := getZp x @@ -134443,25 +138035,34 @@ Palette(): Exports == Implementation where (* Rep := Record(shadeField:I, hueField:C) + + dark : Color -> % + dark c == [1,c] - dark c == [1,c] - - dim c == [2,c] + dim : Color -> % + dim c == [2,c] + bright : Color -> % bright c == [3,c] + pastel : Color -> % pastel c == [4,c] + light : Color -> % light c == [5,c] - hue p == p.hueField + hue : % -> Color + hue p == p.hueField - shade p == p.shadeField + shade : % -> Integer + shade p == p.shadeField sample() == bright(sample()) + coerce : Color -> % coerce(c:Color):% == bright c + coerce : % -> OutputForm coerce(p:%):OutputForm == hconcat ["[",coerce(p.hueField),"] from the ",_ SHADE.(p.shadeField)," palette"] @@ -134572,8 +138173,10 @@ ParametricPlaneCurve(ComponentFunction): Exports == Implementation where Rep := Record(xCoord:ComponentFunction,yCoord:ComponentFunction) + curve : (ComponentFunction,ComponentFunction) -> % curve(x,y) == [x,y] + coordinate : (%,NonNegativeInteger) -> ComponentFunction coordinate(c,n) == n = 1 => c.xCoord n = 2 => c.yCoord @@ -134688,8 +138291,10 @@ ParametricSpaceCurve(ComponentFunction): Exports == Implementation where yCoord:ComponentFunction,_ zCoord:ComponentFunction) + curve : (ComponentFunction,ComponentFunction,ComponentFunction) -> % curve(x,y,z) == [x,y,z] + coordinate : (%,NonNegativeInteger) -> ComponentFunction coordinate(c,n) == n = 1 => c.xCoord n = 2 => c.yCoord @@ -134805,8 +138410,10 @@ ParametricSurface(ComponentFunction): Exports == Implementation where yCoord:ComponentFunction,_ zCoord:ComponentFunction) + surface : (ComponentFunction,ComponentFunction,ComponentFunction) -> % surface(x,y,z) == [x,y,z] + coordinate : (%,NonNegativeInteger) -> ComponentFunction coordinate(c,n) == n = 1 => c.xCoord n = 2 => c.yCoord @@ -135715,20 +139322,6 @@ PartialFraction(R: EuclideanDomain): Cat == Capsule where Rep := Record(whole:R, fract: LfTerm) - -- private function signatures - - copypf: % -> % - - LessThan: (fTerm, fTerm) -> Boolean - - multiplyFracTerms: (fTerm, fTerm) -> % - - normalizeFracTerm: fTerm -> % - - partialFractionNormalized: (R, FRR) -> % - - -- declarations - a,b: % n: Integer @@ -135737,13 +139330,16 @@ PartialFraction(R: EuclideanDomain): Cat == Capsule where -- private function definitions + copypf: % -> % copypf(a: %): % == [a.whole,copy a.fract]$% + LessThan: (fTerm, fTerm) -> Boolean LessThan(s: fTerm, t: fTerm) == -- have to wait until FR has < operation if (GGREATERP(s.den,t.den)$Lisp : Boolean) then false else true + multiplyFracTerms: (fTerm, fTerm) -> % multiplyFracTerms(s : fTerm, t : fTerm) == nthFactor(s.den,1) = nthFactor(t.den,1) => normalizeFracTerm([s.num * t.num, s.den * t.den]$fTerm) : Rep @@ -135762,6 +139358,7 @@ PartialFraction(R: EuclideanDomain): Cat == Capsule where not (null d.fract) => c.fract := append(d.fract,c.fract) c + normalizeFracTerm: fTerm -> % normalizeFracTerm(s : fTerm) == -- makes sure num is "less than" den, whole may be non-zero qr : QR := divide(s.num, (expand s.den)) @@ -135779,6 +139376,7 @@ PartialFraction(R: EuclideanDomain): Cat == Capsule where expon = nexpon => (qr.quotient + qr.remainder) :: % [qr.quotient,[[qr.remainder, nilFactor(f,nexpon-expon)]$fTerm]$LfTerm] + partialFractionNormalized: (R, FRR) -> % partialFractionNormalized(nm: R, dn : FRR) == -- assume unit dn = 1 nm = 0$R => 0$% @@ -135796,6 +139394,7 @@ PartialFraction(R: EuclideanDomain): Cat == Capsule where -- public function definitions + padicFraction : % -> % padicFraction(a : %) == b: % := compactFraction a null b.fract => b @@ -135813,6 +139412,7 @@ PartialFraction(R: EuclideanDomain): Cat == Capsule where d := degree(sp := reductum sp) [b.whole, sort(LessThan,l)]$% + compactFraction : % -> % compactFraction(a : %) == -- only one power for each distinct denom will remain 2 > # a.fract => a @@ -135837,16 +139437,22 @@ PartialFraction(R: EuclideanDomain): Cat == Capsule where b := normalizeFracTerm s [bw + b.whole,append(b.fract,bf)]$% + 0 : () -> % 0 == [0$R, nil()$LfTerm] + 1 : () -> % 1 == [1$R, nil()$LfTerm] + characteristic : () -> NonNegativeInteger characteristic() == characteristic()$R + coerce : R -> % coerce(r): % == [r, nil()$LfTerm] + coerce : Integer -> % coerce(n): % == [(n :: R), nil()$LfTerm] + coerce : % -> Fraction(R) coerce(a): Fraction R == q : Fraction R := (a.whole :: Fraction R) s : fTerm @@ -135854,36 +139460,45 @@ PartialFraction(R: EuclideanDomain): Cat == Capsule where q := q + (s.num / (expand s.den)) q + coerce : Fraction(Factored(R)) -> % coerce(q: Fraction FRR): % == u : R := (recip unit denom q):: R r1 : R := u * expand numer q partialFractionNormalized(r1, u * denom q) + exquo : (%,%) -> Union(%,"failed") a exquo b == b = 0$% => "failed" b = 1$% => a br : Fraction R := inv (b :: Fraction R) a * partialFraction(numer br,(denom br) :: FRR) + recip : % -> Union(%,"failed") recip a == (1$% exquo a) + firstDenom : % -> Factored(R) firstDenom a == -- denominator of 1st fractional term null a.fract => 1$FRR (first a.fract).den + firstNumer : % -> R firstNumer a == -- numerator of 1st fractional term null a.fract => 0$R (first a.fract).num + numberOfFractionalTerms : % -> Integer numberOfFractionalTerms a == # a.fract + nthFractionalTerm : (%,Integer) -> % nthFractionalTerm(a,n) == l : LfTerm := a.fract (n < 1) or (n > # l) => 0$% [0$R,[l.n]$LfTerm]$% + wholePart : % -> R wholePart a == a.whole + partialFraction : (R,Factored(R)) -> % partialFraction(nm: R, dn : FRR) == nm = 0$R => 0$% -- move inv unit of den to numerator @@ -135891,6 +139506,7 @@ PartialFraction(R: EuclideanDomain): Cat == Capsule where u := (recip u) :: R partialFractionNormalized(u * nm,u * dn) + padicallyExpand : (R,R) -> SparseUnivariatePolynomial(R) padicallyExpand(p : R, r : R) == -- expands r as a sum of powers of p, with coefficients -- r = HornerEval(padicallyExpand(p,r),p) @@ -135899,6 +139515,7 @@ PartialFraction(R: EuclideanDomain): Cat == Capsule where (qr.remainder :: SUPR) + monomial(1$R,1$NonNegativeInteger)$SUPR * padicallyExpand(p,qr.quotient) + ?=? : (%,%) -> Boolean a = b == a.whole ^= b.whole => false -- must verify this (null a.fract) => @@ -135908,12 +139525,14 @@ PartialFraction(R: EuclideanDomain): Cat == Capsule where -- oh, no! following is temporary (a :: Fraction R) = (b :: Fraction R) + -? : % -> % - a == s: fTerm l: LfTerm := nil for s in reverse a.fract repeat l := cons([- s.num,s.den]$fTerm,l) [- a.whole,l] + ?*? : (R,%) -> % r * a == r = 0$R => 0$% r = 1$R => a @@ -135926,13 +139545,16 @@ PartialFraction(R: EuclideanDomain): Cat == Capsule where not (null c.fract) => b.fract := append(c.fract, b.fract) b + ?*? : (Integer,%) -> % n * a == (n :: R) * a + ?+? : (%,%) -> % a + b == compactFraction [a.whole + b.whole, sort(LessThan,append(a.fract,copy b.fract))]$% + ?*? : (%,%) -> % a * b == null a.fract => a.whole * b null b.fract => b.whole * a @@ -135944,6 +139566,7 @@ PartialFraction(R: EuclideanDomain): Cat == Capsule where c := c + multiplyFracTerms(s,t) c + coerce : % -> OutputForm coerce(a): Ex == null a.fract => a.whole :: Ex s : fTerm @@ -136187,23 +139810,30 @@ Partition: Exports == Implementation where Rep := List Integer + 0 : () -> % 0 == nil() + coerce : % -> List(Integer) coerce (s:%) == s pretend List Integer + convert : % -> List(Integer) convert x == copy(x pretend L I) + partition : List(Integer) -> % partition list == sort((i1:Integer,i2:Integer):Boolean +-> i2 < i1,list) + ? Boolean x < y == empty? x => not empty? y empty? y => false first x = first y => rest x < rest y first x < first y + ?=? : (%,%) -> Boolean x = y == EQUAL(x,y)$Lisp + ?+? : (%,%) -> % x + y == empty? x => y empty? y => x @@ -136220,6 +139850,7 @@ Partition: Exports == Implementation where remv: (I,%) -> UN remv(i,x) == (member?(i,x) => dp(i,x); "failed") + subtractIfCan : (%,%) -> Union(%,"failed") subtractIfCan(x, y) == empty? x => empty? y => 0 @@ -136229,6 +139860,7 @@ Partition: Exports == Implementation where subtractIfCan((aa :: %), rest y) li1 : L I --!! 'bite' won't compile without this + bite: (I,L I) -> L I bite(i,li) == empty? li => concat(0,nil()) @@ -136238,11 +139870,14 @@ Partition: Exports == Implementation where concat(0,li) li : L I --!! 'powers' won't compile without this + + powers : List(Integer) -> List(List(Integer)) powers l == empty? l => nil() li := bite(first l,rest l) concat([first l,first(li) + 1],powers(rest li)) + conjugate : % -> % conjugate x == conjugate(x pretend Rep)$PartitionsAndPermutations mkterm: (I,I) -> OUT @@ -136258,10 +139893,12 @@ Partition: Exports == Implementation where concat(first(li) :: OUT,nil()) concat(mkterm(first li,second li),mkexp1(rest lli)) + coerce : % -> OutputForm coerce(x:%):OUT == empty? (x pretend Rep) => coerce(x pretend Rep)$Rep paren(reduce("*",mkexp1(powers(x pretend Rep)))) + pdct : % -> Integer pdct x == */[factorial(second a) * (first(a) ** (second(a) pretend NNI)) for a in powers(x pretend Rep)] @@ -136831,89 +140468,97 @@ Pattern(R:SetCategory): Exports == Implementation where dummy:BOP := operator(new()$Symbol) - nopred := coerce(0$Integer)$AnyFunctions1(Integer) - - mkPat : (B, PAT, NonNegativeInteger) -> % - - mkrsy : (SY, B, B, B) -> RSY + nopred := coerce(0$Integer)$AnyFunctions1(Integer) - SYM2O : RSY -> O - - PAT2O : PAT -> O - - patcopy : PAT -> PAT - - bitSet? : (SI , SI) -> B - - pateq? : (PAT, PAT) -> B - - LPAT2O : ((O, O) -> O, List %) -> O - - taggedElt : (SI, List %) -> % - - isTaggedOp: (%, SI) -> Union(List %, "failed") - - incmax : List % -> NonNegativeInteger - + coerce : R -> % coerce(r:R):% == mkPat(true, [r], 0) + mkPat : (B, PAT, NonNegativeInteger) -> % mkPat(c, p, l) == [c, p, l, empty(), nopred] + hasTopPredicate? : % -> Boolean hasTopPredicate? x == not empty?(x.topvar) + topPredicate : % -> Record(var: List(Symbol),pred: Any) topPredicate x == [x.topvar, x.toppred] + setTopPredicate : (%,List(Symbol),Any) -> % setTopPredicate(x, l, f) == (x.topvar := l; x.toppred := f; x) - constant? p == p.cons? + constant? : % -> Boolean + constant? p == p.cons? - depth p == p.lev + depth : % -> NonNegativeInteger + depth p == p.lev - inR? p == p.pat case ret + inR? : % -> Boolean + inR? p == p.pat case ret - symbol? p == p.pat case sym + symbol? : % -> Boolean + symbol? p == p.pat case sym - isPlus p == isTaggedOp(p, PAT_PLUS) + isPlus : % -> Union(List(%),"failed") + isPlus p == isTaggedOp(p, PAT_PLUS) - isTimes p == isTaggedOp(p, PAT_TIMES) + isTimes : % -> Union(List(%),"failed") + isTimes p == isTaggedOp(p, PAT_TIMES) - isList p == isTaggedOp(p, PAT_LIST) + isList : % -> Union(List(%),"failed") + isList p == isTaggedOp(p, PAT_LIST) - isExpt p == (p.pat case exp => p.pat.exp; "failed") + isExpt : % -> Union(Record(val: %,exponent: NonNegativeInteger),"failed") + isExpt p == (p.pat case exp => p.pat.exp; "failed") - isQuotient p == (p.pat case qot => p.pat.qot; "failed") + isQuotient : % -> Union(Record(num: %,den: %),"failed") + isQuotient p == (p.pat case qot => p.pat.qot; "failed") + hasPredicate? : % -> Boolean hasPredicate? p == not empty? predicates p - quoted? p == symbol? p and zero?(p.pat.sym.tag) + quoted? : % -> Boolean + quoted? p == symbol? p and zero?(p.pat.sym.tag) - generic? p == symbol? p and bitSet?(p.pat.sym.tag, SYM_GENERIC) + generic? : % -> Boolean + generic? p == symbol? p and bitSet?(p.pat.sym.tag, SYM_GENERIC) - multiple? p == symbol? p and bitSet?(p.pat.sym.tag,SYM_MULTIPLE) + multiple? : % -> Boolean + multiple? p == symbol? p and bitSet?(p.pat.sym.tag,SYM_MULTIPLE) - optional? p == symbol? p and bitSet?(p.pat.sym.tag,SYM_OPTIONAL) + optional? : % -> Boolean + optional? p == symbol? p and bitSet?(p.pat.sym.tag,SYM_OPTIONAL) + bitSet? : (SI , SI) -> B bitSet?(a, b) == And(a, b) ^= 0 + coerce : % -> OutputForm coerce(p:%):O == PAT2O(p.pat) - p1:% ** p2:% == taggedElt(PAT_EXPT, [p1, p2]) + ?**? : (%,%) -> % + p1:% ** p2:% == taggedElt(PAT_EXPT, [p1, p2]) - LPAT2O(f, l) == reduce(f, [x::O for x in l])$List(O) + LPAT2O : ((O, O) -> O, List %) -> O + LPAT2O(f, l) == reduce(f, [x::O for x in l])$List(O) + retract : % -> R retract(p:%):R == (inR? p => p.pat.ret; error "Not retractable") - convert(l:List %):% == taggedElt(PAT_LIST, l) + convert : List(%) -> % + convert(l:List %):% == taggedElt(PAT_LIST, l) + retractIfCan : % -> Union(R,"failed") retractIfCan(p:%):Union(R,"failed") ==(inR? p => p.pat.ret;"failed") - withPredicates(p, l) == setPredicates(copy p, l) + withPredicates : (%,List(Any)) -> % + withPredicates(p, l) == setPredicates(copy p, l) - coerce(sy:SY):% == patternVariable(sy, false, false, false) + coerce : Symbol -> % + coerce(sy:SY):% == patternVariable(sy, false, false, false) + copy : % -> % copy p == [constant? p, patcopy(p.pat), p.lev, p.topvar, p.toppred] -- returns [a, b] if #l = 2 and optional? a, "failed" otherwise + optpair : List(%) -> Union(List(%),"failed") optpair l == empty? rest rest l => b := first rest l @@ -136922,62 +140567,76 @@ Pattern(R:SetCategory): Exports == Implementation where "failed" "failed" + incmax : List % -> NonNegativeInteger incmax l == 1 + reduce("max", [p.lev for p in l], 0)$List(NonNegativeInteger) + ?=? : (%,%) -> Boolean p1 = p2 == (p1.cons? = p2.cons?) and (p1.lev = p2.lev) and (p1.topvar = p2.topvar) and ((EQ(p1.toppred, p2.toppred)$Lisp) pretend B) and pateq?(p1.pat, p2.pat) + isPower : % -> Union(Record(val: %,exponent: %),"failed") isPower p == (u := isTaggedOp(p, PAT_EXPT)) case "failed" => "failed" [first(u::List(%)), second(u::List(%))] + taggedElt : (SI, List %) -> % taggedElt(n, l) == mkPat(every?(constant?, l), [[n, dummy, l]$KER], incmax l) + elt : (BasicOperator,List(%)) -> % elt(o, l) == is?(o, POWER) and #l = 2 => first(l) ** last(l) mkPat(every?(constant?, l), [[0, o, l]$KER], incmax l) + isOp : % -> Union(Record(op: BasicOperator,arg: List(%)),"failed") isOp p == (p.pat case ker) and zero?(p.pat.ker.tag) => [p.pat.ker.op, p.pat.ker.arg] "failed" + isTaggedOp: (%, SI) -> Union(List %, "failed") isTaggedOp(p,t) == (p.pat case ker) and (p.pat.ker.tag = t) => p.pat.ker.arg "failed" if R has Monoid then + 1 : () -> % 1 == 1::R::% else + 1 : () -> % 1 == taggedElt(PAT_ONE, empty()) if R has AbelianMonoid then + 0 : () -> % 0 == 0::R::% else + 0 : () -> % 0 == taggedElt(PAT_ZERO, empty()) + ?**? : (%,NonNegativeInteger) -> % p:% ** n:NonNegativeInteger == p = 0 and n > 0 => 0 p = 1 or zero? n => 1 (n = 1) => p mkPat(constant? p, [[p, n]$REC], 1 + (p.lev)) + ?/? : (%,%) -> % p1 / p2 == p2 = 1 => p1 mkPat(constant? p1 and constant? p2, [[p1, p2]$QOT], 1 + max(p1.lev, p2.lev)) + ?+? : (%,%) -> % p1 + p2 == p1 = 0 => p2 p2 = 0 => p1 @@ -136989,6 +140648,7 @@ Pattern(R:SetCategory): Exports == Implementation where taggedElt(PAT_PLUS, concat(p1, u2::List %)) taggedElt(PAT_PLUS, [p1, p2]) + ?*? : (%,%) -> % p1 * p2 == p1 = 0 or p2 = 0 => 0 p1 = 1 => p2 @@ -137001,23 +140661,28 @@ Pattern(R:SetCategory): Exports == Implementation where taggedElt(PAT_TIMES, concat(p1, u2::List %)) taggedElt(PAT_TIMES, [p1, p2]) + isOp : (%,BasicOperator) -> Union(List(%),"failed") isOp(p, o) == (p.pat case ker) and zero?(p.pat.ker.tag) and (p.pat.ker.op =o) => p.pat.ker.arg "failed" + predicates : % -> List(Any) predicates p == symbol? p => p.pat.sym.pred empty() + setPredicates : (%,List(Any)) -> % setPredicates(p, l) == generic? p => (p.pat.sym.pred := l; p) error "Can only attach predicates to generic symbol" + resetBadValues : % -> % resetBadValues p == generic? p => (p.pat.sym.bad := empty()$List(Any); p) error "Can only attach bad values to generic symbol" + addBadValue : (%,Any) -> % addBadValue(p, a) == generic? p => if not member?(a, p.pat.sym.bad) then @@ -137025,16 +140690,19 @@ Pattern(R:SetCategory): Exports == Implementation where p error "Can only attach bad values to generic symbol" + getBadValues : % -> List(Any) getBadValues p == generic? p => p.pat.sym.bad error "Not a generic symbol" + SYM2O : RSY -> O SYM2O p == sy := (p.val)::O empty?(p.pred) => sy paren infix(" | "::O, sy, reduce("and",[sub("f"::O, i::O) for i in 1..#(p.pred)])$List(O)) + variables : % -> List(%) variables p == constant? p => empty() generic? p => [p] @@ -137045,6 +140713,7 @@ Pattern(R:SetCategory): Exports == Implementation where q case ker => concat [variables r for r in q.ker.arg] empty() + PAT2O : PAT -> O PAT2O p == p case ret => (p.ret)::O p case sym => SYM2O(p.sym) @@ -137059,6 +140728,7 @@ Pattern(R:SetCategory): Exports == Implementation where (u:=display(p.ker.op)) case "failed" =>prefix(name(p.ker.op)::O,l) (u::(List O -> O)) l + patcopy : PAT -> PAT patcopy p == p case ret => [p.ret] p case sym => @@ -137067,6 +140737,7 @@ Pattern(R:SetCategory): Exports == Implementation where p case qot => [[copy(p.qot.num), copy(p.qot.den)]$QOT] [[copy(p.exp.val), p.exp.exponent]$REC] + pateq? : (PAT, PAT) -> B pateq?(p1, p2) == p1 case ret => (p2 case ret) and (p1.ret = p2.ret) p1 case qot => @@ -137082,16 +140753,19 @@ Pattern(R:SetCategory): Exports == Implementation where (p2 case exp) and (p1.exp.exponent = p2.exp.exponent) and (p1.exp.val = p2.exp.val) + retractIfCan : % -> Union(Symbol,"failed") retractIfCan(p:%):Union(SY, "failed") == symbol? p => p.pat.sym.val "failed" + mkrsy : (SY, B, B, B) -> RSY mkrsy(t, c?, o?, m?) == c? => [0, t, empty(), empty()] mlt := (m? => SYM_MULTIPLE; 0) opt := (o? => SYM_OPTIONAL; 0) [Or(Or(SYM_GENERIC, mlt), opt), t, empty(), empty()] + patternVariable : (Symbol,Boolean,Boolean,Boolean) -> % patternVariable(sy, c?, o?, m?) == rsy := mkrsy(sy, c?, o?, m?) mkPat(zero?(rsy.tag), [rsy], 0) @@ -137233,22 +140907,30 @@ PatternMatchListResult(R:SetCategory, S:SetCategory, L:ListAggregate S): Rep := Record(a:PatternMatchResult(R, S), l:PatternMatchResult(R, L)) - new() == [new(), new()] + new : () -> % + new() == [new(), new()] - atoms r == r.a + atoms : % -> PatternMatchResult(R,S) + atoms r == r.a - lists r == r.l + lists : % -> PatternMatchResult(R,L) + lists r == r.l - failed() == [failed(), failed()] + failed : () -> % + failed() == [failed(), failed()] - failed? r == failed?(atoms r) + failed? : % -> Boolean + failed? r == failed?(atoms r) - x = y == (atoms x = atoms y) and (lists x = lists y) + ?=? : (%,%) -> Boolean + x = y == (atoms x = atoms y) and (lists x = lists y) + makeResult : (PatternMatchResult(R,S),PatternMatchResult(R,L)) -> % makeResult(r1, r2) == failed? r1 or failed? r2 => failed() [r1, r2] + coerce : % -> OutputForm coerce(r:%):OutputForm == failed? r => atoms(r)::OutputForm RecordPrint(r, Rep)$Lisp @@ -137458,19 +141140,26 @@ PatternMatchResult(R:SetCategory, S:SetCategory): SetCategory with Rep := Union(LR, "failed") - new() == empty() + new : () -> % + new() == empty() - failed() == "failed" + failed : () -> % + failed() == "failed" - failed? x == x case "failed" + failed? : % -> Boolean + failed? x == x case "failed" + insertMatch : (Pattern(R),S,%) -> % insertMatch(p, x, l) == concat([retract p, x], l::LR) - construct l == construct(l)$LR + construct : List(Record(key: Symbol,entry: S)) -> % + construct l == construct(l)$LR - destruct l == entries(l::LR)$LR + destruct : % -> List(Record(key: Symbol,entry: S)) + destruct l == entries(l::LR)$LR -- returns "failed" if not all the variables of the pred. are matched + satisfy? : (%,Pattern(R)) -> Union(Boolean,"failed") satisfy?(r, p) == failed? r => false lr := r::LR @@ -137478,23 +141167,28 @@ PatternMatchResult(R:SetCategory, S:SetCategory): SetCategory with else u::S for v in topPredicate(p).var]$List(S) satisfy?(lv, p) + union : (%,%) -> % union(x, y) == failed? x or failed? y => failed() removeDuplicates concat(x::LR, y::LR) + ?=? : (%,%) -> Boolean x = y == failed? x => failed? y failed? y => false x::LR =$LR y::LR + coerce : % -> OutputForm coerce(x:%):OutputForm == failed? x => "Does not match"::OutputForm destruct(x)::OutputForm + addMatchRestricted : (Pattern(R),S,%,S) -> % addMatchRestricted(p, x, l, ident) == (not optional? p) and (x = ident) => failed() addMatch(p, x, l) + addMatch : (Pattern(R),S,%) -> % addMatch(p, x, l) == failed?(l) or not(satisfy?(x, p)) => failed() al := l::LR @@ -137503,6 +141197,7 @@ PatternMatchResult(R:SetCategory, S:SetCategory): SetCategory with r::S = x => l failed() + getMatch : (Pattern(R),%) -> Union(S,"failed") getMatch(p, l) == failed? l => "failed" search(retract(p)@Symbol, l::LR) @@ -137684,20 +141379,29 @@ PendantTree(S: SetCategory): T == C where C == add Rep := Tree S import Tree S + coerce (t:%):Tree S == t pretend Tree S + ptree(n) == tree(n,[])$Rep pretend % + ptree(l,r) == tree(value(r:Rep)$Rep,cons(l,children(r:Rep)$Rep)):% + leaf? t == empty?(children(t)$Rep) + t1=t2 == (t1:Rep) = (t2:Rep) + left b == leaf? b => error "ptree:no left" first(children(b)$Rep) + right b == leaf? b => error "ptree:no right" tree(value(b)$Rep,rest (children(b)$Rep)) + value b == leaf? b => value(b)$Rep error "the pendant tree has no value" + coerce(b:%): OutputForm == leaf? b => value(b)$Rep :: OutputForm paren blankSeparate [left b::OutputForm,right b ::OutputForm] @@ -137707,6 +141411,45 @@ PendantTree(S: SetCategory): T == C where \begin{chunk}{COQ PENDTREE} (* domain PENDTREE *) (* + Rep := Tree S + import Tree S + + + coerce : % -> Tree S + coerce (t:%):Tree S == t pretend Tree S + + ptree : S -> % + ptree(n) == tree(n,[])$Rep pretend % + + ptree : (%,%) -> % + ptree(l,r) == tree(value(r:Rep)$Rep,cons(l,children(r:Rep)$Rep)):% + + leaf? : % -> Boolean + leaf? t == empty?(children(t)$Rep) + + ?=? : (%,%) -> Boolean + t1=t2 == (t1:Rep) = (t2:Rep) + + left : % -> % + left b == + leaf? b => error "ptree:no left" + first(children(b)$Rep) + + right : % -> % + right b == + leaf? b => error "ptree:no right" + tree(value(b)$Rep,rest (children(b)$Rep)) + + value : % -> S + value b == + leaf? b => value(b)$Rep + error "the pendant tree has no value" + + coerce : % -> OutputForm + coerce(b:%): OutputForm == + leaf? b => value(b)$Rep :: OutputForm + paren blankSeparate [left b::OutputForm,right b ::OutputForm] + *) \end{chunk} @@ -138337,45 +142080,23 @@ Permutation(S:SetCategory): public == private where (* domain PERM *) (* - -- representation of the object: - Rep := V L S - -- import of domains and packages - import OutputForm import Vector List S - -- variables - p,q : % exp : I - -- local functions first, signatures: - smaller? : (S,S) -> B - - rotateCycle: L S -> L S - - coerceCycle: L L S -> % - - smallerCycle?: (L S, L S) -> B - - shorterCycle?:(L S, L S) -> B - - permord:(RECCYPE,RECCYPE) -> B - - coerceToCycle:(%,B) -> L L S - - duplicates?: L S -> B - smaller?(a:S, b:S): B == S has OrderedSet => a <$S b S has Finite => lookup a < lookup b false + rotateCycle: L S -> L S rotateCycle(cyc: L S): L S == -- smallest element is put in first place -- doesn't change cycle if underlying set @@ -138389,12 +142110,14 @@ Permutation(S:SetCategory): public == private where (minpos = 1) => cyc concat(last(cyc,((#cyc-minpos+1)::NNI)),first(cyc,(minpos-1)::NNI)) + coerceCycle: L L S -> % coerceCycle(lls : L L S): % == perm : % := 1 for lists in reverse lls repeat perm := cycle lists * perm perm + smallerCycle?: (L S, L S) -> B smallerCycle?(cyca: L S, cycb: L S): B == #cyca ^= #cycb => #cyca < #cycb @@ -138402,14 +142125,17 @@ Permutation(S:SetCategory): public == private where i ^= j => return smaller?(i, j) false + shorterCycle?:(L S, L S) -> B shorterCycle?(cyca: L S, cycb: L S): B == #cyca < #cycb + permord:(RECCYPE,RECCYPE) -> B permord(pa: RECCYPE, pb : RECCYPE): B == for i in pa.cycl for j in pb.cycl repeat i ^= j => return smallerCycle?(i, j) #pa.cycl < #pb.cycl + coerceToCycle:(%,B) -> L L S coerceToCycle(p: %, doSorting?: B): L L S == preim := p.1 im := p.2 @@ -138440,6 +142166,7 @@ Permutation(S:SetCategory): public == private where sort(smallerCycle?,cycles)$(L L S) sort(shorterCycle?,cycles)$(L L S) + duplicates?: L S -> B duplicates? (ls : L S ): B == x := copy ls while not null x repeat @@ -138449,9 +142176,11 @@ Permutation(S:SetCategory): public == private where -- now the exported functions + listRepresentation : % -> Record(preimage: List(S),image: List(S)) listRepresentation p == s : RECPRIM := [p.1,p.2] + coercePreimagesImages : List(List(S)) -> % coercePreimagesImages preImageAndImage == preImage: List S := [] image: List S := [] @@ -138463,10 +142192,13 @@ Permutation(S:SetCategory): public == private where [preImage, image] + movedPoints : % -> Set(S) movedPoints p == construct p.1 + degree : % -> NonNegativeInteger degree p == #movedPoints p + ?=? : (%,%) -> Boolean p = q == #(preimp := p.1) ^= #(preimq := q.1) => false for i in 1..maxIndex preimp repeat @@ -138475,6 +142207,7 @@ Permutation(S:SetCategory): public == private where (p.2).i ^= (q.2).pos => return false true + orbit : (%,S) -> Set(S) orbit(p ,el) == -- start with a 1-element list: out : Set S := brace list el @@ -138486,23 +142219,29 @@ Permutation(S:SetCategory): public == private where el2 := eval(p, el2) out + cyclePartition : % -> Partition cyclePartition p == partition([#c for c in coerceToCycle(p, false)])$Partition + order : % -> NonNegativeInteger order p == ord: I := lcm removeDuplicates convert cyclePartition p ord::NNI + sign : % -> Integer sign(p) == even? p => 1 - 1 + even? : % -> Boolean even?(p) == even?(#(p.1) - numberOfCycles p) -- see the book of James and Kerber on symmetric groups -- for this formula. + odd? : % -> Boolean odd?(p) == odd?(#(p.1) - numberOfCycles p) + ? Boolean pa < pb == pacyc:= coerceToCycle(pa,true) pbcyc:= coerceToCycle(pb,true) @@ -138510,10 +142249,13 @@ Permutation(S:SetCategory): public == private where i ^= j => return smallerCycle? ( i, j ) maxIndex pacyc < maxIndex pbcyc + coerce : List(List(S)) -> % coerce(lls : L L S): % == coerceCycle lls + coerce : List(S) -> % coerce(ls : L S): % == cycle ls + sort : List(%) -> List(%) sort(inList : L %): L % == not (S has OrderedSet or S has Finite) => inList ownList: L RECCYPE := nil()$(L RECCYPE) @@ -138526,6 +142268,7 @@ Permutation(S:SetCategory): public == private where outList := cons(rec.permut, outList) reverse outList + coerce : % -> OutputForm coerce (p: %): OUTFORM == cycles: L L S := coerceToCycle(p,true) outfmL : L OUTFORM := nil() @@ -138541,13 +142284,16 @@ Permutation(S:SetCategory): public == private where null rest outfmL => first outfmL hconcat reverse outfmL + cycles : List(List(S)) -> % cycles(vs ) == coerceCycle vs + cycle : List(S) -> % cycle(ls) == #ls < 2 => 1 duplicates? ls => error "cycle: the input contains duplicates" [ls, append(rest ls, list first ls)] + coerceListOfPairs : List(List(S)) -> % coerceListOfPairs(loP) == preim := nil()$(L S) im := nil()$(L S) @@ -138560,6 +142306,7 @@ Permutation(S:SetCategory): public == private where error "coerceListOfPairs: the input cannot be interpreted as a permutation" [preim, im] + ?*? : (%,%) -> % q * p == -- use vectors for efficiency?? preimOfp : V S := construct p.1 @@ -138589,33 +142336,42 @@ Permutation(S:SetCategory): public == private where imOfq := delete(imOfq, j) [append(preimOfqp, preimOfq), append(imOfqp, imOfq)] + 1 : () -> % 1 == new(2,empty())$Rep + inv : % -> % inv p == [p.2, p.1] + eval : (%,S) -> S eval(p, el) == pos := position(el, p.1) pos = 0 => el (p.2).pos + ?.? : (%,S) -> S elt(p, el) == eval(p, el) + numberOfCycles : % -> NonNegativeInteger numberOfCycles p == #coerceToCycle(p, false) if S has IntegerNumberSystem then + coerceImages : List(S) -> % coerceImages (image) == preImage : L S := [i::S for i in 1..maxIndex image] coercePreimagesImages [preImage,image] if S has Finite then + coerceImages : List(S) -> % coerceImages (image) == preImage : L S := [index(i::PI)::S for i in 1..maxIndex image] coercePreimagesImages [preImage,image] + fixedPoints : % -> Set(S) fixedPoints ( p ) == complement movedPoints p + cyclePartition : % -> Partition cyclePartition p == pt := partition([#c for c in coerceToCycle(p, false)])$Partition pt +$PT conjugate(partition([#fixedPoints(p)])$PT)$PT @@ -140647,56 +144403,31 @@ PermutationGroup(S:SetCategory): public == private where (* domain PERMGRP *) (* - -- representation of the object: - Rep := Record ( gens : L PERM S , information : REC2 ) - -- import of domains and packages - import Permutation S import OutputForm import Symbol import Void - --first the local variables + sgs : L V NNI := [] + baseOfGroup : L NNI := [] + sizeOfGroup : NNI := 1 + degree : NNI := 0 + gporb : L REC := [] + out : L L V NNI := [] + outword : L L L NNI := [] + wordlist : L L NNI := [] + basePoint : NNI := 0 + newBasePoint : B := true + supp : L S := [] + ord : NNI := 1 + wordProblem : B := true - sgs : L V NNI := [] - baseOfGroup : L NNI := [] - sizeOfGroup : NNI := 1 - degree : NNI := 0 - gporb : L REC := [] - out : L L V NNI := [] - outword : L L L NNI := [] - wordlist : L L NNI := [] - basePoint : NNI := 0 - newBasePoint : B := true - supp : L S := [] - ord : NNI := 1 - wordProblem : B := true - - --local functions first, signatures: - - shortenWord:(L NNI, %)->L NNI - times:(V NNI, V NNI)->V NNI - strip:(V NNI,REC,L V NNI,L L NNI)->REC3 - orbitInternal:(%,L S )->L L S - inv: V NNI->V NNI - ranelt:(L V NNI,L L NNI, I)->REC3 - testIdentity:V NNI->B - pointList: %->L S - orbitWithSvc:(L V NNI ,NNI )->REC - cosetRep:(NNI ,REC ,L V NNI )->REC3 - bsgs1:(L V NNI,NNI,L L NNI,I,%,I)->NNI - computeOrbits: I->L NNI - reduceGenerators: I->Void - bsgs:(%, I, I)->NNI - initialize: %->FSET PERM S - knownGroup?: %->Void - subgroup:(%, %)->B - memberInternal:(PERM S, %, B)->REC4 --local functions first, implementations: + shortenWord:(L NNI, %)->L NNI shortenWord ( lw : L NNI , gp : % ) : L NNI == -- tries to shorten a word in the generators by removing identities gpgens : L PERM S := coerce gp @@ -140732,10 +144463,12 @@ PermutationGroup(S:SetCategory): public == private where pointer := 1 newlw + times:(V NNI, V NNI)->V NNI times ( p : V NNI , q : V NNI ) : V NNI == -- internal multiplication of permutations [ qelt(p,qelt(q,i)) for i in 1..degree ] + strip:(V NNI,REC,L V NNI,L L NNI)->REC3 strip(element:V NNI,orbit:REC,group:L V NNI,words:L L NNI) : REC3 == -- strip an element into the stabilizer actelt := element @@ -140751,6 +144484,7 @@ PermutationGroup(S:SetCategory): public == private where if wordProblem then outlist := append( words.(entry::NNI) , outlist ) [ actelt , reverse outlist ] + orbitInternal:(%,L S )->L L S orbitInternal ( gp : % , startList : L S ) : L L S == orbitList : L L S := [ startList ] pos : I := 1 @@ -140767,12 +144501,14 @@ PermutationGroup(S:SetCategory): public == private where pos := pos - 1 reverse orbitList + inv: V NNI->V NNI inv ( p : V NNI ) : V NNI == -- internal inverse of a permutation q : V NNI := new(degree,0)$(V NNI) for i in 1..degree repeat q.(qelt(p,i)) := i q + ranelt:(L V NNI,L L NNI, I)->REC3 ranelt ( group : L V NNI , word : L L NNI , maxLoops : I ) : REC3 == -- generate a "random" element numberOfGenerators := # group @@ -140791,17 +144527,20 @@ PermutationGroup(S:SetCategory): public == private where numberOfLoops := numberOfLoops - 1 [ randomElement , words ] + testIdentity:V NNI->B testIdentity ( p : V NNI ) : B == -- internal test for identity for i in 1..degree repeat qelt(p,i) ^= i => return false true + pointList: %->L S pointList(group : %) : L S == support : FSET S := brace() -- empty set !! for perm in group.gens repeat support := union(support, movedPoints perm) parts support + orbitWithSvc:(L V NNI ,NNI )->REC orbitWithSvc ( group : L V NNI , point : NNI ) : REC == -- compute orbit with Schreier vector, "-2" means not in the orbit, -- "-1" means starting point, the PI correspond to generators @@ -140824,6 +144563,7 @@ PermutationGroup(S:SetCategory): public == private where position := position - 1 [ reverse orbit , schreierVector ] + cosetRep:(NNI ,REC ,L V NNI )->REC3 cosetRep ( point : NNI , o : REC , group : L V NNI ) : REC3 == ppt := point xelt : V NNI := [ n for n in 1..degree ] @@ -140838,6 +144578,7 @@ PermutationGroup(S:SetCategory): public == private where if wordProblem then word := append ( wordlist.p , word ) ppt := x.ppt + bsgs1:(L V NNI,NNI,L L NNI,I,%,I)->NNI bsgs1 (group:L V NNI,number1:NNI,words:L L NNI,maxLoops:I,gp:%,diff:I)_ : NNI == -- try to get a good approximation for the strong generators and base @@ -140891,6 +144632,7 @@ PermutationGroup(S:SetCategory): public == private where baseOfGroup := cons ( i , baseOfGroup ) sizeOfGroup + computeOrbits: I->L NNI computeOrbits ( kkk : I ) : L NNI == -- compute the orbits for the stabilizers sgs := nil() @@ -140905,6 +144647,7 @@ PermutationGroup(S:SetCategory): public == private where gporb := reverse gporb reverse orbitLength + reduceGenerators: I->Void reduceGenerators ( kkk : I ) : Void == -- try to reduce number of strong generators orbitLength := computeOrbits ( kkk ) @@ -140948,7 +144691,7 @@ PermutationGroup(S:SetCategory): public == private where if removedGenerator then orbitLength := computeOrbits ( kkk ) void() - + bsgs:(%, I, I)->NNI bsgs ( group : % ,maxLoops : I , diff : I ) : NNI == -- the MOST IMPORTANT part of the package supp := pointList group @@ -141055,7 +144798,7 @@ PermutationGroup(S:SetCategory): public == private where sizeOfGroup := sizeOfGroup * # gporb.j.orb sizeOfGroup - + initialize: %->FSET PERM S initialize ( group : % ) : FSET PERM S == group2 := brace()$(FSET PERM S) gp : L PERM S := group.gens @@ -141063,6 +144806,7 @@ PermutationGroup(S:SetCategory): public == private where if degree gen > 0 then insert_!(gen, group2) group2 + knownGroup?: %->Void knownGroup? (gp : %) : Void == -- do we know the group already? result := gp.information @@ -141080,6 +144824,7 @@ PermutationGroup(S:SetCategory): public == private where wordlist := result.wd void + subgroup:(%, %)->B subgroup ( gp1 : % , gp2 : % ) : B == gpset1 := initialize gp1 gpset2 := initialize gp2 @@ -141088,6 +144833,7 @@ PermutationGroup(S:SetCategory): public == private where not member? (el, gp2) => return false true + memberInternal:(PERM S, %, B)->REC4 memberInternal ( p : PERM S , gp : % , flag : B ) : REC4 == -- internal membership testing supp := pointList gp @@ -141128,10 +144874,13 @@ PermutationGroup(S:SetCategory): public == private where --now the exported functions + coerce : % -> List(Permutation(S)) coerce ( gp : % ) : L PERM S == gp.gens + generators : % -> List(Permutation(S)) generators ( gp : % ) : L PERM S == gp.gens + strongGenerators : % -> List(Permutation(S)) strongGenerators ( group ) == knownGroup? group degree := # supp @@ -141143,10 +144892,13 @@ PermutationGroup(S:SetCategory): public == private where strongGens := cons ( coerceListOfPairs pairs , strongGens ) reverse strongGens + ?.? : (%,NonNegativeInteger) -> Permutation(S) elt ( gp , i ) == (gp.gens).i + movedPoints : % -> Set(S) movedPoints ( gp ) == brace pointList gp + random : (%,Integer) -> Permutation(S) random ( group , maximalNumberOfFactors ) == maximalNumberOfFactors < 1 => 1$(PERM S) gp : L PERM S := group.gens @@ -141160,14 +144912,18 @@ PermutationGroup(S:SetCategory): public == private where numberOfLoops := numberOfLoops - 1 randomElement + random : % -> Permutation(S) random ( group ) == random ( group , 20 ) + order : % -> NonNegativeInteger order ( group ) == knownGroup? group ord + degree : % -> NonNegativeInteger degree ( group ) == # pointList group + base : % -> List(S) base ( group ) == knownGroup? group groupBase := nil()$(L S) @@ -141175,18 +144931,22 @@ PermutationGroup(S:SetCategory): public == private where groupBase := cons ( supp.i , groupBase ) reverse groupBase + wordsForStrongGenerators : % -> List(List(NonNegativeInteger)) wordsForStrongGenerators ( group ) == knownGroup? group wordlist + coerce : List(Permutation(S)) -> % coerce ( gp : L PERM S ) : % == result : REC2 := [ 0 , [] , [] , [] , [] , [] ] group := [ gp , result ] + permutationGroup : List(Permutation(S)) -> % permutationGroup ( gp : L PERM S ) : % == result : REC2 := [ 0 , [] , [] , [] , [] , [] ] group := [ gp , result ] + coerce : % -> OutputForm coerce(group: %) : OUT == outList := nil()$(L OUT) gp : L PERM S := group.gens @@ -141195,6 +144955,7 @@ PermutationGroup(S:SetCategory): public == private where postfix(outputForm(">":SYM),_ postfix(commaSeparate outList,outputForm("<":SYM))) + orbit : (%,S) -> Set(S) orbit ( gp : % , el : S ) : FSET S == elList : L S := [ el ] outList := orbitInternal ( gp , elList ) @@ -141203,6 +144964,7 @@ PermutationGroup(S:SetCategory): public == private where insert_! ( outList.i.1 , outSet ) outSet + orbits : % -> Set(Set(S)) orbits ( gp ) == spp := movedPoints gp orbits := nil()$(L FSET S) @@ -141213,16 +144975,19 @@ PermutationGroup(S:SetCategory): public == private where spp := difference ( spp , orbitSet ) brace orbits + member? : (Permutation(S),%) -> Boolean member? (p, gp) == wordProblem := false mi := memberInternal ( p , gp , true ) mi.bool + wordInStrongGenerators : (Permutation(S),%) -> List(NonNegativeInteger) wordInStrongGenerators (p, gp ) == mi := memberInternal ( inv p , gp , false ) not mi.bool => error "p is not an element of gp" mi.lst + wordInGenerators : (Permutation(S),%) -> List(NonNegativeInteger) wordInGenerators (p, gp) == lll : L NNI := wordInStrongGenerators (p, gp) outlist := nil()$(L NNI) @@ -141230,16 +144995,19 @@ PermutationGroup(S:SetCategory): public == private where outlist := append ( outlist , wordlist.wd ) shortenWord ( outlist , gp ) + ? Boolean gp1 < gp2 == not empty? difference ( movedPoints gp1 , movedPoints gp2 ) => false not subgroup ( gp1 , gp2 ) => false order gp1 = order gp2 => false true + ?<=? : (%,%) -> Boolean gp1 <= gp2 == not empty? difference ( movedPoints gp1 , movedPoints gp2 ) => false subgroup ( gp1 , gp2 ) + ?=? : (%,%) -> Boolean gp1 = gp2 == movedPoints gp1 ^= movedPoints gp2 => false if #(gp1.gens) <= #(gp2.gens) then @@ -141249,6 +145017,7 @@ PermutationGroup(S:SetCategory): public == private where order gp1 = order gp2 => true false + orbit : (%,Set(S)) -> Set(Set(S)) orbit ( gp : % , startSet : FSET S ) : FSET FSET S == startList : L S := parts startSet outList := orbitInternal ( gp , startList ) @@ -141258,15 +145027,18 @@ PermutationGroup(S:SetCategory): public == private where insert_! ( newSet , outSet ) outSet + orbit : (%,List(S)) -> Set(List(S)) orbit ( gp : % , startList : L S ) : FSET L S == brace orbitInternal(gp, startList) + initializeGroupForWordProblem : (%,Integer,Integer) -> Void initializeGroupForWordProblem ( gp , maxLoops , diff ) == wordProblem := true ord := bsgs ( gp , maxLoops , diff ) gp.information := [ ord , sgs , baseOfGroup , gporb , supp , wordlist ] void + initializeGroupForWordProblem : % -> Void initializeGroupForWordProblem ( gp ) == initializeGroupForWordProblem ( gp , 0 , 1 ) @@ -141521,28 +145293,31 @@ Pi(): Exports == Implementation where sympi := "%pi"::Symbol - p2sf: UP -> DoubleFloat - p2f : UP -> Float - p2o : UP -> OutputForm - p2i : UP -> InputForm - p2p: UP -> PZ - - pi() == (monomial(1, 1)$UP :: RF) pretend % + pi : () -> % + pi() == (monomial(1, 1)$UP :: RF) pretend % - convert(x:%):RF == x pretend RF + convert : % -> Fraction(SparseUnivariatePolynomial(Integer)) + convert(x:%):RF == x pretend RF - convert(x:%):Float == x::Float + convert : % -> Float + convert(x:%):Float == x::Float + convert : % -> DoubleFloat convert(x:%):DoubleFloat == x::DoubleFloat - coerce(x:%):DoubleFloat == p2sf(numer x) / p2sf(denom x) + coerce : % -> DoubleFloat + coerce(x:%):DoubleFloat == p2sf(numer x) / p2sf(denom x) - coerce(x:%):Float == p2f(numer x) / p2f(denom x) + coerce : % -> Float + coerce(x:%):Float == p2f(numer x) / p2f(denom x) - p2o p == outputForm(p, sympi::OutputForm) + p2o : UP -> OutputForm + p2o p == outputForm(p, sympi::OutputForm) - p2i p == convert p2p p + p2i : UP -> InputForm + p2i p == convert p2p p + p2p: UP -> PZ p2p p == ans:PZ := 0 while p ^= 0 repeat @@ -141558,11 +145333,13 @@ Pi(): Exports == Implementation where (r := retractIfCan(x)@Union(UP, "failed")) case UP => p2i(r::UP) p2i(numer x) / p2i(denom x) + p2sf: UP -> DoubleFloat p2sf p == map((x:Integer):DoubleFloat+->x::DoubleFloat, p)_ $SparseUnivariatePolynomialFunctions2(Integer, DoubleFloat) (pi()$DoubleFloat) + p2f : UP -> Float p2f p == map((x:Integer):Float+->x::Float,p)_ $SparseUnivariatePolynomialFunctions2(Integer, Float) @@ -143454,119 +147231,6 @@ PlaneAlgebraicCurvePlot(): PlottablePlaneCurveCategory _ rsolve ==> realSolve$RealSolvePackage() - singValBetween?:(DoubleFloat,DoubleFloat,List DoubleFloat) -> Boolean - - segmentInfo:(DoubleFloat -> DoubleFloat,DoubleFloat,DoubleFloat,_ - List DoubleFloat,List DoubleFloat,List DoubleFloat,_ - DoubleFloat,DoubleFloat) -> _ - Record(seg:Segment DoubleFloat,_ - left: DoubleFloat,_ - lowerVals: List DoubleFloat,_ - upperVals:List DoubleFloat) - - swapCoords:Point DoubleFloat -> Point DoubleFloat - - samePlottedPt?:(Point DoubleFloat,Point DoubleFloat) -> Boolean - - findPtOnList:(Point DoubleFloat,List Point DoubleFloat) -> _ - Union(Point DoubleFloat,"failed") - - makeCorners:(DoubleFloat,DoubleFloat,DoubleFloat,DoubleFloat) -> Corners - - getXMin: Corners -> DoubleFloat - - getXMax: Corners -> DoubleFloat - - getYMin: Corners -> DoubleFloat - - getYMax: Corners -> DoubleFloat - - SFPolyToUPoly:Polynomial DoubleFloat -> _ - SparseUnivariatePolynomial DoubleFloat - - RNPolyToUPoly:Polynomial Fraction Integer -> _ - SparseUnivariatePolynomial Fraction Integer - - coerceCoefsToSFs:Polynomial Integer -> Polynomial DoubleFloat - - coerceCoefsToRNs:Polynomial Integer -> Polynomial Fraction Integer - - RNtoSF:Fraction Integer -> DoubleFloat - - RNtoNF:Fraction Integer -> Float - - SFtoNF:DoubleFloat -> Float - - listPtsOnHorizBdry:(Polynomial Fraction Integer,Symbol,Fraction Integer,_ - Float,Float) -> _ - List Point DoubleFloat - - listPtsOnVertBdry:(Polynomial Fraction Integer,Symbol,Fraction Integer,_ - Float,Float) -> _ - List Point DoubleFloat - - listPtsInRect:(List List Float,Float,Float,Float,Float) -> _ - List Point DoubleFloat - - ptsSuchThat?:(List List Float,List Float -> Boolean) -> Boolean - - inRect?:(List Float,Float,Float,Float,Float) -> Boolean - - onHorzSeg?:(List Float,Float,Float,Float) -> Boolean - - onVertSeg?:(List Float,Float,Float,Float) -> Boolean - - newX:(List List Float,List List Float,Float,Float,Float,Fraction Integer,_ - Fraction Integer) -> Fraction Integer - - newY:(List List Float,List List Float,Float,Float,Float,_ - Fraction Integer,Fraction Integer) -> Fraction Integer - - makeOneVarSketch:(Polynomial Integer,Symbol,Symbol,Fraction Integer,_ - Fraction Integer,Fraction Integer,Fraction Integer,_ - Symbol) -> % - - makeLineSketch:(Polynomial Integer,Symbol,Symbol,Fraction Integer,_ - Fraction Integer,Fraction Integer,Fraction Integer) -> % - - makeRatFcnSketch:(Polynomial Integer,Symbol,Symbol,Fraction Integer,_ - Fraction Integer,Fraction Integer,Fraction Integer,_ - Symbol) -> % - - makeGeneralSketch:(Polynomial Integer,Symbol,Symbol,Fraction Integer,_ - Fraction Integer,Fraction Integer,Fraction Integer) -> % - - traceBranches:(Polynomial DoubleFloat,Polynomial DoubleFloat,_ - Polynomial DoubleFloat,Symbol,Symbol,Corners,DoubleFloat,_ - DoubleFloat,PositiveInteger, List Point DoubleFloat,_ - BoundaryPts) -> List List Point DoubleFloat - - dummyFirstPt:(Point DoubleFloat,Polynomial DoubleFloat,_ - Polynomial DoubleFloat,Symbol,Symbol,List Point DoubleFloat,_ - List Point DoubleFloat,List Point DoubleFloat,_ - List Point DoubleFloat) -> Point DoubleFloat - - listPtsOnSegment:(Polynomial DoubleFloat,Polynomial DoubleFloat,_ - Polynomial DoubleFloat,Symbol,Symbol,Point DoubleFloat,_ - Point DoubleFloat,Corners, DoubleFloat,DoubleFloat,_ - PositiveInteger,List Point DoubleFloat,_ - List Point DoubleFloat) -> List List Point DoubleFloat - - listPtsOnLoop:(Polynomial DoubleFloat,Polynomial DoubleFloat,_ - Polynomial DoubleFloat,Symbol,Symbol,Point DoubleFloat,_ - Corners, DoubleFloat,DoubleFloat,PositiveInteger,_ - List Point DoubleFloat,List Point DoubleFloat) -> _ - List List Point DoubleFloat - - computeNextPt:(Polynomial DoubleFloat,Polynomial DoubleFloat,_ - Polynomial DoubleFloat,Symbol,Symbol,Point DoubleFloat,_ - Point DoubleFloat,Corners, DoubleFloat,DoubleFloat,_ - PositiveInteger,List Point DoubleFloat,_ - List Point DoubleFloat) -> NewPtInfo - - newtonApprox:(SparseUnivariatePolynomial DoubleFloat, DoubleFloat, _ - DoubleFloat, PositiveInteger) -> Union(DoubleFloat, "failed") - --% representation Rep := Record(poly : Polynomial Integer,_ @@ -143605,8 +147269,10 @@ PlaneAlgebraicCurvePlot(): PlottablePlaneCurveCategory _ makePt: (DoubleFloat,DoubleFloat) -> Point DoubleFloat makePt(xx,yy) == point(l : List DoubleFloat := [xx,yy]) + swapCoords:Point DoubleFloat -> Point DoubleFloat swapCoords(pt) == makePt(yCoord pt,xCoord pt) + samePlottedPt?:(Point DoubleFloat,Point DoubleFloat) -> Boolean samePlottedPt?(p0,p1) == -- determines if p1 lies in a square with side 2 PLOTERR -- centered at p0 @@ -143614,6 +147280,8 @@ PlaneAlgebraicCurvePlot(): PlottablePlaneCurveCategory _ x1 := xCoord p1; y1 := yCoord p1 (abs(x1-x0) < PLOTERR) and (abs(y1-y0) < PLOTERR) + findPtOnList:(Point DoubleFloat,List Point DoubleFloat) -> _ + Union(Point DoubleFloat,"failed") findPtOnList(pt,pointList) == for point in pointList repeat samePlottedPt?(pt,point) => return point @@ -143621,42 +147289,64 @@ PlaneAlgebraicCurvePlot(): PlottablePlaneCurveCategory _ --% corners + makeCorners:(DoubleFloat,DoubleFloat,DoubleFloat,DoubleFloat) -> Corners makeCorners(xMinSF,xMaxSF,yMinSF,yMaxSF) == [xMinSF,xMaxSF,yMinSF,yMaxSF] + getXMin: Corners -> DoubleFloat getXMin(corners) == corners.minXVal + + getXMax: Corners -> DoubleFloat getXMax(corners) == corners.maxXVal + + getYMin: Corners -> DoubleFloat getYMin(corners) == corners.minYVal + + getYMax: Corners -> DoubleFloat getYMax(corners) == corners.maxYVal --% coercions + SFPolyToUPoly:Polynomial DoubleFloat -> _ + SparseUnivariatePolynomial DoubleFloat SFPolyToUPoly(p) == -- 'p' is of type Polynomial, but has only one variable zero? p => 0 monomial(leadingCoefficient p,totalDegree p) + SFPolyToUPoly(reductum p) + RNPolyToUPoly:Polynomial Fraction Integer -> _ + SparseUnivariatePolynomial Fraction Integer RNPolyToUPoly(p) == -- 'p' is of type Polynomial, but has only one variable zero? p => 0 monomial(leadingCoefficient p,totalDegree p) + RNPolyToUPoly(reductum p) + coerceCoefsToSFs:Polynomial Integer -> Polynomial DoubleFloat coerceCoefsToSFs(p) == -- coefficients of 'p' are coerced to be DoubleFloat's map(coerce,p)$PolynomialFunctions2(Integer,DoubleFloat) + coerceCoefsToRNs:Polynomial Integer -> Polynomial Fraction Integer coerceCoefsToRNs(p) == -- coefficients of 'p' are coerced to be DoubleFloat's map(coerce,p)$PolynomialFunctions2(Integer,Fraction Integer) + RNtoSF:Fraction Integer -> DoubleFloat RNtoSF(r) == coerce(r)@DoubleFloat + + RNtoNF:Fraction Integer -> Float RNtoNF(r) == coerce(r)@Float + + SFtoNF:DoubleFloat -> Float SFtoNF(x) == convert(x)@Float --% computation of special points + listPtsOnHorizBdry:(Polynomial Fraction Integer,Symbol,Fraction Integer,_ + Float,Float) -> _ + List Point DoubleFloat listPtsOnHorizBdry(pRN,y,y0,xMinNF,xMaxNF) == -- strict inequality here: corners on vertical boundary pointList : List Point DoubleFloat := nil() @@ -143668,6 +147358,9 @@ PlaneAlgebraicCurvePlot(): PlottablePlaneCurveCategory _ pointList := cons(makePt(NFtoSF root, ySF), pointList) pointList + listPtsOnVertBdry:(Polynomial Fraction Integer,Symbol,Fraction Integer,_ + Float,Float) -> _ + List Point DoubleFloat listPtsOnVertBdry(pRN,x,x0,yMinNF,yMaxNF) == pointList : List Point DoubleFloat := nil() xSF := RNtoSF(x0) @@ -143678,6 +147371,8 @@ PlaneAlgebraicCurvePlot(): PlottablePlaneCurveCategory _ pointList := cons(makePt(xSF, NFtoSF root), pointList) pointList + listPtsInRect:(List List Float,Float,Float,Float,Float) -> _ + List Point DoubleFloat listPtsInRect(points,xMin,xMax,yMin,yMax) == pointList : List Point DoubleFloat := nil() for point in points repeat @@ -143686,23 +147381,29 @@ PlaneAlgebraicCurvePlot(): PlottablePlaneCurveCategory _ pointList := cons(makePt(NFtoSF xx,NFtoSF yy),pointList) pointList + ptsSuchThat?:(List List Float,List Float -> Boolean) -> Boolean ptsSuchThat?(points,pred) == for point in points repeat if pred point then return true false + inRect?:(List Float,Float,Float,Float,Float) -> Boolean inRect?(point,xMinNF,xMaxNF,yMinNF,yMaxNF) == xx := first point; yy := second point xMinNF <= xx and xx <= xMaxNF and yMinNF <= yy and yy <= yMaxNF + onHorzSeg?:(List Float,Float,Float,Float) -> Boolean onHorzSeg?(point,xMinNF,xMaxNF,yNF) == xx := first point; yy := second point yy = yNF and xMinNF <= xx and xx <= xMaxNF + onVertSeg?:(List Float,Float,Float,Float) -> Boolean onVertSeg?(point,yMinNF,yMaxNF,xNF) == xx := first point; yy := second point xx = xNF and yMinNF <= yy and yy <= yMaxNF + newX:(List List Float,List List Float,Float,Float,Float,Fraction Integer,_ + Fraction Integer) -> Fraction Integer newX(vtanPts,singPts,yMinNF,yMaxNF,xNF,xRN,horizInc) == xNewNF := xNF + RNtoNF horizInc xRtNF := max(xNF,xNewNF); xLftNF := min(xNF,xNewNF) @@ -143718,6 +147419,8 @@ PlaneAlgebraicCurvePlot(): PlottablePlaneCurveCategory _ horizInc/2::(Fraction Integer)) xRN + horizInc + newY:(List List Float,List List Float,Float,Float,Float,_ + Fraction Integer,Fraction Integer) -> Fraction Integer newY(htanPts,singPts,xMinNF,xMaxNF,yNF,yRN,vertInc) == yNewNF := yNF + RNtoNF vertInc yTopNF := max(yNF,yNewNF); yBotNF := min(yNF,yNewNF) @@ -143735,6 +147438,8 @@ PlaneAlgebraicCurvePlot(): PlottablePlaneCurveCategory _ --% creation of sketches + makeSketch : (Polynomial(Integer),Symbol,Symbol,Segment(Fraction(Integer)), + Segment(Fraction(Integer))) -> % makeSketch(p,x,y,xRange,yRange) == xMin := lo xRange; xMax := hi xRange yMin := lo yRange; yMax := hi yRange @@ -143770,6 +147475,9 @@ PlaneAlgebraicCurvePlot(): PlottablePlaneCurveCategory _ --% special cases + makeOneVarSketch:(Polynomial Integer,Symbol,Symbol,Fraction Integer,_ + Fraction Integer,Fraction Integer,Fraction Integer,_ + Symbol) -> % makeOneVarSketch(p,x,y,xMin,xMax,yMin,yMax,var) == -- the case where 'p' is a polynomial in only one variable -- the graph consists of horizontal or vertical lines @@ -143809,6 +147517,8 @@ PlaneAlgebraicCurvePlot(): PlottablePlaneCurveCategory _ bran := cons(branch,bran) [p,x,y,xMin,xMax,yMin,yMax,[lf,rt,bt,tp],htans,vtans,bran] + makeLineSketch:(Polynomial Integer,Symbol,Symbol,Fraction Integer,_ + Fraction Integer,Fraction Integer,Fraction Integer) -> % makeLineSketch(p,x,y,xMin,xMax,yMin,yMax) == -- the case where p(x,y) = a x + b y + c with a ^= 0, b ^= 0 -- this is a line which is neither vertical nor horizontal @@ -143851,11 +147561,19 @@ PlaneAlgebraicCurvePlot(): PlottablePlaneCurveCategory _ bran := cons(branch,bran) [p,x,y,xMin,xMax,yMin,yMax,[lf,rt,bt,tp],htans,vtans,bran] + singValBetween?:(DoubleFloat,DoubleFloat,List DoubleFloat) -> Boolean singValBetween?(xCurrent,xNext,xSingList) == for xVal in xSingList repeat (xCurrent < xVal) and (xVal < xNext) => return true false + segmentInfo:(DoubleFloat -> DoubleFloat,DoubleFloat,DoubleFloat,_ + List DoubleFloat,List DoubleFloat,List DoubleFloat,_ + DoubleFloat,DoubleFloat) -> _ + Record(seg:Segment DoubleFloat,_ + left: DoubleFloat,_ + lowerVals: List DoubleFloat,_ + upperVals:List DoubleFloat) segmentInfo(f,lo,hi,botList,topList,singList,minSF,maxSF) == repeat -- 'current' is the smallest element of 'topList' and 'botList' @@ -143920,6 +147638,9 @@ PlaneAlgebraicCurvePlot(): PlottablePlaneCurveCategory _ if singValBetween?(current,nxt,singList) then return [segment(lo,current),nxt,botList,topList] + makeRatFcnSketch:(Polynomial Integer,Symbol,Symbol,Fraction Integer,_ + Fraction Integer,Fraction Integer,Fraction Integer,_ + Symbol) -> % makeRatFcnSketch(p,x,y,xMin,xMax,yMin,yMax,depVar) == -- the case where p(x,y) is linear in x or y -- Thus, one variable is a rational function of the other. @@ -144101,6 +147822,8 @@ PlaneAlgebraicCurvePlot(): PlottablePlaneCurveCategory _ --% the general case + makeGeneralSketch:(Polynomial Integer,Symbol,Symbol,Fraction Integer,_ + Fraction Integer,Fraction Integer,Fraction Integer) -> % makeGeneralSketch(pol,x,y,xMin,xMax,yMin,yMax) == --!! corners of region should not be on curve --!! enlarge region if necessary @@ -144174,6 +147897,7 @@ PlaneAlgebraicCurvePlot(): PlottablePlaneCurveCategory _ bound,crits,bdPts) [p,x,y,xMin,xMax,yMin,yMax,bdPts,htans,vtans,bran] + refine:(%,DoubleFloat) -> % refine(plot,stepFraction) == p := plot.poly; x := plot.xVar; y := plot.yVar dpdx := differentiate(p,x); dpdy := differentiate(p,y) @@ -144199,6 +147923,10 @@ PlaneAlgebraicCurvePlot(): PlottablePlaneCurveCategory _ htans := plot.hTanPts; vtans := plot.vTanPts [p,x,y,xMin,xMax,yMin,yMax,bdPts,htans,vtans,bran] + traceBranches:(Polynomial DoubleFloat,Polynomial DoubleFloat,_ + Polynomial DoubleFloat,Symbol,Symbol,Corners,DoubleFloat,_ + DoubleFloat,PositiveInteger, List Point DoubleFloat,_ + BoundaryPts) -> List List Point DoubleFloat traceBranches(pSF,dpdxSF,dpdySF,x,y,corners,delta,err,bound,_ crits,bdPts) == -- for boundary points, trace curve from boundary to boundary @@ -144231,6 +147959,10 @@ PlaneAlgebraicCurvePlot(): PlottablePlaneCurveCategory _ crits := second segInfo bran + dummyFirstPt:(Point DoubleFloat,Polynomial DoubleFloat,_ + Polynomial DoubleFloat,Symbol,Symbol,List Point DoubleFloat,_ + List Point DoubleFloat,List Point DoubleFloat,_ + List Point DoubleFloat) -> Point DoubleFloat dummyFirstPt(p1,dpdxSF,dpdySF,x,y,lf,rt,bt,tp) == -- The function 'computeNextPt' requires 2 points, p0 and p1. -- When computing the second point on a branch which starts @@ -144250,6 +147982,11 @@ PlaneAlgebraicCurvePlot(): PlottablePlaneCurveCategory _ makePt(x1 + one,y1 - one) + listPtsOnSegment:(Polynomial DoubleFloat,Polynomial DoubleFloat,_ + Polynomial DoubleFloat,Symbol,Symbol,Point DoubleFloat,_ + Point DoubleFloat,Corners, DoubleFloat,DoubleFloat,_ + PositiveInteger,List Point DoubleFloat,_ + List Point DoubleFloat) -> List List Point DoubleFloat listPtsOnSegment(pSF,dpdxSF,dpdySF,x,y,p0,p1,corners,_ delta,err,bound,crits,bdry) == -- p1 is a boundary point; p0 is a 'dummy' point @@ -144278,7 +148015,11 @@ PlaneAlgebraicCurvePlot(): PlottablePlaneCurveCategory _ --!! delete next line (compiler bug) [pointList,crits,bdry] - + listPtsOnLoop:(Polynomial DoubleFloat,Polynomial DoubleFloat,_ + Polynomial DoubleFloat,Symbol,Symbol,Point DoubleFloat,_ + Corners, DoubleFloat,DoubleFloat,PositiveInteger,_ + List Point DoubleFloat,List Point DoubleFloat) -> _ + List List Point DoubleFloat listPtsOnLoop(pSF,dpdxSF,dpdySF,x,y,p1,corners,_ delta,err,bound,crits,bdry) == x1 := xCoord p1; y1 := yCoord p1 @@ -144312,6 +148053,11 @@ PlaneAlgebraicCurvePlot(): PlottablePlaneCurveCategory _ --!! delete next line (compiler bug) [pointList,crits,bdry] + computeNextPt:(Polynomial DoubleFloat,Polynomial DoubleFloat,_ + Polynomial DoubleFloat,Symbol,Symbol,Point DoubleFloat,_ + Point DoubleFloat,Corners, DoubleFloat,DoubleFloat,_ + PositiveInteger,List Point DoubleFloat,_ + List Point DoubleFloat) -> NewPtInfo computeNextPt(pSF,dpdxSF,dpdySF,x,y,p0,p1,corners,_ delta,err,bound,crits,bdry) == -- p0=(x0,y0) and p1=(x1,y1) are the last two points on the curve. @@ -144565,6 +148311,8 @@ PlaneAlgebraicCurvePlot(): PlottablePlaneCurveCategory _ --% Newton iterations + newtonApprox:(SparseUnivariatePolynomial DoubleFloat, DoubleFloat, _ + DoubleFloat, PositiveInteger) -> Union(DoubleFloat, "failed") newtonApprox(f,a0,err,bound) == -- Newton iteration to approximate a root of the polynomial 'f' -- using an initial approximation of 'a0' @@ -144585,6 +148333,7 @@ PlaneAlgebraicCurvePlot(): PlottablePlaneCurveCategory _ --% graphics output + listBranches : % -> List(List(Point(DoubleFloat))) listBranches(acplot) == acplot.branches --% terminal output @@ -145048,28 +148797,36 @@ Plcs(K:Field,PCS:LocalPowerSeriesCategory(K)):Exports == Implementation where setOfPlacesName:Symbol:=new(ActualSetOfPlacesName)$Symbol + ?+? : (%,%) -> Divisor(%) a:% + b:% == (a:: Divisor(%)) +$Divisor(%) (b::Divisor(%)) + ?-? : (%,%) -> Divisor(%) a:% - b:% == (a:: Divisor(%)) -$Divisor(%) (b::Divisor(%)) + ?*? : (Integer,%) -> Divisor(%) n:Integer * b:% == n *$Divisor(%) (b :: Divisor(%)) + reduce : List(%) -> Divisor(%) reduce(lp)== lpd:List Divisor(%):= [p :: Divisor(%) for p in lp] reduce("+", lpd, 0$Divisor(%)) + ?+? : (Divisor(%),%) -> Divisor(%) d:Divisor(%) + b:% == d + (b::Divisor(%)) + ?+? : (%,Divisor(%)) -> Divisor(%) a:% + d:Divisor(%) == (a::Divisor(%)) + d + ?-? : (Divisor(%),%) -> Divisor(%) d:Divisor(%) - b:% == d - (b::Divisor(%)) + ?-? : (%,Divisor(%)) -> Divisor(%) a:% - d:Divisor(%) == (a::Divisor(%)) - d + -? : % -> Divisor(%) -a:% == - ( a::Divisor(%)) outName: nameOfPlace -> OutputForm - outName(pt)== pt case Symbol => pt :: OutputForm dd:OutputForm:= ":" :: OutputForm @@ -145078,11 +148835,13 @@ Plcs(K:Field,PCS:LocalPowerSeriesCategory(K)):Exports == Implementation where out:= hconcat lout bracket(out) + coerce : % -> OutputForm coerce(pt:%):OutputForm == nn:OutputForm:= outName(pt.theName) ee:OutputForm:= degree(pt) :: OutputForm nn ** ee + ?=? : (%,%) -> Boolean a:% = b:% == ^(a.actualSet =$Symbol b.actualSet) => a:String:= @@ -145095,22 +148854,27 @@ Plcs(K:Field,PCS:LocalPowerSeriesCategory(K)):Exports == Implementation where error a a.inName =$Symbol b.inName + ?.? : (%,Integer) -> K elt(pl,n)== pt:= (pl :: Rep).theName pt case Symbol => _ error "From Places domain : cannot return the coordinates of a leaf" elt(pt,n)$List(K) + leaf? : % -> Boolean leaf?(pl)==pl.isALeaf + itsALeaf! : % -> Void itsALeaf_!(pl)== pl.isALeaf := true() void() listOfFoundPlaces:List %:=[] - foundPlaces()==listOfFoundPlaces + foundPlaces : () -> List(%) + foundPlaces() == listOfFoundPlaces + setFoundPlacesToEmpty : () -> List(%) setFoundPlacesToEmpty()== tmp:=copy listOfFoundPlaces listOfFoundPlaces:=[] @@ -145132,25 +148896,31 @@ Plcs(K:Field,PCS:LocalPowerSeriesCategory(K)):Exports == Implementation where pt fpl + create : List(K) -> % create(pt:List(K)):%== newName:=new(SIMPLE)$Symbol newPt:%:=[pt,[],1,false(),newName,setOfPlacesName]$rec findInExistOnes(newPt) + create : Symbol -> % create(pt:Symbol):%== newPt:%:=[pt,[],1,false(),pt,setOfPlacesName]$rec findInExistOnes(newPt) + setDegree! : (%,PositiveInteger) -> Void setDegree_!(pt,d)== pt.deg := d void() + setParam! : (%,List(PCS)) -> Void setParam_!(pt,ls)== pt.locPar:=ls void() - localParam(pt)==pt.locPar + localParam : % -> List(PCS) + localParam(pt) == pt.locPar + degree : % -> PositiveInteger degree(pl)==pl.deg *) @@ -145895,35 +149665,12 @@ Plot(): Exports == Implementation where import PointPackage(DoubleFloat) ---% local functions - - checkRange : R -> R - -- checks that left-hand endpoint is less than right-hand endpoint - intersect : (R,R) -> R - -- intersection of two intervals - union : (R,R) -> R - -- union of two intervals - join : (L C,I) -> R - parametricRange: % -> R - select : (L P,P -> F,(F,F) -> F) -> F - rangeRefine : (C,R) -> C - adaptivePlot : (C,R,R,R,I) -> C - basicPlot : (F -> P,R) -> C - basicRefine : (C,R) -> C - pt : (F,F) -> P - Fnan? : F -> Boolean - Pnan? : P -> Boolean - ---% representation - Rep := Record( parametric: B, _ display: L R, _ bounds: L R, _ axisLabels: L S, _ functions: L C ) ---% global constants - ADAPTIVE: B := true MINPOINTS: I := 49 MAXPOINTS: I := 1000 @@ -145932,12 +149679,15 @@ Plot(): Exports == Implementation where ANGLEBOUND: F := cos inv (4::F) DEBUG: B := false + Fnan? : F -> Boolean Fnan?(x) == x ~= x + Pnan? : P -> Boolean Pnan?(x) == any?(Fnan?,x) --% graphics output + listBranches : % -> List(List(Point(DoubleFloat))) listBranches plot == outList : L L P := nil() for curve in plot.functions repeat @@ -145951,12 +149701,19 @@ Plot(): Exports == Implementation where if not empty? newl then outList := concat(newl:=reverse! newl,outList) outList + -- checks that left-hand endpoint is less than right-hand endpoint + checkRange : R -> R checkRange r == (lo r > hi r => error "ranges cannot be negative"; r) + -- intersection of two intervals + intersect : (R,R) -> R intersect(s,t) == checkRange (max(lo s,lo t) .. min(hi s,hi t)) + -- union of two intervals + union : (R,R) -> R union(s,t) == min(lo s,lo t) .. max(hi s,hi t) + join : (L C,I) -> R join(l,i) == rr := first l u : R := @@ -145968,44 +149725,61 @@ Plot(): Exports == Implementation where i = 1 => u := union(u,second(r.ranges)) u := union(u,third(r.ranges)) u + + parametricRange: % -> R parametricRange r == first(r.bounds) + minPoints : () -> Integer minPoints() == MINPOINTS + setMinPoints : Integer -> Integer setMinPoints n == if n < 3 then error "three points minimum required" if MAXPOINTS < n then MAXPOINTS := n MINPOINTS := n + maxPoints : () -> Integer maxPoints() == MAXPOINTS + setMaxPoints : Integer -> Integer setMaxPoints n == if n < 3 then error "three points minimum required" if MINPOINTS > n then MINPOINTS := n MAXPOINTS := n + screenResolution : () -> Integer screenResolution() == SCREENRES + setScreenResolution : Integer -> Integer setScreenResolution n == if n < 2 then error "buy a new terminal" SCREENRES := n + adaptive? : () -> Boolean adaptive?() == ADAPTIVE + setAdaptive : Boolean -> Boolean setAdaptive b == ADAPTIVE := b + parametric? : % -> Boolean parametric? p == p.parametric + numFunEvals : () -> Integer numFunEvals() == NUMFUNEVALS + debug : Boolean -> Boolean debug b == DEBUG := b + xRange : % -> Segment(DoubleFloat) xRange plot == second plot.bounds + yRange : % -> Segment(DoubleFloat) yRange plot == third plot.bounds + tRange : % -> Segment(DoubleFloat) tRange plot == first plot.bounds + select : (L P,P -> F,(F,F) -> F) -> F select(l,f,g) == m := f first l if Fnan? m then m := 0 @@ -146015,6 +149789,7 @@ Plot(): Exports == Implementation where if Fnan? m then m := n m + rangeRefine : (C,R) -> C rangeRefine(curve,nRange) == checkRange nRange; l := lo nRange; h := hi nRange t := curve.knots; p := curve.points; f := curve.source @@ -146049,6 +149824,7 @@ Plot(): Exports == Implementation where yRange := select(q,yCoord,min) .. select(q,yCoord,max) [ f, [nRange,xRange,yRange], c, q] + adaptivePlot : (C,R,R,R,I) -> C adaptivePlot(curve,tRange,xRange,yRange,pixelfraction) == xDiff := hi xRange - lo xRange yDiff := hi yRange - lo yRange @@ -146154,6 +149930,7 @@ Plot(): Exports == Implementation where [ curve.source, [tRange,xRange,yRange], t, p ] curve + basicPlot : (F -> P,R) -> C basicPlot(f,tRange) == checkRange tRange l := lo tRange @@ -146171,14 +149948,17 @@ Plot(): Exports == Implementation where yRange : R := select(p,yCoord,min) .. select(p,yCoord,max) [ f, [tRange,xRange,yRange], t, p ] + zoom : (%,Segment(DoubleFloat)) -> % zoom(p,xRange) == [p.parametric, [xRange,third(p.display)], p.bounds, _ p.axisLabels, p.functions] + zoom : (%,Segment(DoubleFloat),Segment(DoubleFloat)) -> % zoom(p,xRange,yRange) == [p.parametric, [xRange,yRange], p.bounds, _ p.axisLabels, p.functions] + basicRefine : (C,R) -> C basicRefine(curve,nRange) == tRange:R := first curve.ranges -- curve := copy$C curve -- Yet another compiler bug @@ -146200,8 +149980,10 @@ Plot(): Exports == Implementation where yRange := select(p,yCoord,min) .. select(p,yCoord,max) [ curve.source, [tRange,xRange,yRange], t, p ] + refine : % -> % refine p == refine(p,parametricRange p) + refine : (%,Segment(DoubleFloat)) -> % refine(p,nRange) == NUMFUNEVALS := 0 tRange := parametricRange p @@ -146216,6 +149998,7 @@ Plot(): Exports == Implementation where [p.parametric, p.display, [tRange,xRange,yRange], _ p.axisLabels, curves ] + plot : (%,Segment(DoubleFloat)) -> % plot(p:%,tRange:R) == -- re plot p on a new range making use of the points already -- computed if possible @@ -146229,6 +150012,7 @@ Plot(): Exports == Implementation where [ p.parametric, [xRange,yRange], [tRange,xRange,yRange], p.axisLabels, curves ] + pt : (F,F) -> P pt(xx,yy) == point(l : L F := [xx,yy]) myTrap: (F-> F, F) -> F @@ -146239,6 +150023,7 @@ Plot(): Exports == Implementation where r > max()$F or r < min()$F => _$NaNvalue$Lisp r + plot : ((DoubleFloat -> DoubleFloat),Segment(DoubleFloat)) -> % plot(f:F -> F,xRange:R) == p := basicPlot((u1:F):P +-> pt(u1,myTrap(f,u1)),xRange) r := p.ranges @@ -146248,11 +150033,15 @@ Plot(): Exports == Implementation where r := p.ranges [ false, rest r, r, nil(), [ p ] ] + plot : ((DoubleFloat -> DoubleFloat),Segment(DoubleFloat), + Segment(DoubleFloat)) -> % plot(f:F -> F,xRange:R,yRange:R) == p := plot(f,xRange) p.display := [xRange,checkRange yRange] p + plot : ((DoubleFloat -> DoubleFloat),(DoubleFloat -> DoubleFloat), + Segment(DoubleFloat)) -> % plot(f:F -> F,g:F -> F,tRange:R) == p := basicPlot((z1:F):P +-> pt(myTrap(f,z1),myTrap(g,z1)),tRange) r := p.ranges @@ -146262,11 +150051,14 @@ Plot(): Exports == Implementation where r := p.ranges [ true, rest r, r, nil(), [ p ] ] + plot : ((DoubleFloat -> DoubleFloat),(DoubleFloat -> DoubleFloat), + Segment(DoubleFloat),Segment(DoubleFloat),Segment(DoubleFloat)) -> % plot(f:F -> F,g:F -> F,tRange:R,xRange:R,yRange:R) == p := plot(f,g,tRange) p.display := [checkRange xRange,checkRange yRange] p + pointPlot : ((DoubleFloat -> Point(DoubleFloat)),Segment(DoubleFloat)) -> % pointPlot(f:F -> P,tRange:R) == p := basicPlot(f,tRange) r := p.ranges @@ -146276,11 +150068,14 @@ Plot(): Exports == Implementation where r := p.ranges [ true, rest r, r, nil(), [ p ] ] + pointPlot : ((DoubleFloat -> Point(DoubleFloat)),Segment(DoubleFloat), + Segment(DoubleFloat),Segment(DoubleFloat)) -> % pointPlot(f:F -> P,tRange:R,xRange:R,yRange:R) == p := pointPlot(f,tRange) p.display := [checkRange xRange,checkRange yRange] p + plot : (List((DoubleFloat -> DoubleFloat)),Segment(DoubleFloat)) -> % plot(l:L(F -> F),xRange:R) == if null l then error "empty list of functions" t: L C := @@ -146293,19 +150088,24 @@ Plot(): Exports == Implementation where yRange := join(t,2) [false, [xRange,yRange], [xRange,xRange,yRange], nil(), t ] + plot : (List((DoubleFloat -> DoubleFloat)),Segment(DoubleFloat), + Segment(DoubleFloat)) -> % plot(l:L(F -> F),xRange:R,yRange:R) == p := plot(l,xRange) p.display := [xRange,checkRange yRange] p + plotPolar : ((DoubleFloat -> DoubleFloat),Segment(DoubleFloat)) -> % plotPolar(f,thetaRange) == plot((u1:F):F +-> f(u1) * cos(u1), (v1:F):F +-> f(v1) * sin(v1),thetaRange) + plotPolar : (DoubleFloat -> DoubleFloat) -> % plotPolar f == plotPolar(f,segment(0,2*pi())) --% terminal output + coerce : % -> OutputForm coerce r == spaces: OUT := coerce " " xSymbol := "x = " :: OUT @@ -146916,26 +150716,6 @@ Plot3D(): Exports == Implementation where import PointPackage(F) ---% local functions - - fourth : L R -> R - checkRange : R -> R - -- checks that left-hand endpoint is less than right-hand endpoint - intersect : (R,R) -> R - -- intersection of two intervals - union : (R,R) -> R - -- union of two intervals - join : (L C,I) -> R - parametricRange: % -> R --- setColor : (P,F) -> F - select : (L P,P -> F,(F,F) -> F) -> F --- normalizeColor : (P,F,F) -> F - rangeRefine : (C,R) -> C - adaptivePlot : (C,R,R,R,R,I,I) -> C - basicPlot : (F -> P,R) -> C - basicRefine : (C,R) -> C - point : (F,F,F,F) -> P - --% representation Rep := Record( display: L R, _ @@ -146954,16 +150734,25 @@ Plot3D(): Exports == Implementation where ANGLEBOUND : F := cos inv (4::F) DEBUG : B := false + point : (F,F,F,F) -> P point(xx,yy,zz,col) == point(l : L F := [xx,yy,zz,col]) + fourth : L R -> R fourth list == first rest rest rest list + -- checks that left-hand endpoint is less than right-hand endpoint + checkRange : R -> R checkRange r == (lo r > hi r => error "ranges cannot be negative"; r) + -- intersection of two intervals + intersect : (R,R) -> R intersect(s,t) == checkRange (max(lo s,lo t) .. min(hi s,hi t)) + -- union of two intervals + union : (R,R) -> R union(s:R,t:R) == min(lo s,lo t) .. max(hi s,hi t) + join : (L C,I) -> R join(l,i) == rr := first l u : R := @@ -146978,50 +150767,67 @@ Plot3D(): Exports == Implementation where union(u,fourth(r.ranges)) u + parametricRange: % -> R parametricRange r == first(r.bounds) + minPoints3D : () -> Integer minPoints3D() == MINPOINTS + setMinPoints3D : Integer -> Integer setMinPoints3D n == if n < 3 then error "three points minimum required" if MAXPOINTS < n then MAXPOINTS := n MINPOINTS := n + maxPoints3D : () -> Integer maxPoints3D() == MAXPOINTS + setMaxPoints3D : Integer -> Integer setMaxPoints3D n == if n < 3 then error "three points minimum required" if MINPOINTS > n then MINPOINTS := n MAXPOINTS := n + screenResolution3D : () -> Integer screenResolution3D() == SCREENRES + setScreenResolution3D : Integer -> Integer setScreenResolution3D n == if n < 2 then error "buy a new terminal" SCREENRES := n + adaptive3D? : () -> Boolean adaptive3D?() == ADAPTIVE + setAdaptive3D : Boolean -> Boolean setAdaptive3D b == ADAPTIVE := b + numFunEvals3D : () -> Integer numFunEvals3D() == NUMFUNEVALS + debug3D : Boolean -> Boolean debug3D b == DEBUG := b + xRange : % -> Segment(DoubleFloat) xRange plot == second plot.bounds + yRange : % -> Segment(DoubleFloat) yRange plot == third plot.bounds + zRange : % -> Segment(DoubleFloat) zRange plot == fourth plot.bounds + tRange : % -> Segment(DoubleFloat) tRange plot == first plot.bounds + tValues : % -> List(List(DoubleFloat)) tValues plot == outList : L L F := nil() for curve in plot.functions repeat outList := concat(curve.knots,outList) outList + select : (L P,P -> F,(F,F) -> F) -> F select(l,f,g) == m := f first l if (EQL(m, _$NaNvalue$Lisp)$Lisp) then m := 0 @@ -147031,6 +150837,7 @@ Plot3D(): Exports == Implementation where m := g(m,fp) m + rangeRefine : (C,R) -> C rangeRefine(curve,nRange) == checkRange nRange; l := lo nRange; h := hi nRange t := curve.knots; p := curve.points; f := curve.source @@ -147064,7 +150871,7 @@ Plot3D(): Exports == Implementation where zRange := select(q,zCoord,min) .. select(q,zCoord,max) [f,[nRange,xRange,yRange,zRange],c,q] - + adaptivePlot : (C,R,R,R,R,I,I) -> C adaptivePlot(curve,tRg,xRg,yRg,zRg,pixelfraction,resolution) == xDiff := hi xRg - lo xRg yDiff := hi yRg - lo yRg @@ -147093,7 +150900,6 @@ Plot3D(): Exports == Implementation where st := headert; sp := headerp todo1 := todot; todo2 := todop n : I := 0 - while not null todo1 repeat st := first(todo1) t0 := first(st); t1 := second(st); t2 := third(st) @@ -147138,7 +150944,6 @@ Plot3D(): Exports == Implementation where todo2 := concat_!(todo2, p) t := rest t; p := rest p todo1 := rest todo1; todo2 := rest todo2 - tm := (t1+t2)/2::F tj := tm t.rest := concat(tj, rest t) @@ -147161,7 +150966,6 @@ Plot3D(): Exports == Implementation where todo1 := concat_!(todo1, t) todo2 := concat_!(todo2, p) t := rest t; p := rest p - tm := (t1+t2)/2::F tj := tm t.rest := concat(tj, rest t) @@ -147179,6 +150983,7 @@ Plot3D(): Exports == Implementation where [curve.source,[tRg,xRg,yRg,zRg],t,p] else curve + basicPlot : (F -> P,R) -> C basicPlot(f,tRange) == checkRange tRange; l := lo tRange; h := hi tRange t : L F := list l; p : L P := list f l @@ -147193,10 +150998,13 @@ Plot3D(): Exports == Implementation where zRange : R := select(p,zCoord,min) .. select(p,zCoord,max) [f,[tRange,xRange,yRange,zRange],t,p] + zoom : + (%,Segment(DoubleFloat),Segment(DoubleFloat),Segment(DoubleFloat)) -> % zoom(p,xRange,yRange,zRange) == [[xRange,yRange,zRange],p.bounds, p.screenres,p.axisLabels,p.functions] + basicRefine : (C,R) -> C basicRefine(curve,nRange) == tRange:R := first curve.ranges -- curve := copy$C curve -- Yet another @#$%^&* compiler bug @@ -147220,8 +151028,10 @@ Plot3D(): Exports == Implementation where zRange := select(p,zCoord,min) .. select(p,zCoord,max) [curve.source,[tRange,xRange,yRange,zRange],t,p] + refine : % -> % refine p == refine(p,parametricRange p) + refine : (%,Segment(DoubleFloat)) -> % refine(p,nRange) == NUMFUNEVALS := 0 tRange := parametricRange p @@ -147239,6 +151049,7 @@ Plot3D(): Exports == Implementation where [p.display,[tRange,xRange,yRange,zRange], _ scrres,p.axisLabels,curves] + plot : (%,Segment(DoubleFloat)) -> % plot(p:%,tRange:R) == -- re plot p on a new range making use of the points already -- computed if possible @@ -147255,6 +151066,7 @@ Plot3D(): Exports == Implementation where [[xRange,yRange,zRange],[tRange,xRange,yRange,zRange], p.screenres,p.axisLabels,curves] + pointPlot : ((DoubleFloat -> Point(DoubleFloat)),Segment(DoubleFloat)) -> % pointPlot(f:F -> P,tRange:R) == p := basicPlot(f,tRange) r := p.ranges @@ -147263,6 +151075,8 @@ Plot3D(): Exports == Implementation where p := adaptivePlot(p,first r,second r,third r,fourth r,8,SCREENRES) [ rest r, r, SCREENRES, nil(), [ p ] ] + pointPlot : ((DoubleFloat -> Point(DoubleFloat)),Segment(DoubleFloat), + Segment(DoubleFloat),Segment(DoubleFloat),Segment(DoubleFloat)) -> % pointPlot(f:F -> P,tRange:R,xRange:R,yRange:R,zRange:R) == p := pointPlot(f,tRange) p.display:= [checkRange xRange,checkRange yRange,checkRange zRange] @@ -147277,6 +151091,9 @@ Plot3D(): Exports == Implementation where r:F := s r + plot : ((DoubleFloat -> DoubleFloat),(DoubleFloat -> DoubleFloat), + (DoubleFloat -> DoubleFloat),(DoubleFloat -> DoubleFloat), + Segment(DoubleFloat)) -> % plot(f1:F -> F,f2:F -> F,f3:F -> F,col:F -> F,tRange:R) == p := basicPlot( (z:F):P+->point(myTrap(f1,z),myTrap(f2,z),myTrap(f3,z),col(z)),tRange) @@ -147286,6 +151103,10 @@ Plot3D(): Exports == Implementation where p := adaptivePlot(p,first r,second r,third r,fourth r,8,SCREENRES) [ rest r, r, SCREENRES, nil(), [ p ] ] + plot : ((DoubleFloat -> DoubleFloat),(DoubleFloat -> DoubleFloat), + (DoubleFloat -> DoubleFloat),(DoubleFloat -> DoubleFloat), + Segment(DoubleFloat),Segment(DoubleFloat), + Segment(DoubleFloat),Segment(DoubleFloat)) -> % plot(f1:F -> F,f2:F -> F,f3:F -> F,col:F -> F,_ tRange:R,xRange:R,yRange:R,zRange:R) == p := plot(f1,f2,f3,col,tRange) @@ -147294,6 +151115,7 @@ Plot3D(): Exports == Implementation where --% terminal output + coerce : % -> OutputForm coerce r == spaces := " " :: OUT xSymbol := "x = " :: OUT; ySymbol := "y = " :: OUT @@ -147314,6 +151136,7 @@ Plot3D(): Exports == Implementation where ----% graphics output + listBranches : % -> List(List(Point(DoubleFloat))) listBranches plot == outList : L L P := nil() for curve in plot.functions repeat @@ -147524,58 +151347,72 @@ PoincareBirkhoffWittLyndonBasis(VarSet: OrderedSet): Public == Private where (* domain PBWLB *) (* - -- Representation Rep := LWORDS - -- Locales - recursif: ($,$) -> Boolean - - -- Define + 1 : () -> % 1 == nil + ?=? : (%,%) -> Boolean x = y == x =$Rep y + varList : % -> List(VarSet) varList x == null x => nil le: List VarSet := "setUnion"/ [varList$LWORD l for l in x] + first : % -> LyndonWord(VarSet) first x == first(x)$Rep + + rest : % -> % rest x == rest(x)$Rep + coerce : VarSet -> % coerce(v: VarSet):$ == [ v::LWORD ] + + coerce : LyndonWord(VarSet) -> % coerce(l: LWORD):$ == [l] + + listOfTerms : % -> List(LyndonWord(VarSet)) listOfTerms(x:$):LWORDS == x pretend LWORDS + coerce : % -> OrderedFreeMonoid(VarSet) coerce(x:$):WORD == null x => 1 x.first :: WORD *$WORD coerce(x.rest) + coerce : % -> OutputForm coerce(x:$):EX == null x => outputForm(1$Integer)$EX reduce(_* ,[l :: EX for l in x])$List(EX) + retractable? : % -> Boolean retractable? x == null x => false null x.rest + retract : % -> LyndonWord(VarSet) retract x == #x ^= 1 => error "cannot convert to Lyndon word" x.first + retractIfCan : % -> Union(LyndonWord(VarSet),"failed") retractIfCan x == retractable? x => x.first "failed" + length : % -> NonNegativeInteger length x == n: Integer := +/[ length l for l in x] n::NNI + recursif: ($,$) -> Boolean recursif(x, y) == null y => false null x => true x.first = y.first => recursif(rest(x), rest(y)) lexico(x.first, y.first) + ? Boolean x < y == lx: NNI := length x; ly: NNI := length y lx = ly => recursif(x,y) @@ -147840,22 +151677,27 @@ Point(R:Ring) : Exports == Implementation where PI ==> PositiveInteger + point : List(R) -> % point(l:List R):% == pt := new(#l,R) for x in l for i in minIndex(pt).. repeat pt.i := x pt + dimension : % -> PositiveInteger dimension p == (# p)::PI -- Vector returns NonNegativeInteger...? + convert : List(R) -> % convert(l:List R):% == point(l) + cross : (%,%) -> % cross(p0, p1) == #p0 ^=3 or #p1^=3 => error "Arguments to cross must be three dimensional" point [p0.2 * p1.3 - p1.2 * p0.3, _ p1.1 * p0.3 - p0.1 * p1.3, _ p0.1 * p1.2 - p1.1 * p0.2] + extend : (%,List(R)) -> % extend(p,l) == concat(p,point l) *) @@ -148924,6 +152766,7 @@ Polynomial(R:Ring): import UserDefinedPartialOrdering(Symbol) + coerce : % -> OutputForm coerce(p:%):OutputForm == (r:= retractIfCan(p)@Union(R,"failed")) case R => r::R::OutputForm a := @@ -148933,6 +152776,7 @@ Polynomial(R:Ring): if R has Algebra Fraction Integer then + integrate : (%,Symbol) -> % integrate(p, x) == (integrate univariate(p, x)) (x::%) *) @@ -149476,21 +153320,6 @@ PolynomialIdeals(F,Expon,VarSet,DPoly) : C == T --- Representation --- Rep := Record(idl:List DPoly,isGr:Boolean) - - ---- Local Functions ---- - - contractGrob : newIdeal -> Ideal - npoly : DPoly -> newPoly - oldpoly : newPoly -> Union(DPoly,"failed") - leadterm : (DPoly,VarSet) -> DPoly - choosel : (DPoly,DPoly) -> DPoly - isMonic? : (DPoly,VarSet) -> Boolean - randomat : List Z -> Record(mM:MF,imM:MF) - monomDim : (Ideal,List VarSet) -> NNI - variables : Ideal -> List VarSet - subset : List VarSet -> List List VarSet - makeleast : (List VarSet,List VarSet) -> List VarSet - newExpon: OrderedAbelianMonoidSup newExpon:= Product(NNI,Expon) newPoly := PolynomialRing(F,newExpon) @@ -149501,11 +153330,13 @@ PolynomialIdeals(F,Expon,VarSet,DPoly) : C == T newIdeal ==> List(newPoly) + npoly : DPoly -> newPoly npoly(f:DPoly) : newPoly == f=0$DPoly => 0$newPoly monomial(leadingCoefficient f,makeprod(0,degree f))$newPoly + npoly(reductum f) + oldpoly : newPoly -> Union(DPoly,"failed") oldpoly(q:newPoly) : Union(DPoly,"failed") == q=0$newPoly => 0$DPoly dq:newExpon:=degree q @@ -149514,29 +153345,35 @@ PolynomialIdeals(F,Expon,VarSet,DPoly) : C == T ((g:=oldpoly reductum q) case "failed") => "failed" monomial(leadingCoefficient q,selectsecond dq)$DPoly + (g::DPoly) + leadterm : (DPoly,VarSet) -> DPoly leadterm(f:DPoly,lvar:List VarSet) : DPoly == empty?(lf:=variables f) or lf=lvar => f leadterm(leadingCoefficient univariate(f,lf.first),lvar) + choosel : (DPoly,DPoly) -> DPoly choosel(f:DPoly,g:DPoly) : DPoly == g=0 => f (f1:=f exquo g) case "failed" => f choosel(f1::DPoly,g) + contractGrob : newIdeal -> Ideal contractGrob(I1:newIdeal) : Ideal == J1:List(newPoly):=groebner(I1) while (oldpoly J1.first) case "failed" repeat J1:=J1.rest [[(oldpoly f)::DPoly for f in J1],true] + makeleast : (List VarSet,List VarSet) -> List VarSet makeleast(fullVars: List VarSet,leastVars:List VarSet) : List VarSet == n:= # leastVars #fullVars < n => error "wrong vars" n=0 => fullVars append([vv for vv in fullVars| ^member?(vv,leastVars)],leastVars) + isMonic? : (DPoly,VarSet) -> Boolean isMonic?(f:DPoly,x:VarSet) : Boolean == ground? leadingCoefficient univariate(f,x) + subset : List VarSet -> List List VarSet subset(lv : List VarSet) : List List VarSet == #lv =1 => [lv,empty()] v:=lv.1 @@ -149544,6 +153381,7 @@ PolynomialIdeals(F,Expon,VarSet,DPoly) : C == T l1:=[concat(v,set) for set in ll] concat(l1,ll) + monomDim : (Ideal,List VarSet) -> NNI monomDim(listm:Ideal,lv:List VarSet) : NNI == monvar: List List VarSet := [] for f in generators listm repeat @@ -149559,18 +153397,19 @@ PolynomialIdeals(F,Expon,VarSet,DPoly) : C == T if ^(empty? ldif) then return #subs 0 - -- Exported Functions ---- - ---- is I = J ? ---- + ?=? : (%,%) -> Boolean (I:Ideal = J:Ideal) == in?(I,J) and in?(J,I) ---- check if f is in I ---- + element? : (DPoly,%) -> Boolean element?(f:DPoly,I:Ideal) : Boolean == Id:=(groebner I).idl empty? Id => f = 0 normalForm(f,Id) = 0 ---- check if I is contained in J ---- + in? : (%,%) -> Boolean in?(I:Ideal,J:Ideal):Boolean == J:= groebner J empty?(I.idl) => true @@ -149578,6 +153417,7 @@ PolynomialIdeals(F,Expon,VarSet,DPoly) : C == T ---- groebner base for an Ideal ---- + groebner : % -> % groebner(I:Ideal) : Ideal == I.isGr => "or"/[^zero? f for f in I.idl] => I @@ -149585,6 +153425,7 @@ PolynomialIdeals(F,Expon,VarSet,DPoly) : C == T [groebner I.idl ,true] ---- Intersection of two ideals ---- + intersect : (%,%) -> % intersect(I:Ideal,J:Ideal) : Ideal == empty?(Id:=I.idl) => I empty?(Jd:=J.idl) => J @@ -149596,9 +153437,11 @@ PolynomialIdeals(F,Expon,VarSet,DPoly) : C == T ---- intersection for a list of ideals ---- + intersect : List(%) -> % intersect(lid:List(Ideal)) : Ideal == "intersect"/[l for l in lid] ---- quotient by an element ---- + quotient : (%,DPoly) -> % quotient(I:Ideal,f:DPoly) : Ideal == --[[(g exquo f)::DPoly for g in (intersect(I,[f]::%)).idl ],true] import GroebnerInternalPackage(F,Expon,VarSet,DPoly) @@ -149606,6 +153449,7 @@ PolynomialIdeals(F,Expon,VarSet,DPoly) : C == T for g in (intersect(I,[f]::%)).idl ],true] ---- quotient of two ideals ---- + quotient : (%,%) -> % quotient(I:Ideal,J:Ideal) : Ideal == Jdl := J.idl empty?(Jdl) => ideal [1] @@ -149613,24 +153457,29 @@ PolynomialIdeals(F,Expon,VarSet,DPoly) : C == T ---- sum of two ideals ---- + ?+? : (%,%) -> % (I:Ideal + J:Ideal) : Ideal == [groebner(concat(I.idl ,J.idl )),true] ---- product of two ideals ---- + ?*? : (%,%) -> % (I:Ideal * J:Ideal):Ideal == [groebner([:[f*g for f in I.idl ] for g in J.idl ]),true] ---- power of an ideal ---- + ?**? : (%,NonNegativeInteger) -> % (I:Ideal ** n:NNI) : Ideal == n=0 => [[1$DPoly],true] (I * (I**(n-1):NNI)) ---- saturation with respect to the multiplicative set f**n ---- + saturate : (%,DPoly) -> % saturate(I:Ideal,f:DPoly) : Ideal == f=0 => error "f is zero" tp:newPoly := (monomial(1,makeprod(1,0$Expon))$newPoly * npoly f)-1 contractGrob(concat(tp,[npoly g for g in I.idl ])) ---- saturation with respect to a prime principal ideal in lvar --- + saturate : (%,DPoly,List(VarSet)) -> % saturate(I:Ideal,f:DPoly,lvar:List(VarSet)) : Ideal == Id := I.idl fullVars := "setUnion"/[variables g for g in Id] @@ -149644,6 +153493,7 @@ PolynomialIdeals(F,Expon,VarSet,DPoly) : C == T ---- is the ideal zero dimensional? ---- ---- in the ring F[lvar]? ---- + zeroDim? : (%,List(VarSet)) -> Boolean zeroDim?(I:Ideal,lvar:List VarSet) : Boolean == J:=(groebner I).idl empty? J => false @@ -149656,10 +153506,12 @@ PolynomialIdeals(F,Expon,VarSet,DPoly) : C == T empty?(lvar) ---- is the ideal zero dimensional? ---- + zeroDim? : % -> Boolean zeroDim?(I:Ideal):Boolean == zeroDim?(I,"setUnion"/[variables g for g in I.idl]) ---- test if f is in the radical of I ---- + inRadical? : (DPoly,%) -> Boolean inRadical?(f:DPoly,I:Ideal) : Boolean == f=0$DPoly => true tp:newPoly :=(monomial(1,makeprod(1,0$Expon))$newPoly * npoly f)-1 @@ -149668,6 +153520,7 @@ PolynomialIdeals(F,Expon,VarSet,DPoly) : C == T ---- dimension of an ideal ---- ---- in the ring F[lvar] ---- + dimension : (%,List(VarSet)) -> Integer dimension(I:Ideal,lvar:List VarSet) : Z == I:=groebner I empty?(I.idl) => # lvar @@ -149680,10 +153533,12 @@ PolynomialIdeals(F,Expon,VarSet,DPoly) : C == T n1:Z:=monomDim(leadid,truelist)::Z ed+n1 + dimension : % -> Integer dimension(I:Ideal) : Z == dimension(I,"setUnion"/[variables g for g in I.idl]) -- leading term ideal -- + leadingIdeal : % -> % leadingIdeal(I : Ideal) : Ideal == Idl:= (groebner I).idl [[(f-reductum f) for f in Idl],true] @@ -149691,12 +153546,14 @@ PolynomialIdeals(F,Expon,VarSet,DPoly) : C == T ---- ideal of relations among the fi ---- if VarSet has ConvertibleTo Symbol then + monompol : (List NNI,F,List VarSet) -> P monompol(df:List NNI,lcf:F,lv:List VarSet) : P == g:P:=lcf::P for dd in df for v in lv repeat g:= monomial(g,convert v,dd) g + relationsIdeal : List DPoly -> ST relationsIdeal(listf : List DPoly): ST == empty? listf => [empty(),empty()]$ST nf:=#listf @@ -149747,23 +153604,31 @@ PolynomialIdeals(F,Expon,VarSet,DPoly) : C == T solsn:=concat(g,solsn) [solsn,leq]$ST + coerce : List(DPoly) -> % coerce(Id:List DPoly) : Ideal == [Id,false] + coerce : % -> OutputForm coerce(I:Ideal) : OutputForm == Idl := I.idl empty? Idl => [0$DPoly] :: OutputForm Idl :: OutputForm + ideal : List(DPoly) -> % ideal(Id:List DPoly) :Ideal == [[f for f in Id|f^=0],false] + groebnerIdeal : List(DPoly) -> % groebnerIdeal(Id:List DPoly) : Ideal == [Id,true] + generators : % -> List(DPoly) generators(I:Ideal) : List DPoly == I.idl + groebner? : % -> Boolean groebner?(I:Ideal) : Boolean == I.isGr + one? : % -> Boolean one?(I:Ideal) : Boolean == element?(1, I) + zero? : % -> Boolean zero?(I:Ideal) : Boolean == empty? (groebner I).idl *) @@ -150229,11 +154094,9 @@ PolynomialRing(R:Ring,E:OrderedAbelianMonoid): T == C (* FreeModule(R,E) add - --representations Term:= Record(k:E,c:R) Rep:= List Term - --declarations x,y,p,p1,p2: % n: Integer nn: NonNegativeInteger @@ -150241,56 +154104,66 @@ PolynomialRing(R:Ring,E:OrderedAbelianMonoid): T == C e: E r: R - --local operations - + 1 : () -> % 1 == [[0$E,1$R]] + characteristic : () -> NonNegativeInteger characteristic == characteristic$R + numberOfMonomials : % -> NonNegativeInteger numberOfMonomials x == (# x)$Rep + degree : % -> E degree p == if null p then 0 else p.first.k + minimumDegree : % -> E minimumDegree p == if null p then 0 else (last p).k + leadingCoefficient : % -> R leadingCoefficient p == if null p then 0$R else p.first.c + leadingMonomial : % -> % leadingMonomial p == if null p then 0 else [p.first] + reductum : % -> % reductum p == if null p then p else p.rest + retractIfCan : % -> Union(R,"failed") retractIfCan(p:%):Union(R,"failed") == null p => 0$R not null p.rest => "failed" zero?(p.first.k) => p.first.c "failed" + coefficient : (%,E) -> R coefficient(p,e) == for tm in p repeat tm.k=e => return tm.c tm.k < e => return 0$R 0$R + recip : % -> Union(%,"failed") recip(p) == null p => "failed" p.first.k > 0$E => "failed" (u:=recip(p.first.c)) case "failed" => "failed" (u::R)::% + coerce : R -> % coerce(r) == if zero? r then 0$% else [[0$E,r]] + coerce : Integer -> % coerce(n) == (n::R)::% + ground? : % -> Boolean ground?(p): Boolean == empty? p or (empty? rest p and zero? degree p) qsetrest!: (Rep, Rep) -> Rep qsetrest!(l: Rep, e: Rep): Rep == RPLACD(l, e)$Lisp - times!: (R, %) -> % - times: (R, E, %) -> % - entireRing? := R has EntireRing + times!: (R, %) -> % times!(r: R, x: %): % == res, endcell, newend, xx: Rep if entireRing? then @@ -150318,20 +154191,18 @@ PolynomialRing(R:Ring,E:OrderedAbelianMonoid): T == C termTimes: (R, E, Term) -> Term termTimes(r: R, e: E, tx:Term): Term == [e+tx.k, r*tx.c] + times: (R, E, %) -> % times(tco: R, tex: E, rx: %): % == if entireRing? then map(x1+->termTimes(tco, tex, x1), rx::Rep) else [[tex + tx.k, r] for tx in rx::Rep | not zero? (r := tco * tx.c)] - - -- local addm! + -- p1 + coef*x^E * p2 + -- `spare' (commented out) is for storage efficiency (not so good for + -- performance though. addm!: (Rep, R, E, Rep) -> Rep - -- p1 + coef*x^E * p2 - -- `spare' (commented out) is for storage efficiency (not so good for - -- performance though. - addm!(p1:Rep, coef:R, exp: E, p2:Rep): Rep == --local res, newend, last: Rep res, newcell, endcell: Rep @@ -150376,8 +154247,10 @@ PolynomialRing(R:Ring,E:OrderedAbelianMonoid): T == C qsetrest!(endcell, newcell) res + pomopo! : (%,R,E,%) -> % pomopo! (p1, r, e, p2) == addm!(p1, r, e, p2) + ?*? : (%,%) -> % p1 * p2 == xx := p1::Rep empty? xx => p1 @@ -150395,13 +154268,16 @@ PolynomialRing(R:Ring,E:OrderedAbelianMonoid): T == C if R has CommutativeRing then + ?**? : (%,PositiveInteger) -> % p ** np == p ** (np pretend NonNegativeInteger) + ?^? : (%,PositiveInteger) -> % p ^ np == p ** (np pretend NonNegativeInteger) + ?^? : (%,NonNegativeInteger) -> % p ^ nn == p ** nn - + ?**? : (%,NonNegativeInteger) -> % p ** nn == null p => 0 zero? nn => 1 @@ -150413,11 +154289,13 @@ PolynomialRing(R:Ring,E:OrderedAbelianMonoid): T == C if R has Field then + unitNormal : % -> Record(unit: %,canonical: %,associate: %) unitNormal(p) == null p or (lcf:R:=p.first.c) = 1 => [1,p,1] a := inv lcf [lcf::%, [[p.first.k,1],:(a * p.rest)], a::%] + unitCanonical : % -> % unitCanonical(p) == null p or (lcf:R:=p.first.c) = 1 => p a := inv lcf @@ -150425,11 +154303,13 @@ PolynomialRing(R:Ring,E:OrderedAbelianMonoid): T == C else if R has IntegralDomain then + unitNormal : % -> Record(unit: %,canonical: %,associate: %) unitNormal(p) == null p or p.first.c = 1 => [1,p,1] (u,cf,a):=unitNormal(p.first.c) [u::%, [[p.first.k,cf],:(a * p.rest)], a::%] + unitCanonical : % -> % unitCanonical(p) == null p or p.first.c = 1 => p (u,cf,a):=unitNormal(p.first.c) @@ -150437,6 +154317,7 @@ PolynomialRing(R:Ring,E:OrderedAbelianMonoid): T == C if R has IntegralDomain then + associates? : (%,%) -> Boolean associates?(p1,p2) == null p1 => null p2 null p2 => false @@ -150444,6 +154325,7 @@ PolynomialRing(R:Ring,E:OrderedAbelianMonoid): T == C associates?(p1.first.c,p2.first.c) and ((p2.first.c exquo p1.first.c)::R * p1.rest = p2.rest) + exquo : (%,R) -> Union(%,"failed") p exquo r == [(if (a:= tm.c exquo r) case "failed" then return "failed" else [tm.k,a]) @@ -150451,6 +154333,7 @@ PolynomialRing(R:Ring,E:OrderedAbelianMonoid): T == C if E has CancellationAbelianMonoid then + fmecg : (%,E,R,%) -> % fmecg(p1:%,e:E,r:R,p2:%):% == -- p1 - r * X**e * p2 rout:%:= [] r:= - r @@ -150467,6 +154350,7 @@ PolynomialRing(R:Ring,E:OrderedAbelianMonoid): T == C if R has approximate then + exquo : (%,%) -> Union(%,"failed") p1 exquo p2 == null p2 => error "Division by 0" p2 = 1 => p1 @@ -150485,6 +154369,7 @@ PolynomialRing(R:Ring,E:OrderedAbelianMonoid): T == C else -- R not approximate + exquo : (%,%) -> Union(%,"failed") p1 exquo p2 == null p2 => error "Division by 0" p2 = 1 => p1 @@ -150501,6 +154386,7 @@ PolynomialRing(R:Ring,E:OrderedAbelianMonoid): T == C if R has Field then + ?/? : (%,R) -> % x/r == inv(r)*x *) @@ -151117,23 +155003,32 @@ PrimitiveArray(S:Type): OneDimensionalArrayAggregate S == add Qsetelt ==> SETELT$Lisp Qnew ==> MAKE_-ARRAY$Lisp - #x == Qsize x + #? : % -> NonNegativeInteger + #x == Qsize x - minIndex x == 0 + minIndex : % -> Integer + minIndex x == 0 - empty() == Qnew(0$Lisp) + empty : () -> % + empty() == Qnew(0$Lisp) - new(n, x) == fill_!(Qnew n, x) + new : (NonNegativeInteger,S) -> % + new(n, x) == fill_!(Qnew n, x) - qelt(x, i) == Qelt(x, i) + qelt : (%,Integer) -> S + qelt(x, i) == Qelt(x, i) - elt(x:%, i:Integer) == Qelt(x, i) + ?.? : (%,Integer) -> S + elt(x:%, i:Integer) == Qelt(x, i) - qsetelt_!(x, i, s) == Qsetelt(x, i, s) + qsetelt! : (%,Integer,S) -> S + qsetelt_!(x, i, s) == Qsetelt(x, i, s) + setelt : (%,Integer,S) -> S setelt(x:%, i:Integer, s:S) == Qsetelt(x, i, s) - fill_!(x, s) == (for i in 0..Qmax x repeat Qsetelt(x, i, s); x) + fill! : (%,S) -> % + fill_!(x, s) == (for i in 0..Qmax x repeat Qsetelt(x, i, s); x) *) @@ -151450,10 +155345,8 @@ Product (A:SetCategory,B:SetCategory) : C == T (* domain PRODUCT *) (* - --representations Rep := Record(acomp:A,bcomp:B) - --declarations x,y: % i: NonNegativeInteger p: NonNegativeInteger @@ -151461,46 +155354,59 @@ Product (A:SetCategory,B:SetCategory) : C == T b: B d: Integer - --define + coerce : % -> OutputForm coerce(x):OutputForm == paren [(x.acomp)::OutputForm, (x.bcomp)::OutputForm] + ?=? : (%,%) -> Boolean x=y == x.acomp = y.acomp => x.bcomp = y.bcomp false + makeprod : (A,B) -> % makeprod(a:A,b:B) :% == [a,b] + selectfirst : % -> A selectfirst(x:%) : A == x.acomp + selectsecond : % -> B selectsecond (x:%) : B == x.bcomp if A has Monoid and B has Monoid then + 1 : () -> % 1 == [1$A,1$B] + ?*? : (%,%) -> % x * y == [x.acomp * y.acomp,x.bcomp * y.bcomp] + ?**? : (%,NonNegativeInteger) -> % x ** p == [x.acomp ** p ,x.bcomp ** p] if A has Finite and B has Finite then + size : () -> NonNegativeInteger size == size$A () * size$B () if A has Group and B has Group then + inv : % -> % inv(x) == [inv(x.acomp),inv(x.bcomp)] if A has AbelianMonoid and B has AbelianMonoid then + 0 : () -> % 0 == [0$A,0$B] + ?+? : (%,%) -> % x + y == [x.acomp + y.acomp,x.bcomp + y.bcomp] + ?*? : (NonNegativeInteger,%) -> % c:NonNegativeInteger * x == [c * x.acomp,c*x.bcomp] if A has CancellationAbelianMonoid and B has CancellationAbelianMonoid then + subtractIfCan : (%,%) -> Union(%,"failed") subtractIfCan(x, y) : Union(%,"failed") == (na:= subtractIfCan(x.acomp, y.acomp)) case "failed" => "failed" (nb:= subtractIfCan(x.bcomp, y.bcomp)) case "failed" => "failed" @@ -151508,18 +155414,23 @@ Product (A:SetCategory,B:SetCategory) : C == T if A has AbelianGroup and B has AbelianGroup then + -? : % -> % - x == [- x.acomp,-x.bcomp] + ?-? : (%,%) -> % (x - y):% == [x.acomp - y.acomp,x.bcomp - y.bcomp] + ?*? : (Integer,%) -> % d * x == [d * x.acomp,d * x.bcomp] if A has OrderedAbelianMonoidSup and B has OrderedAbelianMonoidSup then + sup : (%,%) -> % sup(x,y) == [sup(x.acomp,y.acomp),sup(x.bcomp,y.bcomp)] if A has OrderedSet and B has OrderedSet then + ? Boolean x < y == xa:= x.acomp ; ya:= y.acomp xa < ya => true @@ -151975,6 +155886,7 @@ ProjectiveSpace(dim,K):Exports == Implementation where Rep:= List(K) + coerce : % -> OutputForm coerce(pt:%):OutputForm == dd:OutputForm:= ":" :: OutputForm llout:List(OutputForm):=[ hconcat(dd, a::OutputForm) for a in rest pt] @@ -151984,32 +155896,40 @@ ProjectiveSpace(dim,K):Exports == Implementation where ee:OutputForm:= degree(pt) :: OutputForm oo**ee + definingField : % -> K definingField(pt)== K has PseudoAlgebraicClosureOfPerfectFieldCategory => _ maxTower(pt pretend Rep) 1$K + degree : % -> PositiveInteger degree(pt)== K has PseudoAlgebraicClosureOfPerfectFieldCategory => _ extDegree definingField pt 1 + coerce : % -> List(K) coerce(pt:%):List(K) == pt pretend Rep + projectivePoint : List(K) -> % projectivePoint(pt:LIST(K))== pt :: % + list : % -> List(K) list(ptt)== ptt pretend Rep + pointValue : % -> List(K) pointValue(ptt)== ptt pretend Rep + conjugate : (%,NonNegativeInteger) -> % conjugate(p,e)== lp:Rep:=p pc:List(K):=[c**e for c in lp] projectivePoint(pc) + homogenize : (%,Integer) -> % homogenize(ptt,nV)== if K has Field then pt:=list(ptt)$% @@ -152019,12 +155939,16 @@ ProjectiveSpace(dim,K):Exports == Implementation where else ptt + rational? : (%,NonNegativeInteger) -> Boolean rational?(p,n)== p=conjugate(p,n) + rational? : % -> Boolean rational?(p)==rational?(p,characteristic()$K) + removeConjugate : List(%) -> List(%) removeConjugate(l)==removeConjugate(l,characteristic()$K) + removeConjugate : (List(%),NonNegativeInteger) -> List(%) removeConjugate(l:LIST(%),n:NNI):LIST(%)== if K has FiniteFieldCategory then allconj:LIST(%):=empty() @@ -152037,10 +155961,13 @@ ProjectiveSpace(dim,K):Exports == Implementation where else error "The field is not finite" + conjugate : % -> % conjugate(p)==conjugate(p,characteristic()$K) + orbit : % -> List(%) orbit(p)==orbit(p,characteristic()$K) + orbit : (%,NonNegativeInteger) -> List(%) orbit(p,e)== if K has FiniteFieldCategory then l:LIST(%):=[p] @@ -152054,11 +155981,13 @@ ProjectiveSpace(dim,K):Exports == Implementation where else error "Cannot compute the conjugate" + ?=? : (%,%) -> Boolean aa:% = bb:% == ah:=homogenize(aa) bh:=homogenize(bb) ah =$Rep bh + coerce : List(K) -> % coerce(pt:LIST(K))== ^(dim=#pt) => error "Le point n'a pas la bonne dimension" reduce("and",[zero?(a) for a in pt]) => _ @@ -152066,6 +155995,7 @@ ProjectiveSpace(dim,K):Exports == Implementation where ptt:%:= pt homogenize ptt + homogenize : % -> % homogenize(ptt)== homogenize(ptt,lastNonNull(ptt)) @@ -152073,11 +156003,13 @@ ProjectiveSpace(dim,K):Exports == Implementation where nonZero?(a)== not(zero?(a)) + lastNonNull : % -> Integer lastNonNull(ptt)== pt:=ptt pretend Rep (dim pretend Integer)+1-_ (position("nonZero?",(reverse(pt)$LIST(K)))$LIST(K)) + lastNonNul : % -> Integer lastNonNul(pt)==lastNonNull(pt) *) @@ -152540,12 +156472,8 @@ PseudoAlgebraicClosureOfAlgExtOfRationalNumber(downLevel:K):Exp == Impl where (* Rep := Union(recRep,K) - - -- signature of local function - replaceRecEl: (%,SUP(%)) -> % - - down: % -> % + retractPol : SUP(%) -> SUP(K) retractPol( pol:SUP(%) ):SUP(K)== zero? pol => 0$SUP(K) lc := leadingCoefficient pol @@ -152553,6 +156481,7 @@ PseudoAlgebraicClosureOfAlgExtOfRationalNumber(downLevel:K):Exp == Impl where rlc := retractToGrn( lc ) monomial( rlc , d )$SUP(K) + retractPol( reductum pol ) + retractToGrn : % -> PseudoAlgebraicClosureOfRationalNumber retractToGrn(aa)== aa case K => aa a:=(aa pretend recRep) @@ -152563,6 +156492,7 @@ PseudoAlgebraicClosureOfAlgExtOfRationalNumber(downLevel:K):Exp == Impl where n:= a.recName newElement(retractPol el, retractPol t, d, retractToGrn pt, n)$K + newElement : (SparseUnivariatePolynomial(%),%,Symbol) -> % newElement(pol,subF,inName) == -- pol is an irreducible polynomial over the field extension -- given by subF. @@ -152579,8 +156509,10 @@ PseudoAlgebraicClosureOfAlgExtOfRationalNumber(downLevel:K):Exp == Impl where d:PI := (dp pretend PI) * extDegree(subF) [monomial(1$%,1)$SUP(%),pol,d,subF,inName] :: Rep + coerce : Integer -> % coerce(a:Integer):%== (a :: K) + down: % -> % down(a:%) == a case K => a aa:=(a pretend recRep) @@ -152589,6 +156521,7 @@ PseudoAlgebraicClosureOfAlgExtOfRationalNumber(downLevel:K):Exp == Impl where gel:%:=ground(elel) down(gel) + ?*? : (Integer,%) -> % n:INT * a:% == one?(n) => a zero?(a) or zero?(n) => 0 @@ -152596,6 +156529,7 @@ PseudoAlgebraicClosureOfAlgExtOfRationalNumber(downLevel:K):Exp == Impl where mm:PositiveInteger:=(n pretend PositiveInteger) double(mm,a)$RepeatedDoubling(%) + replaceRecEl: (%,SUP(%)) -> % replaceRecEl(a,el)== a case K => a aa:=copy a @@ -152604,22 +156538,26 @@ PseudoAlgebraicClosureOfAlgExtOfRationalNumber(downLevel:K):Exp == Impl where localTower :% := downLevel + lift : % -> SparseUnivariatePolynomial(%) lift(a) == a case K => monomial(a,0) (a pretend recRep).recEl + lift : (%,%) -> SparseUnivariatePolynomial(%) lift(a,b)== extDegree a > extDegree b => _ error "Cannot lift something at lower level !!!!!" extDegree a < extDegree b => monomial(a,0)$SUP(%) lift a + reduce : SparseUnivariatePolynomial(%) -> % reduce(a)== localTower case K => coefficient(a,0) ar:= a rem (localTower pretend recRep).recTower replaceRecEl(localTower,ar) + maxTower : List(%) -> % maxTower(la)== --return an element from the list la which is in the largest --extension of the ground field @@ -152627,8 +156565,10 @@ PseudoAlgebraicClosureOfAlgExtOfRationalNumber(downLevel:K):Exp == Impl where m:="max"/[extDegree(a)$% for a in la] first [b for b in la | extDegree(b)=m] + ground? : % -> Boolean ground?(a)== a case K + vectorise : (%,%) -> Vector(%) vectorise(a,lev)== da:=extDegree a dlev:=extDegree lev @@ -152641,7 +156581,6 @@ PseudoAlgebraicClosureOfAlgExtOfRationalNumber(downLevel:K):Exp == Impl where pa:= monomial(a,0)$SUP(%) na:= replaceRecEl(lev,pa) vectorise(na,lev)$% - prevLev:=previousTower(lev) a case K => error "At this point a is not suppose to be in K" aEl:=(a pretend recRep).recEl @@ -152649,14 +156588,17 @@ PseudoAlgebraicClosureOfAlgExtOfRationalNumber(downLevel:K):Exp == Impl where lv:=[vectorise(c,prevLev)$% for c in entries(vectorise(aEl,daEl)$SUP(%))] concat lv + retractIfCan : % -> Union(PseudoAlgebraicClosureOfRationalNumber,"failed") retractIfCan(a:%):Union(K,"failed")== a case K => a "failed" + retractIfCan : % -> Union(Integer,"failed") retractIfCan(a:%):Union(Integer,"failed")== a case K => retractIfCan(a)$K "failed" + setTower! : % -> Void setTower!(a) == if a case K then localTower := downLevel @@ -152664,8 +156606,10 @@ PseudoAlgebraicClosureOfAlgExtOfRationalNumber(downLevel:K):Exp == Impl where localTower:=a void() + definingPolynomial : () -> SparseUnivariatePolynomial(%) definingPolynomial == definingPolynomial(localTower) + ?+? : (%,%) -> % a:% + b:% == (a case K) and (b case K) => a +$K b extDegree(a) > extDegree(b) => b + a @@ -152679,6 +156623,7 @@ PseudoAlgebraicClosureOfAlgExtOfRationalNumber(downLevel:K):Exp == Impl where res2:= replaceRecEl(b,res1) down(res2) + ?*? : (%,%) -> % a:% * b:% == (a case K) and (b case K) => a *$K b extDegree(a) > extDegree(b) => b * a @@ -152692,6 +156637,7 @@ PseudoAlgebraicClosureOfAlgExtOfRationalNumber(downLevel:K):Exp == Impl where res2:= replaceRecEl(b,res1) down(res2) + distinguishedRootsOf : (SparseUnivariatePolynomial(%),%) -> List(%) distinguishedRootsOf(polyZero,ee) == setTower!(ee) zero?(polyZero) => error "to lazy to give you all the roots of 0 !!!" @@ -152703,14 +156649,18 @@ PseudoAlgebraicClosureOfAlgExtOfRationalNumber(downLevel:K):Exp == Impl where listOfZeros:List(%):=concat([ root ], listOfZeros) listOfZeros + 1 : () -> % 1 == 1$K + 0 : () -> % 0 == 0$K + newElement : (SparseUnivariatePolynomial(%),Symbol) -> % newElement(poll:SUP(%),inName:Symbol)== newElement(poll,localTower,inName)$% --Field operations + inv : % -> % inv(a)== a case K => inv(a)$K aRecEl:= (a pretend recRep).recEl @@ -152724,16 +156674,21 @@ PseudoAlgebraicClosureOfAlgExtOfRationalNumber(downLevel:K):Exp == Impl where -- C'est ce que fait la fonction replaceRecEl. replaceRecEl( a , aInv.coef1 ) + ?/? : (%,%) -> % a:% / b:% == a * inv(b) + ?*? : (PseudoAlgebraicClosureOfRationalNumber,%) -> % a:K * b:%== (a :: %) * b + ?*? : (%,PseudoAlgebraicClosureOfRationalNumber) -> % b:% * a:K == a*b + ?-? : (%,%) -> % a:% - b:% == a + (-b) + ?*? : (%,Fraction(Integer)) -> % a:% * b:Fraction(Integer) == bn:=numer b bd:=denom b @@ -152741,6 +156696,7 @@ PseudoAlgebraicClosureOfAlgExtOfRationalNumber(downLevel:K):Exp == Impl where ebd:%:= bd * 1$% a * ebn * inv(ebd) + -? : % -> % -a:% == a case K => -$K a [-$SUP(%) (a pretend recRep).recEl,_ @@ -152749,6 +156705,7 @@ PseudoAlgebraicClosureOfAlgExtOfRationalNumber(downLevel:K):Exp == Impl where (a pretend recRep).recPrevTower,_ (a pretend recRep).recName ] + ?=? : (%,%) -> Boolean bb:% = aa:% == b:=down bb a:=down aa @@ -152759,43 +156716,53 @@ PseudoAlgebraicClosureOfAlgExtOfRationalNumber(downLevel:K):Exp == Impl where not (rda.recTower =$SUP(%) rdb.recTower) => false rdb.recEl =$SUP(%) rda.recEl + zero? : % -> Boolean zero?(a:%) == da:=down a -- just to be sure !!! ^(da case K) => false zero?(da)$K + one? : % -> Boolean one?(a:%) == da:= down a -- just to be sure !!! ^(da case K) => false one?(da)$K + coerce : PseudoAlgebraicClosureOfRationalNumber -> % coerce(a:K):% == a + coerce : % -> OutputForm coerce(a:%):OutputForm == a case K => ((retract a)@K) ::OutputForm outputForm((a pretend recRep).recEl,_ ((a pretend recRep).recName)::OutputForm) $SUP(%) + fullOutput : % -> OutputForm fullOutput(a:%):OutputForm== a case K => ((retract a)@K) ::OutputForm (a pretend recRep)::OutputForm + definingPolynomial : % -> SparseUnivariatePolynomial(%) definingPolynomial(a:%): SUP % == a case K => monomial(1,1)$SUP(%) (a pretend recRep).recTower + extDegree : % -> PositiveInteger extDegree(a:%): PI == a case K => 1 (a pretend recRep).recDeg + previousTower : % -> % previousTower(a:%):% == a case K => error "No previous extension for ground field element" (a pretend recRep).recPrevTower + name : % -> Symbol name(a:%):Symbol == a case K => error "No name for ground field element" (a pretend recRep).recName + characteristic : () -> NonNegativeInteger characteristic == characteristic()$K *) @@ -153367,12 +157334,7 @@ PseudoAlgebraicClosureOfFiniteField(K):Exports == Implementation where Rep := Union(recRep,K) - -- signature of local function replaceRecEl: (%,SUP(%)) -> % - down: % -> % - localRandom: % -> % - repPolynomial : % -> SUP(%) - replaceRecEl(a,el)== a case K => a aa:=copy a @@ -153385,14 +157347,17 @@ PseudoAlgebraicClosureOfFiniteField(K):Exports == Implementation where localSize :NNI := size()$K -- implemetation of exported function + degree : % -> OnePointCompletion(PositiveInteger) degree(a)== da:PositiveInteger:= extDegree a coerce(da@PositiveInteger)$OnePointCompletion(PositiveInteger) + repPolynomial : % -> SUP(%) repPolynomial(a)== a case K => error "Is in ground field" (a pretend recRep).recEl + inv : % -> % inv(a)== a case K => inv(a)$K aRecEl:= repPolynomial a @@ -153401,25 +157366,31 @@ PseudoAlgebraicClosureOfFiniteField(K):Exports == Implementation where aInv case "failed" => error "PACOFF : division by zero" down replaceRecEl( a , aInv.coef1 ) + ?**? : (%,PositiveInteger) -> % a:% ** n:PositiveInteger == zero?(a) => 0 expt( a , n )$RepeatedSquaring(%) + ?**? : (%,NonNegativeInteger) -> % a:% ** n:NonNegativeInteger == zero?(a) and zero?(n) => error " --- 0^0 not defined " zero?(n) => 1$% a ** ( n pretend PositiveInteger ) + ?**? : (%,Integer) -> % a:% ** n:Integer == n < 0 => inv( a ** ( (-n) pretend PositiveInteger) ) a ** ( n pretend NonNegativeInteger ) + unitNormal : % -> Record(unit: %,canonical: %,associate: %) unitNormal(a)== zero? a => [1,0,1] [a,1,inv a] + ground? : % -> Boolean ground?(a)== a case K + vectorise : (%,%) -> Vector(%) vectorise(a,lev)== da:=extDegree a dlev:=extDegree lev @@ -153440,13 +157411,16 @@ PseudoAlgebraicClosureOfFiniteField(K):Exports == Implementation where lv:=[vectorise(c,prevLev)$% for c in entries(vectorise(aEl,daEl)$SUP(%))] concat lv + size : () -> NonNegativeInteger size == localSize + setTower! : % -> Void setTower!(a) == localTower:=a localSize:=(size()$K)**extDegree(a) void() + localRandom: % -> % localRandom(a) == --return a random element at the extension of a a case K => random()$K @@ -153455,6 +157429,7 @@ PseudoAlgebraicClosureOfFiniteField(K):Exports == Implementation where pol:=reduce("+",[monomial(localRandom(subF),i)$SUP(%) for i in 0..d]) down replaceRecEl(a,pol) + ?+? : (%,%) -> % a:% + b:% == (a case K) and (b case K) => a +$K b extDegree(a) > extDegree(b) => b + a @@ -153468,6 +157443,7 @@ PseudoAlgebraicClosureOfFiniteField(K):Exports == Implementation where res2:= replaceRecEl(b,res1) down(res2) + ?*? : (K,%) -> % a:% * b:% == (a case K) and (b case K) => a *$K b extDegree(a) > extDegree(b) => b * a @@ -153481,6 +157457,7 @@ PseudoAlgebraicClosureOfFiniteField(K):Exports == Implementation where res2:= replaceRecEl(b,res1) down(res2) + distinguishedRootsOf : (SparseUnivariatePolynomial(%),%) -> List(%) distinguishedRootsOf(polyZero,ee) == setTower!(ee) zero?(polyZero) => error "to lazy to give you all the roots of 0 !!!" @@ -153492,6 +157469,7 @@ PseudoAlgebraicClosureOfFiniteField(K):Exports == Implementation where listOfZeros:List(%):=concat([ root ], listOfZeros) listOfZeros + random : () -> % random== localRandom(localTower) @@ -153501,6 +157479,7 @@ PseudoAlgebraicClosureOfFiniteField(K):Exports == Implementation where i:= i + 1 i + charthRoot : % -> Union(%,"failed") charthRoot(a : %): % == --return a**(1/chararcteristic ) a case K => charthRoot(retract a)$K @@ -153511,13 +157490,17 @@ PseudoAlgebraicClosureOfFiniteField(K):Exports == Implementation where c:= (characteristic()$K) ** b a**c + conjugate : % -> % conjugate(a)== a ** size()$K + 1 : () -> % 1 == 1$K + 0 : () -> % 0 == 0$K + newElement : (SparseUnivariatePolynomial(%),%,Symbol) -> % newElement(pol:SUP(%),subF:%,inName:Symbol): % == -- pol is an irreducible polynomial over the field extension -- given by subF. @@ -153531,9 +157514,11 @@ PseudoAlgebraicClosureOfFiniteField(K):Exports == Implementation where d:PI := (dp pretend PI) * extDegree(subF) [monomial(1$%,1),pol,d,subF,inName] :: Rep + newElement : (SparseUnivariatePolynomial(%),Symbol) -> % newElement(poll:SUP(%),inName:Symbol)== newElement(poll,localTower,inName) + maxTower : List(%) -> % maxTower(la)== --return an element from the list la which is in the largest --extension of the ground field @@ -153543,16 +157528,21 @@ PseudoAlgebraicClosureOfFiniteField(K):Exports == Implementation where --Field operations + ?/? : (%,%) -> % a:% / b:% == a * inv(b) + ?*? : (K,%) -> % a:K * b:%== (a :: %) * b + ?*? : (%,K) -> % b:% * a:K == a*b + ?-? : (%,%) -> % a:% - b:% == a + (-b) + ?*? : (%,Fraction(Integer)) -> % a:% * b:Fraction(Integer) == bn:=numer b bd:=denom b @@ -153560,6 +157550,7 @@ PseudoAlgebraicClosureOfFiniteField(K):Exports == Implementation where ebd:%:= bd * 1$% a * ebn * inv(ebd) + -? : % -> % -a:% == a case K => -$K a [-$SUP(%) (a pretend recRep).recEl,_ @@ -153568,6 +157559,7 @@ PseudoAlgebraicClosureOfFiniteField(K):Exports == Implementation where (a pretend recRep).recPrevTower,_ (a pretend recRep).recName ] + ?*? : (Integer,%) -> % n:INT * a:% == one?(n) => a zero?(a) or zero?(n) => 0 @@ -153575,6 +157567,7 @@ PseudoAlgebraicClosureOfFiniteField(K):Exports == Implementation where mm:PositiveInteger:=(n pretend PositiveInteger) double(mm,a)$RepeatedDoubling(%) + ?=? : (%,%) -> Boolean bb:% = aa:% == b:=down bb a:=down aa @@ -153585,11 +157578,13 @@ PseudoAlgebraicClosureOfFiniteField(K):Exports == Implementation where not (rda.recTower =$SUP(%) rdb.recTower) => false rdb.recEl =$SUP(%) rda.recEl + zero? : % -> Boolean zero?(a:%) == da:=down a -- just to be sure !!! ^(da case K) => false zero?(da)$K + one? : % -> Boolean one?(a:%) == da:= down a -- just to be sure !!! ^(da case K) => false @@ -153597,55 +157592,68 @@ PseudoAlgebraicClosureOfFiniteField(K):Exports == Implementation where --Coerce Functions + coerce : K -> % coerce(a:K) == a + retractIfCan : % -> Union(K,"failed") retractIfCan(a)== a case K => a "failed" + coerce : % -> OutputForm coerce(a:%):OutputForm == a case K => (retract a)::OutputForm outputForm((a pretend recRep).recEl,_ ((a pretend recRep).recName)::OutputForm) $SUP(%) + fullOutput : % -> OutputForm fullOutput(a:%):OutputForm== a case K => (retract a)::OutputForm (a pretend recRep)::OutputForm + definingPolynomial : % -> SparseUnivariatePolynomial(%) definingPolynomial(a:%): SUP % == a case K => 1 (a pretend recRep).recTower + extDegree : % -> PositiveInteger extDegree(a:%): PI == a case K => 1 (a pretend recRep).recDeg + previousTower : % -> % previousTower(a:%):% == a case K => error "No previous extension for ground field element" (a pretend recRep).recPrevTower + name : % -> Symbol name(a:%):Symbol == a case K => error "No name for ground field element" (a pretend recRep).recName -- function related to the ground field + lookup : % -> PositiveInteger lookup(a:%)== aa:=down a ^(aa case K) => _ error "From NonGlobalDynamicExtensionOfFiniteField fnc Lookup: Cannot take i-dex" lookup(retract aa)$K + index : PositiveInteger -> % index(i)==(index(i)$K) fromPrimeField? == characteristic()$K = size()$K + representationType : () -> Union("prime",polynomial,normal,cyclic) representationType == representationType()$K + characteristic : () -> NonNegativeInteger characteristic == characteristic()$K -- implementation of local functions + down: % -> % down(a:%) == a case K => a aa:=(a pretend recRep) @@ -154156,11 +158164,8 @@ PseudoAlgebraicClosureOfRationalNumber:Exports == Implementation where (* Rep := Union(recRep,K) - - -- signature of local function - replaceRecEl: (%,SUP(%)) -> % + down: % -> % - down(a:%) == a case K => a aa:=(a pretend recRep) @@ -154169,8 +158174,10 @@ PseudoAlgebraicClosureOfRationalNumber:Exports == Implementation where gel:%:=ground(elel) down(gel) + coerce : Integer -> % coerce(a:Integer):%== (a :: K) + ?*? : (Integer,%) -> % n:INT * a:% == one?(n) => a zero?(a) or zero?(n) => 0 @@ -154178,6 +158185,7 @@ PseudoAlgebraicClosureOfRationalNumber:Exports == Implementation where mm:PositiveInteger:=(n pretend PositiveInteger) double(mm,a)$RepeatedDoubling(%) + replaceRecEl: (%,SUP(%)) -> % replaceRecEl(a,el)== a case K => a aa:=copy a @@ -154189,22 +158197,26 @@ PseudoAlgebraicClosureOfRationalNumber:Exports == Implementation where -- implemetation of exported function + lift : % -> SparseUnivariatePolynomial(%) lift(a) == a case K => monomial(a,0) (a pretend recRep).recEl + lift : (%,%) -> SparseUnivariatePolynomial(%) lift(a,b)== extDegree a > extDegree b => _ error "Cannot lift something at lower level !!!!!" extDegree a < extDegree b => monomial(a,0)$SUP(%) lift a + reduce : SparseUnivariatePolynomial(%) -> % reduce(a)== localTower case K => coefficient(a,0) ar:= a rem (localTower pretend recRep).recTower replaceRecEl(localTower,ar) + maxTower : List(%) -> % maxTower(la)== --return an element from the list la which is in the largest --extension of the ground field @@ -154212,8 +158224,10 @@ PseudoAlgebraicClosureOfRationalNumber:Exports == Implementation where m:="max"/[extDegree(a)$% for a in la] first [b for b in la | extDegree(b)=m] + ground? : % -> Boolean ground?(a)== a case K + vectorise : (%,%) -> Vector(%) vectorise(a,lev)== da:=extDegree a dlev:=extDegree lev @@ -154233,12 +158247,15 @@ PseudoAlgebraicClosureOfRationalNumber:Exports == Implementation where lv:=[vectorise(c,prevLev)$% for c in entries(vectorise(aEl,daEl)$SUP(%))] concat lv + setTower! : % -> Void setTower!(a) == localTower:=a void() + definingPolynomial : () -> SparseUnivariatePolynomial(%) definingPolynomial == definingPolynomial(localTower) + ?+? : (%,%) -> % a:% + b:% == (a case K) and (b case K) => a +$K b extDegree(a) > extDegree(b) => b + a @@ -154252,6 +158269,7 @@ PseudoAlgebraicClosureOfRationalNumber:Exports == Implementation where res2:= replaceRecEl(b,res1) down(res2) + ?*? : (%,%) -> % a:% * b:% == (a case K) and (b case K) => a *$K b extDegree(a) > extDegree(b) => b * a @@ -154265,6 +158283,7 @@ PseudoAlgebraicClosureOfRationalNumber:Exports == Implementation where res2:= replaceRecEl(b,res1) down(res2) + distinguishedRootsOf : (SparseUnivariatePolynomial(%),%) -> List(%) distinguishedRootsOf(polyZero,ee) == setTower!(ee) zero?(polyZero) => error "to lazy to give you all the roots of 0 !!!" @@ -154276,10 +158295,13 @@ PseudoAlgebraicClosureOfRationalNumber:Exports == Implementation where listOfZeros:List(%):=concat([ root ], listOfZeros) listOfZeros + 1 : () -> % 1 == 1$K + 0 : () -> % 0 == 0$K + newElement : (SparseUnivariatePolynomial(%),%,Symbol) -> % newElement(pol:SUP(%),subF:%,inName:Symbol): % == -- pol is an irreducible polynomial over the field extension -- given by subF. @@ -154293,13 +158315,17 @@ PseudoAlgebraicClosureOfRationalNumber:Exports == Implementation where d:PI := (dp pretend PI) * extDegree(subF) [monomial(1$%,1),pol,d,subF,inName] :: Rep + newElement : (SparseUnivariatePolynomial(%),Symbol) -> % newElement(poll:SUP(%),inName:Symbol)== newElement(poll,localTower,inName) + newElement : (SparseUnivariatePolynomial(%),SparseUnivariatePolynomial(%), + PositiveInteger,%,Symbol) -> % newElement(elPol:SUP(%),pol:SUP(%),d:PI,subF:%,inName:Symbol): % == [elPol, pol,d,subF,inName] :: Rep --Field operations + inv : % -> % inv(a)== a case K => inv(a)$K aRecEl:= (a pretend recRep).recEl @@ -154313,16 +158339,21 @@ PseudoAlgebraicClosureOfRationalNumber:Exports == Implementation where -- C'est ce que fait la fonction replaceRecEl. replaceRecEl( a , aInv.coef1 ) + ?/? : (%,%) -> % a:% / b:% == a * inv(b) + ?*? : (Fraction(Integer),%) -> % a:K * b:%== (a :: %) * b + ?*? : (%,Fraction(Integer)) -> % b:% * a:K == a*b + ?-? : (%,%) -> % a:% - b:% == a + (-b) + ?*? : (%,Fraction(Integer)) -> % a:% * b:Fraction(Integer) == bn:=numer b bd:=denom b @@ -154330,6 +158361,7 @@ PseudoAlgebraicClosureOfRationalNumber:Exports == Implementation where ebd:%:= bd * 1$% a * ebn * inv(ebd) + -? : % -> % -a:% == a case K => -$K a [-$SUP(%) (a pretend recRep).recEl,_ @@ -154338,6 +158370,7 @@ PseudoAlgebraicClosureOfRationalNumber:Exports == Implementation where (a pretend recRep).recPrevTower,_ (a pretend recRep).recName ] + ?=? : (%,%) -> Boolean bb:% = aa:% == b:=down bb a:=down aa @@ -154348,11 +158381,13 @@ PseudoAlgebraicClosureOfRationalNumber:Exports == Implementation where not (rda.recTower =$SUP(%) rdb.recTower) => false rdb.recEl =$SUP(%) rda.recEl + zero? : % -> Boolean zero?(a:%) == da:=down a -- just to be sure !!! ^(da case K) => false zero?(da)$K + one? : % -> Boolean one?(a:%) == da:= down a -- just to be sure !!! ^(da case K) => false @@ -154360,43 +158395,53 @@ PseudoAlgebraicClosureOfRationalNumber:Exports == Implementation where --Coerce Functions + coerce : Fraction(Integer) -> % coerce(a:K):% == a + retractIfCan : % -> Union(Integer,"failed") retractIfCan(a:%):Union(Integer,"failed")== a case K => retractIfCan(a)$K "failed" + retractIfCan : % -> Union(Fraction(Integer),"failed") retractIfCan(a:%):Union(K,"failed")== a case K => a "failed" + coerce : % -> OutputForm coerce(a:%):OutputForm == a case K => ((retract a)@K) ::OutputForm outputForm((a pretend recRep).recEl,_ ((a pretend recRep).recName)::OutputForm) $SUP(%) + fullOutput : % -> OutputForm fullOutput(a:%):OutputForm== a case K => ((retract a)@K) ::OutputForm (a pretend recRep)::OutputForm + definingPolynomial : % -> SparseUnivariatePolynomial(%) definingPolynomial(a:%): SUP % == a case K => monomial(1,1)$SUP(%) (a pretend recRep).recTower + extensionDegree : () -> OnePointCompletion(PositiveInteger) extDegree(a:%): PI == a case K => 1 (a pretend recRep).recDeg + previousTower : % -> % previousTower(a:%):% == a case K => error "No previous extension for ground field element" (a pretend recRep).recPrevTower + name : % -> Symbol name(a:%):Symbol == a case K => error "No name for ground field element" (a pretend recRep).recName -- function related to the ground field + characteristic : () -> NonNegativeInteger characteristic == characteristic()$K *) @@ -154528,13 +158573,16 @@ QuadraticForm(n, K): T == Impl where SM(n,K) add Rep := SM(n,K) + quadraticForm : SquareMatrix(n,K) -> % quadraticForm m == not symmetric? m => error "quadraticForm requires a symmetric matrix" m::% + matrix : % -> SquareMatrix(n,K) matrix q == q pretend SM(n,K) + ?.? : (%,DirectProduct(n,K)) -> K elt(q,v) == dot(v, (matrix q * v)) *) @@ -154843,19 +158891,14 @@ QuasiAlgebraicSet(R, Var,Expon,Dpoly) : C == T import GroebnerPackage(R,newExpon,Var,newPoly) import GroebnerInternalPackage(R,Expon,Var,Dpoly) - ---- Local Functions ---- - - minset : List List Dpoly -> List List Dpoly - overset? : (List Dpoly, List List Dpoly) -> Boolean - npoly : Dpoly -> newPoly - oldpoly : newPoly -> Union(Dpoly,"failed") - - if (R has EuclideanDomain) and (R has CharacteristicZero) then + + factorset : Dpoly -> List Dpoly factorset (y:Dpoly):List Dpoly == ground? y => [] [j.factor for j in factors factor$mrf y] + simplify : % -> % simplify x == if x.status case "failed" then x:=quasiAlgebraicSet(zro:=groebner x.zero, redPol(x.nzero,zro)) @@ -154865,13 +158908,15 @@ QuasiAlgebraicSet(R, Var,Expon,Dpoly) : C == T mset:=[setDifference(s,nzro) for s in mset] zro:=groebner [*/s for s in mset] member? (1$Dpoly, zro) => empty() - [x.status, zro, primitivePart redPol(*/nzro, zro)] + [x.status, zro, primitivePart redPol( */nzro, zro)] + npoly : Dpoly -> newPoly npoly(f:Dpoly) : newPoly == zero? f => 0 monomial(leadingCoefficient f,makeprod(0,degree f))$newPoly + npoly(reductum f) + oldpoly : newPoly -> Union(Dpoly,"failed") oldpoly(q:newPoly) : Union(Dpoly,"failed") == q=0$newPoly => 0$Dpoly dq:newExpon:=degree q @@ -154880,27 +158925,36 @@ QuasiAlgebraicSet(R, Var,Expon,Dpoly) : C == T ((g:=oldpoly reductum q) case "failed") => "failed" monomial(leadingCoefficient q,selectsecond dq)$Dpoly + (g::Dpoly) + coerce : % -> OutputForm coerce x == x.status = true => "Empty"::Ex bracket [[hconcat(f::Ex, " = 0"::Ex) for f in x.zero ]::Ex, hconcat( x.nzero::Ex, " != 0"::Ex)] + empty? : % -> Boolean empty? x == if x.status case "failed" then x:=idealSimplify x x.status :: Boolean + empty : () -> % empty() == [true::Status, [1$Dpoly], 0$Dpoly] + status : % -> Union(Boolean,"failed") status x == x.status + setStatus : (%,Union(Boolean,"failed")) -> % setStatus(x,t) == [t,x.zero,x.nzero] + definingEquations : % -> List(Dpoly) definingEquations x == x.zero + definingInequation : % -> Dpoly definingInequation x == x.nzero + quasiAlgebraicSet : (List(Dpoly),Dpoly) -> % quasiAlgebraicSet(z0,n0) == ["failed", z0, n0] + idealSimplify : % -> % idealSimplify x == x.status case Boolean => x z0:= x.zero @@ -154916,11 +158970,12 @@ QuasiAlgebraicSet(R, Var,Expon,Dpoly) : C == T ngb:=ngb.rest [false::Status, gb, primitivePart redPol(n0, gb)] - + minset : List List Dpoly -> List List Dpoly minset lset == empty? lset => lset [s for s in lset | ^(overset?(s,lset))] + overset? : (List Dpoly, List List Dpoly) -> Boolean overset?(p,qlist) == empty? qlist => false or/[(brace$(Set Dpoly) q) <$(Set Dpoly) (brace$(Set Dpoly) p) _ @@ -155360,23 +159415,31 @@ Quaternion(R:CommutativeRing): QuaternionCategory(R) == add Rep := Record(r:R,i:R,j:R,k:R) + 0 : () -> % 0 == [0,0,0,0] + 1 : () -> % 1 == [1,0,0,0] a,b,c,d : R x,y : $ + real : % -> R real x == x.r + imagI : % -> R imagI x == x.i + imagJ : % -> R imagJ x == x.j + imagK : % -> R imagK x == x.k + quatern : (R,R,R,R) -> % quatern(a,b,c,d) == [a,b,c,d] + ?*? : (%,%) -> % x * y == [x.r*y.r-x.i*y.i-x.j*y.j-x.k*y.k, x.r*y.i+x.i*y.r+x.j*y.k-x.k*y.j, x.r*y.j+x.j*y.r+x.k*y.i-x.i*y.k, @@ -155481,12 +159544,16 @@ QueryEquation(): Exports == Implementation where Rep := Record(var:Symbol, val:String) + coerce : % -> OutputForm coerce(u) == coerce(u.var)$Symbol = coerce(u.val)$String + equation : (Symbol,String) -> % equation(x,s) == [x,s] + variable : % -> Symbol variable q == q.var + value : % -> String value q == q.val *) @@ -156406,31 +160473,41 @@ Queue(S:SetCategory): QueueAggregate S with lastTail==> LAST$Lisp + enqueue! : (S,%) -> S enqueue_!(e,q) == if null deref q then setref(q, list e) else lastTail.(deref q).rest := list e e + insert! : (S,%) -> % insert_!(e,q) == (enqueue_!(e,q);q) + dequeue! : % -> S dequeue_! q == empty? q => error "empty queue" e := first deref q setref(q,rest deref q) e + extract! : % -> S extract_! q == dequeue_! q + rotate! : % -> % rotate_! q == if empty? q then q else (enqueue_!(dequeue_! q,q); q) + length : % -> NonNegativeInteger length q == # deref q + front : % -> S front q == if empty? q then error "empty queue" else first deref q + inspect : % -> S inspect q == front q + back : % -> S back q == if empty? q then error "empty queue" else last deref q + queue : List(S) -> % queue q == ref copy q *) @@ -156977,18 +161054,6 @@ RadicalFunctionField(F, UP, UPUP, radicnd, n): Exports == Impl where import InnerCommonDenominator(UP, RF, Vector UP, Vector RF) import UnivariatePolynomialCategoryFunctions2(RF, UPUP, UP, UP2) - diag : Vector RF -> Vector $ - startUp : Boolean -> Void - fullVector : (Factored UP, N) -> PrimitiveArray UP - iBasis : (UP, N) -> Vector UP - inftyBasis : (RF, N) -> Vector RF - basisvec : () -> Vector RF - char0StartUp: () -> Void - charPStartUp: () -> Void - getInfBasis : () -> Void - radcand : () -> UP - charPintbas : (UPUP, RF, Vector RF, Vector RF) -> Void - brandNew?:Reference(Boolean) := ref true discPoly:Reference(RF) := ref(0$RF) newrad:Reference(UP) := ref(0$UP) @@ -157000,47 +161065,65 @@ RadicalFunctionField(F, UP, UPUP, radicnd, n): Exports == Impl where invinfbasis:Vector(RF):= new(n, 0) mini := minIndex ibasis - discriminant() == (INIT; discPoly()) + discriminant : () -> Fraction(UP) + discriminant() == (INIT; discPoly()) - radcand() == (INIT; newrad()) + radcand : () -> UP + radcand() == (INIT; newrad()) - integralBasis() == (INIT; diag ibasis) + integralBasis : () -> Vector(%) + integralBasis() == (INIT; diag ibasis) - integralBasisAtInfinity() == (INIT; diag infbasis) + integralBasisAtInfinity : () -> Vector(%) + integralBasisAtInfinity() == (INIT; diag infbasis) - basisvec() == (INIT; ibasis) + basisvec : () -> Vector RF + basisvec() == (INIT; ibasis) - integralMatrix() == diagonalMatrix basisvec() + integralMatrix : () -> Matrix(Fraction(UP)) + integralMatrix() == diagonalMatrix basisvec() - integralMatrixAtInfinity() == (INIT; diagonalMatrix infbasis) + integralMatrixAtInfinity : () -> Matrix(Fraction(UP)) + integralMatrixAtInfinity() == (INIT; diagonalMatrix infbasis) - inverseIntegralMatrix() == (INIT; diagonalMatrix invibasis) + inverseIntegralMatrix : () -> Matrix(Fraction(UP)) + inverseIntegralMatrix() == (INIT; diagonalMatrix invibasis) - inverseIntegralMatrixAtInfinity()==(INIT;diagonalMatrix invinfbasis) + inverseIntegralMatrixAtInfinity : () -> Matrix(Fraction(UP)) + inverseIntegralMatrixAtInfinity() == (INIT;diagonalMatrix invinfbasis) - definingPolynomial() == modulus + definingPolynomial : () -> UPUP + definingPolynomial() == modulus - ramified?(point:F) == zero?(radcand() point) + ramified? : UP -> Boolean + ramified?(point:F) == zero?(radcand() point) + branchPointAtInfinity? : () -> Boolean branchPointAtInfinity?() == (degree(radcand()) exquo n) case "failed" - elliptic() == (n = 2 and degree(radcand()) = 3 => radcand(); "failed") + elliptic : () -> Union(UP,"failed") + elliptic() == (n = 2 and degree(radcand()) = 3 => radcand(); "failed") + hyperelliptic : () -> Union(UP,"failed") hyperelliptic() == (n=2 and odd? degree(radcand()) => radcand(); "failed") + diag : Vector RF -> Vector $ diag v == [reduce monomial(qelt(v,i+mini), i) for i in 0..n1] + integralRepresents : (Vector(UP),UP) -> % integralRepresents(v, d) == ib := basisvec() represents [qelt(ib, i) * (qelt(v, i) /$RF d) for i in mini .. maxIndex ib] + integralCoordinates : % -> Record(num: Vector(UP),den: UP) integralCoordinates f == v := coordinates f ib := basisvec() splitDenominator [qelt(v,i) / qelt(ib,i) for i in mini .. maxIndex ib]$Vector(RF) + integralDerivationMatrix : (UP -> UP) -> Record(num: Matrix(UP),den: UP) integralDerivationMatrix d == dlogp := differentiate(radicnd, d) / (n * radicnd) v := basisvec() @@ -157052,6 +161135,7 @@ RadicalFunctionField(F, UP, UPUP, radicnd, n): Exports == Impl where -- return (d0,...,d(n-1)) s.t. (1/d0, y/d1,...,y**(n-1)/d(n-1)) -- is an integral basis for the curve y**d = p -- requires that p has no factor of multiplicity >= d + iBasis : (UP, N) -> Vector UP iBasis(p, d) == pl := fullVector(squareFree p, d) d1 := (d - 1)::N @@ -157059,6 +161143,7 @@ RadicalFunctionField(F, UP, UPUP, radicnd, n): Exports == Impl where -- returns a vector [a0,a1,...,a_{m-1}] of length m such that -- p = a0^0 a1^1 ... a_{m-1}^{m-1} + fullVector : (Factored UP, N) -> PrimitiveArray UP fullVector(p, m) == ans:PrimitiveArray(UP) := new(m, 0) ans.0 := unit p @@ -157071,6 +161156,7 @@ RadicalFunctionField(F, UP, UPUP, radicnd, n): Exports == Impl where -- return (f0,...,f(n-1)) s.t. (f0, y f1,..., y**(n-1) f(n-1)) -- is a local integral basis at infinity for the curve y**d = p + inftyBasis : (RF, N) -> Vector RF inftyBasis(p, m) == rt := rootPoly(p(x := inv(monomial(1, 1)$UP :: RF)), m) m ^= rt.exponent => @@ -157084,6 +161170,7 @@ RadicalFunctionField(F, UP, UPUP, radicnd, n): Exports == Impl where b := b * a w + charPintbas : (UPUP, RF, Vector RF, Vector RF) -> Void charPintbas(p, c, v, w) == degree(p) ^= n => error "charPintbas: should not happen" q:UP2 := map(s+->retract(s)@UP, p) @@ -157100,6 +161187,7 @@ RadicalFunctionField(F, UP, UPUP, radicnd, n): Exports == Impl where a := a * c void + charPStartUp: () -> Void charPStartUp() == r := mkIntegral modulus charPintbas(r.poly, r.coef, ibasis, invibasis) @@ -157108,6 +161196,7 @@ RadicalFunctionField(F, UP, UPUP, radicnd, n): Exports == Impl where r := mkIntegral invmod charPintbas(r.poly, (r.coef) x, infbasis, invinfbasis) + startUp : Boolean -> Void startUp b == brandNew?() := b if zero?(p := characteristic()$F) or p > n then char0StartUp() @@ -157118,6 +161207,7 @@ RadicalFunctionField(F, UP, UPUP, radicnd, n): Exports == Impl where discPoly() := primitivePart(numer dsc) / denom(dsc) void + char0StartUp: () -> Void char0StartUp() == rp := rootPoly(radicnd, n) rp.exponent ^= n => @@ -157134,26 +161224,31 @@ RadicalFunctionField(F, UP, UPUP, radicnd, n): Exports == Impl where qsetelt_!(invinfbasis, i, inv a) void + ramified? : F -> Boolean ramified?(p:UP) == (r := retractIfCan(p)@Union(F, "failed")) case F => singular?(r::F) (radcand() exquo p) case UP + singular? : UP -> Boolean singular?(p:UP) == (r := retractIfCan(p)@Union(F, "failed")) case F => singular?(r::F) (radcand() exquo(p**2)) case UP + branchPoint? : UP -> Boolean branchPoint?(p:UP) == (r := retractIfCan(p)@Union(F, "failed")) case F => branchPoint?(r::F) ((q := (radcand() exquo p)) case UP) and ((q::UP exquo p) case "failed") + singular? : F -> Boolean singular?(point:F) == zero?(radcand() point) and zero?(((radcand() exquo (monomial(1,1)$UP-point::UP))::UP) point) + branchPoint? : F -> Boolean branchPoint?(point:F) == zero?(radcand() point) and not zero?(((radcand() exquo (monomial(1,1)$UP-point::UP))::UP) point) @@ -157949,48 +162044,62 @@ RadixExpansion(bb): Exports == Implementation where a,b: % n: I - radixInt: (I, I) -> List I - radixFrac: (I, I, I) -> Record(pfx: List I, cyc: List I) - checkRagits: List I -> Boolean - -- Arithmetic operations + characteristic : () -> NonNegativeInteger characteristic() == 0 + differentiate : % -> % if Integer has DIFRING differentiate a == 0 - 0 == [1, nil(), nil(), nil()] + 0 : () -> % + 0 == [1, nil(), nil(), nil()] - 1 == [1, [1], nil(), nil()] + 1 : () -> % + 1 == [1, [1], nil(), nil()] + -? : % -> % - a == (a = 0 => 0; [-a.sgn, a.int, a.pfx, a.cyc]) + ?+? : (%,%) -> % a + b == (a::RN + b::RN)::% + ?-? : (%,%) -> % a - b == (a::RN - b::RN)@RN::% + ?*? : (Integer,%) -> % n * a == (n * a::RN)::% + ?*? : (%,%) -> % a * b == (a::RN * b::RN)::% + ?/? : (%,%) -> % a / b == (a::RN / b::RN)::% + ?/? : (Integer,Integer) -> % (i:I) / (j:I) == (i/j)@RN :: % + ? Boolean a < b == a::RN < b::RN + ?=? : (%,%) -> Boolean a = b == a.sgn = b.sgn and a.int = b.int and a.pfx = b.pfx and a.cyc = b.cyc + numer : % -> Integer numer a == numer(a::RN) + denom : % -> Integer denom a == denom(a::RN) -- Algebraic coercions + coerce : % -> Fraction(Integer) coerce(a):RN == (wholePart a) :: RN + fractionPart a + coerce : Integer -> % coerce(n):% == n :: RN :: % + coerce : Fraction(Integer) -> % coerce(q):% == s := 1; if q < 0 then (s := -1; q := -q) qr := divide(numer q,denom q) @@ -158006,15 +162115,19 @@ RadixExpansion(bb): Exports == Implementation where -- Exported constructor/destructors + ceiling : % -> Integer ceiling a == ceiling(a::RN) + floor : % -> Integer floor a == floor(a::RN) + wholePart : % -> Integer wholePart a == n0 := 0 for r in a.int repeat n0 := bb*n0 + r a.sgn*n0 + fractionPart : % -> % fractionPart a == n0 := 0 for r in a.pfx repeat n0 := bb*n0 + r @@ -158026,18 +162139,24 @@ RadixExpansion(bb): Exports == Implementation where d := (bb**((#a.cyc)::NNI) - 1) * bb**((#a.pfx)::NNI) a.sgn*n/d + wholeRagits : % -> List(Integer) wholeRagits a == a.int + fractRagits : % -> Stream(Integer) fractRagits a == concat(construct(a.pfx)@ST,repeating a.cyc) + prefixRagits : % -> List(Integer) prefixRagits a == a.pfx + cycleRagits : % -> List(Integer) cycleRagits a == a.cyc + wholeRadix : List(Integer) -> % wholeRadix li == checkRagits li [1, li, nil(), nil()] + fractRadix : (List(Integer),List(Integer)) -> % fractRadix(lpfx, lcyc) == checkRagits lpfx; checkRagits lcyc [1, nil(), lpfx, lcyc] @@ -158046,17 +162165,20 @@ RadixExpansion(bb): Exports == Implementation where ALPHAS : String := "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + intToExpr : I -> OUT intToExpr(i:I): OUT == -- computes a digit for bases between 11 and 36 i < 10 => i :: OUT elt(ALPHAS,(i-10) + minIndex(ALPHAS)) :: OUT + exprgroup : List OUT -> OUT exprgroup(le: List OUT): OUT == empty? le => error "exprgroup needs non-null list" empty? rest le => first le abs bb <= 36 => hconcat le blankSeparate le + intgroup : List I -> OUT intgroup(li: List I): OUT == empty? li => error "intgroup needs non-null list" empty? rest li => intToExpr first(li) @@ -158064,8 +162186,10 @@ RadixExpansion(bb): Exports == Implementation where abs bb <= 36 => hconcat [intToExpr(i) for i in li] blankSeparate [i :: OUT for i in li] + overBar : List I -> OUT overBar(li: List I): OUT == overbar intgroup li + coerce : % -> OutputForm coerce(a): OUT == le : List OUT := nil() if not null a.cyc then le := concat(overBar a.cyc,le) @@ -158077,11 +162201,13 @@ RadixExpansion(bb): Exports == Implementation where if a.sgn < 0 then -rex else rex -- Construction utilities + checkRagits: List I -> Boolean checkRagits li == for i in li repeat if i < 0 or i >= bb then error "Each ragit (digit) must be between 0 and base-1" true + radixInt: (I, I) -> List I radixInt(n,bas) == rits: List I := nil() while abs n ^= 0 repeat @@ -158090,6 +162216,7 @@ RadixExpansion(bb): Exports == Implementation where rits := concat(qr.remainder,rits) rits + radixFrac: (I, I, I) -> Record(pfx: List I, cyc: List I) radixFrac(num,den,bas) == -- Rits is the sequence of quotient/remainder pairs -- in calculating the radix expansion of the rational number. @@ -159843,18 +163970,9 @@ RealClosure(TheField): PUB == PRIV where (* domain RECLOS *) (* --- local functions - - lessAlgebraic : $ -> $ - newElementIfneeded : (SEG,E) -> $ - --- Representation - Rec := Record(seg: SEG, val:PME, outForm:E, order:N) Rep := Union(TheField,Rec) --- global (mutable) variables - orderOfCreation : N := 1$N -- it is internally used to sort the algebraic levels @@ -159862,15 +163980,14 @@ RealClosure(TheField): PUB == PRIV where -- this used to print the results, thus different instanciations -- use different names --- now the code - + relativeApprox : (%,%) -> Fraction(Integer) relativeApprox(nbe,prec) == nbe case TheField => retract(nbe) appr := relativeApprox(nbe.val, nbe.seg, prec) -- now appr has the good exact precision but is $ relativeApprox(appr,prec) - + approximate : (%,%) -> Fraction(Integer) approximate(nbe,prec) == abs(nbe) < prec => 0 nbe case TheField => retract(nbe) @@ -159878,6 +163995,7 @@ RealClosure(TheField): PUB == PRIV where -- now appr has the good exact precision but is $ approximate(appr,prec) + newElementIfneeded : (SEG,E) -> $ newElementIfneeded(s,o) == p := definingPolynomial(s) degree(p) = 1 => @@ -159886,6 +164004,8 @@ RealClosure(TheField): PUB == PRIV where orderOfCreation := orderOfCreation + 1 res :: $ + algebraicOf : (RightOpenIntervalRootCharacterization(%, + SparseUnivariatePolynomial(%)),OutputForm) -> % algebraicOf(s,o) == pol := definingPolynomial(s) degree(pol) = 1 => @@ -159894,13 +164014,17 @@ RealClosure(TheField): PUB == PRIV where orderOfCreation := orderOfCreation + 1 res :: $ + rename! : (%,OutputForm) -> % rename!(x,o) == x.outForm := o x + rename : (%,OutputForm) -> % rename(x,o) == [x.seg, x.val, o, x.order]$Rec + rootOf : (SparseUnivariatePolynomial(%),PositiveInteger) -> + Union(%,"failed") rootOf(pol,n) == degree(pol) = 0 => "failed" degree(pol) = 1 => @@ -159914,6 +164038,7 @@ RealClosure(TheField): PUB == PRIV where o := hconcat(instanceName :: E , orderOfCreation :: E)$E algebraicOf(r,o) + allRootsOf : SparseUnivariatePolynomial(%) -> List(%) allRootsOf(pol:SUP):List($) == degree(pol)=0 => [] degree(pol)=1 => [-coefficient(pol,0) / leadingCoefficient(pol)] @@ -159924,53 +164049,70 @@ RealClosure(TheField): PUB == PRIV where res := cons(algebraicOf(term,o), res) reverse! res + coerce : % -> % coerce(x:$):$ == x case TheField => x [x.seg,x.val rem$PME definingPolynomial(x.seg),x.outForm,x.order]$Rec + positive? : % -> Boolean positive?(x) == x case TheField => positive?(x)$TheField positive?(x.val,x.seg)$SEG + negative? : % -> Boolean negative?(x) == x case TheField => negative?(x)$TheField negative?(x.val,x.seg)$SEG + abs : % -> % abs(x) == sign(x)*x + sign : % -> Integer sign(x) == x case TheField => sign(x)$TheField sign(x.val,x.seg)$SEG + ? Boolean x < y == positive?(y-x) + ?=? : (%,%) -> Boolean x = y == zero?(x-y) + mainCharacterization : % -> + Union(RightOpenIntervalRootCharacterization(%, + SparseUnivariatePolynomial(%)),"failed") mainCharacterization(x) == x case TheField => "failed" x.seg + mainDefiningPolynomial : % -> + Union(SparseUnivariatePolynomial(%),"failed") mainDefiningPolynomial(x) == x case TheField => "failed" definingPolynomial x.seg + mainForm : % -> Union(OutputForm,"failed") mainForm(x) == x case TheField => "failed" x.outForm + mainValue : % -> Union(SparseUnivariatePolynomial(%),"failed") mainValue(x) == x case TheField => "failed" x.val + coerce : % -> OutputForm coerce(x:$):E == x case TheField => x::TheField :: E xx:$ := coerce(x) outputForm(univariate(xx.val),x.outForm)$SUP + inv : % -> % inv(x) == (res:= recip x) case "failed" => error "Division by 0" res :: $ + recip : % -> Union(%,"failed") recip(x) == x case TheField => if ((r := recip(x)$TheField) case TheField) @@ -159980,18 +164122,21 @@ RealClosure(TheField): PUB == PRIV where then "failed" else lessAlgebraic([x.seg,r::PME,x.outForm,x.order]$Rec) + ?*? : (Integer,%) -> % (n:Z * x:$):$ == x case TheField => n *$TheField x zero?(n) => 0 one?(n) => x [x.seg,map(z+->n*z, x.val),x.outForm,x.order]$Rec + ?*? : (Fraction(Integer),%) -> % (rn:TheField * x:$):$ == x case TheField => rn *$TheField x zero?(rn) => 0 one?(rn) => x [x.seg,map(z+->rn*z, x.val),x.outForm,x.order]$Rec + ?*? : (%,%) -> % (x:$ * y:$):$ == (x case TheField) and (y case TheField) => x *$TheField y (x case TheField) => x::TheField * y @@ -160010,16 +164155,19 @@ RealClosure(TheField): PUB == PRIV where x.outForm, x.order]$Rec) + nonNull : Rec -> $ nonNull(rep:Rec):$ == degree(rep.val)=0 => leadingCoefficient(rep.val) numberOfMonomials(rep.val) = 1 => rep zero?(rep.val,rep.seg)$SEG => 0 rep + zero? : % -> Boolean zero?(x) == x case TheField => zero?(x)$TheField false + ?+? : (%,%) -> % x + y == (x case TheField) and (y case TheField) => x +$TheField y (x case TheField) => @@ -160045,10 +164193,12 @@ RealClosure(TheField): PUB == PRIV where -- however wee need to call lessAlgebraic nonNull([x.seg,x.val + y.val,x.outForm,x.order]) + -? : % -> % -x == x case TheField => -$TheField (x::TheField) [x.seg,-$PME x.val,x.outForm,x.order]$Rec + retractIfCan : % -> Union(TheField,"failed") retractIfCan(x:$):Union(TheField,"failed") == x case TheField => x o := x.order @@ -160057,6 +164207,7 @@ RealClosure(TheField): PUB == PRIV where o = res.order => "failed" retractIfCan res + retract : % -> TheField retract(x:$):TheField == x case TheField => x o := x.order @@ -160065,6 +164216,7 @@ RealClosure(TheField): PUB == PRIV where o = res.order => error "Can't retract" retract res + lessAlgebraic : $ -> $ lessAlgebraic(x) == x case TheField => x degree(x.val) = 0 => leadingCoefficient(x.val) @@ -160073,10 +164225,13 @@ RealClosure(TheField): PUB == PRIV where x.val.(- coefficient(def,0) / leadingCoefficient(def)) x + 0 : () -> % 0 == (0$TheField) :: $ + 1 : () -> % 1 == (1$TheField) :: $ + coerce : TheField -> % coerce(rn:TheField):$ == rn :: $ *) @@ -160340,10 +164495,14 @@ RectangularMatrix(m,n,R): Exports == Implementation where maxi ==> maxIndex ZERO := new(m,n,0)$Matrix(R) pretend $ - 0 == ZERO + + 0 : () -> % + 0 == ZERO + coerce : % -> OutputForm coerce(x:$):OutputForm == coerce(x pretend Matrix R)$Matrix(R) + matrix : List(List(R)) -> % matrix(l: List List R) == -- error check: this is a top level function #l ^= m => error "matrix: wrong number of rows" @@ -160355,12 +164514,16 @@ RectangularMatrix(m,n,R): Exports == Implementation where qsetelt_!(ans,i,j,r) ans pretend $ - row(x,i) == directProduct row(x pretend Matrix(R),i) + row : (%,Integer) -> DirectProduct(n,R) + row(x,i) == directProduct row(x pretend Matrix(R),i) + column : (%,Integer) -> DirectProduct(m,R) column(x,j) == directProduct column(x pretend Matrix(R),j) + coerce : % -> Matrix(R) coerce(x:$):Matrix(R) == copy(x pretend Matrix(R)) + rectangularMatrix : Matrix(R) -> % rectangularMatrix x == (nrows(x) ^= m) or (ncols(x) ^= n) => error "rectangularMatrix: matrix of bad dimensions" @@ -160368,23 +164531,29 @@ RectangularMatrix(m,n,R): Exports == Implementation where if R has EuclideanDomain then + rowEchelon : % -> % rowEchelon x == rowEchelon(x pretend Matrix(R)) pretend $ if R has IntegralDomain then + rank : % -> NonNegativeInteger rank x == rank(x pretend Matrix(R)) + nullity : % -> NonNegativeInteger nullity x == nullity(x pretend Matrix(R)) + nullSpace : % -> List(DirectProduct(m,R)) nullSpace x == [directProduct c for c in nullSpace(x pretend Matrix(R))] if R has Field then + dimension : () -> CardinalNumber dimension() == (m * n) :: CardinalNumber if R has ConvertibleTo InputForm then + convert : % -> InputForm convert(x:$):InputForm == convert [convert("rectangularMatrix"::Symbol)@InputForm, convert(x::Matrix(R))]$List(InputForm) @@ -160517,20 +164686,27 @@ Reference(S:Type): Type with Rep := Record(value: S) - p = q == EQ(p, q)$Lisp + ?=? : (%,%) -> Boolean + p = q == EQ(p, q)$Lisp - ref v == [v] + ref : S -> % + ref v == [v] - elt p == p.value + elt : % -> S + elt p == p.value + setelt : (%,S) -> S setelt(p, v) == p.value := v - deref p == p.value + deref : % -> S + deref p == p.value + setref : (%,S) -> S setref(p, v) == p.value := v if S has SetCategory then + coerce : % -> OutputForm coerce p == prefix(message("ref"@String), [p.value::OutputForm]) @@ -162843,63 +167019,81 @@ RegularTriangularSet(R,E,V,P) : Exports == Implementation where Rep ==> LP + rep : $ -> Rep rep(s:$):Rep == s pretend Rep + per : Rep -> $ per(l:Rep):$ == l pretend $ + copy : % -> % copy ts == per(copy(rep(ts))$LP) + empty : () -> % empty() == per([]) + empty? : % -> Boolean empty?(ts:$) == empty?(rep(ts)) + parts : % -> List(P) parts ts == rep(ts) + members : % -> List(P) members ts == rep(ts) + map : ((P -> P),%) -> % map (f : PtoP, ts : $) : $ == construct(map(f,rep(ts))$LP)$$ + map! : ((P -> P),%) -> % map! (f : PtoP, ts : $) : $ == construct(map!(f,rep(ts))$LP)$$ + member? : (P,%) -> Boolean member? (p,ts) == member?(p,rep(ts))$LP unitIdealIfCan() == "failed"::Union($,"failed") + roughUnitIdeal? : % -> Boolean roughUnitIdeal? ts == false + coerce : % -> OutputForm coerce(ts:$) : OutputForm == lp : List(P) := reverse(rep(ts)) brace([p::OutputForm for p in lp]$List(OutputForm))$OutputForm + mvar : % -> V mvar ts == empty? ts => error "mvar$REGSET: #1 is empty" mvar(first(rep(ts)))$P + first : % -> Union(P,"failed") first ts == empty? ts => "failed"::Union(P,"failed") first(rep(ts))::Union(P,"failed") + last : % -> Union(P,"failed") last ts == empty? ts => "failed"::Union(P,"failed") last(rep(ts))::Union(P,"failed") + rest : % -> Union(%,"failed") rest ts == empty? ts => "failed"::Union($,"failed") per(rest(rep(ts)))::Union($,"failed") + coerce : % -> List(P) coerce(ts:$) : (List P) == rep(ts) + collectUpper : (%,V) -> % collectUpper (ts,v) == empty? ts => ts lp := rep(ts) @@ -162909,6 +167103,7 @@ RegularTriangularSet(R,E,V,P) : Exports == Implementation where lp := rest lp per(reverse(newlp)) + collectUnder : (%,V) -> % collectUnder (ts,v) == empty? ts => ts lp := rep(ts) @@ -162916,6 +167111,7 @@ RegularTriangularSet(R,E,V,P) : Exports == Implementation where lp := rest lp per(lp) + construct : List(P) -> % construct(lp:List(P)) == ts : $ := per([]) empty? lp => ts @@ -162928,6 +167124,7 @@ RegularTriangularSet(R,E,V,P) : Exports == Implementation where lp := rest lp ts + extendIfCan : (%,P) -> Union(%,"failed") extendIfCan(ts:$,p:P) == ground? p => "failed"::Union($,"failed") empty? ts => @@ -162938,6 +167135,7 @@ RegularTriangularSet(R,E,V,P) : Exports == Implementation where (per(cons(p,rep(ts))))::Union($,"failed") "failed"::Union($,"failed") + removeZero : (P,%) -> P removeZero(p:P, ts:$): P == (ground? p) or (empty? ts) => p v := mvar(p) @@ -162954,16 +167152,19 @@ RegularTriangularSet(R,E,V,P) : Exports == Implementation where p := tail(p) q + removeZero(p,ts_v_-) + internalAugment : (P,%) -> % internalAugment(p:P,ts:$): $ == -- ASSUME that adding p to ts DOES NOT require any split ground? p => error "in internalAugment$REGSET: ground? #1" first(internalAugment(p,ts,false,false,false,false,false)) + internalAugment : (List(P),%) -> % internalAugment(lp:List(P),ts:$): $ == -- ASSUME that adding p to ts DOES NOT require any split empty? lp => ts internalAugment(rest lp, internalAugment(first lp, ts)) + internalAugment : (P,%,Boolean,Boolean,Boolean,Boolean,Boolean) -> List(%) internalAugment(p:P,ts:$,rem?:B,red?:B,prim?:B,sqfr?:B,extend?:B):Split == -- ASSUME p is not a constant -- ASSUME mvar(p) is not algebraic w.r.t. ts @@ -162988,6 +167189,7 @@ RegularTriangularSet(R,E,V,P) : Exports == Implementation where extend? => extend(members(ts_v_+),lts) [per(concat(rep(ts_v_+),rep(us))) for us in lts] + augment : (P,%) -> List(%) augment(p:P,ts:$): List $ == ground? p => error "in augment$REGSET: ground? #1" algebraic?(mvar(p),ts) => error "in augment$REGSET: bad #1" @@ -162996,6 +167198,7 @@ RegularTriangularSet(R,E,V,P) : Exports == Implementation where -- THUS reduction, mainPrimitivePart and squareFree are NEEDED internalAugment(p,ts,true,true,true,true,true) + extend : (P,List(%)) -> List(%) extend(p:P,ts:$): List $ == ground? p => error "in extend$REGSET: ground? #1" v := mvar(p) @@ -163006,44 +167209,56 @@ RegularTriangularSet(R,E,V,P) : Exports == Implementation where lts := concat(augment(p,us),lts) lts + invertible? : (P,%) -> Boolean invertible?(p:P,ts:$): Boolean == toseInvertible?(p,ts)$regsetgcdpack + invertible? : (P,%) -> List(Record(val: Boolean,tower: %)) invertible?(p:P,ts:$): List BWT == toseInvertible?(p,ts)$regsetgcdpack + invertibleSet : (P,%) -> List(%) invertibleSet(p:P,ts:$): Split == toseInvertibleSet(p,ts)$regsetgcdpack + lastSubResultant : (P,P,%) -> List(Record(val: P,tower: %)) lastSubResultant(p1:P,p2:P,ts:$): List PWT == toseLastSubResultant(p1,p2,ts)$regsetgcdpack + squareFreePart : (P,%) -> List(Record(val: P,tower: %)) squareFreePart(p:P, ts: $): List PWT == toseSquareFreePart(p,ts)$regsetgcdpack + intersect : (P,List(%)) -> List(%) intersect(p:P, ts: $): List($) == decompose([p], [ts], false, false)$regsetdecomppack + intersect : (List(P),%) -> List(%) intersect(lp: LP, lts: List($)): List($) == decompose(lp, lts, false, false)$regsetdecomppack -- SOLVE in the regular zero sense -- and DO NOT PRINT info + decompose : (P,$) -> List($) decompose(p:P, ts: $): List($) == decompose([p], [ts], true, false)$regsetdecomppack + decompose : (LP,List($)) -> List($) decompose(lp: LP, lts: List($)): List($) == decompose(lp, lts, true, false)$regsetdecomppack -- SOLVE in the closure sense -- and DO NOT PRINT info + zeroSetSplit : List(P) -> List(%) zeroSetSplit(lp:List(P)) == zeroSetSplit(lp,true,false) -- by default SOLVE in the closure sense -- and DO NOT PRINT info + zeroSetSplit : (List(P),Boolean) -> List(%) zeroSetSplit(lp:List(P), clos?: B) == zeroSetSplit(lp,clos?, false) -- DO NOT PRINT info + zeroSetSplit : (List(P),Boolean,Boolean) -> List(%) zeroSetSplit(lp:List(P), clos?: B, info?: B) == -- if clos? then SOLVE in the closure sense -- if info? then PRINT info @@ -163051,6 +167266,7 @@ RegularTriangularSet(R,E,V,P) : Exports == Implementation where -- and PREPROCESS the input system zeroSetSplit(lp,true,clos?,info?,true) + zeroSetSplit : (List(P),Boolean,Boolean,Boolean,Boolean) -> List(%) zeroSetSplit(lp:List(P),hash?:B,clos?:B,info?:B,prep?:B) == -- if hash? then USE hash-tables -- if info? then PRINT information @@ -163078,6 +167294,7 @@ RegularTriangularSet(R,E,V,P) : Exports == Implementation where stopTableInvSet!()$regsetgcdpack lts + internalZeroSetSplit : (List(P),Boolean,Boolean,Boolean) -> List(%) internalZeroSetSplit(lp:LP,clos?:B,info?:B,prep?:B) == -- if info? then PRINT information -- if clos? then SOLVE in the closure sense @@ -163101,6 +167318,7 @@ RegularTriangularSet(R,E,V,P) : Exports == Implementation where lts := decompose([p],lts, clos?, info?)$regsetdecomppack lts + largeSystem? : LP -> Boolean largeSystem?(lp:LP): Boolean == -- Gonnet and Gerdt and not Wu-Wang.2 #lp > 16 => true @@ -163108,17 +167326,22 @@ RegularTriangularSet(R,E,V,P) : Exports == Implementation where lts: List($) := [] (#lp :: Z - numberOfVariables(lp,lts)$regsetdecomppack :: Z) > 3 + smallSystem? : LP -> Boolean smallSystem?(lp:LP): Boolean == -- neural, Vermeer, Liu, and not f-633 and not Hairer-2 #lp < 5 + mediumSystem? : LP -> Boolean mediumSystem?(lp:LP): Boolean == -- f-633 and not Hairer-2 lts: List($) := [] (numberOfVariables(lp,lts)$regsetdecomppack :: Z - #lp :: Z) < 2 + lin? : P -> Boolean lin?(p:P):Boolean == ground?(init(p)) and (mdeg(p) = 1) + preprocess : (List(P),Boolean,Boolean) -> + Record(val: List(P),towers: List(%)) pre_process(lp:LP,clos?:B,info?:B): Record(val: LP, towers: Split) == -- if info? then PRINT information -- if clos? then SOLVE in the closure sense @@ -163352,8 +167575,6 @@ ResidueRing(F,Expon,VarSet,FPol,LFPol) : Dom == Body (* domain RESRING *) (* - --representation - Rep:= FPol import GroebnerPackage(F,Expon,VarSet,FPol) @@ -163362,36 +167583,45 @@ ResidueRing(F,Expon,VarSet,FPol,LFPol) : Dom == Body relations = [1] => error "the residue ring is the zero ring" - --declarations - x,y: $ - --definitions - + 0 : () -> % 0 == 0$Rep + 1 : () -> % 1 == 1$Rep + reduce : FPol -> % reduce(f : FPol) : $ == normalForm(f,relations) + coerce : FPol -> % coerce(f : FPol) : $ == normalForm(f,relations) + lift : % -> FPol lift x == x :: Rep :: FPol + ?+? : (%,%) -> % x + y == x +$Rep y + -? : % -> % -x == -$Rep x + ?*? : (%,%) -> % x*y == normalForm(lift(x *$Rep y),relations) + ?*? : (Integer,%) -> % (n : Integer) * x == n *$Rep x + ?*? : (F,%) -> % (a : F) * x == a *$Rep x + ?=? : (%,%) -> Boolean x = y == x =$Rep y - characteristic() == characteristic()$F + characteristic : () -> NonNegativeInteger + characteristic() == characteristic()$F + coerce : % -> OutputForm coerce(x) : OutputForm == coerce(x)$Rep *) @@ -163661,16 +167891,15 @@ Result():Exports==Implementation where (* domain RESULT *) (* - -- Constant colon := ": "::Symbol::O elide := "..."::Symbol::O - -- Flags showScalarValuesFlag : Boolean := false showArrayValuesFlag : Boolean := false + cleanUpDomainForm : SExpression -> O cleanUpDomainForm(d:SExpression):O == not list? d => d::O #d=1 => (car d)::O @@ -163681,6 +167910,7 @@ Result():Exports==Implementation where prefix((car d)::O,[cleanUpDomainForm(u) _ for u in destruct cdr(d)]$List(O)) + display : (Any,SExpression) -> O display(v:Any,d:SExpression):O == not list? d => error "Domain form is non-list" #d=1 => @@ -163692,14 +167922,18 @@ Result():Exports==Implementation where showArrayValuesFlag => objectOf v cleanUpDomainForm d + makeEntry : (Symbol,Any) -> O makeEntry(k:Symbol,v:Any):O == hconcat [k::O,colon,display(v,dom v)] + coerce : % -> OutputForm coerce(r:%):O == bracket [makeEntry(key,r.key) for key in reverse! keys(r)] + showArrayValues : Boolean -> Boolean showArrayValues(b:Boolean):Boolean == showArrayValuesFlag := b + showScalarValues : Boolean -> Boolean showScalarValues(b:Boolean):Boolean == showScalarValuesFlag := b *) @@ -163981,44 +168215,50 @@ RewriteRule(Base, R, F): Exports == Implementation where Rep := Record(pat: P, lft: F, rgt: F, qot: List Symbol) - mkRule : (P, F, F, List Symbol) -> $ - transformLhs: P -> Record(plus: F, times: F) - bad? : Union(List P, "failed") -> Boolean - appear? : (P, List P) -> Boolean - opt : F -> P - F2Symbol : F -> F - - pattern x == x.pat + pattern : % -> Pattern(Base) + pattern x == x.pat - lhs x == x.lft + lhs : % -> F + lhs x == x.lft - rhs x == x.rgt + rhs : % -> F + rhs x == x.rgt - quotedOperators x == x.qot + quotedOperators : % -> List(Symbol) + quotedOperators x == x.qot - mkRule(pt, p, s, l) == [pt, p, s, l] + mkRule : (P, F, F, List Symbol) -> $ + mkRule(pt, p, s, l) == [pt, p, s, l] + coerce : Equation(F) -> % coerce(eq:Equation F):$ == rule(lhs eq, rhs eq, empty()) - rule(l, r) == rule(l, r, empty()) + rule : (F,F) -> % + rule(l, r) == rule(l, r, empty()) + ?.? : (%,F) -> F elt(r:$, s:F) == applyRules([r pretend RewriteRule(Base, R, F)], s) + suchThat : (%,List(Symbol),(List(F) -> Boolean)) -> % suchThat(x, l, f) == mkRule(suchThat(pattern x,l,f), lhs x, rhs x, quotedOperators x) + ?=? : (%,%) -> Boolean x = y == (lhs x = lhs y) and (rhs x = rhs y) and (quotedOperators x = quotedOperators y) + elt : (%,F,PositiveInteger) -> F elt(r:$, s:F, n:PositiveInteger) == applyRules([r pretend RewriteRule(Base, R, F)], s, n) -- remove the extra properties from the constant symbols in f + F2Symbol : F -> F F2Symbol f == l := select_!(z+->symbolIfCan z case Symbol, tower f)$List(Kernel F) eval(f, l, [symbolIfCan(k)::Symbol::F for k in l]) + retractIfCan : % -> Union(Equation(F),"failed") retractIfCan r == constant? pattern r => (u:= retractIfCan(lhs r)@Union(Kernel F,"failed")) case "failed" @@ -164026,17 +168266,20 @@ RewriteRule(Base, R, F): Exports == Implementation where F2Symbol(u::Kernel(F)::F) = rhs r "failed" + rule : (F,F,List(Symbol)) -> % rule(p, s, l) == lh := transformLhs(pt := convert(p)@P) mkRule(opt(lh.times) * (opt(lh.plus) + pt), lh.times * (lh.plus + p), lh.times * (lh.plus + s), l) + opt : F -> P opt f == retractIfCan(f)@Union(R, "failed") case R => convert f convert optional f -- appear?(x, [p1,...,pn]) is true if x appears as a variable in -- a composite pattern pi. + appear? : (P, List P) -> Boolean appear?(x, l) == for p in l | p ^= x repeat member?(x, variables p) => return true @@ -164051,6 +168294,7 @@ RewriteRule(Base, R, F): Exports == Implementation where -- examples of "good" combinations -- sin(x) @ y + bad? : Union(List P, "failed") -> Boolean bad? u == u case List(P) => for x in u::List(P) repeat @@ -164058,11 +168302,13 @@ RewriteRule(Base, R, F): Exports == Implementation where true false + transformLhs: P -> Record(plus: F, times: F) transformLhs p == bad? isPlus p => [new()$Symbol :: F, 1] bad? isTimes p => [0, new()$Symbol :: F] [0, 1] + coerce : % -> OutputForm coerce(x:$):OutputForm == infix(" == "::Symbol::OutputForm, lhs(x)::OutputForm, rhs(x)::OutputForm) @@ -164635,37 +168881,13 @@ RightOpenIntervalRootCharacterization(TheField,ThePolDom) : PUB == PRIV where (* domain ROIRC *) (* - -- local functions - - makeChar: (TheField,TheField,ThePolDom) -> $ - refine! : $ -> $ - sturmIsolate : (List(P), TheField, TheField,N,N) -> List TwoPoints - isolate : List(P) -> List TwoPoints - rootBound : P -> TheField - linearRecip : ( P , $) -> Union(P, "failed") - linearZero? : (TheField,$) -> B - linearSign : (P,$) -> Z - sturmNthRoot : (List(P), TheField, TheField,N,N,N) -> _ - Union(TwoPoints,"failed") - addOne : P -> P - minus : P -> P - translate : (P,TheField) -> P - dilate : (P,TheField) -> P - invert : P -> P - evalOne : P -> TheField - hasVarsl: List(TheField) -> B - hasVars: P -> B - --- Representation - Rep:= Record(low:TheField,high:TheField,defPol:ThePolDom) --- and now the code ! - - + size : % -> TheField size(rootCode) == rootCode.high - rootCode.low + relativeApprox : (ThePolDom,%,TheField) -> TheField relativeApprox(pval,rootCode,prec) == -- beurk ! dPol := rootCode.defPol @@ -164710,6 +168932,7 @@ RightOpenIntervalRootCharacterization(TheField,ThePolDom) : PUB == PRIV where b := pval.r (a+b)/(2::TheField) + approximate : (ThePolDom,%,TheField) -> TheField approximate(pval,rootCode,prec) == -- glurp dPol := rootCode.defPol @@ -164743,21 +168966,27 @@ RightOpenIntervalRootCharacterization(TheField,ThePolDom) : PUB == PRIV where r := right(rootCode) (a+b)/(2::TheField) - + addOne : P -> P addOne(p) == p.(monomial(1,1)+(1::P)) + minus : P -> P minus(p) == p.(monomial(-1,1)) + translate : (P,TheField) -> P translate(p,a) == p.(monomial(1,1)+(a::P)) + dilate : (P,TheField) -> P dilate(p,a) == p.(monomial(a,1)) + evalOne : P -> TheField evalOne(p) == "+" / coefficients(p) + invert : P -> P invert(p) == d := degree(p) mapExponents(z +-> (d-z)::N, p) + rootBound : P -> TheField rootBound(p) == res : TheField := 1 raw :TheField := 1+boundOfCauchy(p)$UTIL @@ -164765,6 +168994,8 @@ RightOpenIntervalRootCharacterization(TheField,ThePolDom) : PUB == PRIV where res := 2*(res) res + sturmNthRoot : (List(P), TheField, TheField,N,N,N) -> _ + Union(TwoPoints,"failed") sturmNthRoot(lp,l,r,vl,vr,n) == nv := (vl - vr)::N nv < n => "failed" @@ -164781,6 +169012,7 @@ RightOpenIntervalRootCharacterization(TheField,ThePolDom) : PUB == PRIV where else sturmNthRoot(lp,l,int,vl,vi,n) + sturmIsolate : (List(P), TheField, TheField,N,N) -> List TwoPoints sturmIsolate(lp,l,r,vl,vr) == r <= l => error "ROIRC: sturmIsolate: bad bounds" n := (vl - vr)::N @@ -164790,6 +169022,7 @@ RightOpenIntervalRootCharacterization(TheField,ThePolDom) : PUB == PRIV where vi := sturmVariationsOf( [t.int for t in lp ] )$UTIL append(sturmIsolate(lp,l,int,vl,vi),sturmIsolate(lp,int,r,vi,vr)) + isolate : List(P) -> List TwoPoints isolate(lp) == b := rootBound(first(lp)) l1,l2 : List(TheField) @@ -164808,6 +169041,7 @@ RightOpenIntervalRootCharacterization(TheField,ThePolDom) : PUB == PRIV where sturmVariationsOf(l1)$UTIL, sturmVariationsOf(l2)$UTIL) + rootOf : (ThePolDom,PositiveInteger) -> Union(%,"failed") rootOf(pol,n) == ls := sturmSequence(pol)$UTIL pol := unitCanonical(first(ls)) -- this one is SqFR @@ -164833,6 +169067,7 @@ RightOpenIntervalRootCharacterization(TheField,ThePolDom) : PUB == PRIV where res case "failed" => "failed" makeChar(res.low,res.high,pol) + allRootsOf : ThePolDom -> List(%) allRootsOf(pol) == ls := sturmSequence(unitCanonical pol)$UTIL pol := unitCanonical(first(ls)) -- this one is SqFR @@ -164841,6 +169076,7 @@ RightOpenIntervalRootCharacterization(TheField,ThePolDom) : PUB == PRIV where [ makeChar(term.low,term.high,pol) for term in isolate(ls) ] + hasVarsl: List(TheField) -> B hasVarsl(l:List(TheField)) == null(l) => false f := sign(first(l)) @@ -164848,12 +169084,13 @@ RightOpenIntervalRootCharacterization(TheField,ThePolDom) : PUB == PRIV where if f*term < 0 then return(true) false + hasVars: P -> B hasVars(p:P) == zero?(p) => error "ROIRC: hasVars: null polynonial" zero?(coefficient(p,0)) => true hasVarsl(coefficients(p)) - + mightHaveRoots : (ThePolDom,%) -> Boolean mightHaveRoots(p,rootChar) == a := rootChar.low q := translate(p,a) @@ -164866,10 +169103,12 @@ RightOpenIntervalRootCharacterization(TheField,ThePolDom) : PUB == PRIV where q := invert(q) hasVars(addOne(q)) + coerce : % -> OutputForm coerce(rootChar:$):O == commaSeparate([ hconcat("[" :: O , (rootChar.low)::O), hconcat((rootChar.high)::O,"[" ::O ) ]) + ?=? : (%,%) -> Boolean c1 = c2 == mM := max(c1.low,c2.low) Mm := min(c1.high,c2.high) @@ -164878,6 +169117,7 @@ RightOpenIntervalRootCharacterization(TheField,ThePolDom) : PUB == PRIV where degree(rr) = 0 => false sign(rr.mM) * sign(rr.Mm) <= 0 + makeChar: (TheField,TheField,ThePolDom) -> $ makeChar(left,right,pol) == res :$ := [left,right,leadingMonomial(pol)+reductum(pol)]$Rep -- safe copy while zero?(pol.(res.high)) repeat refine!(res) @@ -164885,8 +169125,10 @@ RightOpenIntervalRootCharacterization(TheField,ThePolDom) : PUB == PRIV where zero?(pol.(res.low)) => [res.low,res.high,monomial(1,1)-(res.low)::P] res + definingPolynomial : % -> ThePolDom definingPolynomial(rootChar) == rootChar.defPol + linearRecip : ( P , $) -> Union(P, "failed") linearRecip(toTest,rootChar) == c := - inv(leadingCoefficient(toTest)) * coefficient(toTest,0) r := recip(rootChar.defPol.c) @@ -164901,6 +169143,7 @@ RightOpenIntervalRootCharacterization(TheField,ThePolDom) : PUB == PRIV where else ((1$ThePolDom - (r::TheField)*rootChar.defPol) exquo toTest)::P + recip : (ThePolDom,%) -> Union(ThePolDom,"failed") recip(toTest,rootChar) == degree(toTest) = 0 or degree(rootChar.defPol) <= degree(toTest) => error "IRC: recip: Not reduced" @@ -164924,6 +169167,7 @@ RightOpenIntervalRootCharacterization(TheField,ThePolDom) : PUB == PRIV where d := extendedEuclidean(newPol,toTest) d.coef2 + linearSign : (P,$) -> Z linearSign(toTest,rootChar) == c := - inv(leadingCoefficient(toTest)) * coefficient(toTest,0) ev := sign(rootChar.defPol.c) @@ -164941,6 +169185,7 @@ RightOpenIntervalRootCharacterization(TheField,ThePolDom) : PUB == PRIV where else sign(toTest.(rootChar.low)) + sign : (ThePolDom,%) -> Integer sign(toTest,rootChar) == degree(toTest) = 0 or degree(rootChar.defPol) <= degree(toTest) => error "IRC: sign: Not reduced" @@ -164967,10 +169212,12 @@ RightOpenIntervalRootCharacterization(TheField,ThePolDom) : PUB == PRIV where newChar := refine(newChar) s*sign(toTest.(newChar.low)) + linearZero? : (TheField,$) -> B linearZero?(c,rootChar) == zero?((rootChar.defPol).c) and (c - rootChar.low) * (c - rootChar.high) <= 0 + zero? : (ThePolDom,%) -> Boolean zero?(toTest,rootChar) == degree(toTest) = 0 or degree(rootChar.defPol) <= degree(toTest) => error "IRC: zero?: Not reduced" @@ -164985,7 +169232,7 @@ RightOpenIntervalRootCharacterization(TheField,ThePolDom) : PUB == PRIV where degree(delta) = 0 => false sign(delta.(rootChar.low) * delta.(rootChar.high)) <= 0 - + refine! : $ -> $ refine!(rootChar) == -- this is not a safe function, it can work with badly created object -- we do not assume (rootChar.defPol).(rootChar.high) <> 0 @@ -165007,6 +169254,7 @@ RightOpenIntervalRootCharacterization(TheField,ThePolDom) : PUB == PRIV where rootChar.low := int rootChar + refine : % -> % refine(rootChar) == -- we assume (rootChar.defPol).(rootChar.high) <> 0 int := middle(rootChar) @@ -165018,10 +169266,13 @@ RightOpenIntervalRootCharacterization(TheField,ThePolDom) : PUB == PRIV where else [rootChar.low,int,rootChar.defPol] + left : % -> TheField left(rootChar) == rootChar.low + right : % -> TheField right(rootChar) == rootChar.high + middle : % -> TheField middle(rootChar) == (rootChar.low + rootChar.high)/(2::TheField) *) @@ -165538,12 +169789,16 @@ RomanNumeral(): IntegerNumberSystem with import NumberFormats() + roman : Integer -> % roman(n:Integer) == n::% + roman : Symbol -> % roman(sy:Symbol) == convert sy - convert(sy:Symbol):% == ScanRoman(string sy)::% + convert : Symbol -> % + convert(sy:Symbol):% == ScanRoman(string sy)::% + coerce : % -> OutputForm coerce(r:%):OutputForm == n := convert(r)@Integer -- okay, we stretch it @@ -166191,70 +170446,89 @@ RoutinesTable(): E == I where showTheRoutinesTable():% == theRoutinesTable + integrationRoutine? : Record(key:Symbol,entry:Any) -> Boolean integrationRoutine?(r:Record(key:Symbol,entry:Any)):Boolean == (a := retractIfCan(r.entry)$AnyFunctions1(Entry)) case Entry => elt(a,chapter) = "Integration" false + selectIntegrationRoutines : % -> % selectIntegrationRoutines(R:%):% == select(integrationRoutine?,R) + optimizationRoutine? : Record(key:Symbol,entry:Any) -> Boolean optimizationRoutine?(r:Record(key:Symbol,entry:Any)):Boolean == (a := retractIfCan(r.entry)$AnyFunctions1(Entry)) case Entry => elt(a,chapter) = "Optimization" false + selectOptimizationRoutines : % -> % selectOptimizationRoutines(R:%):% == select(optimizationRoutine?,R) + PDERoutine? : Record(key:Symbol,entry:Any) -> Boolean PDERoutine?(r:Record(key:Symbol,entry:Any)):Boolean == (a := retractIfCan(r.entry)$AnyFunctions1(Entry)) case Entry => elt(a,chapter) = "PDE" false + selectPDERoutines : % -> % selectPDERoutines(R:%):% == select(PDERoutine?,R) + ODERoutine? : Record(key:Symbol,entry:Any) -> Boolean ODERoutine?(r:Record(key:Symbol,entry:Any)):Boolean == (a := retractIfCan(r.entry)$AnyFunctions1(Entry)) case Entry => elt(a,chapter) = "ODE" false + selectODEIVPRoutines : % -> % selectODEIVPRoutines(R:%):% == select(ODERoutine?,R) + sumOfSquaresRoutine? : Record(key:Symbol,entry:Any) -> Boolean sumOfSquaresRoutine?(r:Record(key:Symbol,entry:Any)):Boolean == (a := retractIfCan(r.entry)$AnyFunctions1(Entry)) case Entry => elt(a,type) = "SS" false + selectSumOfSquaresRoutines : % -> % selectSumOfSquaresRoutines(R:%):% == select(sumOfSquaresRoutine?,R) + finiteRoutine? : Record(key:Symbol,entry:Any) -> Boolean finiteRoutine?(r:Record(key:Symbol,entry:Any)):Boolean == (a := retractIfCan(r.entry)$AnyFunctions1(Entry)) case Entry => elt(a,type) = "One-dimensional finite" false + selectFiniteRoutines : % -> % selectFiniteRoutines(R:%):% == select(finiteRoutine?,R) + infiniteRoutine? : Record(key:Symbol,entry:Any) -> Boolean infiniteRoutine?(r:Record(key:Symbol,entry:Any)):Boolean == (a := retractIfCan(r.entry)$AnyFunctions1(Entry)) case Entry => elt(a,type) = "One-dimensional infinite" false + semiInfiniteRoutine? : Record(key:Symbol,entry:Any) -> Boolean semiInfiniteRoutine?(r:Record(key:Symbol,entry:Any)):Boolean == (a := retractIfCan(r.entry)$AnyFunctions1(Entry)) case Entry => elt(a,type) = "One-dimensional semi-infinite" false + nonFiniteRoutine? : Record(key:Symbol,entry:Any) -> Boolean nonFiniteRoutine?(r:Record(key:Symbol,entry:Any)):Boolean == (semiInfiniteRoutine?(r) or infiniteRoutine?(r)) + selectNonFiniteRoutines : % -> % selectNonFiniteRoutines(R:%):% == select(nonFiniteRoutine?,R) + multiDimensionalRoutine? : Record(key:Symbol,entry:Any) -> Boolean multiDimensionalRoutine?(r:Record(key:Symbol,entry:Any)):Boolean == (a := retractIfCan(r.entry)$AnyFunctions1(Entry)) case Entry => elt(a,type) = "Multi-dimensional" false + selectMultiDimensionalRoutines : % -> % selectMultiDimensionalRoutines(R:%):% == select(multiDimensionalRoutine?,R) + concat : (%,%) -> % concat(a:%,b:%):% == membersOfa := (members(a)@List(Record(key:Symbol,entry:Any))) membersOfb := (members(b)@List(Record(key:Symbol,entry:Any))) @@ -166262,6 +170536,7 @@ RoutinesTable(): E == I where concat(membersOfa,membersOfb)$List(Record(key:Symbol,entry:Any)) construct(allMembers) + changeThreshhold : (%,Symbol,Float) -> % changeThreshhold(R:%,s:Symbol,newValue:F):% == (a := search(s,R)) case Any => e := retract(a)$AnyFunctions1(Entry) @@ -166271,6 +170546,7 @@ RoutinesTable(): E == I where error("changeThreshhold",_ "Cannot find routine of that name")$ErrorFunctions + changeMeasure : (%,Symbol,Float) -> % changeMeasure(R:%,s:Symbol,newValue:F):% == (a := search(s,R)) case Any => e := retract(a)$AnyFunctions1(Entry) @@ -166279,18 +170555,21 @@ RoutinesTable(): E == I where insert!([s,a],R) error("changeMeasure","Cannot find routine of that name")$ErrorFunctions + getMeasure : (%,Symbol) -> Float getMeasure(R:%,s:Symbol):F == (a := search(s,R)) case Any => e := retract(a)$AnyFunctions1(Entry) e.measure error("getMeasure","Cannot find routine of that name")$ErrorFunctions + deleteRoutine! : (%,Symbol) -> % deleteRoutine!(R:%,s:Symbol):% == (a := search(s,R)) case Any => e:Record(key:Symbol,entry:Any) := [s,a] remove!(e,R) error("deleteRoutine!","Cannot find routine of that name")$ErrorFunctions + routines : () -> % routines():% == f := "One-dimensional finite" s := "One-dimensional semi-infinite" @@ -166489,6 +170768,7 @@ RoutinesTable(): E == I where ["e04ucf" :: Symbol, coerce(e04ucfEntry)$AnyFunctions1(Entry)]] construct(rl) + getIFL : (Symbol,%) -> Union(IFL,"failed") getIFL(s:Symbol,l:%):Union(IFL,"failed") == o := search(s,l)$% o case "failed" => "failed" @@ -166496,6 +170776,7 @@ RoutinesTable(): E == I where e case "failed" => "failed" e.failList + getInstruction : (IFL,Integer) -> Union(ST,"failed") getInstruction(l:IFL,ifailValue:Integer):Union(ST,"failed") == output := empty()$ST for i in 1..#l repeat @@ -166504,6 +170785,7 @@ RoutinesTable(): E == I where empty?(output)$ST => "failed" output + recoverAfterFail : (%,String,Integer) -> Union(String,"failed") recoverAfterFail(routs:%,routineName:ST, ifailValue:Integer):Union(ST,"failed") == name := routineName :: Symbol @@ -166517,6 +170799,7 @@ RoutinesTable(): E == I where concat(routineName," failed - trying alternatives")$ST instr + getExplanations : (%,String) -> List(String) getExplanations(R:%,routineName:ST):LST == name := routineName :: Symbol (a := search(name,R)) case Any => @@ -166613,13 +170896,17 @@ RuleCalled(f:Symbol): SetCategory with (* domain RULECOLD *) (* - name r == f + name : % -> Symbol + name r == f + coerce : % -> OutputForm coerce(r:%):OutputForm == f::OutputForm - x = y == true + ?=? : (%,%) -> Boolean + x = y == true - latex(x:%):String == latex f + latex : % -> String + latex(x:%):String == latex f *) @@ -166748,17 +171035,23 @@ Ruleset(Base, R, F): Exports == Implementation where Rep := Set RR - ruleset l == {l}$Rep + ruleset : List(RewriteRule(Base,R,F)) -> % + ruleset l == {l}$Rep - coerce(x:$):OutputForm == coerce(x)$Rep + coerce : % -> OutputForm + coerce(x:$):OutputForm == coerce(x)$Rep - x = y == x =$Rep y + ?=? : (%,%) -> Boolean + x = y == x =$Rep y - elt(x:$, f:F) == applyRules(rules x, f) + ?.? : (%,F) -> F + elt(x:$, f:F) == applyRules(rules x, f) + elt : (%,F,PositiveInteger) -> F elt(r:$, s:F, n:PositiveInteger) == applyRules(rules r, s, n) - rules x == parts(x)$Rep + rules : % -> List(RewriteRule(Base,R,F)) + rules x == parts(x)$Rep *) @@ -167280,8 +171573,6 @@ ScriptFormulaFormat(): public == private where Rep := Record(prolog : L S, formula : L S, epilog : L S) - -- local variables declarations and definitions - expr: E prec,opPrec: I str: S @@ -167321,39 +171612,17 @@ ScriptFormulaFormat(): public == private where specialStringsInFormula : L S := [" alpha "," ellipsis "] - -- local function signatures - - addBraces: S -> S - addBrackets: S -> S - group: S -> S - formatBinary: (S,L E, I) -> S - formatFunction: (S,L E, I) -> S - formatMatrix: L E -> S - formatNary: (S,L E, I) -> S - formatNaryNoGroup: (S,L E, I) -> S - formatNullary: S -> S - formatPlex: (S,L E, I) -> S - formatSpecial: (S,L E, I) -> S - formatUnary: (S, E, I) -> S - formatFormula: (E,I) -> S - parenthesize: S -> S - precondition: E -> E - postcondition: S -> S - splitLong: (S,I) -> L S - splitLong1: (S,I) -> L S - stringify: E -> S - - -- public function definitions - new() : % == [[".eq set blank @",":df."]$(L S), [""]$(L S), [":edf."]$(L S)]$Rep + coerce : OutputForm -> % coerce(expr : E): % == f : % := new()$% f.formula := [postcondition formatFormula(precondition expr, minPrec)]$(L S) f + convert : (OutputForm,Integer) -> % convert(expr : E, stepNum : I): % == f : % := new()$% f.formula := concat([" Void display(f : %, len : I) == s,t : S for s in f.prolog repeat sayFORMULA(s)$Lisp @@ -167369,17 +171639,29 @@ ScriptFormulaFormat(): public == private where for s in f.epilog repeat sayFORMULA(s)$Lisp void()$Void + display : % -> Void display(f : %) == display(f, _$LINELENGTH$Lisp pretend I) + prologue : % -> List(String) prologue(f : %) == f.prolog + + formula : % -> List(String) formula(f : %) == f.formula + + epilogue : % -> List(String) epilogue(f : %) == f.epilog + setPrologue! : (%,List(String)) -> List(String) setPrologue!(f : %, l : L S) == f.prolog := l + + setFormula! : (%,List(String)) -> List(String) setFormula!(f : %, l : L S) == f.formula := l + + setEpilogue! : (%,List(String)) -> List(String) setEpilogue!(f : %, l : L S) == f.epilog := l + coerce : % -> OutputForm coerce(f : %): E == s,t : S l : L S := nil @@ -167390,8 +171672,7 @@ ScriptFormulaFormat(): public == private where for s in f.epilog repeat l := concat(s,l) (reverse l) :: E - -- local function definitions - + postcondition: S -> S postcondition(str: S): S == len : I := #str len < 4 => str @@ -167402,13 +171683,16 @@ ScriptFormulaFormat(): public == private where then setelt(str,i,char " ")$S str + stringify: E -> S stringify expr == object2String(expr)$Lisp pretend S + splitLong: (S,I) -> L S splitLong(str : S, len : I): L S == -- this blocks into lines if len < 20 then len := _$LINELENGTH$Lisp splitLong1(str, len) + splitLong1: (S,I) -> L S splitLong1(str : S, len : I) == l : List S := nil s : S := "" @@ -167427,21 +171711,27 @@ ScriptFormulaFormat(): public == private where if ls > 0 then l := concat(s,l)$List(S) reverse l + group: S -> S group str == concat ["<",str,">"] + addBraces: S -> S addBraces str == concat ["left lbrace ",str," right rbrace"] + addBrackets: S -> S addBrackets str == concat ["left lb ",str," right rb"] + parenthesize: S -> S parenthesize str == concat ["left lparen ",str," right rparen"] + precondition: E -> E precondition expr == outputTran(expr)$Lisp + formatSpecial: (S,L E, I) -> S formatSpecial(op : S, args : L E, prec : I) : S == op = "AGGLST" => formatNary(",",args,prec) @@ -167498,6 +171788,7 @@ ScriptFormulaFormat(): public == private where op = "MATRIX" => formatMatrix rest args concat ["not done yet for ",op] + formatPlex: (S,L E, I) -> S formatPlex(op : S, args : L E, prec : I) : S == hold : S p : I := position(op,plexOps) @@ -167528,17 +171819,21 @@ ScriptFormulaFormat(): public == private where if opPrec < prec then s := parenthesize s group s + formatMatrix: L E -> S formatMatrix(args : L E) : S == -- format for args is [[ROW ...],[ROW ...],[ROW ...]] group addBrackets formatNary(" habove ",args,minPrec) + formatFunction: (S,L E, I) -> S formatFunction(op : S, args : L E, prec : I) : S == group concat [op, " ", parenthesize formatNary(",",args,minPrec)] + formatNullary: S -> S formatNullary(op : S) == op = "NOTHING" => "" group concat [op,"()"] + formatUnary: (S, E, I) -> S formatUnary(op : S, arg : E, prec : I) == p : I := position(op,unaryOps) p < 1 => error "unknown Script Formula Formatter unary op" @@ -167548,6 +171843,7 @@ ScriptFormulaFormat(): public == private where op = "-" => s group s + formatBinary: (S,L E, I) -> S formatBinary(op : S, args : L E, prec : I) : S == p : I := position(op,binaryOps) p < 1 => error "unknown Script Formula Formatter binary op" @@ -167564,9 +171860,11 @@ ScriptFormulaFormat(): public == private where opPrec < prec => parenthesize s s + formatNary: (S,L E, I) -> S formatNary(op : S, args : L E, prec : I) : S == group formatNaryNoGroup(op, args, prec) + formatNaryNoGroup: (S,L E, I) -> S formatNaryNoGroup(op : S, args : L E, prec : I) : S == null args => "" p : I := position(op,naryOps) @@ -167586,6 +171884,7 @@ ScriptFormulaFormat(): public == private where opPrec < prec => parenthesize s s + formatFormula: (E,I) -> S formatFormula(expr,prec) == i : Integer ATOM(expr)$Lisp pretend Boolean => @@ -167601,22 +171900,17 @@ ScriptFormulaFormat(): public == private where op : S := stringify first l args : L E := rest l nargs : I := #args - -- special cases member?(op, specialOps) => formatSpecial(op,args,prec) member?(op, plexOps) => formatPlex(op,args,prec) - -- nullary case 0 = nargs => formatNullary op - -- unary case (1 = nargs) and member?(op, unaryOps) => formatUnary(op, first args, prec) - -- binary case (2 = nargs) and member?(op, binaryOps) => formatBinary(op, args, prec) - -- nary case member?(op,naryNGOps) => formatNaryNoGroup(op,args, prec) member?(op,naryOps) => formatNary(op,args, prec) @@ -167944,27 +172238,37 @@ Segment(S:Type): SegmentCategory(S) with Rep := Record(low: S, high: S, incr: Integer) + ?..? : (S,S) -> % a..b == [a,b,1] + lo : % -> S lo s == s.low + low : % -> S low s == s.low + hi : % -> S hi s == s.high + high : % -> S high s == s.high + incr : % -> Integer incr s == s.incr + segment : (S,S) -> % segment(a,b) == [a,b,1] + BY : (%,Integer) -> % BY(s, r) == [lo s, hi s, r] if S has SetCategory then + ?=? : (%,%) -> Boolean (s1:%) = (s2:%) == s1.low = s2.low and s1.high=s2.high and s1.incr = s2.incr + coerce : % -> OutputForm coerce(s:%):OutputForm == seg := SEGMENT(s.low::OutputForm, s.high::OutputForm) s.incr = 1 => seg @@ -167973,6 +172277,8 @@ Segment(S:Type): SegmentCategory(S) with convert a == [a,a,1] if S has OrderedRing then + + expand : List(%) -> List(S) expand(ls: List %):List S == lr := nil()$List(S) for s in ls repeat @@ -167990,8 +172296,10 @@ Segment(S:Type): SegmentCategory(S) with l := l + inc reverse_! lr + expand : % -> List(S) expand(s : %) == expand([s]$List(%))$% + map : ((S -> S),%) -> List(S) map(f : S->S, s : %): List S == lr := nil()$List(S) l := lo s @@ -168213,8 +172521,10 @@ SegmentBinding(S:Type): Type with (* domain SEGBIND *) (* - b1 = b2 == variable b1 = variable b2 and segment b1 = segment b2 + ?=? : (%,%) -> Boolean + b1 = b2 == variable b1 = variable b2 and segment b1 = segment b2 + coerce : % -> OutputForm coerce(b:%):OutputForm == variable(b)::OutputForm = segment(b)::OutputForm @@ -168859,58 +173169,79 @@ Set(S:SetCategory): FiniteSetAggregate S == add Rep := FlexibleArray(S) - # s == _#$Rep s + #? : % -> NonNegativeInteger + # s == _#$Rep s - brace() == empty() + brace : () -> % + brace() == empty() - set() == empty() + set : () -> % + set() == empty() - empty() == empty()$Rep + empty : () -> % + empty() == empty()$Rep - copy s == copy(s)$Rep + copy : % -> % + copy s == copy(s)$Rep + parts : % -> List(S) parts s == parts(s)$Rep + inspect : % -> S inspect s == (empty? s => error "Empty set"; s(maxIndex s)) + extract! : % -> S extract_! s == x := inspect s delete_!(s, maxIndex s) x + find : ((S -> Boolean),%) -> Union(S,"failed") find(f, s) == find(f, s)$Rep + map : ((S -> S),%) -> % map(f, s) == map_!(f,copy s) + map! : ((S -> S),%) -> % map_!(f,s) == map_!(f,s)$Rep removeDuplicates_! s + reduce : (((S,S) -> S),%) -> S reduce(f, s) == reduce(f, s)$Rep + reduce : (((S,S) -> S),%,S) -> S reduce(f, s, x) == reduce(f, s, x)$Rep + reduce : (((S,S) -> S),%,S,S) -> S reduce(f, s, x, y) == reduce(f, s, x, y)$Rep if S has ConvertibleTo InputForm then + + convert : % -> InputForm convert(x:%):InputForm == convert [convert("set"::Symbol)@InputForm, convert(parts x)@InputForm] if S has OrderedSet then + ?=? : (%,%) -> Boolean s = t == s =$Rep t + max : % -> S max s == inspect s + min : % -> S min s == (empty? s => error "Empty set"; s(minIndex s)) + construct : List(S) -> % construct l == zero?(n := #l) => empty() a := new(n, first l) for i in minIndex(a).. for x in l repeat a.i := x removeDuplicates_! sort_! a + insert! : (S,%) -> % insert_!(x, s) == n := inc maxIndex s k := minIndex s @@ -168918,6 +173249,7 @@ Set(S:SetCategory): FiniteSetAggregate S == add k < n and s.k = x => s insert_!(x, s, k) + member? : (S,%) -> Boolean member?(x, s) == -- binary search empty? s => false t := maxIndex s @@ -168927,6 +173259,7 @@ Set(S:SetCategory): FiniteSetAggregate S == add if x > s.m then b := m+1 else t := m x = s.t + remove! : (S,%) -> % if $ has finiteAggregate remove_!(x:S, s:%) == n := inc maxIndex s k := minIndex s @@ -168935,6 +173268,7 @@ Set(S:SetCategory): FiniteSetAggregate S == add s -- the set operations are implemented as variations of merging + intersect : (%,%) -> % intersect(s, t) == m := maxIndex s n := maxIndex t @@ -168946,6 +173280,7 @@ Set(S:SetCategory): FiniteSetAggregate S == add if s.i < t.j then i := i+1 else j := j+1 r + difference : (%,%) -> % difference(s:%, t:%) == m := maxIndex s n := maxIndex t @@ -168959,6 +173294,7 @@ Set(S:SetCategory): FiniteSetAggregate S == add while i <= m repeat (concat_!(r, s.i); i := i+1) r + symmetricDifference : (%,%) -> % symmetricDifference(s, t) == m := maxIndex s n := maxIndex t @@ -168973,6 +173309,7 @@ Set(S:SetCategory): FiniteSetAggregate S == add while j <= n repeat (concat_!(r, t.j); j := j+1) r + subset? : (%,%) -> Boolean subset?(s, t) == m := maxIndex s n := maxIndex t @@ -168985,6 +173322,7 @@ Set(S:SetCategory): FiniteSetAggregate S == add return false i > m + union : (%,%) -> % union(s:%, t:%) == m := maxIndex s n := maxIndex t @@ -169001,11 +173339,13 @@ Set(S:SetCategory): FiniteSetAggregate S == add else + insert! : (S,%) -> % insert_!(x, s) == for k in minIndex s .. maxIndex s repeat s.k = x => return s insert_!(x, s, inc maxIndex s) + remove! : (S,%) -> % remove_!(x:S, s:%) == n := inc maxIndex s k := minIndex s @@ -169259,30 +173599,33 @@ SetOfMIntegersInOneToN(m, n): Exports == Implementation where Rep := Record(bits:Bits, pos:N) - reallyEnumerate: () -> Vector % - - enum: (N, N, PI) -> List Bits - all:Reference Vector % := ref empty() sz:Reference N := ref 0 - s1 = s2 == s1.bits =$Bits s2.bits + ?=? : (%,%) -> Boolean + s1 = s2 == s1.bits =$Bits s2.bits + coerce : % -> OutputForm coerce(s:%):OutputForm == brace [i::OutputForm for i in elements s] - random() == index((1 + (random()$Integer rem size()))::PI) + random : () -> % + random() == index((1 + (random()$Integer rem size()))::PI) - reallyEnumerate() == [[b, i] for b in enum(m, n, n) for i in 1..] + reallyEnumerate: () -> Vector % + reallyEnumerate() == [[b, i] for b in enum(m, n, n) for i in 1..] - member?(p, s) == s.bits.p + member? : (PositiveInteger,%) -> Boolean + member?(p, s) == s.bits.p + enumerate : () -> Vector(%) enumerate() == if empty? all() then all() := reallyEnumerate() all() -- enumerates the sets of p integers in 1..q, returns them as sets in 1..n -- must have p <= q + enum: (N, N, PI) -> List Bits enum(p, q, n) == zero? p or zero? q => empty() p = q => @@ -169295,21 +173638,25 @@ SetOfMIntegersInOneToN(m, n): Exports == Implementation where for s in l repeat s.q := true concat_!(enum(p, q1, n), l) + size : () -> NonNegativeInteger size() == if zero? sz() then sz() := binomial(n, m)$IntegerCombinatoricFunctions(Integer) :: N sz() + lookup : % -> PositiveInteger lookup s == if empty? all() then all() := reallyEnumerate() if zero?(s.pos) then s.pos := position(s, all()) :: N s.pos :: PI + index : PositiveInteger -> % index p == p > size() => error "index: argument too large" if empty? all() then all() := reallyEnumerate() all().p + setOfMinN : List(PositiveInteger) -> % setOfMinN l == s := new(n, false)$Bits count:N := 0 @@ -169321,6 +173668,7 @@ SetOfMIntegersInOneToN(m, n): Exports == Implementation where count < m => error "setOfMinN: improper set of integers" [s, 0] + elements : % -> List(PositiveInteger) elements s == b := s.bits l:List PI := empty() @@ -169333,6 +173681,7 @@ SetOfMIntegersInOneToN(m, n): Exports == Implementation where i := i + 1 reverse_! l + incrementKthElement : (%,PositiveInteger) -> Union(%,"failed") incrementKthElement(s, k) == b := s.bits found:N := 0 @@ -169346,6 +173695,7 @@ SetOfMIntegersInOneToN(m, n): Exports == Implementation where newb.((i-1)::N) := false [newb, 0] + delta : (%,PositiveInteger,PositiveInteger) -> NonNegativeInteger delta(s, k, p) == b := s.bits count:N := found:N := 0 @@ -169357,6 +173707,7 @@ SetOfMIntegersInOneToN(m, n): Exports == Implementation where i := i + 1 count + replaceKthElement: (%,PositiveInteger,PositiveInteger) -> Union(%,"failed") replaceKthElement(s, k, p) == b := s.bits found:N := 0 @@ -169846,12 +174197,16 @@ SequentialDifferentialVariable(S:OrderedSet):DifferentialVariableCategory(S) Rep := Record(var:S, ord:NonNegativeInteger) + makeVariable : (S,NonNegativeInteger) -> % makeVariable(s,n) == [s, n] - variable v == v.var + variable : % -> S + variable v == v.var - order v == v.ord + order : % -> NonNegativeInteger + order v == v.ord + ? Boolean v < u == variable v = variable u => order v < order u variable v < variable u @@ -170171,6 +174526,7 @@ SExpressionOf(Str, Sym, Int, Flt, Expr): Decl == Body where dotex:OutputForm := INTERN(".")$Lisp + coerce : % -> OutputForm coerce(b:%):OutputForm == null? b => paren empty() atom? b => coerce(b)$Rep @@ -170182,58 +174538,85 @@ SExpressionOf(Str, Sym, Int, Flt, Expr): Decl == Body where #l = 2 and (first(l1) = QUOTE)@Boolean => quote first rest l1 paren blankSeparate l1 - b1 = b2 == EQUAL(b1,b2)$Lisp + ?=? : (%,%) -> Boolean + b1 = b2 == EQUAL(b1,b2)$Lisp - eq(b1, b2) == EQ(b1,b2)$Lisp + eq : (%,%) -> Boolean + eq(b1, b2) == EQ(b1,b2)$Lisp - null? b == NULL(b)$Lisp + null? : % -> Boolean + null? b == NULL(b)$Lisp - atom? b == ATOM(b)$Lisp + atom? : % -> Boolean + atom? b == ATOM(b)$Lisp - pair? b == CONSP(b)$Lisp + pair? : % -> Boolean + pair? b == CONSP(b)$Lisp - list? b == CONSP(b)$Lisp or NULL(b)$Lisp + list? : % -> Boolean + list? b == CONSP(b)$Lisp or NULL(b)$Lisp - string? b == STRINGP(b)$Lisp + string? : % -> Boolean + string? b == STRINGP(b)$Lisp - symbol? b == IDENTP(b)$Lisp + symbol? : % -> Boolean + symbol? b == IDENTP(b)$Lisp - integer? b == INTEGERP(b)$Lisp + integer? : % -> Boolean + integer? b == INTEGERP(b)$Lisp - float? b == FLOATP(b)$Lisp + float? : % -> Boolean + float? b == FLOATP(b)$Lisp - destruct b == (list? b => b pretend List %; error "Non-list") + destruct : % -> List(%) + destruct b == (list? b => b pretend List %; error "Non-list") + string : % -> Str string b == (STRINGP(b)$Lisp=> b pretend Str;error "Non-string") + symbol : % -> Sym symbol b == (IDENTP(b)$Lisp => b pretend Sym;error "Non-symbol") - float b == (FLOATP(b)$Lisp => b pretend Flt;error "Non-float") + float : % -> Flt + float b == (FLOATP(b)$Lisp => b pretend Flt;error "Non-float") + integer : % -> Int integer b == (INTEGERP(b)$Lisp => b pretend Int;error "Non-integer") - expr b == b pretend Expr + expr : % -> Expr + expr b == b pretend Expr + convert : List(%) -> % convert(l: List %) == l pretend % - convert(st: Str) == st pretend % + convert : Str -> % + convert(st: Str) == st pretend % - convert(sy: Sym) == sy pretend % + convert : Sym -> % + convert(sy: Sym) == sy pretend % - convert(n: Int) == n pretend % + convert : Int -> % + convert(n: Int) == n pretend % - convert(f: Flt) == f pretend % + convert : Flt -> % + convert(f: Flt) == f pretend % - convert(e: Expr) == e + convert : Expr -> % + convert(e: Expr) == e - car b == CAR(b)$Lisp + car : % -> % + car b == CAR(b)$Lisp - cdr b == CDR(b)$Lisp + cdr : % -> % + cdr b == CDR(b)$Lisp - # b == LENGTH(b)$Lisp + #? : % -> Integer + # b == LENGTH(b)$Lisp - elt(b:%, i:Integer) == destruct(b).i + ?.? : (%,Integer) -> % + elt(b:%, i:Integer) == destruct(b).i + ?.? : (%,List(Integer)) -> % elt(b:%, li:List Integer) == for i in li repeat b := destruct(b).i b @@ -170692,24 +175075,17 @@ SimpleAlgebraicExtension(R:CommutativeRing, (* domain SAE *) (* - --sqFr(pb): FactorS(Poly) from UnivPolySquareFree(Poly) - - --degree(M) > 0 and M must be monic if R is not a field. if (r := recip leadingCoefficient M) case "failed" then error "Modulus cannot be made monic" Rep := UP x,y :$ c: R - mkDisc : Boolean -> Void - - mkDiscMat: Boolean -> Void - - M := r::R * M + M := r::R * M - d := degree M + d := degree M - d1 := subtractIfCan(d,1)::NonNegativeInteger + d1 := subtractIfCan(d,1)::NonNegativeInteger discmat:Matrix(R) := zero(d, d) @@ -170723,54 +175099,77 @@ SimpleAlgebraicExtension(R:CommutativeRing, if R has Finite then + size : () -> NonNegativeInteger size == size$R ** d + random : () -> % random == represents([random()$R for i in 0..d1]) + 0 : () -> % 0 == 0$Rep + 1 : () -> % 1 == 1$Rep + ?*? : (R,%) -> % c * x == c *$Rep x + ?*? : (Integer,%) -> % n:Integer * x == n *$Rep x - coerce(n:Integer):$ == coerce(n)$Rep + coerce : Integer -> % + coerce(n:Integer):$ == coerce(n)$Rep + coerce : R -> % coerce(c) == monomial(c,0)$Rep + coerce : % -> OutputForm coerce(x):OutputForm == coerce(x)$Rep + lift : % -> UP lift(x) == x pretend Rep + reduce : UP -> % reduce(p:UP):$ == (monicDivide(p,M)$Rep).remainder + ?=? : (%,%) -> Boolean x = y == x =$Rep y + ?+? : (%,%) -> % x + y == x +$Rep y + -? : % -> % - x == -$Rep x + ?*? : (%,%) -> % x * y == reduce((x *$Rep y) pretend UP) + coordinates : % -> Vector(R) coordinates(x) == [coefficient(lift(x),i) for i in 0..d1] + represents : Vector(R) -> % represents(vect) == +/[monomial(vect.(i+1),i) for i in 0..d1] + definingPolynomial : () -> UP definingPolynomial() == M - characteristic() == characteristic()$R + characteristic : () -> NonNegativeInteger + characteristic() == characteristic()$R - rank() == d::PositiveInteger + rank : () -> PositiveInteger + rank() == d::PositiveInteger - basis() == copy(bsis@Vector(Rep) pretend Vector($)) + basis : () -> Vector(%) + basis() == copy(bsis@Vector(Rep) pretend Vector($)) if R has Field then + minimalPolynomial : % -> UP minimalPolynomial x == squareFreePart characteristicPolynomial x if R has Field then + coordinates : (%,Vector(%)) -> Vector(R) coordinates(x:$,bas: Vector $) == (m := inverse transpose coordinates bas) case "failed" => error "coordinates: second argument must be a basis" @@ -170778,6 +175177,7 @@ SimpleAlgebraicExtension(R:CommutativeRing, else if R has IntegralDomain then + coordinates : (%,Vector(%)) -> Vector(R) coordinates(x:$,bas: Vector $) == -- we work over the quotient field of R to invert a matrix qf := Fraction R @@ -170797,28 +175197,35 @@ SimpleAlgebraicExtension(R:CommutativeRing, error "coordinates: coordinates are not integral over ground ring" vec + reducedSystem : Matrix(%) -> Matrix(R) reducedSystem(m:Matrix $):Matrix(R) == reducedSystem(map(lift, m)$MatrixCategoryFunctions2($, Vector $, Vector $, Matrix $, UP, Vector UP, Vector UP, Matrix UP)) + reducedSystem : (Matrix(%),Vector(%)) -> + Record(mat: Matrix(R),vec: Vector(R)) reducedSystem(m:Matrix $, v:Vector $):Record(mat:Matrix R,vec:Vector R) == reducedSystem(map(lift, m)$MatrixCategoryFunctions2($, Vector $, Vector $, Matrix $, UP, Vector UP, Vector UP, Matrix UP), map(lift, v)$VectorFunctions2($, UP)) + discriminant : () -> R discriminant() == if nodisc?() then mkDisc false disc() + mkDisc : Boolean -> Void mkDisc b == nodisc?() := b disc() := discriminant M void + traceMatrix : () -> Matrix(R) traceMatrix() == if nodiscmat?() then mkDiscMat false discmat + mkDiscMat: Boolean -> Void mkDiscMat b == nodiscmat?() := b mr := minRowIndex discmat; mc := minColIndex discmat @@ -170827,6 +175234,7 @@ SimpleAlgebraicExtension(R:CommutativeRing, qsetelt_!(discmat,mr + i,mc + j,trace reduce monomial(1,i + j)) void + trace : % -> R trace x == --this could be coded perhaps more efficiently xn := x; ans := coefficient(lift xn, 0) for n in 1..d1 repeat @@ -170835,6 +175243,7 @@ SimpleAlgebraicExtension(R:CommutativeRing, if R has Finite then + index : PositiveInteger -> % index k == i:Integer := k rem size() p:Integer := size()$R @@ -170851,6 +175260,7 @@ SimpleAlgebraicExtension(R:CommutativeRing, i := i quo p ans + lookup : % -> PositiveInteger lookup(z : $) : PositiveInteger == -- z = index lookup z, n = lookup index n -- the answer is merely the Horner evaluation of the @@ -171056,18 +175466,24 @@ SimpleCell(TheField,ThePols) : PUB == PRIV where hasDim:B, varOf:Symbol) + samplePoint : % -> TheField samplePoint(c) == c.samplePoint + stablePol : % -> ThePols stablePol(c) == error "Prout" + hasDimension? : % -> Boolean hasDimension?(c) == c.hasDim + variableOf : % -> Symbol variableOf(c) == c.varOf + coerce : % -> OutputForm coerce(c:%):O == o : O := ((c.varOf)::O) = ((c.samplePoint)::O) brace [o,(c.hasDim)::O] + separe : (List(TheField),TheField,TheField) -> List(TheField) separe(liste,gauche,droite) == milieu : TheField := (gauche + droite) / (2::TheField) liste = [] => [milieu] @@ -171100,14 +175516,17 @@ SimpleCell(TheField,ThePols) : PUB == PRIV where append(separe(reverse(lg),gauche,newDroite), cons(milieu,separe(ld,newGauche,droite))) + pointToCell : (TheField,Boolean,Symbol) -> % pointToCell(sp,hasDim?,varName) == [sp,hasDim?,varName]$Rep + allSimpleCells : (ThePols,Symbol) -> List(%) allSimpleCells(p:ThePols,var:Symbol) == allSimpleCells([p],var) PACK ==> CylindricalAlgebraicDecompositionUtilities(TheField,ThePols) + allSimpleCells : (List(ThePols),Symbol) -> List(%) allSimpleCells(lp:List(ThePols),var:Symbol) == lp1 := gcdBasis(lp)$PACK null(lp1) => [pointToCell(0,true,var)] @@ -171259,20 +175678,27 @@ SimpleFortranProgram(R,FS): Exports == Implementation where Rep := Record(name : Symbol, type : FST, body : FS ) + fortran : (Symbol,FortranScalarType,FS) -> % fortran(fname, ftype, res) == construct(fname,ftype,res)$Rep + nameOf : $ -> Symbol nameOf(u:$):Symbol == u . name + typeOf : $ -> Union(FST,"void") typeOf(u:$):Union(FST,"void") == u . type + bodyOf : $ -> FS bodyOf(u:$):FS == u . body + argumentsOf : $ -> List Symbol argumentsOf(u:$):List Symbol == variables(bodyOf u)$FS + coerce : % -> OutputForm coerce(u:$):OutputForm == coerce(nameOf u)$Symbol + outputAsFortran : % -> Void outputAsFortran(u:$):Void == ftype := (checkType(typeOf(u)::OutputForm)$Lisp)::OutputForm fname := nameOf(u)::OutputForm @@ -171924,6 +176350,7 @@ SingleInteger(): Join(IntegerNumberSystem,Logic,OpenMath) with MULTIPLIER ==> 314159269$Lisp -- from Knuth's table MODULUS ==> 2147483647$Lisp -- 2**31-1 + writeOMSingleInt : (OpenMathDevice,%) -> Void writeOMSingleInt(dev: OpenMathDevice, x: %): Void == if x < 0 then OMputApp(dev) @@ -171933,6 +176360,7 @@ SingleInteger(): Join(IntegerNumberSystem,Logic,OpenMath) with else OMputInteger(dev, convert(x)) + OMwrite : % -> String OMwrite(x: %): String == s: String := "" sp := OM_-STRINGTOSTRINGPTR(s)$Lisp @@ -171944,6 +176372,7 @@ SingleInteger(): Join(IntegerNumberSystem,Logic,OpenMath) with s := OM_-STRINGPTRTOSTRING(sp)$Lisp @ String s + OMwrite : (%,Boolean) -> String OMwrite(x: %, wholeObj: Boolean): String == s: String := "" sp := OM_-STRINGTOSTRINGPTR(s)$Lisp @@ -171957,11 +176386,13 @@ SingleInteger(): Join(IntegerNumberSystem,Logic,OpenMath) with s := OM_-STRINGPTRTOSTRING(sp)$Lisp @ String s + OMwrite : (OpenMathDevice,%) -> Void OMwrite(dev: OpenMathDevice, x: %): Void == OMputObject(dev) writeOMSingleInt(dev, x) OMputEndObject(dev) + OMwrite : (OpenMathDevice,%,Boolean) -> Void OMwrite(dev: OpenMathDevice, x: %, wholeObj: Boolean): Void == if wholeObj then OMputObject(dev) @@ -171969,96 +176400,141 @@ SingleInteger(): Join(IntegerNumberSystem,Logic,OpenMath) with if wholeObj then OMputEndObject(dev) - reducedSystem m == m pretend Matrix(Integer) + reducedSystem : Matrix(%) -> Matrix(Integer) + reducedSystem m == m pretend Matrix(Integer) + coerce : % -> OutputForm coerce(x):OutputForm == (convert(x)@Integer)::OutputForm + convert : % -> Integer convert(x:%):Integer == x pretend Integer - i:Integer * y:% == i::% * y + ?*? : (Integer,%) -> % + i:Integer * y:% == i::% * y - 0 == 0$Lisp + 0 : () -> % + 0 == 0$Lisp - 1 == 1$Lisp + 1 : () -> % + 1 == 1$Lisp - base() == 2$Lisp + base : () -> % + base() == 2$Lisp - max() == MAXINT + max : () -> % + max() == MAXINT - min() == MININT + min : () -> % + min() == MININT - x = y == EQL(x,y)$Lisp + ?=? : (%,%) -> Boolean + x = y == EQL(x,y)$Lisp - _~ x == LOGNOT(x)$Lisp + ~? : % -> % + _~ x == LOGNOT(x)$Lisp - not(x) == LOGNOT(x)$Lisp + ~? : % -> % + not(x) == LOGNOT(x)$Lisp + ?/\? : (%,%) -> % _/_\(x,y) == LOGAND(x,y)$Lisp + ?\/? : (%,%) -> % _\_/(x,y) == LOGIOR(x,y)$Lisp + Not : % -> % Not(x) == LOGNOT(x)$Lisp + And : (%,%) -> % And(x,y) == LOGAND(x,y)$Lisp + Or : (%,%) -> % Or(x,y) == LOGIOR(x,y)$Lisp + xor : (%,%) -> % xor(x,y) == LOGXOR(x,y)$Lisp - x < y == QSLESSP(x,y)$Lisp + ? Boolean + x < y == QSLESSP(x,y)$Lisp - inc x == QSADD1(x)$Lisp + inc : % -> % + inc x == QSADD1(x)$Lisp - dec x == QSSUB1(x)$Lisp + dec : % -> % + dec x == QSSUB1(x)$Lisp - - x == QSMINUS(x)$Lisp + -? : % -> % + - x == QSMINUS(x)$Lisp - x + y == QSPLUS(x,y)$Lisp + ?+? : (%,%) -> % + x + y == QSPLUS(x,y)$Lisp + ?-? : (%,%) -> % x:% - y:% == QSDIFFERENCE(x,y)$Lisp + ?*? : (%,%) -> % x:% * y:% == QSTIMES(x,y)$Lisp + ?**? : (%,NonNegativeInteger) -> % x:% ** n:NonNegativeInteger == ((EXPT(x, n)$Lisp) @ Integer)::% + ?quo? : (%,%) -> % x quo y == QSQUOTIENT(x,y)$Lisp + ?rem? : (%,%) -> % x rem y == QSREMAINDER(x,y)$Lisp - divide(x, y) == CONS(QSQUOTIENT(x,y)$Lisp,QSREMAINDER(x,y)$Lisp)$Lisp + divide : (%,%) -> Record(quotient: %,remainder: %) + divide(x, y) == CONS(QSQUOTIENT(x,y)$Lisp,QSREMAINDER(x,y)$Lisp)$Lisp + gcd : (%,%) -> % gcd(x,y) == GCD(x,y)$Lisp - abs(x) == QSABSVAL(x)$Lisp + abs : % -> % + abs(x) == QSABSVAL(x)$Lisp - odd?(x) == QSODDP(x)$Lisp + odd? : % -> Boolean + odd?(x) == QSODDP(x)$Lisp - zero?(x) == QSZEROP(x)$Lisp + zero? : % -> Boolean + zero?(x) == QSZEROP(x)$Lisp - one?(x) == x = 1 + one? : % -> Boolean + one?(x) == x = 1 + max : (%,%) -> % max(x,y) == QSMAX(x,y)$Lisp + min : (%,%) -> % min(x,y) == QSMIN(x,y)$Lisp + hash : % -> SingleInteger hash(x) == SXHASH(x)$Lisp + length : % -> % length(x) == INTEGER_-LENGTH(x)$Lisp + shift : (%,%) -> % shift(x,n) == QSLEFTSHIFT(x,n)$Lisp + mulmod : (%,%,%) -> % mulmod(a,b,p) == QSMULTMOD(a,b,p)$Lisp + addmod : (%,%,%) -> % addmod(a,b,p) == QSADDMOD(a,b,p)$Lisp + submod : (%,%,%) -> % submod(a,b,p) == QSDIFMOD(a,b,p)$Lisp + negative? : % -> Boolean negative?(x) == QSMINUSP$Lisp x - + reducedSystem : (Matrix(%),Vector(%)) -> + Record(mat: Matrix(Integer),vec: Vector(Integer)) reducedSystem(m, v) == [m pretend Matrix(Integer), v pretend Vector(Integer)] + positiveRemainder : (%,%) -> % positiveRemainder(x,n) == r := QSREMAINDER(x,n)$Lisp QSMINUSP(r)$Lisp => @@ -172066,19 +176542,23 @@ SingleInteger(): Join(IntegerNumberSystem,Logic,OpenMath) with QSPLUS(r, n)$Lisp r + coerce : Integer -> % coerce(x:Integer):% == (x <= max pretend Integer) and (x >= min pretend Integer) => x pretend % error "integer too large to represent in a machine word" + random : () -> % random() == seed := REMAINDER(TIMES(MULTIPLIER,seed)$Lisp,MODULUS)$Lisp REMAINDER(seed,BASE)$Lisp + random : % -> % random(n) == RANDOM(n)$Lisp UCA ==> Record(unit:%,canonical:%,associate:%) + unitNormal : % -> Record(unit: %,canonical: %,associate: %) unitNormal x == x < 0 => [-1,-x,-1]$UCA [1,x,1]$UCA @@ -172195,18 +176675,25 @@ SingletonAsOrderedSet(): OrderedSet with (* domain SAOS *) (* + create : () -> % create() == "?" pretend % + ? Boolean a OutputForm coerce(a) == outputForm "?" -- CJW doesn't like this: change ? + ?=? : (%,%) -> Boolean a=b == true -- only one element + min : (%,%) -> % min(a,b) == a -- only one element + max : (%,%) -> % max(a,b) == a -- only one element + convert : % -> Symbol convert a == coerce("?") *) @@ -173096,6 +177583,7 @@ SparseEchelonMatrix(C : OrderedSet, D : Ring) : Cat == Def where seed : I := 113 -- seed for random number generation GCDmode : Sy := iter -- flag for gcd algorithm + greater : (ROWREC,ROWREC) -> B greater(r1 : ROWREC, r2 : ROWREC) : B == empty? r1.Indices => false empty? r2.Indices => true @@ -173109,36 +177597,45 @@ SparseEchelonMatrix(C : OrderedSet, D : Ring) : Cat == Def where Rep := Record(NCols : NNI, NRows : NNI, AllInds : L C, Rows : V ROWREC) + ncols : % -> NonNegativeInteger ncols(A : %) : NNI == A.NCols + nrows : % -> NonNegativeInteger nrows(A : %) : NNI == A.NRows + allIndices : % -> List(C) allIndices(A : %) : L C == copy A.AllInds + row : (%,Integer) -> Record(Indices: List(C),Entries: List(D)) row(A : %, i : I) : ROWREC == -- i < 0 or i > A.NRows => error "index out of range" qelt(A.Rows, i) + setRow! : (%,I,ROWREC) -> Void setRow!(A : %, i : I, r : ROWREC) : Void == -- i < 0 or i > A.NRows => error "index out of range" qsetelt!(A.Rows, i, r) void + setRow! : (%,Integer,Record(Indices: List(C),Entries: List(D))) -> Void setRow!(A : %, i : I, inds : L C, ents : L D) : Void == -- i < 0 or i > A.NRows => error "index out of range" -- #inds ^= #ents => error "improper row" qsetelt!(A.Rows, i, [inds, ents]) void + new : (List(C),Integer) -> % new(inds : L C, n : I) : % == [#inds, n::NNI, inds, [copy emptyRec for i in 1..n]] + elt : (%,Integer,C) -> D elt(A : %, i : I, c : C) : D == r := row(A, i) pos := position(c, r.Indices) pos < minInd => 0$D qelt(r.Entries, pos) + setelt! : (%,Integer,C,D) -> Void setelt!(A : %, i : I, c : C, d : D) : Void == r := row(A, i) pos := position(c, r.Indices) @@ -173153,6 +177650,7 @@ SparseEchelonMatrix(C : OrderedSet, D : Ring) : Cat == Def where qsetelt!(A.Rows, i, r) void + coerce : % -> Matrix(D) coerce(A : %) : MD == zero? A.NCols => error "cannot coerce matrix with zero columns" AA : MD := new(A.NRows, A.NCols, 0$D) @@ -173167,10 +177665,12 @@ SparseEchelonMatrix(C : OrderedSet, D : Ring) : Cat == Def where ents := rest ents AA + coerce : % -> OutputForm coerce(A : %) : OUT == zero? A.NCols => 0$D ::OUT A::MD::OUT + copy : % -> % copy(A : %) : % == resRows : V ROWREC := new(A.NRows, emptyRec) for l in 1..A.NRows repeat @@ -173182,6 +177682,7 @@ SparseEchelonMatrix(C : OrderedSet, D : Ring) : Cat == Def where -- Basic Matrix Operations -- -- ----------------------- -- + elimZeroCols! : % -> Void elimZeroCols!(A : %) : Void == newInds : L C := empty for r in entries(A.Rows) repeat @@ -173190,6 +177691,7 @@ SparseEchelonMatrix(C : OrderedSet, D : Ring) : Cat == Def where A.AllInds := newInds void + purge! : (%,(C -> Boolean)) -> Void purge!(A : %, crit : C-> B) : Void == newInds : L C := empty for c in A.AllInds repeat @@ -173209,6 +177711,7 @@ SparseEchelonMatrix(C : OrderedSet, D : Ring) : Cat == Def where qsetelt!(A.Rows, l, [reverse! newInds, reverse! newEnts]) void + sortedPurge! : (%,(C -> Boolean)) -> Void sortedPurge!(A : %, crit : C-> B) : Void == if crit first A.AllInds then while not(empty? A.AllInds) and crit first A.AllInds repeat @@ -173221,6 +177724,7 @@ SparseEchelonMatrix(C : OrderedSet, D : Ring) : Cat == Def where qsetelt!(A.Rows, l, r) void + deleteRow! : (%,Integer) -> Void deleteRow!(A : %, i : I) : Void == i > A.NRows => A nr := (A.NRows-1)::NNI @@ -173233,6 +177737,7 @@ SparseEchelonMatrix(C : OrderedSet, D : Ring) : Cat == Def where A.Rows := resRows void + consRow! : (%,Record(Indices: List(C),Entries: List(D))) -> Void consRow!(A : %, r : ROWREC) : Void == A.NRows := A.NRows + 1 newRows : L ROWREC := cons(r, entries A.Rows) @@ -173243,6 +177748,7 @@ SparseEchelonMatrix(C : OrderedSet, D : Ring) : Cat == Def where sort!((x, y) +-> y < x, newInds)) void + appendRow! : (%,Record(Indices: List(C),Entries: List(D))) -> Void appendRow!(A : %, r : ROWREC) : Void == A.NRows := A.NRows + 1 newRows : L ROWREC := concat(entries A.Rows, r) @@ -173253,6 +177759,7 @@ SparseEchelonMatrix(C : OrderedSet, D : Ring) : Cat == Def where sort!((x, y) +-> y < x, newInds)) void + extract : (%,Integer,Integer) -> % extract(A : %, i1 : I, i2 : I) : % == nr := (i2-i1+1)::NNI resRows : V ROWREC := new(nr, emptyRec) @@ -173263,6 +177770,7 @@ SparseEchelonMatrix(C : OrderedSet, D : Ring) : Cat == Def where newInds, row(A, i).Indices) [A.NCols, nr, newInds, resRows] + join : (%,%) -> % join(A1 : %, A2 : %) : % == newInds := removeDuplicates! merge((x : C, y : C) : Boolean +-> y < x, A1.AllInds, A2.AllInds) @@ -173274,6 +177782,7 @@ SparseEchelonMatrix(C : OrderedSet, D : Ring) : Cat == Def where qsetelt!(newRows, A1.NRows+l, qelt(A2.Rows, l)) [#newInds, newNRows, newInds, newRows] + horizJoin : (%,%) -> % horizJoin(A1 : %, A2 : %) : % == A1.NRows ^= A2.NRows => error "incompatible dimensions in horizJoin" newInds := append(A1.AllInds, A2.AllInds) @@ -173285,6 +177794,7 @@ SparseEchelonMatrix(C : OrderedSet, D : Ring) : Cat == Def where append(r1.Entries, r2.Entries)) res + horizSplit : (%,C) -> Record(Left: %,Right: %) horizSplit(A : %, c : C) : Record(Left : %, Right : %) == rinds : L C := allIndices A linds : L C := empty @@ -173319,6 +177829,7 @@ SparseEchelonMatrix(C : OrderedSet, D : Ring) : Cat == Def where -- Row Echelon -- -- ----------- -- + addRows : (D,ROWREC,D,ROWREC) -> ROWREC addRows(d1 : D, r1 : ROWREC, d2 : D, r2 : ROWREC) : ROWREC == -- Computes linear combination of two rows. -- Local function. @@ -173366,11 +177877,13 @@ SparseEchelonMatrix(C : OrderedSet, D : Ring) : Cat == Def where resE := rest resE [resI, resE] + pivot : (%,Integer) -> Record(Index: C,Entry: D) pivot(A : %, i : I) : Record(Index : C, Entry : D) == r := row(A, i) empty? r.Indices => error "empty row" [first r.Indices, first r.Entries] + pivots : % -> Record(Indices: List(C),Entries: List(D)) pivots(A : %) : ROWREC == resI : L C := empty resE : L D := empty @@ -173379,11 +177892,12 @@ SparseEchelonMatrix(C : OrderedSet, D : Ring) : Cat == Def where resE := cons(first r.Entries, resE) [reverse! resI, reverse! resE] + rowEchelon : % -> Record(Ech: %,Lt: Matrix(D),Pivots: List(D), + Rank: NonNegativeInteger) rowEchelon(AA : %) : Record(Ech : %, Lt : MD, Pivots : L D, Rank : NNI) == A := copy AA LTr : MD := diagonalMatrix [1$D for i in 1..A.NRows] Pivs : L D := empty - -- check pivots for i in 1..A.NRows repeat r := qelt(A.Rows, i) @@ -173394,7 +177908,6 @@ SparseEchelonMatrix(C : OrderedSet, D : Ring) : Cat == Def where changed? := true if changed? then qsetelt!(A.Rows, i, r) - -- sort rows by pivots (bubble sort) sorted? : B := false until sorted? repeat @@ -173409,7 +177922,6 @@ SparseEchelonMatrix(C : OrderedSet, D : Ring) : Cat == Def where sorted? := false else oldr := newr - -- fraction-free elimination finished? : B := false pivlen, pivrow, rk : NNI @@ -173433,7 +177945,6 @@ SparseEchelonMatrix(C : OrderedSet, D : Ring) : Cat == Def where pivrow := j piv : D := first qelt(A.Rows, pivrow).Entries Pivs := cons(piv, Pivs) - -- elimination necessary? if k > 0 then if pivrow ^= i then @@ -173463,13 +177974,13 @@ SparseEchelonMatrix(C : OrderedSet, D : Ring) : Cat == Def where qsetelt!(A.Rows, l-1, qelt(A.Rows, l)) swapRows!(LTr, l-1, l) qsetelt!(A.Rows, l-1, r) - if not finished? then rk : NNI := A.NRows [A, LTr, Pivs, rk] if D has GcdDomain then + setGcdMode : Symbol -> Symbol if D has GCDDOM setGcdMode(s : Sy) : Sy == tmp := GCDmode (s = iter) or (s = rand) => @@ -173477,6 +177988,7 @@ SparseEchelonMatrix(C : OrderedSet, D : Ring) : Cat == Def where tmp error "unknown gcd mode" + randomGCD : L D -> D randomGCD(le : L D) : D == -- Probabilistic technique. #le = 2 => gcd(first le, second le) @@ -173500,6 +178012,7 @@ SparseEchelonMatrix(C : OrderedSet, D : Ring) : Cat == Def where one?(#l) => h randomGCD l + iteratedGCD : L D -> D iteratedGCD(le : L D) : D == -- Computes gcd iteratively res := gcd(first le, second le) @@ -173509,6 +178022,7 @@ SparseEchelonMatrix(C : OrderedSet, D : Ring) : Cat == Def where l := rest l res + makePrimitive : ROWREC -> Record(GCD : D, Row : ROWREC) makePrimitive(r : ROWREC) : Record(GCD : D, Row : ROWREC) == -- remove common gcd of row le := r.Entries @@ -173522,6 +178036,8 @@ SparseEchelonMatrix(C : OrderedSet, D : Ring) : Cat == Def where le := [(e exquo g)::D for e in le] [g, [r.Indices, le]] + primitiveRowEchelon : % -> Record(Ech: %,Lt: Matrix(Fraction(D)), + Pivots: List(D),Rank: NonNegativeInteger) if D has GCDDOM primitiveRowEchelon(AA : %) : _ Record(Ech : %, Lt : MFD, Pivots : L D, Rank : NNI) == A := copy AA @@ -173538,7 +178054,6 @@ SparseEchelonMatrix(C : OrderedSet, D : Ring) : Cat == Def where changed? := true if changed? then qsetelt!(A.Rows, i, r) - -- sort rows by pivots (bubble sort) sorted? : B := false until sorted? repeat @@ -173553,7 +178068,6 @@ SparseEchelonMatrix(C : OrderedSet, D : Ring) : Cat == Def where sorted? := false else oldr := newr - -- primitive fraction-free elimination finished? : B := false pivlen, pivrow, rk : NNI @@ -173586,7 +178100,6 @@ SparseEchelonMatrix(C : OrderedSet, D : Ring) : Cat == Def where qsetelt!(LTr, pivrow, l, q*qelt(LTr, pivrow, l)) piv : D := first qelt(A.Rows, pivrow).Entries Pivs := cons(piv, Pivs) - -- elimination necessary? if k > 0 then if pivrow ^= i then @@ -173594,7 +178107,6 @@ SparseEchelonMatrix(C : OrderedSet, D : Ring) : Cat == Def where qsetelt!(A.Rows, pivrow, qelt(A.Rows, i)) qsetelt!(A.Rows, i, pr) swapRows!(LTr, i, pivrow) - -- elimination (and resorting of rows) pr := copy tmp.Row pr.Indices := rest pr.Indices @@ -173617,7 +178129,6 @@ SparseEchelonMatrix(C : OrderedSet, D : Ring) : Cat == Def where qsetelt!(A.Rows, l-1, qelt(A.Rows, l)) swapRows!(LTr, l-1, l) qsetelt!(A.Rows, l-1, r) - if not finished? then rk : NNI := A.NRows [A, LTr, Pivs, rk] @@ -173626,6 +178137,7 @@ SparseEchelonMatrix(C : OrderedSet, D : Ring) : Cat == Def where -- Multiplication -- -- -------------- -- + ?*? : (Matrix(D),%) -> % L : MD * AA : % == ncols(L) ^= AA.NRows => error "improper matrix dimensions" A := copy AA @@ -173649,7 +178161,6 @@ SparseEchelonMatrix(C : OrderedSet, D : Ring) : Cat == Def where r.Indices := cons(c, r.Indices) r.Entries := cons(qelt(tmp, k), r.Entries) qsetelt!(res.Rows, k, r) - for k in 1..rlen repeat r := qelt(res.Rows, k) r.Indices := reverse! r.Indices @@ -173659,12 +178170,14 @@ SparseEchelonMatrix(C : OrderedSet, D : Ring) : Cat == Def where if D has IntegralDomain then + mult : (FD,D) -> D mult(f : FD, d : D) : D == res := numer(f)*d tmp := res exquo denom(f) tmp case "failed" => error "cannot divide in mult" tmp::D + ?*? : (Matrix(Fraction(D)),%) -> % L : MFD * AA : % == ncols(L) ^= AA.NRows => error "improper matrix dimensions" A := copy AA @@ -173690,7 +178203,6 @@ SparseEchelonMatrix(C : OrderedSet, D : Ring) : Cat == Def where r.Indices := cons(c, r.Indices) r.Entries := cons(d::D, r.Entries) qsetelt!(res.Rows, k, r) - for k in 1..rlen repeat r := qelt(res.Rows, k) r.Indices := reverse! r.Indices @@ -174511,15 +179023,10 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where \begin{chunk}{COQ SMP} (* domain SMP *) (* - --constants - --D := F(%) replaced by next line until compiler support completed - - --representations D := SparseUnivariatePolynomial(%) VPoly:= Record(v:VarSet,ts:D) Rep:= Union(R,VPoly) - --declarations fn: R -> R n: Integer k: NonNegativeInteger @@ -174535,44 +179042,47 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where Lpval : List(%) Lvar : List(VarSet) - --define + 0 : () -> % 0 == 0$R::% + 1 : () -> % 1 == 1$R::% + zero? : % -> Boolean zero? p == p case R and zero?(p)$R + one? : % -> Boolean one? p == p case R and ((p) = 1)$R - -- a local function + red : % -> % red(p:%):% == p case R => 0 if ground?(reductum p.ts) then leadingCoefficient(reductum p.ts) else [p.v,reductum p.ts]$VPoly + numberOfMonomials : % -> NonNegativeInteger numberOfMonomials(p): NonNegativeInteger == p case R => zero?(p)$R => 0 1 +/[numberOfMonomials q for q in coefficients(p.ts)] + coerce : VarSet -> % coerce(mvar):% == [mvar,monomial(1,1)$D]$VPoly + monomial? : % -> Boolean monomial? p == p case R => true sup : D := p.ts 1 ^= numberOfMonomials(sup) => false monomial? leadingCoefficient(sup)$D --- local - moreThanOneVariable?: % -> Boolean - moreThanOneVariable? p == p case R => false q:=p.ts @@ -174581,21 +179091,23 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where -- if we already know we use this (slighlty) faster function univariateKnown: % -> SparseUnivariatePolynomial R - univariateKnown p == p case R => (leadingCoefficient p) :: SparseUnivariatePolynomial(R) monomial( leadingCoefficient p,degree p.ts)+ univariateKnown(red p) + univariate : % -> SparseUnivariatePolynomial(R) univariate p == p case R =>(leadingCoefficient p) :: SparseUnivariatePolynomial(R) moreThanOneVariable? p => error "not univariate" monomial( leadingCoefficient p,degree p.ts)+ univariate(red p) + multivariate : (SparseUnivariatePolynomial(R),VarSet) -> % multivariate (u:SparseUnivariatePolynomial(R),var:VarSet) == ground? u => (leadingCoefficient u) ::% [var,monomial(leadingCoefficient u,degree u)$D]$VPoly + multivariate(reductum u,var) + univariate : (%,VarSet) -> SparseUnivariatePolynomial(%) univariate(p:%,mvar:VarSet):SparseUnivariatePolynomial(%) == p case R or mvar>p.v => monomial(p,0)$D pt:=p.ts @@ -174604,11 +179116,13 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where univariate(red p,mvar) -- a local functions, used in next definition + unlikeUnivReconstruct : (SparseUnivariatePolynomial(%),VarSet) -> % unlikeUnivReconstruct(u:SparseUnivariatePolynomial(%),mvar:VarSet):% == zero? (d:=degree u) => coefficient(u,0) monomial(leadingCoefficient u,mvar,d)+ unlikeUnivReconstruct(reductum u,mvar) + multivariate : (SparseUnivariatePolynomial(%),VarSet) -> % multivariate(u:SparseUnivariatePolynomial(%),mvar:VarSet):% == ground? u => coefficient(u,0) uu:=u @@ -174618,20 +179132,24 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where return unlikeUnivReconstruct(u,mvar) [mvar,u]$VPoly + ground? : % -> Boolean ground?(p:%):Boolean == p case R => true false + monomial : (%,VarSet,NonNegativeInteger) -> % monomial(p,mvar,k1) == zero? k1 or zero? p => p p case R or mvar>p.v => [mvar,monomial(p,k1)$D]$VPoly p*[mvar,monomial(1,k1)$D]$VPoly + monomial : (R,IndexedExponents(VarSet)) -> % monomial(c:R,e:IndexedExponents(VarSet)):% == zero? e => (c::%) monomial(1,leadingSupport e, leadingCoefficient e) * monomial(c,reductum e) + coefficient : (%,IndexedExponents(VarSet)) -> R coefficient(p:%, e:IndexedExponents(VarSet)) : R == zero? e => p case R => p::R @@ -174644,29 +179162,36 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where ve > vp => 0 coefficient(coefficient(p.ts,leadingCoefficient e),reductum e) + coerce : Integer -> % coerce(n) == n::R::% + coerce : R -> % coerce(c) == c::% + characteristic : () -> NonNegativeInteger characteristic == characteristic$R + recip : % -> Union(%,"failed") recip(p) == p case R => (uu:=recip(p::R);uu case "failed" => "failed"; uu::%) "failed" + -? : % -> % - p == p case R => -$R p [p.v, - p.ts]$VPoly + ?*? : (Integer,%) -> % n * p == p case R => n * p::R mvar:=p.v up:=n*p.ts if ground? up then leadingCoefficient(up) else [mvar,up]$VPoly + ?*? : (R,%) -> % c * p == c = 1 => p p case R => c * p::R @@ -174674,6 +179199,7 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where up:=c*p.ts if ground? up then leadingCoefficient(up) else [mvar,up]$VPoly + ?+? : (%,%) -> % p1 + p2 == p1 case R and p2 case R => p1 +$R p2 p1 case R => [p2.v, p1::D + p2.ts]$VPoly @@ -174686,6 +179212,7 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where [p2.v, p1::D + p2.ts]$VPoly [p1.v, p1.ts + p2::D]$VPoly + ?-? : (%,%) -> % p1 - p2 == p1 case R and p2 case R => p1 -$R p2 p1 case R => [p2.v, p1::D - p2.ts]$VPoly @@ -174698,6 +179225,7 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where [p2.v, p1::D - p2.ts]$VPoly [p1.v, p1.ts - p2::D]$VPoly + ?=? : (%,%) -> Boolean p1 = p2 == p1 case R => p2 case R => p1 =$R p2 @@ -174706,6 +179234,7 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where p1.v = p2.v => p1.ts = p2.ts false + ?*? : (%,%) -> % p1 * p2 == p1 case R => p1::R * p2 p2 case R => @@ -174725,15 +179254,19 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where up:=p1*p2.ts if ground? up then leadingCoefficient(up) else [mvar,up]$VPoly + ?^? : (%,PositiveInteger) -> % p ^ kp == p ** (kp pretend NonNegativeInteger) + ?**? : (%,PositiveInteger) -> % p ** kp == p ** (kp pretend NonNegativeInteger ) + ?^? : (%,NonNegativeInteger) -> % p ^ k == p ** k + ?**? : (%,NonNegativeInteger) -> % p ** k == p case R => p::R ** k -- univariate special case @@ -174746,6 +179279,8 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where if R has IntegralDomain then UnitCorrAssoc ==> Record(unit:%,canonical:%,associate:%) + + unitNormal : % -> Record(unit: %,canonical: %,associate: %) unitNormal(p) == u,c,a:R p case R => @@ -174754,21 +179289,25 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where (u,c,a):= unitNormal(leadingCoefficient(p))$R [u::%,(a*p)::%,a::%]$UnitCorrAssoc + unitCanonical : % -> % unitCanonical(p) == p case R => unitCanonical(p::R)$R (u,c,a):= unitNormal(leadingCoefficient(p))$R a*p + unit? : % -> Boolean unit? p == p case R => unit?(p::R)$R false + associates? : (%,%) -> Boolean if R has INTDOM associates?(p1,p2) == p1 case R => p2 case R and associates?(p1,p2)$R p2 case VPoly and p1.v = p2.v and associates?(p1.ts,p2.ts) if R has approximate then + exquo : (%,%) -> Union(%,"failed") p1 exquo p2 == p1 case R and p2 case R => a:= (p1::R exquo p2::R) @@ -174796,6 +179335,7 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where leadingCoefficient(up) else [mvar,up]$VPoly::% else + exquo : (%,%) -> Union(%,"failed") p1 exquo p2 == p1 case R and p2 case R => a:= (p1::R exquo p2::R) @@ -174813,6 +179353,7 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where up:SUP %:=a if ground? up then leadingCoefficient(up) else [mvar,up]$VPoly::% + map : ((R -> R),%) -> % map(fn,p) == p case R => fn(p) mvar:=p.v @@ -174821,11 +179362,13 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where if R has Field then + ?/? : (%,R) -> % (p : %) / (r : R) == inv(r) * p if R has GcdDomain then + content : % -> R content(p) == p case R => p c :R :=0 @@ -174839,13 +179382,16 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where R has CharacteristicZero and not(R has FloatingPointSystem) then + content : (%,VarSet) -> % if R has GCDDOM content(p,mvar) == p case R => p gcd(coefficients univariate(p,mvar))$pgcd + gcd : (%,%) -> % gcd(p1,p2) == gcd(p1,p2)$pgcd + gcd : List(%) -> % gcd(lp:List %) == gcd(lp)$pgcd @@ -174854,10 +179400,12 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where else if R has GcdDomain then + content : (%,VarSet) -> % if R has GCDDOM content(p,mvar) == p case R => p content univariate(p,mvar) + gcd : (%,%) -> % gcd(p1,p2) == p1 case R => p2 case R => gcd(p1,p2)$R::% @@ -174876,6 +179424,9 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where -- eventually need a better notion of gcd's over floats -- this essentially computes the gcds of the monomial contents + gcdPolynomial : (SparseUnivariatePolynomial(%), + SparseUnivariatePolynomial(%)) -> + SparseUnivariatePolynomial(%) gcdPolynomial(a:SUP $,b:SUP $):SUP $ == ground? (a) => zero? a => b @@ -174900,18 +179451,22 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where not((b exquo a) case "failed") => mong * a mong + coerce : % -> OutputForm coerce(p):OutputForm == p case R => (p::R)::OutputForm outputForm(p.ts,p.v::OutputForm) + coefficients : % -> List(R) coefficients p == p case R => list(p :: R)$List(R) "append"/[coefficients(p1)$% for p1 in coefficients(p.ts)] + retract : % -> R retract(p:%):R == p case R => p :: R error "cannot retract nonconstant polynomial" + retractIfCan : % -> Union(R,"failed") retractIfCan(p:%):Union(R, "failed") == p case R => p::R "failed" @@ -174939,6 +179494,7 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where setrest!(m,mymerge(l,rest m)) m + variables : % -> List(VarSet) variables p == p case R => empty() lv:List VarSet:=empty() @@ -174948,16 +179504,20 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where q := reductum q cons(p.v,lv) + mainVariable : % -> Union(VarSet,"failed") mainVariable p == p case R => "failed" p.v + eval : (%,List(VarSet),List(%)) -> % eval(p,mvar,pval) == univariate(p,mvar)(pval) + eval : (%,List(VarSet),List(R)) -> % eval(p,mvar,val) == univariate(p,mvar)(val) + evalSortedVarlist : (%,List(VarSet),List(%)):% evalSortedVarlist(p,Lvar,Lpval):% == p case R => p empty? Lvar or empty? Lpval => p @@ -174970,6 +179530,7 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where pts pval multivariate(pts,p.v) + eval : (%,List(VarSet),List(%)):% eval(p,Lvar,Lpval) == empty? rest Lvar => evalSortedVarlist(p,Lvar,Lpval) sorted?((x1,x2) +-> x1 > x2, Lvar) => evalSortedVarlist(p,Lvar,Lpval) @@ -174979,27 +179540,33 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where nlpval := [Lpval.position(mvar,Lvar) for mvar in nlvar] evalSortedVarlist(p,nlvar,nlpval) + eval : (%,List(VarSet),List(%)):% eval(p,Lvar,Lval) == eval(p,Lvar,[val::% for val in Lval]$(List %)) -- kill? + degree : (%,VarSet) -> NonNegativeInteger degree(p,mvar) == p case R => 0 mvar= p.v => degree p.ts mvar > p.v => 0 -- might as well take advantage of the order max(degree(leadingCoefficient p.ts,mvar),degree(red p,mvar)) + degree : (%,List(VarSet)) -> List(NonNegativeInteger) degree(p,Lvar) == [degree(p,mvar) for mvar in Lvar] + degree : % -> IndexedExponents(VarSet) degree p == p case R => 0 degree(leadingCoefficient(p.ts)) + monomial(degree(p.ts), p.v) + minimumDegree : % -> IndexedExponents(VarSet) minimumDegree p == p case R => 0 md := minimumDegree p.ts minimumDegree(coefficient(p.ts,md)) + monomial(md, p.v) + minimumDegree : (%,VarSet) -> NonNegativeInteger minimumDegree(p,mvar) == p case R => 0 mvar = p.v => minimumDegree p.ts @@ -175007,9 +179574,11 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where zero? (p1:=red p) => md min(md,minimumDegree(p1,mvar)) + monicDivide : (%,%,VarSet) -> Record(quotient: %,remainder: %) minimumDegree(p,Lvar) == [minimumDegree(p,mvar) for mvar in Lvar] + totalDegree : (%,List(VarSet)) -> NonNegativeInteger totalDegree(p, Lvar) == ground? p => 0 null setIntersection(Lvar, variables p) => 0 @@ -175025,6 +179594,7 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where if R has CommutativeRing then + differentiate : (%,VarSet) -> % differentiate(p,mvar) == p case R => 0 mvar=p.v => @@ -175033,15 +179603,18 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where up:=map(x1 +-> differentiate(x1,mvar),p.ts) if ground? up then leadingCoefficient(up) else [p.v,up]$VPoly + leadingCoefficient : % -> R leadingCoefficient(p) == p case R => p leadingCoefficient(leadingCoefficient(p.ts)) + leadingMonomial : % -> % leadingMonomial p == p case R => p monomial(leadingMonomial leadingCoefficient(p.ts), p.v, degree(p.ts)) + reductum : % -> % reductum(p) == p case R => 0 p - leadingMonomial p @@ -175884,18 +180457,23 @@ SparseMultivariateTaylorSeries(Coef,Var,SMP):_ Rep := StS -- Below we use the fact that Rep of PS is Stream SMP. + coefficientes : % -> StS coefficientes(s:%):StS == s::Rep + series : Stream(SMP) -> % series(st:StS):% == st + extend : (%,NonNegativeInteger) -> % extend(x,n) == extend(x,n + 1)$Rep + complete : % -> % complete x == complete(x)$Rep + stream : % -> Rep stream(x:%):Rep == x @ Rep @@ -175911,15 +180489,18 @@ SparseMultivariateTaylorSeries(Coef,Var,SMP):_ ints,s pretend ST Coef)$ST3(NNI,Coef,SMP) -- We can extract a polynomial giving the terms of given total degree + coefficient : (%,NonNegativeInteger) -> SMP coefficient(s,n) == elt(s,n + 1)$Rep -- 1-based indexing for streams -- Here we have to take into account that we reduce the degree of each -- term of the stream by a constant + coefficient : (%,List(Var),List(NonNegativeInteger)) -> % coefficient(s:%,lv:List Var,ln:List NNI):% == map ((z1:SMP):SMP +-> coefficient(z1,lv,ln),rest(s,reduce(_+,ln))) -- the coefficient of a particular monomial: + coefficient : (%,IndexedExponents(Var)) -> Coef coefficient(s:%,m:IndexedExponents Var):Coef == n:=leadingCoefficient(mon:=m) while not zero?(mon:=reductum mon) repeat @@ -175928,18 +180509,23 @@ SparseMultivariateTaylorSeries(Coef,Var,SMP):_ --% creation of series + coerce : Coef -> % coerce(r:Coef) == monom(r::SMP,0)$STT + ?*? : (SMP,%) -> % smp:SMP * p:% == (((smp) * (p @ Rep))$STT) @ % + ?*? : (Coef,%) -> % r:Coef * p:% == (((r::SMP) * (p @ Rep))$STT) @ % + ?*? : (%,Coef) -> % p:% * r:Coef == (((r::SMP) * (p @ Rep))$STT) @ % + mts : SMP -> % mts(p:SMP):% == (uv := mainVariable p) case "failed" => monom(p,0)$STT v := uv :: Var @@ -175950,12 +180536,15 @@ SparseMultivariateTaylorSeries(Coef,Var,SMP):_ up := reductum up s + coerce : SMP -> % coerce(p:SMP) == mts p + coerce : Var -> % coerce(v:Var) == v :: SMP :: % + monomial : (%,Var,NonNegativeInteger) -> % monomial(r:%,v:Var,n:NNI) == r * monom(monomial(1,v,n)$SMP,n)$STT @@ -175982,9 +180571,11 @@ SparseMultivariateTaylorSeries(Coef,Var,SMP):_ nq : L % := [q position$(L Var) (i,vl) for i in nlv] substvar(p,nlv,nq) + csubst : (List(Var),List(Stream(SMP))) -> (SMP -> Stream(SMP)) csubst(vl,q) == (p1:SMP):StS+->sortmfirst(p1,vl,q pretend L(%)) pretend StS + restCheck : StS -> StS restCheck(s:StS):StS == -- checks that stream is null or first element is 0 -- returns empty() or rest of stream @@ -175993,12 +180584,14 @@ SparseMultivariateTaylorSeries(Coef,Var,SMP):_ error "eval: constant coefficient should be 0" rst s + eval : (%,List(Var),List(%)) -> % eval(s:%,v:L Var,q:L %) == #v ^= #q => error "eval: number of variables should equal number of values" nq : L StS := [restCheck(i pretend StS) for i in q] addiag(map(csubst(v,nq),s pretend StS)$ST2(SMP,StS))$STT @ % + substmts : (Var,SMP,%) -> % substmts(v:Var,p:SMP,q:%):% == up := univariate(p,v) ss : % := 0 @@ -176009,6 +180602,7 @@ SparseMultivariateTaylorSeries(Coef,Var,SMP):_ up := reductum up ss + subststream : (Var,SMP,StS) -> StS subststream(v:Var,p:SMP,q:StS):StS== substmts(v,p,q @ %) pretend StS @@ -176016,6 +180610,7 @@ SparseMultivariateTaylorSeries(Coef,Var,SMP):_ comp1(v,r,t)== addiag(map((p1:SMP):StS +-> subststream(v,p1,t),r)$ST2(SMP,StS))$STT + comp : (Var,StS,StS) -> StS comp(v:Var,s:StS,t:StS):StS == delay empty? s => s f := frst s; r : StS := rst s; @@ -176025,103 +180620,135 @@ SparseMultivariateTaylorSeries(Coef,Var,SMP):_ error "eval: constant coefficient should be zero" concat(f,comp1(v,r,rst t)) + eval : (%,Var,%) -> % eval(s:%,v:Var,t:%) == comp(v,s pretend StS,t pretend StS) --% differentiation and integration + differentiate : (%,Var) -> % differentiate(s:%,v:Var):% == empty? s => 0 map((z1:SMP):SMP +-> differentiate(z1,v),rst s) if Coef has Algebra Fraction Integer then + ?**? : (%,Fraction(Integer)) -> % (x:%) ** (r:RN) == powern(r,stream x)$STT + ?*? : (Fraction(Integer),%) -> % (r:RN) * (x:%) == map((z1:SMP):SMP +-> r*z1,stream x)$ST2(SMP,SMP) @ % + ?*? : (%,Fraction(Integer)) -> % (x:%) * (r:RN) == map((z1:SMP):SMP +-> z1*r,stream x)$ST2(SMP,SMP) @ % + exp : % -> % exp x == exp(stream x)$STF + log : % -> % log x == log(stream x)$STF + sin : % -> % sin x == sin(stream x)$STF + cos : % -> % cos x == cos(stream x)$STF + tan : % -> % tan x == tan(stream x)$STF + cot : % -> % cot x == cot(stream x)$STF + sec : % -> % sec x == sec(stream x)$STF + csc : % -> % csc x == csc(stream x)$STF + asin : % -> % asin x == asin(stream x)$STF + acos : % -> % acos x == acos(stream x)$STF + atan : % -> % atan x == atan(stream x)$STF + acot : % -> % acot x == acot(stream x)$STF + asec : % -> % asec x == asec(stream x)$STF + acsc : % -> % acsc x == acsc(stream x)$STF + sinh : % -> % sinh x == sinh(stream x)$STF + cosh : % -> % cosh x == cosh(stream x)$STF + tanh : % -> % tanh x == tanh(stream x)$STF + coth : % -> % coth x == coth(stream x)$STF + sech : % -> % sech x == sech(stream x)$STF + csch : % -> % csch x == csch(stream x)$STF + asinh : % -> % asinh x == asinh(stream x)$STF + acosh : % -> % acosh x == acosh(stream x)$STF + atanh : % -> % atanh x == atanh(stream x)$STF + acoth : % -> % acoth x == acoth(stream x)$STF + asech : % -> % asech x == asech(stream x)$STF + acsch : % -> % acsch x == acsch(stream x)$STF + intsmp : (Var,SMP) -> SMP intsmp(v:Var,p: SMP): SMP == up := univariate(p,v) ss : SMP := 0 @@ -176132,13 +180759,16 @@ SparseMultivariateTaylorSeries(Coef,Var,SMP):_ up := reductum up ss + fintegrate : ((() -> %),Var,Coef) -> % fintegrate(f,v,r) == concat(r::SMP,delay map((z1:SMP):SMP +-> intsmp(v,z1),f() pretend StS)) + integrate : (%,Var,Coef) -> % integrate(s,v,r) == concat(r::SMP,map((z1:SMP):SMP +-> intsmp(v,z1),s pretend StS)) -- If there is more than one term of the same order, group them. + tout : SMP -> OUT tout(p:SMP):OUT == pe := p :: OUT monomial? p => pe @@ -176148,6 +180778,7 @@ SparseMultivariateTaylorSeries(Coef,Var,SMP):_ showAll?: () -> Boolean showAll?() == true + coerce : % -> OutputForm coerce(s:%):OUT == uu := s pretend Stream(SMP) empty? uu => (0$SMP) :: OUT @@ -176172,6 +180803,7 @@ SparseMultivariateTaylorSeries(Coef,Var,SMP):_ SF2==> StreamFunctions2 + ?/? : (%,Coef) -> % p:% / r:Coef == (map((z1:SMP):SMP +-> z1/$SMP r,stream p)$SF2(SMP,SMP)) @ % @@ -177085,60 +181717,94 @@ SparseUnivariateLaurentSeries(Coef,var,cen): Exports == Implementation where Rep := InnerSparseUnivariatePowerSeries(Coef) + variable : % -> Symbol variable x == var - center x == cen + center : % -> Coef + center x == cen + + coerce : Variable(var) -> % coerce(v: Variable(var)) == zero? cen => monomial(1,1) monomial(1,1) + monomial(cen,0) + pole? : % -> Boolean pole? x == negative? order(x,0) --% operations with Taylor series + coerce : SparseUnivariateTaylorSeries(Coef,var,cen) -> % coerce(uts:SUTS) == uts pretend % + taylorIfCan : % -> + Union(SparseUnivariateTaylorSeries(Coef,var,cen),"failed") taylorIfCan uls == pole? uls => "failed" uls pretend SUTS + taylor : % -> SparseUnivariateTaylorSeries(Coef,var,cen) taylor uls == (uts := taylorIfCan uls) case "failed" => error "taylor: Laurent series has a pole" uts :: SUTS + retractIfCan : % -> + Union(SparseUnivariateTaylorSeries(Coef,var,cen),"failed") retractIfCan(x:%):Union(SUTS,"failed") == taylorIfCan x + laurent : (Integer,SparseUnivariateTaylorSeries(Coef,var,cen)) -> % laurent(n,uts) == monomial(1,n) * (uts :: %) - removeZeroes uls == uls + removeZeroes : % -> % + removeZeroes uls == uls + + removeZeroes : (Integer,%) -> % removeZeroes(n,uls) == uls + taylorRep : % -> SparseUnivariateTaylorSeries(Coef,var,cen) taylorRep uls == taylor(monomial(1,-order(uls,0)) * uls) - degree uls == order(uls,0) + degree : % -> Integer + degree uls == order(uls,0) + + numer : % -> SparseUnivariateTaylorSeries(Coef,var,cen) numer uls == taylorRep uls + + denom : % -> SparseUnivariateTaylorSeries(Coef,var,cen) denom uls == monomial(1,(-order(uls,0)) :: NNI)$SUTS + ?*? : (SparseUnivariateTaylorSeries(Coef,var,cen),%) -> % (uts:SUTS) * (uls:%) == (uts :: %) * uls + + ?*? : (%,SparseUnivariateTaylorSeries(Coef,var,cen)) -> % (uls:%) * (uts:SUTS) == uls * (uts :: %) if Coef has Field then + + ?/? : (SparseUnivariateTaylorSeries(Coef,var,cen), + SparseUnivariateTaylorSeries(Coef,var,cen)) -> % (uts1:SUTS) / (uts2:SUTS) == (uts1 :: %) / (uts2 :: %) + recip : % -> Union(%,"failed") recip(uls) == iExquo(1,uls,false) if Coef has IntegralDomain then + + exquo : (%,%) -> Union(%,"failed") uls1 exquo uls2 == iExquo(uls1,uls2,false) if Coef has Field then + + ?/? : (%,%) -> % uls1:% / uls2:% == (q := uls1 exquo uls2) case "failed" => error "quotient cannot be computed" q :: % + differentiate : (%,Variable(var)) -> % differentiate(uls:%,v:Variable(var)) == differentiate uls + ?.? : (%,%) -> % elt(uls1:%,uls2:%) == order(uls2,1) < 1 => error "elt: second argument must have positive order" @@ -177150,6 +181816,8 @@ SparseUnivariateLaurentSeries(Coef,var,cen): Exports == Implementation where iCompose(uls1,uls2) if Coef has IntegralDomain then + + rationalFunction : (%,Integer) -> Fraction(Polynomial(Coef)) rationalFunction(uls,n) == zero?(e := order(uls,0)) => negative? n => 0 @@ -177159,77 +181827,109 @@ SparseUnivariateLaurentSeries(Coef,var,cen): Exports == Implementation where v := variable(uls) :: RF; c := center(uls) :: P :: RF poly / (v - c) ** ((-e) :: NNI) + rationalFunction : (%,Integer,Integer) -> Fraction(Polynomial(Coef)) rationalFunction(uls,n1,n2) == rationalFunction(truncate(uls,n1,n2),n2) if Coef has Algebra Fraction Integer then + integrate : % -> % integrate uls == zero? coefficient(uls,-1) => error "integrate: series has term of order -1" integrate(uls)$Rep + integrate : (%,Variable(var)) -> % integrate(uls:%,v:Variable(var)) == integrate uls + ?**? : (%,%) -> % (uls1:%) ** (uls2:%) == exp(log(uls1) * uls2) + exp : % -> % exp uls == exp(uls)$EFULS + log : % -> % log uls == log(uls)$EFULS + sin : % -> % sin uls == sin(uls)$EFULS + cos : % -> % cos uls == cos(uls)$EFULS + tan : % -> % tan uls == tan(uls)$EFULS + cot : % -> % cot uls == cot(uls)$EFULS + sec : % -> % sec uls == sec(uls)$EFULS + csc : % -> % csc uls == csc(uls)$EFULS + asin : % -> % asin uls == asin(uls)$EFULS + acos : % -> % acos uls == acos(uls)$EFULS + atan : % -> % atan uls == atan(uls)$EFULS + acot : % -> % acot uls == acot(uls)$EFULS + asec : % -> % asec uls == asec(uls)$EFULS + acsc : % -> % acsc uls == acsc(uls)$EFULS + sinh : % -> % sinh uls == sinh(uls)$EFULS + cosh : % -> % cosh uls == cosh(uls)$EFULS + tanh : % -> % tanh uls == tanh(uls)$EFULS + coth : % -> % coth uls == coth(uls)$EFULS + sech : % -> % sech uls == sech(uls)$EFULS + csch : % -> % csch uls == csch(uls)$EFULS + asinh : % -> % asinh uls == asinh(uls)$EFULS + acosh : % -> % acosh uls == acosh(uls)$EFULS + atanh : % -> % atanh uls == atanh(uls)$EFULS + acoth : % -> % acoth uls == acoth(uls)$EFULS + asech : % -> % asech uls == asech(uls)$EFULS + acsch : % -> % acsch uls == acsch(uls)$EFULS if Coef has CommutativeRing then + ?**? : (%,Fraction(Integer)) -> % (uls:%) ** (r:RN) == cRationalPower(uls,r) else + ?**? : (%,Fraction(Integer)) -> % (uls:%) ** (r:RN) == negative?(ord0 := order(uls,0)) => order := ord0 :: I @@ -177243,6 +181943,7 @@ SparseUnivariateLaurentSeries(Coef,var,cen): Exports == Implementation where --% OutputForms + coerce : % -> OutputForm coerce(uls:%): OUT == st := getStream uls if not(explicitlyEmpty? st or explicitEntries? st) _ @@ -177675,9 +182376,6 @@ SparseUnivariatePolynomial(R:Ring): UnivariatePolynomialCategory(R) with empty?(p) one?(p):Boolean == - not empty? p and (empty? rest p and zero? first(p).k and one? first(p).c) - - one?(p):Boolean == not empty? p and (empty? rest p and zero? first(p).k and (first(p).c = 1)) ground?(p): Boolean == @@ -177950,12 +182648,16 @@ SparseUnivariatePolynomial(R:Ring): UnivariatePolynomialCategory(R) with if R has FieldOfPrimeCharacteristic then + ?**? : (%,PositiveInteger) -> % p ** np == p ** (np pretend NonNegativeInteger) + ?^? : (%,PositiveInteger) -> % p ^ np == p ** (np pretend NonNegativeInteger) + ?^? : (%,NonNegativeInteger) -> % p ^ n == p ** n + ?**? : (%,NonNegativeInteger) -> % p ** n == null p => 0 zero? n => 1 @@ -177984,21 +182686,23 @@ SparseUnivariatePolynomial(R:Ring): UnivariatePolynomialCategory(R) with rn:= rec.remainder y + zero? : % -> Boolean zero?(p): Boolean == empty?(p) - one?(p):Boolean == - not empty? p and (empty? rest p and zero? first(p).k and one? first(p).c) - + one? : % -> Boolean one?(p):Boolean == not empty? p and (empty? rest p and zero? first(p).k and (first(p).c = 1)) + ground? : % -> Boolean ground?(p): Boolean == empty? p or (empty? rest p and zero? first(p).k) + multiplyExponents : (%,NonNegativeInteger) -> % multiplyExponents(p,n) == [ [u.k*n,u.c] for u in p] + divideExponents : (%,NonNegativeInteger) -> Union(%,"failed") divideExponents(p,n) == null p => p m:= (p.first.k :: Integer exquo n::Integer) @@ -178007,6 +182711,7 @@ SparseUnivariatePolynomial(R:Ring): UnivariatePolynomialCategory(R) with u case "failed" => "failed" [[m::Integer::NonNegativeInteger,p.first.c],:u] + karatsubaDivide : (%,NonNegativeInteger) -> Record(quotient: %,remainder: %) karatsubaDivide(p, n) == zero? n => [p, 0] lowp: Rep := p @@ -178019,12 +182724,15 @@ SparseUnivariatePolynomial(R:Ring): UnivariatePolynomialCategory(R) with highp := cons([subtractIfCan(t.k,n)::NonNegativeInteger,t.c]$Term,highp) [ reverse highp, lowp] + shiftRight : (%,NonNegativeInteger) -> % shiftRight(p, n) == [[subtractIfCan(t.k,n)::NonNegativeInteger,t.c]$Term for t in p] + shiftLeft : (%,NonNegativeInteger) -> % shiftLeft(p, n) == [[t.k + n,t.c]$Term for t in p] + pomopo! : (%,R,NonNegativeInteger,%) -> % pomopo!(p1,r,e,p2) == rout:%:= [] for tm in p2 repeat @@ -178038,16 +182746,20 @@ SparseUnivariatePolynomial(R:Ring): UnivariatePolynomialCategory(R) with p1:=p1.rest NRECONC(rout,p1)$Lisp + univariate : % -> SparseUnivariatePolynomial(R) univariate(p:%) == p pretend SparseUnivariatePolynomial(R) + multivariate : (SparseUnivariatePolynomial(R),SingletonAsOrderedSet) -> % multivariate(sup:SparseUnivariatePolynomial(R),v:SingletonAsOrderedSet) == sup pretend % + univariate : (%,SingletonAsOrderedSet) -> SparseUnivariatePolynomial(%) univariate(p:%,v:SingletonAsOrderedSet) == zero? p => 0 monomial(leadingCoefficient(p)::%,degree p) + univariate(reductum p,v) + multivariate : (SparseUnivariatePolynomial(%),SingletonAsOrderedSet) -> % multivariate(supp:SparseUnivariatePolynomial(%),v:SingletonAsOrderedSet) == zero? supp => 0 lc:=leadingCoefficient supp @@ -178058,21 +182770,34 @@ SparseUnivariatePolynomial(R:Ring): UnivariatePolynomialCategory(R) with if R has FiniteFieldCategory and R has PolynomialFactorizationExplicit then RXY ==> SparseUnivariatePolynomial SparseUnivariatePolynomial R + squareFreePolynomial : SparseUnivariatePolynomial(%) -> + Factored(SparseUnivariatePolynomial(%)) if R has PFECAT squareFreePolynomial pp == squareFree(pp)$UnivariatePolynomialSquareFree(%,FP) + factorPolynomial : SparseUnivariatePolynomial(%) -> + Factored(SparseUnivariatePolynomial(%)) if R has PFECAT factorPolynomial pp == (generalTwoFactor(pp pretend RXY)$TwoFactorize(R)) pretend Factored SparseUnivariatePolynomial % + factorSquareFreePolynomial : SparseUnivariatePolynomial(%) -> + Factored(SparseUnivariatePolynomial(%)) if R has PFECAT factorSquareFreePolynomial pp == (generalTwoFactor(pp pretend RXY)$TwoFactorize(R)) pretend Factored SparseUnivariatePolynomial % + gcdPolynomial : (SparseUnivariatePolynomial(%), + SparseUnivariatePolynomial(%)) -> + SparseUnivariatePolynomial(%) if R has GCDDOM gcdPolynomial(pp,qq) == gcd(pp,qq)$FP + factor : % -> Factored(%) factor p == factor(p)$DistinctDegreeFactorize(R,%) + solveLinearPolynomialEquation : (List(SparseUnivariatePolynomial(%)), + SparseUnivariatePolynomial(%)) -> + Union(List(SparseUnivariatePolynomial(%)),"failed") solveLinearPolynomialEquation(lpp,pp) == solveLinearPolynomialEquation(lpp, pp)_ $FiniteFieldSolveLinearPolynomialEquation(R,%,FP) @@ -178080,18 +182805,26 @@ SparseUnivariatePolynomial(R:Ring): UnivariatePolynomialCategory(R) with else if R has PolynomialFactorizationExplicit then import PolynomialFactorizationByRecursionUnivariate(R,%) + solveLinearPolynomialEquation : (List(SparseUnivariatePolynomial(%)), + SparseUnivariatePolynomial(%)) -> + Union(List(SparseUnivariatePolynomial(%)),"failed") solveLinearPolynomialEquation(lpp,pp)== solveLinearPolynomialEquationByRecursion(lpp,pp) + factorPolynomial : SparseUnivariatePolynomial(%) -> + Factored(SparseUnivariatePolynomial(%)) factorPolynomial(pp) == factorByRecursion(pp) + factorSquareFreePolynomial : SparseUnivariatePolynomial(%) -> + Factored(SparseUnivariatePolynomial(%)) factorSquareFreePolynomial(pp) == factorSquareFreeByRecursion(pp) if R has IntegralDomain then if R has approximate then + exquo : (%,%) -> Union(%,"failed") p1 exquo p2 == null p2 => error "Division by 0" p2 = 1 => p1 @@ -178109,6 +182842,7 @@ SparseUnivariatePolynomial(R:Ring): UnivariatePolynomialCategory(R) with else -- R not approximate + exquo : (%,%) -> Union(%,"failed") p1 exquo p2 == null p2 => error "Division by 0" p2 = 1 => p1 @@ -178123,6 +182857,7 @@ SparseUnivariatePolynomial(R:Ring): UnivariatePolynomialCategory(R) with null p1 => reverse(rout)::% -- nreverse? "failed" + fmecg : (%,NonNegativeInteger,R,%) -> % fmecg(p1,e,r,p2) == -- p1 - r * x**e * p2 rout:%:= [] r:= - r @@ -178137,6 +182872,7 @@ SparseUnivariatePolynomial(R:Ring): UnivariatePolynomialCategory(R) with p1:=p1.rest NRECONC(rout,p1)$Lisp + pseudoRemainder : (%,%) -> % pseudoRemainder(p1,p2) == null p2 => error "PseudoDivision by Zero" null p1 => 0 @@ -178151,6 +182887,7 @@ SparseUnivariatePolynomial(R:Ring): UnivariatePolynomialCategory(R) with e1 = 0 => p1 co ** e1 * p1 + toutput : (Term,OutputForm) -> OutputForm toutput(t1:Term,v:OutputForm):OutputForm == t1.k = 0 => t1.c :: OutputForm if t1.k = 1 @@ -178161,14 +182898,17 @@ SparseUnivariatePolynomial(R:Ring): UnivariatePolynomialCategory(R) with ((t1.c :: OutputForm) = (-1$Integer)::OutputForm)@Boolean => - mon t1.c::OutputForm * mon + outputForm : (%,OutputForm) -> OutputForm outputForm(p:%,v:OutputForm) == l: List(OutputForm) l:=[toutput(t,v) for t in p] null l => (0$Integer)::OutputForm -- else FreeModule 0 problems reduce("+",l) + coerce : % -> OutputForm coerce(p:%):OutputForm == outputForm(p, "?"::OutputForm) + ?.? : (%,R) -> R elt(p:%,val:R) == null p => 0$R co:=p.first.c @@ -178177,6 +182917,8 @@ SparseUnivariatePolynomial(R:Ring): UnivariatePolynomialCategory(R) with co:= co * val ** (n - (n:=tm.k)):NonNegativeInteger + tm.c n = 0 => co co * val ** n + + ?.? : (%,%) -> % elt(p:%,val:%) == null p => 0$% coef:% := p.first.c :: % @@ -178186,6 +182928,7 @@ SparseUnivariatePolynomial(R:Ring): UnivariatePolynomialCategory(R) with n = 0 => coef coef * val ** n + monicDivide : (%,%) -> Record(quotient: %,remainder: %) monicDivide(p1:%,p2:%) == null p2 => error "monicDivide: division by 0" leadingCoefficient p2 ^= 1 => error "Divisor Not Monic" @@ -178202,30 +182945,37 @@ SparseUnivariatePolynomial(R:Ring): UnivariatePolynomialCategory(R) with if R has IntegralDomain then + discriminant : % -> R discriminant(p) == discriminant(p)$PseudoRemainderSequence(R,%) + subResultantGcd : (%,%) -> % subResultantGcd(p1,p2) == subResultantGcd(p1,p2)$PseudoRemainderSequence(R,%) + resultant : (%,%) -> R resultant(p1,p2) == resultant(p1,p2)$PseudoRemainderSequence(R,%) if R has GcdDomain then + content : % -> R content(p) == if null p then 0$R else "gcd"/[tm.c for tm in p] --make CONTENT more efficient? + primitivePart : % -> % primitivePart(p) == null p => p ct :=content(p) unitCanonical((p exquo ct)::%) -- exquo present since % is now an IntegralDomain + gcd : (%,%) -> % gcd(p1,p2) == gcdPolynomial(p1 pretend SparseUnivariatePolynomial R, p2 pretend SparseUnivariatePolynomial R) pretend % if R has Field then + divide : (%,%) -> Record(quotient: %,remainder: %) divide( p1, p2) == zero? p2 => error "Division by 0" (p2 = 1) => [p1,0] @@ -178239,6 +182989,7 @@ SparseUnivariatePolynomial(R:Ring): UnivariatePolynomialCategory(R) with p1:=fmecg(p1.rest, rout.first.k, rout.first.c, p2) [reverse_!(rout),p1] + ?/? : (%,R) -> % p / co == inv(co) * p *) @@ -178668,31 +183419,42 @@ SparseUnivariatePolynomialExpressions(R: Ring): Exports == Implementation where if R has TranscendentalFunctionCategory then + log : % -> % log(p: %): % == ground? p => coerce log ground p output(hconcat("log p for p= ", p::OutputForm))$OutputPackage error "SUPTRAFUN: log only defined for elements of the coefficient ring" + exp : % -> % exp(p: %): % == ground? p => coerce exp ground p output(hconcat("exp p for p= ", p::OutputForm))$OutputPackage error "SUPTRAFUN: exp only defined for elements of the coefficient ring" + + sin : % -> % sin(p: %): % == ground? p => coerce sin ground p output(hconcat("sin p for p= ", p::OutputForm))$OutputPackage error "SUPTRAFUN: sin only defined for elements of the coefficient ring" + + asin : % -> % asin(p: %): % == ground? p => coerce asin ground p output(hconcat("asin p for p= ", p::OutputForm))$OutputPackage error "SUPTRAFUN: asin only defined for elements of the coefficient ring" + + cos : % -> % cos(p: %): % == ground? p => coerce cos ground p output(hconcat("cos p for p= ", p::OutputForm))$OutputPackage error "SUPTRAFUN: cos only defined for elements of the coefficient ring" + + acos : % -> % acos(p: %): % == ground? p => coerce acos ground p output(hconcat("acos p for p= ", p::OutputForm))$OutputPackage error "SUPTRAFUN: acos only defined for elements of the coefficient ring" + *) \end{chunk} @@ -179079,29 +183841,40 @@ SparseUnivariatePuiseuxSeries(Coef,var,cen): Exports == Implementation where getExpon: % -> RN getExpon pxs == pxs.expon + variable : % -> Symbol variable x == var - center x == cen + center : % -> Coef + center x == cen + coerce : Variable(var) -> % coerce(v: Variable(var)) == zero? cen => monomial(1,1) monomial(1,1) + monomial(cen,0) + coerce : SparseUnivariateTaylorSeries(Coef,var,cen) -> % coerce(uts:SUTS) == uts :: SULS :: % + retractIfCan : % -> + Union(SparseUnivariateTaylorSeries(Coef,var,cen),"failed") retractIfCan(upxs:%):Union(SUTS,"failed") == (uls := retractIfCan(upxs)@Union(SULS,"failed")) case "failed" => "failed" retractIfCan(uls :: SULS)@Union(SUTS,"failed") if Coef has "*": (Fraction Integer, Coef) -> Coef then + + differentiate : (%,Variable(var)) -> % differentiate(upxs:%,v:Variable(var)) == differentiate upxs if Coef has Algebra Fraction Integer then + + integrate : (%,Variable(var)) -> % integrate(upxs:%,v:Variable(var)) == integrate upxs --% OutputForms + coerce : % -> OutputForm coerce(x:%): OUT == sups : SUPS := laurentRep(x) pretend SUPS st := getStream sups; refer := getRef sups @@ -179312,20 +184085,26 @@ SparseUnivariateSkewPolynomial(R:Ring, sigma:Automorphism R, delta: R -> R): import UnivariateSkewPolynomialCategoryOps(R, %) - x:% * y:% == times(x, y, sigma, delta) + ?*? : (%,%) -> % + x:% * y:% == times(x, y, sigma, delta) + apply : (%,R,R) -> R apply(p, c, r) == apply(p, c, r, sigma, delta) if R has IntegralDomain then + monicLeftDivide : (%,%) -> Record(quotient: %,remainder: %) monicLeftDivide(a, b) == monicLeftDivide(a, b, sigma) + monicRightDivide : (%,%) -> Record(quotient: %,remainder: %) monicRightDivide(a, b) == monicRightDivide(a, b, sigma) if R has Field then + leftDivide : (%,%) -> Record(quotient: %,remainder: %) leftDivide(a, b) == leftDivide(a, b, sigma) + rightDivide : (%,%) -> Record(quotient: %,remainder: %) rightDivide(a, b) == rightDivide(a, b, sigma) *) @@ -180009,29 +184788,40 @@ SparseUnivariateTaylorSeries(Coef,var,cen): Exports == Implementation where getExpon: Term -> Integer getExpon term == term.k + monomial : (Coef,NonNegativeInteger) -> % monomial(coef,expon) == monomial(coef,expon)$Rep + extend : (%,NonNegativeInteger) -> % extend(x,n) == extend(x,n)$Rep + 0 : () -> % 0 == monomial(0,0)$Rep + 1 : () -> % 1 == monomial(1,0)$Rep + recip : % -> Union(%,"failed") recip uts == iExquo(1,uts,true) if Coef has IntegralDomain then + + exquo : (%,%) -> Union(%,"failed") uts1 exquo uts2 == iExquo(uts1,uts2,true) + quoByVar : % -> % quoByVar uts == taylorQuoByVar(uts)$Rep + differentiate : (%,Variable(var)) -> % differentiate(x:%,v:Variable(var)) == differentiate x --% Creation and destruction of series + coerce : Variable(var) -> % coerce(v: Variable(var)) == zero? cen => monomial(1,1) monomial(1,1) + monomial(cen,0) + coerce : UnivariatePolynomial(var,Coef) -> % coerce(p:UP) == zero? p => 0 if not zero? cen then p := p(monomial(1,1)$UP + monomial(cen,0)$UP) @@ -180041,6 +184831,8 @@ SparseUnivariateTaylorSeries(Coef,var,cen): Exports == Implementation where p := reductum p makeSeries(ref plusInfinity(),st) + univariatePolynomial : (%,NonNegativeInteger) -> + UnivariatePolynomial(var,Coef) univariatePolynomial(x,n) == extend(x,n); st := getStream x ans : UP := 0; oldDeg : I := 0; @@ -180053,6 +184845,7 @@ SparseUnivariateTaylorSeries(Coef,var,cen): Exports == Implementation where st := rst st ans + polynomial : (%,NonNegativeInteger) -> Polynomial(Coef) polynomial(x,n) == extend(x,n); st := getStream x ans : P := 0; oldDeg : I := 0; @@ -180065,10 +184858,13 @@ SparseUnivariateTaylorSeries(Coef,var,cen): Exports == Implementation where st := rst st ans + polynomial : (%,NonNegativeInteger,NonNegativeInteger) -> Polynomial(Coef) polynomial(x,n1,n2) == polynomial(truncate(x,n1,n2),n2) - truncate(x,n) == truncate(x,n)$Rep + truncate : (%,NonNegativeInteger) -> % + truncate(x,n) == truncate(x,n)$Rep + truncate : (%,NonNegativeInteger,NonNegativeInteger) -> % truncate(x,n1,n2) == truncate(x,n1,n2)$Rep iCoefficients: (ST,REF,I) -> Stream Coef @@ -180088,10 +184884,12 @@ SparseUnivariateTaylorSeries(Coef,var,cen): Exports == Implementation where concat(0,iCoefficients(x,refer,n + 1)) concat(0,iCoefficients(x,refer,n + 1)) + coefficients : % -> Stream(Coef) coefficients uts == refer := getRef uts; x := getStream uts iCoefficients(x,refer,0) + terms : % -> Stream(Record(k: NonNegativeInteger,c: Coef)) terms uts == terms(uts)$Rep pretend Stream Record(k:NNI,c:Coef) iSeries: (Stream Coef,I,REF) -> ST @@ -180103,6 +184901,7 @@ SparseUnivariateTaylorSeries(Coef,var,cen): Exports == Implementation where zero? (coef := frst st) => iSeries(rst st,n + 1,refer) concat(makeTerm(n,coef),iSeries(rst st,n + 1,refer)) + series : Stream(Coef) -> % series(st:Stream Coef) == refer := ref(-1) makeSeries(refer,iSeries(st,0,refer)) @@ -180113,26 +184912,35 @@ SparseUnivariateTaylorSeries(Coef,var,cen): Exports == Implementation where term : Term := [(frst st).k,(frst st).c] concat(term,nniToI rst st) + series : Stream(Record(k: NonNegativeInteger,c: Coef)) -> % series(st:Stream Record(k:NNI,c:Coef)) == series(nniToI st)$Rep --% Values + variable : % -> Symbol variable x == var - center x == cen + center : % -> Coef + center x == cen + coefficient : (%,NonNegativeInteger) -> Coef coefficient(x,n) == coefficient(x,n)$Rep + ?.? : (%,NonNegativeInteger) -> Coef elt(x:%,n:NonNegativeInteger) == coefficient(x,n) + pole? : % -> Boolean pole? x == false - order x == (order(x)$Rep) :: NNI + order : % -> NonNegativeInteger + order x == (order(x)$Rep) :: NNI + order : (%,NonNegativeInteger) -> NonNegativeInteger order(x,n) == (order(x,n)$Rep) :: NNI --% Composition + ?.? : (%,%) -> % elt(uts1:%,uts2:%) == zero? uts2 => coefficient(uts1,0) :: % not zero? coefficient(uts2,0) => @@ -180143,76 +184951,106 @@ SparseUnivariateTaylorSeries(Coef,var,cen): Exports == Implementation where if Coef has Algebra Fraction Integer then + integrate : (%,Variable(var)) -> % integrate(x:%,v:Variable(var)) == integrate x --% Transcendental functions + ?**? : (%,%) -> % (uts1:%) ** (uts2:%) == exp(log(uts1) * uts2) if Coef has CommutativeRing then + ?**? : (%,Fraction(Integer)) -> % (uts:%) ** (r:RN) == cRationalPower(uts,r) + exp : % -> % exp uts == cExp uts + log : % -> % log uts == cLog uts + sin : % -> % sin uts == cSin uts + cos : % -> % cos uts == cCos uts + tan : % -> % tan uts == cTan uts + cot : % -> % cot uts == cCot uts + sec : % -> % sec uts == cSec uts + csc : % -> % csc uts == cCsc uts + asin : % -> % asin uts == cAsin uts + acos : % -> % acos uts == cAcos uts + atan : % -> % atan uts == cAtan uts + acot : % -> % acot uts == cAcot uts + asec : % -> % asec uts == cAsec uts + acsc : % -> % acsc uts == cAcsc uts + sinh : % -> % sinh uts == cSinh uts + cosh : % -> % cosh uts == cCosh uts + tanh : % -> % tanh uts == cTanh uts + coth : % -> % coth uts == cCoth uts + sech : % -> % sech uts == cSech uts + csch : % -> % csch uts == cCsch uts + asinh : % -> % asinh uts == cAsinh uts + acosh : % -> % acosh uts == cAcosh uts + atanh : % -> % atanh uts == cAtanh uts + acoth : % -> % acoth uts == cAcoth uts + asech : % -> % asech uts == cAsech uts + acsch : % -> % acsch uts == cAcsch uts else - ZERO : SG := "series must have constant coefficient zero" + ZERO : SG := "series must have constant coefficient zero" - ONE : SG := "series must have constant coefficient one" + ONE : SG := "series must have constant coefficient one" NPOWERS : SG := "series expansion has terms of negative degree" + ?**? : (%,Fraction(Integer)) -> % (uts:%) ** (r:RN) == not (coefficient(uts,0) = 1) => error "**: constant coefficient must be one" @@ -180220,129 +185058,156 @@ SparseUnivariateTaylorSeries(Coef,var,cen): Exports == Implementation where ratPow := cPower(uts,r :: Coef) iCompose(ratPow,uts - 1) + exp : % -> % exp uts == zero? coefficient(uts,0) => expx := cExp monomial(1,1) iCompose(expx,uts) error concat("exp: ",ZERO) + log : % -> % log uts == (coefficient(uts,0) = 1) => log1PlusX := cLog(monomial(1,0) + monomial(1,1)) iCompose(log1PlusX,uts - 1) error concat("log: ",ONE) + sin : % -> % sin uts == zero? coefficient(uts,0) => sinx := cSin monomial(1,1) iCompose(sinx,uts) error concat("sin: ",ZERO) + cos : % -> % cos uts == zero? coefficient(uts,0) => cosx := cCos monomial(1,1) iCompose(cosx,uts) error concat("cos: ",ZERO) + tan : % -> % tan uts == zero? coefficient(uts,0) => tanx := cTan monomial(1,1) iCompose(tanx,uts) error concat("tan: ",ZERO) + cot : % -> % cot uts == zero? uts => error "cot: cot(0) is undefined" zero? coefficient(uts,0) => error concat("cot: ",NPOWERS) error concat("cot: ",ZERO) + sec : % -> % sec uts == zero? coefficient(uts,0) => secx := cSec monomial(1,1) iCompose(secx,uts) error concat("sec: ",ZERO) + csc : % -> % csc uts == zero? uts => error "csc: csc(0) is undefined" zero? coefficient(uts,0) => error concat("csc: ",NPOWERS) error concat("csc: ",ZERO) + asin : % -> % asin uts == zero? coefficient(uts,0) => asinx := cAsin monomial(1,1) iCompose(asinx,uts) error concat("asin: ",ZERO) + atan : % -> % atan uts == zero? coefficient(uts,0) => atanx := cAtan monomial(1,1) iCompose(atanx,uts) error concat("atan: ",ZERO) + acos : % -> % acos z == error "acos: acos undefined on this coefficient domain" + acot : % -> % acot z == error "acot: acot undefined on this coefficient domain" + asec : % -> % asec z == error "asec: asec undefined on this coefficient domain" + acsc : % -> % acsc z == error "acsc: acsc undefined on this coefficient domain" + sinh : % -> % sinh uts == zero? coefficient(uts,0) => sinhx := cSinh monomial(1,1) iCompose(sinhx,uts) error concat("sinh: ",ZERO) + cosh : % -> % cosh uts == zero? coefficient(uts,0) => coshx := cCosh monomial(1,1) iCompose(coshx,uts) error concat("cosh: ",ZERO) + tanh : % -> % tanh uts == zero? coefficient(uts,0) => tanhx := cTanh monomial(1,1) iCompose(tanhx,uts) error concat("tanh: ",ZERO) + coth : % -> % coth uts == zero? uts => error "coth: coth(0) is undefined" zero? coefficient(uts,0) => error concat("coth: ",NPOWERS) error concat("coth: ",ZERO) + sech : % -> % sech uts == zero? coefficient(uts,0) => sechx := cSech monomial(1,1) iCompose(sechx,uts) error concat("sech: ",ZERO) + csch : % -> % csch uts == zero? uts => error "csch: csch(0) is undefined" zero? coefficient(uts,0) => error concat("csch: ",NPOWERS) error concat("csch: ",ZERO) + asinh : % -> % asinh uts == zero? coefficient(uts,0) => asinhx := cAsinh monomial(1,1) iCompose(asinhx,uts) error concat("asinh: ",ZERO) + atanh : % -> % atanh uts == zero? coefficient(uts,0) => atanhx := cAtanh monomial(1,1) iCompose(atanhx,uts) error concat("atanh: ",ZERO) + acosh : % -> % acosh uts == error "acosh: acosh undefined on this coefficient domain" + acoth : % -> % acoth uts == error "acoth: acoth undefined on this coefficient domain" + asech : % -> % asech uts == error "asech: asech undefined on this coefficient domain" + acsch : % -> % acsch uts == error "acsch: acsch undefined on this coefficient domain" if Coef has Field then if Coef has Algebra Fraction Integer then + ?**? : (%,Coef) -> % (uts:%) ** (r:Coef) == not (coefficient(uts,1) = 1) => error "**: constant coefficient should be 1" @@ -180350,6 +185215,7 @@ SparseUnivariateTaylorSeries(Coef,var,cen): Exports == Implementation where --% OutputForms + coerce : % -> OutputForm coerce(x:%): OUT == count : NNI := _$streamCount$Lisp extend(x,count) @@ -180641,6 +185507,7 @@ SplitHomogeneousDirectProduct(dimtot,dim1,S) : T == C where Rep:=Vector(S) + lessThanRlex : (%,%,NNI,NNI) -> Boolean lessThanRlex(v1:%,v2:%,low:NNI,high:NNI):Boolean == -- reverse lexicographical ordering n1:S:=0 @@ -180655,6 +185522,7 @@ SplitHomogeneousDirectProduct(dimtot,dim1,S) : T == C where if qelt(v1,i) < qelt(v2,i) then return false false + ? Boolean (v1:% < v2:%):Boolean == lessThanRlex(v1,v2,1,dim1) => true for i in 1..dim1 repeat @@ -180927,68 +185795,90 @@ SplittingNode(V,C) : Exports == Implementation where Rep ==> VTB + rep : % -> Rep rep(n:%):Rep == n pretend Rep + per : Rep -> % per(r:Rep):% == r pretend % + empty : () -> % empty() == per [empty()$V,empty()$C,false]$Rep + empty? : % -> Boolean empty?(n:%) == empty?((rep n).val)$V and empty?((rep n).tower)$C + value : % -> V value(n:%) == (rep n).val + condition : % -> C condition(n:%) == (rep n).tower + status : % -> Boolean status(n:%) == (rep n).flag + construct : (V,C,Boolean) -> % construct(v:V,t:C,b:B) == per [v,t,b]$Rep + construct : (V,C) -> % construct(v:V,t:C) == [v,t,false]$% + construct : Record(val: V,tower: C) -> % construct(vt:VT) == [vt.val,vt.tower]$% + construct : List(Record(val: V,tower: C)) -> List(%) construct(lvt:List VT) == [[vt]$% for vt in lvt] + construct : (V,List(C)) -> List(%) construct(v:V,lt: List C) == [[v,t]$% for t in lt] + copy : % -> % copy(n:%) == per copy rep n + setValue! : (%,V) -> % setValue!(n:%,v:V) == (rep n).val := v n + setCondition! : (%,C) -> % setCondition!(n:%,t:C) == (rep n).tower := t n + setStatus! : (%,Boolean) -> % setStatus!(n:%,b:B) == (rep n).flag := b n + setEmpty! : % -> % setEmpty!(n:%) == (rep n).val := empty()$V (rep n).tower := empty()$C n + infLex? : (%,%,((V,V) -> Boolean),((C,C) -> Boolean)) -> Boolean infLex?(n1,n2,o1,o2) == o1((rep n1).val,(rep n2).val) => true (rep n1).val = (rep n2).val => o2((rep n1).tower,(rep n2).tower) false + subNode? : (%,%,((C,C) -> Boolean)) -> Boolean subNode?(n1,n2,o2) == (rep n1).val = (rep n2).val => o2((rep n1).tower,(rep n2).tower) false + ?=? : (%,%) -> Boolean n1:% = n2:% == (rep n1).val ~= (rep n2).val => false (rep n1).tower = (rep n2).tower + ?~=? : (%,%) -> Boolean n1:% ~= n2:% == (rep n1).val = (rep n2).val => false (rep n1).tower ~= (rep n2).tower + coerce : % -> OutputForm coerce(n:%):O == l1,l2,l3,l : List O l1 := [message("value == "), ((rep n).val)::O] @@ -181498,26 +186388,35 @@ SplittingTree(V,C) : Exports == Implementation where Rep ==> A + rep : % -> Rep rep(n:%):Rep == n pretend Rep + per : Rep -> % per(r:Rep):% == r pretend % + construct : SplittingNode(V,C) -> % construct(s:S) == per [s,[]]$A + construct : (V,C,List(%)) -> % construct(v:V,t:C,la:List(%)) == per [[v,t]$S,la]$A + construct : (V,C,List(SplittingNode(V,C))) -> % construct(v:V,t:C,ls:List(S)) == per [[v,t]$S,[[s]$% for s in ls]]$A + construct : (V,C,V,List(C)) -> % construct(v1:V,t:C,v2:V,lt:List(C)) == [v1,t,([v2,lt]$S)@(List S)]$% + empty? : % -> Boolean empty?(a:%) == empty?((rep a).root) and empty?((rep a).subTrees) + empty : () -> % empty() == [empty()$S]$% + remove : (SplittingNode(V,C),%) -> % remove(s:S,a:%) == empty? a => a (s = value(a)) and (status(s) = status(value(a))) => empty()$% @@ -181529,6 +186428,7 @@ SplittingTree(V,C) : Exports == Implementation where lb := reverse remove(empty?,lb) [value(value(a)),condition(value(a)),lb]$% + remove! : (SplittingNode(V,C),%) -> % remove!(s:S,a:%) == empty? a => a (s = value(a)) and (status(s) = status(value(a))) => @@ -181543,64 +186443,79 @@ SplittingTree(V,C) : Exports == Implementation where lb := reverse remove(empty()$%,lb) setchildren!(a,lb) + value : % -> SplittingNode(V,C) value(a:%) == (rep a).root + children : % -> List(%) children(a:%) == (rep a).subTrees + leaf? : % -> Boolean leaf?(a:%) == empty? a => false empty? (rep a).subTrees + setchildren! : (%,List(%)) -> % setchildren!(a:%,la:List(%)) == (rep a).subTrees := la a + setvalue! : (%,SplittingNode(V,C)) -> SplittingNode(V,C) setvalue!(a:%,s:S) == (rep a).root := s s + cyclic? : % -> Boolean cyclic?(a:%) == false + map : ((SplittingNode(V,C) -> SplittingNode(V,C)),%) -> % map(foo:(S -> S),a:%) == empty? a => a b : % := [foo(value(a))]$% leaf? a => b setchildren!(b,[map(foo,c) for c in children(a)]) + map! : ((SplittingNode(V,C) -> SplittingNode(V,C)),%) -> % map!(foo:(S -> S),a:%) == empty? a => a setvalue!(a,foo(value(a))) leaf? a => a setchildren!(a,[map!(foo,c) for c in children(a)]) + copy : % -> % copy(a:%) == map(copy,a) + eq? : (%,%) -> Boolean eq?(a1:%,a2:%) == error"in eq? from SPLTREE : la vache qui rit est-elle folle?" + nodes : % -> List(%) nodes(a:%) == empty? a => [] leaf? a => [a] cons(a,concat([nodes(c) for c in children(a)])) + leaves : % -> List(SplittingNode(V,C)) leaves(a:%) == empty? a => [] leaf? a => [value(a)] concat([leaves(c) for c in children(a)]) + members : % -> List(SplittingNode(V,C)) members(a:%) == empty? a => [] leaf? a => [value(a)] cons(value(a),concat([members(c) for c in children(a)])) + #? : % -> NonNegativeInteger #(a:%) == empty? a => 0$NNI leaf? a => 1$NNI reduce("+",[#c for c in children(a)],1$NNI)$(List NNI) + ?=? : (%,%) -> Boolean a1:% = a2:% == empty? a1 => empty? a2 empty? a2 => false @@ -181611,6 +186526,7 @@ SplittingTree(V,C) : Exports == Implementation where value(a1) ~=$S value(a2) => false children(a1) = children(a2) + localCoerce : (%,NNI) -> O localCoerce(a:%,k:NNI):O == s : String if k = 1 then s := "* " else s := "-> " @@ -181621,10 +186537,12 @@ SplittingTree(V,C) : Exports == Implementation where lo := cons(ro,lo) vconcat(lo)$O + coerce : % -> OutputForm coerce(a:%):O == empty? a => vconcat(message(" ")$O,message("* []")$O) vconcat(message(" ")$O,localCoerce(a,1)) + extractSplittingLeaf : % -> Union(%,"failed") extractSplittingLeaf(a:%) == empty? a => "failed"::Union(%,"failed") status(value(a))$S => "failed"::Union(%,"failed") @@ -181636,6 +186554,7 @@ SplittingTree(V,C) : Exports == Implementation where la := rest la "failed"::Union(%,"failed") + updateStatus! : % -> % updateStatus!(a:%) == la := children(a) (empty? la) or (status(value(a))$S) => a @@ -181646,6 +186565,7 @@ SplittingTree(V,C) : Exports == Implementation where setStatus!(value(a),done)$S a + result : % -> List(Record(val: V,tower: C)) result(a:%) == empty? a => [] not status(value(a))$S => @@ -181653,11 +186573,13 @@ SplittingTree(V,C) : Exports == Implementation where ls : List S := leaves(a) [[value(s),condition(s)]$VT for s in ls] + conditions : % -> List(C) conditions(a:%) == empty? a => [] ls : List S := leaves(a) [condition(s) for s in ls] + nodeOf? : (SplittingNode(V,C),%) -> Boolean nodeOf?(s:S,a:%) == empty? a => false s =$S value(a) => true @@ -181666,6 +186588,7 @@ SplittingTree(V,C) : Exports == Implementation where la := rest la not empty? la + subNodeOf? : (SplittingNode(V,C),%,((C,C) -> Boolean)) -> Boolean subNodeOf?(s:S,a:%,sub?:((C,C) -> B)) == empty? a => false -- s =$S value(a) => true @@ -181675,6 +186598,7 @@ SplittingTree(V,C) : Exports == Implementation where la := rest la not empty? la + splitNodeOf! : (%,%,List(SplittingNode(V,C))) -> % splitNodeOf!(l:%,a:%,ls:List(S)) == ln := removeDuplicates ls la : List % := [] @@ -181688,6 +186612,7 @@ SplittingTree(V,C) : Exports == Implementation where if empty? la then (rep l).root := [empty()$V,empty()$C,true]$S updateStatus!(a) + splitNodeOf! : (%,%,List(SplittingNode(V,C)),((C,C) -> Boolean)) -> % splitNodeOf!(l:%,a:%,ls:List(S),sub?:((C,C) -> B)) == ln := removeDuplicates ls la : List % := [] @@ -182810,63 +187735,82 @@ SquareFreeRegularTriangularSet(R,E,V,P) : Exports == Implementation where Rep ==> LP + rep : $ -> Rep rep(s:$):Rep == s pretend Rep + per : Rep -> $ per(l:Rep):$ == l pretend $ + copy : % -> % copy ts == per(copy(rep(ts))$LP) + empty : () -> % empty() == per([]) + empty? : % -> Boolean empty?(ts:$) == empty?(rep(ts)) + parts : % -> List(P) parts ts == rep(ts) + members : % -> List(P) members ts == rep(ts) + map : ((P -> P),%) -> % map (f : PtoP, ts : $) : $ == construct(map(f,rep(ts))$LP)$$ + map! : ((P -> P),%) -> % map! (f : PtoP, ts : $) : $ == construct(map!(f,rep(ts))$LP)$$ + member? : (P,%) -> Boolean member? (p,ts) == member?(p,rep(ts))$LP + unitIdealIfCan : () -> Union($,"failed") unitIdealIfCan() == "failed"::Union($,"failed") + roughUnitIdeal? : % -> Boolean roughUnitIdeal? ts == false + coerce : % -> OutputForm coerce(ts:$) : OutputForm == lp : List(P) := reverse(rep(ts)) brace([p::OutputForm for p in lp]$List(OutputForm))$OutputForm + mvar : % -> V mvar ts == empty? ts => error "mvar$SREGSET: #1 is empty" mvar(first(rep(ts)))$P + first : % -> Union(P,"failed") first ts == empty? ts => "failed"::Union(P,"failed") first(rep(ts))::Union(P,"failed") + last : % -> Union(P,"failed") last ts == empty? ts => "failed"::Union(P,"failed") last(rep(ts))::Union(P,"failed") + rest : % -> Union(%,"failed") rest ts == empty? ts => "failed"::Union($,"failed") per(rest(rep(ts)))::Union($,"failed") + coerce : % -> List(P) coerce(ts:$) : (List P) == rep(ts) + collectUpper : (%,V) -> % collectUpper (ts,v) == empty? ts => ts lp := rep(ts) @@ -182876,6 +187820,7 @@ SquareFreeRegularTriangularSet(R,E,V,P) : Exports == Implementation where lp := rest lp per(reverse(newlp)) + collectUnder : (%,V) -> % collectUnder (ts,v) == empty? ts => ts lp := rep(ts) @@ -182883,6 +187828,7 @@ SquareFreeRegularTriangularSet(R,E,V,P) : Exports == Implementation where lp := rest lp per(lp) + construct : List(P) -> % construct(lp:List(P)) == ts : $ := per([]) empty? lp => ts @@ -182895,6 +187841,7 @@ SquareFreeRegularTriangularSet(R,E,V,P) : Exports == Implementation where lp := rest lp ts + extendIfCan : (%,P) -> Union(%,"failed") extendIfCan(ts:$,p:P) == ground? p => "failed"::Union($,"failed") empty? ts => @@ -182907,6 +187854,7 @@ SquareFreeRegularTriangularSet(R,E,V,P) : Exports == Implementation where (first lts)::Union($,"failed") "failed"::Union($,"failed") + removeZero : (P,%) -> P removeZero(p:P, ts:$): P == (ground? p) or (empty? ts) => p v := mvar(p) @@ -182923,16 +187871,19 @@ SquareFreeRegularTriangularSet(R,E,V,P) : Exports == Implementation where p := tail(p) q + removeZero(p,ts_v_-) + internalAugment : (P,%) -> % internalAugment(p:P,ts:$): $ == -- ASSUME that adding p to ts DOES NOT require any split ground? p => error "in internalAugment$SREGSET: ground? #1" first(internalAugment(p,ts,false,false,false,false,false)) + internalAugment : (List(P),%) -> % internalAugment(lp:List(P),ts:$): $ == -- ASSUME that adding p to ts DOES NOT require any split empty? lp => ts internalAugment(rest lp, internalAugment(first lp, ts)) + internalAugment : (P,%,Boolean,Boolean,Boolean,Boolean,Boolean) -> List(%) internalAugment(p:P,ts:$,rem?:B,red?:B,prim?:B,sqfr?:B,extend?:B):Split == -- ASSUME p is not a constant -- ASSUME mvar(p) is not algebraic w.r.t. ts @@ -182964,6 +187915,7 @@ SquareFreeRegularTriangularSet(R,E,V,P) : Exports == Implementation where extend? => extend(members(ts_v_+),lts) [per(concat(rep(ts_v_+),rep(us))) for us in lts] + augment : (P,%) -> List(%) augment(p:P,ts:$): List $ == ground? p => error "in augment$SREGSET: ground? #1" algebraic?(mvar(p),ts) => error "in augment$SREGSET: bad #1" @@ -182972,6 +187924,7 @@ SquareFreeRegularTriangularSet(R,E,V,P) : Exports == Implementation where -- THUS reduction, mainPrimitivePart and squareFree are NEEDED internalAugment(p,ts,true,true,true,true,true) + extend : (P,%) -> List(%) extend(p:P,ts:$): List $ == ground? p => error "in extend$SREGSET: ground? #1" v := mvar(p) @@ -182982,40 +187935,51 @@ SquareFreeRegularTriangularSet(R,E,V,P) : Exports == Implementation where lts := concat(augment(p,us),lts) lts + invertible? : (P,%) -> Boolean invertible?(p:P,ts:$): Boolean == stoseInvertible?(p,ts)$regsetgcdpack + invertible? : (P,%) -> List(Record(val: Boolean,tower: %)) invertible?(p:P,ts:$): List BWT == stoseInvertible?_sqfreg(p,ts)$regsetgcdpack + invertibleSet : (P,%) -> List(%) invertibleSet(p:P,ts:$): Split == stoseInvertibleSet_sqfreg(p,ts)$regsetgcdpack + lastSubResultant : (P,P,%) -> List(Record(val: P,tower: %)) lastSubResultant(p1:P,p2:P,ts:$): List PWT == stoseLastSubResultant(p1,p2,ts)$regsetgcdpack + squareFreePart : (P,%) -> List(Record(val: P,tower: %)) squareFreePart(p:P, ts: $): List PWT == stoseSquareFreePart(p,ts)$regsetgcdpack + intersect : (P,%) -> List(%) intersect(p:P, ts: $): List($) == decompose([p], [ts], false, false)$regsetdecomppack + intersect : (List(P),List(%)) -> List(%) intersect(lp: LP, lts: List($)): List($) == decompose(lp, lts, false, false)$regsetdecomppack -- SOLVE in the regular zero sense -- and DO NOT PRINT info + decompose : (LP,List($)) -> List($) decompose(lp: LP, lts: List($)): List($) == decompose(lp, lts, true, false)$regsetdecomppack -- SOLVE in the closure sense -- and DO NOT PRINT info + zeroSetSplit : List(P) -> List(%) zeroSetSplit(lp:List(P)) == zeroSetSplit(lp,true,false) -- by default SOLVE in the closure sense -- and DO NOT PRINT info + zeroSetSplit : (List(P),Boolean) -> List(%) zeroSetSplit(lp:List(P), clos?: B) == zeroSetSplit(lp,clos?, false) + zeroSetSplit : (List(P),Boolean,Boolean) -> List(%) zeroSetSplit(lp:List(P), clos?: B, info?: B) == -- if clos? then SOLVE in the closure sense -- if info? then PRINT info @@ -183023,6 +187987,7 @@ SquareFreeRegularTriangularSet(R,E,V,P) : Exports == Implementation where -- and PREPROCESS the input system zeroSetSplit(lp,true,clos?,info?,true) + zeroSetSplit : (List(P),Boolean,Boolean,Boolean,Boolean) -> List(%) zeroSetSplit(lp:List(P),hash?:B,clos?:B,info?:B,prep?:B) == -- if hash? then USE hash-tables -- if info? then PRINT information @@ -183050,7 +188015,8 @@ SquareFreeRegularTriangularSet(R,E,V,P) : Exports == Implementation where stopTableInvSet!()$regsetgcdpack lts - internalZeroSetSplit(lp:LP,clos?:B,info?:B,prep?:B) == + internalZeroSetSplit : (List(P),Boolean,Boolean,Boolean) -> List(%) + internalZeroSetSplit(lp:LP,clos?:B,info?:B,prep?:B) == -- if info? then PRINT information -- if clos? then SOLVE in the closure sense -- if prep? then PREPROCESS the input system @@ -183073,6 +188039,7 @@ SquareFreeRegularTriangularSet(R,E,V,P) : Exports == Implementation where lts := decompose([p],lts, clos?, info?)$regsetdecomppack lts + largeSystem?( : LP -> Boolean largeSystem?(lp:LP): Boolean == -- Gonnet and Gerdt and not Wu-Wang.2 #lp > 16 => true @@ -183080,17 +188047,22 @@ SquareFreeRegularTriangularSet(R,E,V,P) : Exports == Implementation where lts: List($) := [] (#lp :: Z - numberOfVariables(lp,lts)$regsetdecomppack :: Z) > 3 + smallSystem? : LP -> Boolean smallSystem?(lp:LP): Boolean == -- neural, Vermeer, Liu, and not f-633 and not Hairer-2 #lp < 5 + mediumSystem? : LP -> Boolean mediumSystem?(lp:LP): Boolean == -- f-633 and not Hairer-2 lts: List($) := [] (numberOfVariables(lp,lts)$regsetdecomppack :: Z - #lp :: Z) < 2 + lin? : P -> Boolean lin?(p:P):Boolean == ground?(init(p)) and (mdeg(p) = 1) + preprocess : (List(P),Boolean,Boolean) -> + Record(val: List(P),towers: List(%)) pre_process(lp:LP,clos?:B,info?:B): Record(val: LP, towers: Split) == -- if info? then PRINT information -- if clos? then SOLVE in the closure sense @@ -183653,14 +188625,18 @@ SquareMatrix(ndim,R): Exports == Implementation where ZERO := scalarMatrix 0 - 0 == ZERO + 0 : () -> % + 0 == ZERO ONE := scalarMatrix 1 - 1 == ONE + 1 : () -> % + 1 == ONE + characteristic : () -> NonNegativeInteger characteristic() == characteristic()$R + matrix : List(List(R)) -> % matrix(l: List List R) == -- error check: this is a top level function #l ^= ndim => error "matrix: wrong number of rows" @@ -183672,69 +188648,90 @@ SquareMatrix(ndim,R): Exports == Implementation where qsetelt_!(ans,i,j,r) ans pretend $ - row(x,i) == directProduct row(x pretend Matrix(R),i) + row : (%,Integer) -> DirectProduct(ndim,R) + row(x,i) == directProduct row(x pretend Matrix(R),i) + column : (%,Integer) -> DirectProduct(ndim,R) column(x,j) == directProduct column(x pretend Matrix(R),j) + coerce : % -> OutputForm coerce(x:$):OutputForm == coerce(x pretend Matrix R)$Matrix(R) + scalarMatrix : R -> % scalarMatrix r == scalarMatrix(ndim,r)$Matrix(R) pretend $ + diagonalMatrix : List(R) -> % diagonalMatrix l == #l ^= ndim => error "diagonalMatrix: wrong number of entries in list" diagonalMatrix(l)$Matrix(R) pretend $ + coerce : % -> Matrix(R) coerce(x:$):Matrix(R) == copy(x pretend Matrix(R)) + squareMatrix : Matrix(R) -> % squareMatrix x == (nrows(x) ^= ndim) or (ncols(x) ^= ndim) => error "squareMatrix: matrix of bad dimensions" copy(x) pretend $ + ?*? : (%,R) -> % x:$ * v:Col == directProduct((x pretend Matrix(R)) * (v :: Vector(R))) + ?*? : (R,%) -> % v:Row * x:$ == directProduct((v :: Vector(R)) * (x pretend Matrix(R))) + ?**? : (%,NonNegativeInteger) -> % x:$ ** n:NonNegativeInteger == ((x pretend Matrix(R)) ** n) pretend $ if R has commutative("*") then + determinant : % -> R determinant x == determinant(x pretend Matrix(R)) - minordet x == minordet(x pretend Matrix(R)) + minordet : % -> R + minordet x == minordet(x pretend Matrix(R)) if R has EuclideanDomain then + rowEchelon : % -> % rowEchelon x == rowEchelon(x pretend Matrix(R)) pretend $ if R has IntegralDomain then - rank x == rank(x pretend Matrix(R)) + rank : % -> NonNegativeInteger + rank x == rank(x pretend Matrix(R)) + nullity : % -> NonNegativeInteger nullity x == nullity(x pretend Matrix(R)) + nullSpace : % -> List(DirectProduct(ndim,R)) nullSpace x == [directProduct c for c in nullSpace(x pretend Matrix(R))] if R has Field then + dimension : () -> CardinalNumber dimension() == (m * n) :: CardinalNumber + inverse : % -> Union(%,"failed") if R has FIELD inverse x == (u := inverse(x pretend Matrix(R))) case "failed" => "failed" (u :: Matrix(R)) pretend $ + ?**? : (%,Integer) -> % x:$ ** n:Integer == ((x pretend Matrix(R)) ** n) pretend $ + recip : % -> Union(%,"failed") recip x == inverse x if R has ConvertibleTo InputForm then + convert : % -> InputForm convert(x:$):InputForm == convert [convert("squareMatrix"::Symbol)@InputForm, convert(x::Matrix(R))]$List(InputForm) @@ -184587,44 +189584,61 @@ Stack(S:SetCategory): StackAggregate S with Rep := Reference List S + ?=? : (%,%) -> Boolean s = t == deref s = deref t + coerce : % -> OutputForm coerce(d:%): OutputForm == bracket [e::OutputForm for e in deref d] + copy : % -> % copy s == ref copy deref s + depth : % -> NonNegativeInteger depth s == # deref s + #? : % -> NonNegativeInteger # s == depth s + pop! : % -> S pop_! (s:%):S == empty? s => error "empty stack" e := first deref s setref(s,rest deref s) e + extract! : % -> S extract_! (s:%):S == pop_! s + top : % -> S top (s:%):S == empty? s => error "empty stack" first deref s + inspect : % -> S inspect s == top s + push! : (S,%) -> S push_!(e,s) == (setref(s,cons(e,deref s));e) + insert! : (S,%) -> % insert_!(e:S,s:%):% == (push_!(e,s);s) + empty : () -> % empty() == ref nil()$List(S) + empty? : % -> Boolean empty? s == null deref s + stack : List(S) -> % stack s == ref copy s + parts : % -> List(S) parts s == copy deref s + map : ((S -> S),%) -> % map(f,s) == ref map(f,deref s) + map! : ((S -> S),%) -> % map!(f,s) == ref map!(f,deref s) *) @@ -185168,12 +190182,15 @@ StochasticDifferential(R:Join(OrderedSet, IntegralDomain)): Rep:=SparseMultivariatePolynomial(ER,BSD) + ?/? : (%,Expression(R)) -> % (v:% / s:ER):% == inv(s) * v tableQuadVar:Table(%,%) := table() tableDrift:Table(%,%) := table() + alterQuadVar! : (BasicStochasticDifferential, + BasicStochasticDifferential,%) -> Union(%,"failed") alterQuadVar!(da:BSD,db:BSD,dXdY:%):Union(%,"failed") == -- next two lines for security only! 1 < totalDegree(dXdY) => "failed" @@ -185183,12 +190200,14 @@ StochasticDifferential(R:Join(OrderedSet, IntegralDomain)): -- We have to take care here to avoid a bad -- recursion on \axiom{*:(%,%)->%} + alterDrift! : (BasicStochasticDifferential,%) -> Union(%,"failed") alterDrift!(da:BSD,dx:%):Union(%,"failed") == 1 < totalDegree(dx) => "failed" 0 ~= coefficient(dx,degree(1)$Rep) => "failed" not(0::% = (dx*dx)::%) => "failed" setelt(tableDrift,da::Rep,dx)$Table(%,%) + multSDOrError : % -> % multSDOrError(dm:%):% == c := leadingCoefficient dm (dmm := search(dm/c,tableQuadVar)) @@ -185197,6 +190216,7 @@ StochasticDifferential(R:Join(OrderedSet, IntegralDomain)): error "Above product of sd's is not defined" c*dmm + ?*? : (%,%) -> % (dx:% * dy:%) : % == 1 < totalDegree(dx) => print hconcat(message("ERROR IN ")$OF,dx::OF) @@ -185208,13 +190228,16 @@ StochasticDifferential(R:Join(OrderedSet, IntegralDomain)): -- We have to take care here to avoid a bad -- recursion on \axiom{*:(%,%)->%} + ?**? : (%,PositiveInteger) -> % (dx:% ** n:PI) : % == n = 1 => dx n = 2 => dx*dx n > 2 => 0::% + ?^? : (%,PositiveInteger) -> % (dx:% ^ n:PI) : % == dx**n + driftSDOrError : % -> % driftSDOrError(dm:%):% == c := leadingCoefficient dm (dmm := search(dm/c,tableDrift)) @@ -185223,37 +190246,49 @@ StochasticDifferential(R:Join(OrderedSet, IntegralDomain)): error "drift of sd is not defined" c*dmm + drift : % -> % drift(dx:%):% == reduce("+",map(driftSDOrError,monomials(dx)),0) + freeOf? : (%,BasicStochasticDifferential) -> Boolean freeOf?(sd,dX) == (0 = coefficient(sd,dX,1)) + coefficient : (%,BasicStochasticDifferential) -> Expression(R) coefficient(sd:%,dX:BSD):ER == retract(coefficient(sd,dX,1))@ER + listSD : % -> List(BasicStochasticDifferential) listSD(sd) == [retract(dX)@BSD for dX in primitiveMonomials(sd)] + equation : (%,R) -> Union(Equation(%),"failed") equation(dx:%,zero:R):Union(Equation %,"failed") == not(0 = zero) => "failed" equation(dx,0::%) + equation : (R,%) -> Union(Equation(%),"failed") equation(zero:R,dx:%):Union(Equation %,"failed") == not(0 = zero) => "failed" equation(0::%,dx) + copyDrift : () -> Table(%,%) copyDrift() == tableDrift + + copyQuadVar : () -> Table(%,%) copyQuadVar() == tableQuadVar + xDrift : BSD -> OF xDrift(dx:BSD):OF == (xdx := search(dx::Rep,tableDrift)) case "failed" => "?"::OF xdx::OF + xQV : (BSD,BSD) -> OF xQV(dx:BSD,dy:BSD):OF == (xdxdy := search((dx::% * dy::%)$Rep,tableQuadVar)) case "failed" => "?"::Symbol::OF xdxdy::OF + statusIto : () -> OutputForm statusIto():OF == bsd := copyBSD()$BSD bsdo := [dx::OF for dx in bsd] @@ -185269,16 +190304,20 @@ StochasticDifferential(R:Join(OrderedSet, IntegralDomain)): for dy in bsd] matrix(append([head,drift,space],qv))$OF + uncorrelated? : (%,%) -> Boolean uncorrelated?(dx:%,dy:%): Boolean == (0::% = dx*dy) + uncorrelated? : (List(%),List(%)) -> Boolean uncorrelated?(l1:List %,l2:List %): Boolean == reduce("and", [ reduce("and",[uncorrelated?(dx,dy) for dy in l2],true) for dx in l1 ],true) + uncorrelated1? : (List %,List List %) -> Boolean uncorrelated1?(l1:List %,ll:List List %): Boolean == reduce("and",[uncorrelated?(l1,l2) for l2 in ll],true) + uncorrelated? : List(List(%)) -> Boolean uncorrelated?(ll:List List %): Boolean == (0$Integer = # ll) => true (1 = # ll) => true @@ -186352,29 +191391,30 @@ Stream(S): Exports == Implementation where Rep := Record(firstElt: S, restOfStream: %) + explicitlyEmpty? : % -> Boolean explicitlyEmpty? x == EQ(frst x,NullStream)$Lisp - lazy? x == EQ(frst x,NonNullStream)$Lisp + lazy? : % -> Boolean + lazy? x == EQ(frst x,NonNullStream)$Lisp --% signatures of local functions - setfrst_! : (%,S) -> S - setrst_! : (%,%) -> % - setToNil_! : % -> % - setrestt_! : (%,I,%) -> % - lazyEval : % -> % - expand_! : (%,I) -> % --% functions to access or change record fields without lazy evaluation + frst : % -> S frst x == x.firstElt + rst : % -> % rst x == x.restOfStream + setfrst_! : (%,S) -> S setfrst_!(x,s) == x.firstElt := s + setrst_! : (%,%) -> % setrst_!(x,y) == x.restOfStream := y + setToNil_! : % -> % setToNil_! x == -- destructively changes x to a null stream setfrst_!(x,NullStream); setrst_!(x,NIL$Lisp) @@ -186384,10 +191424,7 @@ Stream(S): Exports == Implementation where if S has SetCategory then - getm : (%,L OUT,I) -> L OUT - streamCountCoerce : % -> OUT - listm : (%,L OUT,I) -> L OUT - + getm : (%,L OUT,I) -> L OUT getm(x,le,n) == explicitlyEmpty? x => le lazy? x => @@ -186399,6 +191436,7 @@ Stream(S): Exports == Implementation where n > 0 => getm(rst x,concat(frst(x) :: OUT,le),n - 1) concat(message("..."),le) + streamCountCoerce : % -> OUT streamCountCoerce x == -- this will not necessarily display all stream elements -- which have been computed @@ -186421,6 +191459,7 @@ Stream(S): Exports == Implementation where overbar commaSeparate reverse_! pl bracket reverse_! concat(pp,le) + listm : (%,L OUT,I) -> L OUT listm(x,le,n) == explicitlyEmpty? x => le lazy? x => @@ -186430,6 +191469,7 @@ Stream(S): Exports == Implementation where concat(message("..."),le) listm(rst x,concat(frst(x) :: OUT,le),n-1) + showAllElements : % -> OutputForm showAllElements x == -- this will display all stream elements which have been computed -- and will display at least n elements with n = streamCount$Lisp @@ -186453,10 +191493,12 @@ Stream(S): Exports == Implementation where overbar commaSeparate reverse_! pl bracket reverse_! concat(pp,le) + showAll? : () -> Boolean showAll?() == NULL(_$streamsShowAll$Lisp)$Lisp => false true + coerce : % -> OutputForm coerce(x):OUT == showAll?() => showAllElements x streamCountCoerce x @@ -186468,6 +191510,7 @@ Stream(S): Exports == Implementation where empty? x => empty() concat(frst x, copy rst x) + copy : % -> % copy x == cycElt := cycleElt x cycElt case "failed" => lazyCopy x @@ -186484,6 +191527,7 @@ Stream(S): Exports == Implementation where --% CNAGG functions + construct : List(S) -> % construct l == -- copied from defaults to avoid loading defaults empty? l => empty() @@ -186491,6 +191535,7 @@ Stream(S): Exports == Implementation where --% ELTAGG functions + ?.? : (%,Integer) -> S elt(x:%,n:I) == -- copied from defaults to avoid loading defaults n < MIN or empty? x => error "elt: no such element" @@ -186502,6 +191547,7 @@ Stream(S): Exports == Implementation where n = MIN => setfrst_!(x,s) seteltt(rst x,n - 1,s) + setelt : (%,Integer,S) -> S setelt(x,n:I,s:S) == n < MIN or empty? x => error "setelt: no such element" x := expand_!(x,n - MIN + 1) @@ -186515,6 +191561,7 @@ Stream(S): Exports == Implementation where p(frst x) => remove(p,rst x) concat(frst x,remove(p,rst x)) + remove : ((S -> Boolean),%) -> % remove(p,x) == explicitlyEmpty? x => empty() eq?(x,rst x) => @@ -186528,6 +191575,7 @@ Stream(S): Exports == Implementation where not p(frst x) => select(p, rst x) concat(frst x,select(p,rst x)) + select : ((S -> Boolean),%) -> % select(p,x) == explicitlyEmpty? x => empty() eq?(x,rst x) => @@ -186535,17 +191583,21 @@ Stream(S): Exports == Implementation where empty() selectt(p,x) + map : ((S -> S),%) -> % map(f,x) == map(f,x pretend Stream(S))$StreamFunctions2(S,S) pretend % + map : (((S,S) -> S),%,%) -> % map(g,x,y) == xs := x pretend Stream(S); ys := y pretend Stream(S) map(g,xs,ys)$StreamFunctions3(S,S,S) pretend % + fill! : (%,S) -> % fill_!(x,s) == setfrst_!(x,s) setrst_!(x,x) + map! : ((S -> S),%) -> % map_!(f,x) == -- too many problems with map_! on a lazy stream, so -- in this case, an error message is returned @@ -186563,6 +191615,7 @@ Stream(S): Exports == Implementation where x error "map!: stream with lazy evaluation" + swap! : (%,Integer,Integer) -> Void swap_!(x,m,n) == (not index?(m,x)) or (not index?(n,x)) => error "swap!: no such elements" @@ -186573,19 +191626,23 @@ Stream(S): Exports == Implementation where --% LNAGG functions + concat : (%,S) -> % concat(x:%,s:S) == delay empty? x => concat(s,empty()) concat(frst x,concat(rst x,s)) + concat : (%,%) -> % concat(x:%,y:%) == delay empty? x => copy y concat(frst x,concat(rst x, y)) + concat : List(%) -> % concat l == delay empty? l => empty() empty?(x := first l) => concat rest l concat(frst x,concat(rst x,concat rest l)) + setelt : (%,UniversalSegment(Integer),S) -> S setelt(x,seg:U,s:S) == low := lo seg hasHi seg => @@ -186606,10 +191663,13 @@ Stream(S): Exports == Implementation where --% RCAGG functions + empty : () -> % empty() == [NullStream, NIL$Lisp] + lazyEval : % -> % lazyEval x == (rst(x):(()-> %)) () + lazyEvaluate : % -> % lazyEvaluate x == st := lazyEval x setfrst_!(x, frst st) @@ -186618,6 +191678,7 @@ Stream(S): Exports == Implementation where -- empty? is the only function that explicitly causes evaluation -- of a stream element + empty? : % -> Boolean empty? x == while lazy? x repeat st := lazyEval x @@ -186627,6 +191688,7 @@ Stream(S): Exports == Implementation where --% URAGG functions + first : (%,NonNegativeInteger) -> % first(x,n) == delay -- former name: take n = 0 or empty? x => empty() @@ -186635,6 +191697,7 @@ Stream(S): Exports == Implementation where concat(s:S,x:%) == [s,x] cons(s,x) == concat(s,x) + cycleSplit! : % -> % cycleSplit_! x == cycElt := cycleElt x cycElt case "failed" => @@ -186646,6 +191709,7 @@ Stream(S): Exports == Implementation where eq?(y,z) => (setrest_!(x,empty()); return y) x := z ; z := rst z + expand_! : (%,I) -> % expand_!(x,n) == -- expands cycles (if necessary) so that the first n -- elements of x will not be part of a cycle @@ -186675,32 +191739,41 @@ Stream(S): Exports == Implementation where setrst_!(rest(x,(d-1) :: NNI),y) x + first : % -> S first x == empty? x => error "Can't take the first of an empty stream." frst x + concat! : (%,%) -> % concat_!(x:%,y:%) == empty? x => y setrst_!(tail x,y) + concat! : (%,S) -> % concat_!(x:%,s:S) == concat_!(x,concat(s,empty())) + setrestt_! : (%,I,%) -> % setfirst_!(x,s) == setelt(x,0,s) + setelt : (%,first,S) -> S setelt(x,"first",s) == setfirst_!(x,s) + setrest! : (%,%) -> % setrest_!(x,y) == empty? x => error "setrest!: empty stream" setrst_!(x,y) + setelt : (%,rest,%) -> % setelt(x,"rest",y) == setrest_!(x,y) + setlast! : (%,S) -> S setlast_!(x,s) == empty? x => error "setlast!: empty stream" setfrst_!(tail x, s) setelt(x,"last",s) == setlast_!(x,s) + split! : (%,Integer) -> % split_!(x,n) == n < MIN => error "split!: index out of range" n = MIN => @@ -186717,8 +191790,10 @@ Stream(S): Exports == Implementation where --% STREAM functions + coerce : List(S) -> % coerce(l: L S) == construct l + repeating : List(S) -> % repeating l == empty? l => error "Need a non-null list to make a repeating stream." @@ -186728,6 +191803,7 @@ Stream(S): Exports == Implementation where if S has SetCategory then + repeating? : (List(S),%) -> Boolean repeating?(l, x) == empty? l => error "Need a non-empty? list to make a repeating stream." @@ -186739,6 +191815,9 @@ Stream(S): Exports == Implementation where x := rst x eq?(x,x0) + findCycle : (NonNegativeInteger,%) -> + Record(cycle?: Boolean,prefix: NonNegativeInteger, + period: NonNegativeInteger) findCycle(n, x) == hd := x -- Determine whether periodic within n. @@ -186754,17 +191833,21 @@ Stream(S): Exports == Implementation where while not eq?(x,xp) repeat (x := rst x; xp := rst xp; npp := npp+1) [true, npp, per] + delay : (() -> %) -> % delay(fs:()->%) == [NonNullStream, fs pretend %] + explicitEntries? : % -> Boolean explicitEntries? x == not explicitlyEmpty? x and not lazy? x + numberOfComputedEntries : % -> NonNegativeInteger numberOfComputedEntries x == explicitEntries? x => numberOfComputedEntries(rst x) + 1 0 if S has SetCategory then + output : (Integer,%) -> Void output(n,x) == (not(n>0))or empty? x => void() mathPrint(frst(x)::OUT)$Lisp @@ -186774,18 +191857,22 @@ Stream(S): Exports == Implementation where n = 0 => setrst_!(x,y) setrestt_!(rst x,n-1,y) + setrest! : (%,Integer,%) -> % setrest_!(x,n,y) == n < 0 or empty? x => error "setrest!: no such rest" x := expand_!(x,n+1) setrestt_!(x,n,y) - generate f == delay concat(f(), generate f) + generate : (() -> S) -> % + generate f == delay concat(f(), generate f) gen:(S -> S,S) -> % gen(f,s) == delay(ss:=f s; concat(ss, gen(f,ss))) + generate : ((S -> S),S) -> % generate(f,s)==concat(s,gen(f,s)) + concat : (%,%) -> % concat(x:%,y:%) ==delay empty? x => y concat(frst x,concat(rst x,y)) @@ -186808,6 +191895,7 @@ Stream(S): Exports == Implementation where p(frst x) => concat(frst x,empty()) concat(frst x, filterUntil(p, rst x)) + filterUntil : ((S -> Boolean),%) -> % filterUntil(p,x)== explicitlyEmpty? x => empty() eq?(x,rst x) => @@ -187576,8 +192664,10 @@ String(): StringCategory == IndexedString(1) add (* domain STRING *) (* + string : Integer -> % string n == PRINC_-TO_-STRING(n)$Lisp + OMwrite : % -> String OMwrite(x: %): String == s: String := "" sp := OM_-STRINGTOSTRINGPTR(s)$Lisp @@ -187589,6 +192679,7 @@ String(): StringCategory == IndexedString(1) add s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String s + OMwrite : (%,Boolean) -> String OMwrite(x: %, wholeObj: Boolean): String == s: String := "" sp := OM_-STRINGTOSTRINGPTR(s)$Lisp @@ -187602,11 +192693,13 @@ String(): StringCategory == IndexedString(1) add s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String s + OMwrite : (OpenMathDevice,%) -> Void OMwrite(dev: OpenMathDevice, x: %): Void == OMputObject(dev) OMputString(dev, x pretend String) OMputEndObject(dev) + OMwrite : (OpenMathDevice,%,Boolean) -> Void OMwrite(dev: OpenMathDevice, x: %, wholeObj: Boolean): Void == if wholeObj then OMputObject(dev) @@ -188487,17 +193580,23 @@ SubSpace(n:PI,R:Ring) : Exports == Implementation where TELLWATT : String := "Non-null list: Please inform Tim Daly" + leaf? : % -> Boolean leaf? space == empty? children space + root? : % -> Boolean root? space == (space.levelField = 0$NNI) + internal? : % -> Boolean internal? space == ^(root? space and leaf? space) + new : () -> % new() == [point(empty())$POINT,0,new()$PROP,empty(),empty(),0,_ empty(),empty(),0,0,empty()] + subspace : () -> % subspace() == new() + birth : % -> % birth momma == baby := new() baby.levelField := momma.levelField+1 @@ -188515,13 +193614,17 @@ SubSpace(n:PI,R:Ring) : Exports == Implementation where momma.noChildren := momma.noChildren + 1 baby + child : (%,NonNegativeInteger) -> % child(space,num) == space.childrenField.num + children : % -> List(%) children space == space.childrenField + numberOfChildren : % -> NonNegativeInteger numberOfChildren space == space.noChildren + shallowCopy : % -> % shallowCopy space == node := new() node.pt := space.pt @@ -188535,6 +193638,7 @@ SubSpace(n:PI,R:Ring) : Exports == Implementation where node.noPoints := space.noPoints node + deepCopy : % -> % deepCopy space == node := shallowCopy(space) leaf? space => node @@ -188546,15 +193650,17 @@ SubSpace(n:PI,R:Ring) : Exports == Implementation where node.lastChild := tail node.childrenField node + ------------------ need to worry about reindexing s2 & parentField + merge : (%,%) -> % merge(s1,s2) == - ------------------ need to worry about reindexing s2 & parentField n1 : Rep := deepCopy s1 n2 : Rep := deepCopy s2 n1.childrenField := append(children n1,children n2) n1 + ------------------ need to worry about reindexing & parentField + merge : List(%) -> % merge listOfSpaces == - ------------------ need to worry about reindexing & parentField empty? listOfSpaces => error "empty list passed as argument to merge" -- notice that the properties of the first subspace on the -- list are the ones that are inherited...hmmmm... @@ -188566,8 +193672,9 @@ SubSpace(n:PI,R:Ring) : Exports == Implementation where append(space.childrenField,[deepCopy c for c in s.childrenField]) space + ------------------ need to worry about reindexing & parentField + separate : % -> List(%) separate space == - ------------------ need to worry about reindexing & parentField spaceList := empty() for s in space.childrenField repeat spc:=shallowCopy space @@ -188575,6 +193682,7 @@ SubSpace(n:PI,R:Ring) : Exports == Implementation where spaceList := cons(spc,spaceList) spaceList + addPoint : (%,List(NonNegativeInteger),Point(R)) -> % addPoint(space:%,path:List NNI,point:POINT) == if not empty?(lastPt := space.lastPoint) then not empty? rest lastPt => error TELLWATT @@ -188598,6 +193706,7 @@ SubSpace(n:PI,R:Ring) : Exports == Implementation where node.index := which space + addPoint2 : (%,Point(R)) -> % addPoint2(space:%,point:POINT) == if not empty?(lastPt := space.lastPoint) then not empty? rest lastPt => error TELLWATT @@ -188620,6 +193729,7 @@ SubSpace(n:PI,R:Ring) : Exports == Implementation where node.index := which first + addPointLast : (%,%,Point(R),NonNegativeInteger) -> % addPointLast(space:%,node:%, point:POINT, depth:NNI) == if not empty?(lastPt := space.lastPoint) then not empty? rest lastPt => error TELLWATT @@ -188639,6 +193749,7 @@ SubSpace(n:PI,R:Ring) : Exports == Implementation where node.index := which node -- space + addPoint : (%,List(NonNegativeInteger),NonNegativeInteger) -> % addPoint(space:%,path:List NNI,which:NNI) == node := space depth : NNI := 0 @@ -188651,6 +193762,7 @@ SubSpace(n:PI,R:Ring) : Exports == Implementation where node.index := which space + addPoint : (%,Point(R)) -> NonNegativeInteger addPoint(space:%,point:POINT) == root? space => if not empty?(lastPt := space.lastPoint) then @@ -188665,6 +193777,7 @@ SubSpace(n:PI,R:Ring) : Exports == Implementation where space.noPoints := space.noPoints + 1 error "You need to pass a top level SubSpace (level should be zero)" + modifyPoint : (%,List(NonNegativeInteger),Point(R)) -> % modifyPoint(space:%,path:List NNI,point:POINT) == if not empty?(lastPt := space.lastPoint) then not empty? rest lastPt => error TELLWATT @@ -188684,6 +193797,7 @@ SubSpace(n:PI,R:Ring) : Exports == Implementation where node.index := which space + modifyPoint : (%,List(NonNegativeInteger),NonNegativeInteger) -> % modifyPoint(space:%,path:List NNI,which:NNI) == node := space for i in path repeat @@ -188692,12 +193806,14 @@ SubSpace(n:PI,R:Ring) : Exports == Implementation where node.index := which space + modifyPoint : (%,NonNegativeInteger,Point(R)) -> % modifyPoint(space:%,which:NNI,point:POINT) == root? space => space.pointDataField.which := point space error "You need to pass a top level SubSpace (level should be zero)" + closeComponent : (%,List(NonNegativeInteger),Boolean) -> % closeComponent(space,path,val) == node := space for i in path repeat @@ -188705,6 +193821,7 @@ SubSpace(n:PI,R:Ring) : Exports == Implementation where close(node.property,val) space + defineProperty: (%,List(NonNegativeInteger),SubSpaceComponentProperty) -> % defineProperty(space,path,prop) == node := space for i in path repeat @@ -188712,32 +193829,41 @@ SubSpace(n:PI,R:Ring) : Exports == Implementation where node.property := prop space + traverse : (%,List(NonNegativeInteger)) -> % traverse(space,path) == for i in path repeat space := child(space,i) space + extractPoint : % -> Point(R) extractPoint space == node := space while ^root? node repeat node := parent node (node.pointDataField).(space.index) + extractIndex : % -> NonNegativeInteger extractIndex space == space.index + extractClosed : % -> Boolean extractClosed space == closed? space.property + extractProperty : % -> SubSpaceComponentProperty extractProperty space == space.property + parent : % -> % parent space == empty? space.parentField => _ error "This is a top level SubSpace - it does not have a parent" first space.parentField + pointData : % -> List(Point(R)) pointData space == space.pointDataField + level : % -> NonNegativeInteger level space == space.levelField + ------------ extra checks for list of point data + ?=? : (%,%) -> Boolean s1 = s2 == - ------------ extra checks for list of point data (leaf? s1 and leaf? s2) => (s1.pt = s2.pt) and (s1.property = s2.property) _ and (s1.levelField = s2.levelField) @@ -188746,6 +193872,7 @@ SubSpace(n:PI,R:Ring) : Exports == Implementation where and/[c1 = c2 for c1 in s1.childrenField for c2 in s2.childrenField] and (s1.property = s2.property) and (s1.levelField = s2.levelField) + coerce : % -> OutputForm coerce(space:%):O == hconcat([n::O,"-Space with depth of "::O, _ (n - space.levelField)::O," and "::O,(s:=(#space.childrenField))::O, _ @@ -188888,22 +194015,29 @@ SubSpaceComponentProperty() : Exports == Implementation where Rep := Record(closed:B, solid:B) + closed? : % -> Boolean closed? p == p.closed + solid? : % -> Boolean solid? p == p.solid + close : (%,Boolean) -> Boolean close(p,b) == p.closed := b + solid : (%,Boolean) -> Boolean solid(p,b) == p.solid := b + new : () -> % new() == [false,false] + copy : % -> % copy p == annuderOne := new() close(annuderOne,closed? p) solid(annuderOne,solid? p) annuderOne + coerce : % -> OutputForm coerce p == hconcat(["Component is "::O, (closed? p => ""::O; "not "::O),"closed, "::O, _ @@ -189016,12 +194150,16 @@ SuchThat(S1, S2): Cat == Capsule where Rep := Record(obj: S1, cond: S2) + construct : (S1,S2) -> % construct(o, c) == [o, c]$Record(obj: S1, cond: S2) + lhs : % -> S1 lhs st == st.obj + rhs : % -> S2 rhs st == st.cond + coerce : % -> OutputForm coerce(w):E == infix("|"::E, w.obj::E, w.cond::E) *) @@ -189211,6 +194349,7 @@ Switch():public == private where nullOp : BasicOperator := operator NULL + coerce : % -> OutputForm coerce(s:%):OutputForm == rat := (s . op)::OutputForm ran := [u::OutputForm for u in s.rands] @@ -189219,33 +194358,58 @@ Switch():public == private where prefix(rat,ran) infix(rat,ran) + coerce : Symbol -> % coerce(s:Symbol):$ == [nullOp,[[s::Expression(Integer)]$EXPR]$List(EXPR)]$Rep + NOT : Union(I: Expression(Integer),F: Expression(Float), + CF: Expression(Complex(Float)),switch: %) -> % NOT(r:EXPR):% == [operator("~"::Symbol),[r]$List(EXPR)]$Rep + NOT : % -> % NOT(r:%):% == [operator("~"::Symbol),[[r]$EXPR]$List(EXPR)]$Rep + LT : (Union(I: Expression(Integer),F: Expression(Float), + CF: Expression(Complex(Float)),switch: %),Union(I: Expression(Integer), + F: Expression(Float),CF: Expression(Complex(Float)),switch: %)) -> % LT(r1:EXPR,r2:EXPR):% == [operator("<"::Symbol),[r1,r2]$List(EXPR)]$Rep + GT : (Union(I: Expression(Integer),F: Expression(Float), + CF: Expression(Complex(Float)),switch: %),Union(I: Expression(Integer), + F: Expression(Float),CF: Expression(Complex(Float)),switch: %)) -> % GT(r1:EXPR,r2:EXPR):% == [operator(">"::Symbol),[r1,r2]$List(EXPR)]$Rep + LE : (Union(I: Expression(Integer),F: Expression(Float), + CF: Expression(Complex(Float)),switch: %),Union(I: Expression(Integer), + F: Expression(Float),CF: Expression(Complex(Float)),switch: %)) -> % LE(r1:EXPR,r2:EXPR):% == [operator("<="::Symbol),[r1,r2]$List(EXPR)]$Rep + GE : (Union(I: Expression(Integer),F: Expression(Float), + CF: Expression(Complex(Float)),switch: %),Union(I: Expression(Integer), + F: Expression(Float),CF: Expression(Complex(Float)),switch: %)) -> % GE(r1:EXPR,r2:EXPR):% == [operator(">="::Symbol),[r1,r2]$List(EXPR)]$Rep + AND : (Union(I: Expression(Integer),F: Expression(Float), + CF: Expression(Complex(Float)),switch: %),Union(I: Expression(Integer), + F: Expression(Float),CF: Expression(Complex(Float)),switch: %)) -> % AND(r1:EXPR,r2:EXPR):% == [operator("and"::Symbol),[r1,r2]$List(EXPR)]$Rep + OR : (Union(I: Expression(Integer),F: Expression(Float), + CF: Expression(Complex(Float)),switch: %),Union(I: Expression(Integer), + F: Expression(Float),CF: Expression(Complex(Float)),switch: %)) -> % OR(r1:EXPR,r2:EXPR):% == [operator("or"::Symbol),[r1,r2]$List(EXPR)]$Rep + EQ : (Union(I: Expression(Integer),F: Expression(Float), + CF: Expression(Complex(Float)),switch: %),Union(I: Expression(Integer), + F: Expression(Float),CF: Expression(Complex(Float)),switch: %)) -> % EQ(r1:EXPR,r2:EXPR):% == [operator("EQ"::Symbol),[r1,r2]$List(EXPR)]$Rep @@ -190061,11 +195225,13 @@ Symbol(): Exports == Implementation where alphas:String:="abcdefghijklmnopqrstuvwxyz" + writeOMSym : (OpenMathDevice,%) -> Void writeOMSym(dev: OpenMathDevice, x: %): Void == scripted? x => error "Cannot convert a scripted symbol to OpenMath" OMputVariable(dev, x pretend Symbol) + OMwrite : % -> String OMwrite(x: %): String == s: String := "" sp := OM_-STRINGTOSTRINGPTR(s)$Lisp @@ -190077,6 +195243,7 @@ Symbol(): Exports == Implementation where s := OM_-STRINGPTRTOSTRING(sp)$Lisp @ String s + OMwrite : (%,Boolean) -> String OMwrite(x: %, wholeObj: Boolean): String == s: String := "" sp := OM_-STRINGTOSTRINGPTR(s)$Lisp @@ -190090,11 +195257,13 @@ Symbol(): Exports == Implementation where s := OM_-STRINGPTRTOSTRING(sp)$Lisp @ String s + OMwrite : (OpenMathDevice,%) -> Void OMwrite(dev: OpenMathDevice, x: %): Void == OMputObject(dev) writeOMSym(dev, x) OMputEndObject(dev) + OMwrite : (OpenMathDevice,%,Boolean) -> Void OMwrite(dev: OpenMathDevice, x: %, wholeObj: Boolean): Void == if wholeObj then OMputObject(dev) @@ -190106,52 +195275,66 @@ Symbol(): Exports == Implementation where lhd := #hd ord0 := ord char("0")$Character - istring : Integer -> String - syprefix : Scripts -> String - syscripts: Scripts -> L - + convert : % -> InputForm convert(s:%):InputForm == convert(s pretend Symbol)$InputForm - convert(s:%):Symbol == s pretend Symbol + convert : % -> Symbol + convert(s:%):Symbol == s pretend Symbol - coerce(s:String):% == VALUES(INTERN(s)$Lisp)$Lisp + coerce : String -> % + coerce(s:String):% == VALUES(INTERN(s)$Lisp)$Lisp - x = y == EQUAL(x,y)$Lisp + ?=? : (%,%) -> Boolean + x = y == EQUAL(x,y)$Lisp - x < y == GGREATERP(y, x)$Lisp + ? Boolean + x < y == GGREATERP(y, x)$Lisp + coerce : % -> OutputForm coerce(x:%):OutputForm == outputForm(x pretend Symbol) - subscript(sy, lx) == script(sy, [lx, nil, nil(), nil(), nil()]) + subscript : (%,List(OutputForm)) -> % + subscript(sy, lx) == script(sy, [lx, nil, nil(), nil(), nil()]) - elt(sy,lx) == subscript(sy,lx) + ?.? : (%,List(OutputForm)) -> % + elt(sy,lx) == subscript(sy,lx) - superscript(sy, lx) == script(sy,[nil(),lx, nil(), nil(), nil()]) + superscript : (%,List(OutputForm)) -> % + superscript(sy, lx) == script(sy,[nil(),lx, nil(), nil(), nil()]) - argscript(sy, lx) == script(sy,[nil(),nil(), nil(), nil(), lx]) + argscript : (%,List(OutputForm)) -> % + argscript(sy, lx) == script(sy,[nil(),nil(), nil(), nil(), lx]) + patternMatch : (%,Pattern(Integer),PatternMatchResult(Integer,%)) -> + PatternMatchResult(Integer,%) patternMatch(x:%,p:Pattern Integer,l:PatternMatchResult(Integer,%))== (patternMatch(x pretend Symbol, p, l pretend PatternMatchResult(Integer, Symbol))$PatternMatchSymbol(Integer)) pretend PatternMatchResult(Integer, %) + patternMatch : (%,Pattern(Float),PatternMatchResult(Float,%)) -> + PatternMatchResult(Float,%) patternMatch(x:%, p:Pattern Float, l:PatternMatchResult(Float, %)) == (patternMatch(x pretend Symbol, p, l pretend PatternMatchResult(Float, Symbol))$PatternMatchSymbol(Float)) pretend PatternMatchResult(Float, %) + convert : % -> Pattern(Float) convert(x:%):Pattern(Float) == coerce(x pretend Symbol)$Pattern(Float) + convert : % -> Pattern(Integer) convert(x:%):Pattern(Integer) == coerce(x pretend Symbol)$Pattern(Integer) + syprefix : Scripts -> String syprefix sc == ns: List Integer := [#sc.presub, #sc.presup, #sc.sup, #sc.sub] while #ns >= 2 and zero? first ns repeat ns := rest ns concat concat(concat(hd, istring(#sc.args)), [istring n for n in reverse_! ns]) + syscripts: Scripts -> L syscripts sc == all := sc.presub all := concat(sc.presup, all) @@ -190159,6 +195342,7 @@ Symbol(): Exports == Implementation where all := concat(sc.sub, all) concat(all, sc.args) + script : (%,List(List(OutputForm))) -> % script(sy: %, ls: List L) == sc: Scripts := [nil(), nil(), nil(), nil(), nil()] if not null ls then (sc.sub := first ls; ls := rest ls) @@ -190168,16 +195352,21 @@ Symbol(): Exports == Implementation where if not null ls then (sc.args := first ls; ls := rest ls) script(sy, sc) + script : (%,Record(sub: List(OutputForm),sup: List(OutputForm), + presup: List(OutputForm),presub: List(OutputForm), + args: List(OutputForm))) -> % script(sy: %, sc: Scripts) == scripted? sy => error "Cannot add scripts to a scripted symbol" (concat(concat(syprefix sc, string name sy)::%::OutputForm, syscripts sc)) pretend % + string : % -> String string e == not scripted? e => PNAME(e)$Lisp error "Cannot form string from non-atomic symbols." -- Scripts ==> Record(sub:L,sup:L,presup:L,presub:L,args:L) + latex : % -> String latex e == s : String := (PNAME(name e)$Lisp) @ String if #s > 1 and s.1 ^= char "\" then @@ -190232,6 +195421,7 @@ Symbol(): Exports == Implementation where s := concat(s, sc)$String s + anyRadix : (Integer,String) -> String anyRadix(n:Integer,s:String):String == ns:String:="" repeat @@ -190240,11 +195430,13 @@ Symbol(): Exports == Implementation where ns := concat(s.(qr.remainder+minIndex s),ns) if zero?(n) then return ns + new : () -> % new() == sym := anyRadix(count()::Integer,ALPHAS) count() := count() + 1 concat("%",sym)::% + new : % -> % new x == n:Integer := (u := search(x, xcount)) case "failed" => 0 @@ -190261,14 +195453,17 @@ Symbol(): Exports == Implementation where not scripted? x => xx::% script(xx::%,scripts x) + resetNew : () -> Void resetNew() == count() := 0 for k in keys xcount repeat remove_!(k, xcount) void + scripted? : % -> Boolean scripted? sy == not ATOM(sy)$Lisp + name : % -> % name sy == not scripted? sy => sy str := string first list sy @@ -190276,6 +195471,8 @@ Symbol(): Exports == Implementation where not digit?(str.i) => return((str.(i..#str))::%) error "Improper scripted symbol" + scripts : % -> Record(sub: List(OutputForm),sup: List(OutputForm), + presup: List(OutputForm),presub: List(OutputForm),args: List(OutputForm)) scripts sy == not scripted? sy => [nil(), nil(), nil(), nil(), nil()] nscripts: List NonNegativeInteger := [0, 0, 0, 0, 0] @@ -190296,15 +195493,18 @@ Symbol(): Exports == Implementation where [lscripts.m, lscripts.(m+1), lscripts.(m+2), lscripts.(m+3), lscripts.(m+4)] + istring : Integer -> String istring n == n > 9 => error "Can have at most 9 scripts of each kind" istrings.(n + minIndex istrings) + list : % -> List(%) list sy == not scripted? sy => error "Cannot convert a symbol to a list if it is not subscripted" sy pretend List(%) + sample : () -> % sample() == "aSymbol"::% *) @@ -190571,35 +195771,47 @@ SymbolTable() : exports == implementation where Rep := Table(Symbol,FortranType) + coerce : % -> OutputForm coerce(t:$):OFORM == coerce(t)$Rep + coerce : % -> Table(Symbol,FortranType) coerce(t:$):Table(Symbol,FortranType) == t pretend Table(Symbol,FortranType) + symbolTable : List(Record(key: Symbol,entry: FortranType)) -> % symbolTable(l:L Record(key:Symbol,entry:FortranType)):$ == table(l)$Rep + empty : () -> % empty():$ == empty()$Rep + parametersOf : % -> List(Symbol) parametersOf(tab:$):L(Symbol) == keys(tab) + declare! : (Symbol,FortranType,%) -> FortranType declare!(name:Symbol,type:FortranType,tab:$):FortranType == setelt(tab,name,type)$Rep type + declare! : (List(Symbol),FortranType,%) -> FortranType declare!(names:L Symbol,type:FortranType,tab:$):FortranType == for name in names repeat setelt(tab,name,type)$Rep type + fortranTypeOf : (Symbol,%) -> FortranType fortranTypeOf(u:Symbol,tab:$):FortranType == elt(tab,u)$Rep + externalList : % -> List(Symbol) externalList(tab:$):L(Symbol) == [u for u in keys(tab) | external? fortranTypeOf(u,tab)] + typeList : (FortranScalarType,%) -> + List(Union(name: Symbol, + bounds: List(Union(S: Symbol,P: Polynomial(Integer))))) typeList(type:FortranScalarType,tab:$):TL == scalarList := []@TL arrayList := []@TL @@ -190616,6 +195828,8 @@ SymbolTable() : exports == implementation where -- used as an array dimension. append(scalarList,arrayList) + typeLists : % -> List(List(Union(name: Symbol, + bounds: List(Union(S: Symbol,P: Polynomial(Integer)))))) typeList2(type:FortranScalarType,tab:$):TL == tl := []@TL symbolType : Symbol := coerce(type)$FortranScalarType @@ -190629,6 +195843,7 @@ SymbolTable() : exports == implementation where empty? tl => tl cons([symbolType]$TU,tl) + updateList : (SEX,SEX,SEX,SEX) -> SEX updateList(sType:SEX,name:SEX,lDims:SEX,tl:SEX):SEX == l : SEX := ASSOC(sType,tl)$Lisp entry : SEX := if null?(lDims) then name else CONS(name,lDims)$Lisp @@ -190636,6 +195851,7 @@ SymbolTable() : exports == implementation where RPLACD(l,CONS(entry,cdr l)$Lisp)$Lisp tl + newTypeLists : % -> SExpression newTypeLists(tab:$):SEX == tl := []$Lisp for u in keys(tab)$Rep repeat @@ -190649,6 +195865,7 @@ SymbolTable() : exports == implementation where tl := updateList(lType,convert(u)@SEX,convert(lDims)@SEX,tl) tl + typeLists : $ -> L(TL) typeLists(tab:$):L(TL) == fortranTypes := ["real"::FortranScalarType, _ "double precision"::FortranScalarType, _ @@ -190663,19 +195880,23 @@ SymbolTable() : exports == implementation where tl := cons(types,tl)$(L TL) tl + oForm2 : T -> OFORM oForm2(w:T):OFORM == w case S => w.S::OFORM w case P => w.P::OFORM + oForm : TU -> OFORM oForm(v:TU):OFORM == v case name => v.name::OFORM v case bounds => ll : L OFORM := [oForm2(uu) for uu in v.bounds] ll :: OFORM + outForm TL -> L OFORM outForm(t:TL):L OFORM == [oForm(u) for u in t] + printTypes : % -> Void printTypes(tab:$):Void == -- It is important that INTEGER is the first element of this -- list since INTEGER symbols used in type declarations must @@ -190896,6 +196117,7 @@ SymmetricPolynomial(R:Ring) == PolynomialRing(R,Partition) add if R has EntireRing then + ?*? : (%,%) -> % (p1:%) * (p2:%) == null p1 => 0 null p2 => 0 @@ -190908,6 +196130,7 @@ SymmetricPolynomial(R:Ring) == PolynomialRing(R,Partition) add else + ?*? : (%,%) -> % (p1:%) * (p2:%) == null p1 => 0 null p2 => 0 @@ -191532,8 +196755,10 @@ Tableau(S:SetCategory):Exports == Implementation where Rep := L L S + tableau : List(List(S)) -> % tableau(lls:(L L S)) == lls pretend % + listOfLists : % -> List(List(S)) listOfLists(x:%):(L L S) == x pretend (L L S) makeupv : (NNI,L S) -> L OUT @@ -191550,6 +196775,7 @@ Tableau(S:SetCategory):Exports == Implementation where [blankSeparate makeupv(sz,i) for i in lls] pile ll + coerce : % -> OutputForm coerce(x:%):OUT == maketab listOfLists x *) @@ -191828,6 +197054,7 @@ TaylorSeries(Coef): Exports == Implementation where Rep := StS -- Below we use the fact that Rep of PS is Stream SMP. + polynomial : (%,NonNegativeInteger) -> Polynomial(Coef) polynomial(s,n) == sum : SMP := 0 for i in 0..n while not empty? s repeat @@ -192665,8 +197892,6 @@ TexFormat(): public == private where Rep := Record(prolog : L S, TeX : L S, epilog : L S) - -- local variables declarations and definitions - expr: E prec,opPrec: I str: S @@ -192709,51 +197934,30 @@ TexFormat(): public == private where "\cosh","\coth","\csch","\sech","\sinh","\tanh", "\arccos","\arcsin","\arctan","\erf","\ldots","\$","\infty"] - -- local function signatures - - addBraces: S -> S - addBrackets: S -> S - group: S -> S - formatBinary: (S,L E, I) -> S - formatFunction: (S,L E, I) -> S - formatMatrix: L E -> S - formatNary: (S,L E, I) -> S - formatNaryNoGroup: (S,L E, I) -> S - formatNullary: S -> S - formatPlex: (S,L E, I) -> S - formatSpecial: (S,L E, I) -> S - formatUnary: (S, E, I) -> S - formatTex: (E,I) -> S - newWithNum: I -> $ - parenthesize: S -> S - precondition: E -> E - postcondition: S -> S - splitLong: (S,I) -> L S - splitLong1: (S,I) -> L S - stringify: E -> S - ungroup: S -> S - - -- public function definitions - + new : () -> % new() : $ == [["$$"]$(L S), [""]$(L S), ["$$"]$(L S)]$Rep + newWithNum: I -> $ newWithNum(stepNum: I) : $ == num : S := concat(concat("\leqno(",string(stepNum)$S),")")$S [["$$"]$(L S), [""]$(L S), [num,"$$"]$(L S)]$Rep + coerce : OutputForm -> % coerce(expr : E): $ == f : $ := new()$$ f.TeX := [postcondition formatTex(precondition expr, minPrec)]$(L S) f + convert : (OutputForm,Integer) -> % convert(expr : E, stepNum : I): $ == f : $ := newWithNum(stepNum) f.TeX := [postcondition formatTex(precondition expr, minPrec)]$(L S) f + display : (%,Integer) -> Void display(f : $, len : I) == s,t : S for s in f.prolog repeat sayTeX$Lisp s @@ -192762,17 +197966,29 @@ TexFormat(): public == private where for s in f.epilog repeat sayTeX$Lisp s void()$Void + display : % -> Void display(f : $) == display(f, _$LINELENGTH$Lisp pretend I) + prologue : % -> List(String) prologue(f : $) == f.prolog + + tex : % -> List(String) tex(f : $) == f.TeX + + epilogue : % -> List(String) epilogue(f : $) == f.epilog + setPrologue! : (%,List(String)) -> List(String) setPrologue!(f : $, l : L S) == f.prolog := l + + setTex! : (%,List(String)) -> List(String) setTex!(f : $, l : L S) == f.TeX := l + + setEpilogue! : (%,List(String)) -> List(String) setEpilogue!(f : $, l : L S) == f.epilog := l + coerce : % -> OutputForm coerce(f : $): E == s,t : S l : L S := nil @@ -192783,8 +197999,7 @@ TexFormat(): public == private where for s in f.epilog repeat l := concat(s,l) (reverse l) :: E - -- local function definitions - + ungroup: S -> S ungroup(str: S): S == len : I := #str len < 2 => str @@ -192796,6 +198011,7 @@ TexFormat(): public == private where str := str.u str + postcondition: S -> S postcondition(str: S): S == str := ungroup str len : I := #str @@ -192807,37 +198023,35 @@ TexFormat(): public == private where then setelt(str,i,char " ")$S str + stringify: E -> S stringify expr == (mathObject2String$Lisp expr)@S + lineConcat : (S,L S ) -> L S lineConcat( line : S, lines: L S ) : L S == length := #line - if ( length > 0 ) then -- If the last character is a backslash then split at "\ ". -- Reinstate the blank. - if (line.length = char "\" ) then line := concat(line, " ") - -- Remark: for some reason, "\%" at the beginning -- of a line has the "\" erased when printed - if ( line.1 = char "%" ) then line := concat(" \", line) else if ( line.1 = char "\" ) and length > 1 _ and ( line.2 = char "%" ) then line := concat(" ", line) - lines := concat(line,lines)$List(S) lines + splitLong: (S,I) -> L S splitLong(str : S, len : I): L S == -- this blocks into lines if len < 20 then len := _$LINELENGTH$Lisp splitLong1(str, len) + splitLong1: (S,I) -> L S splitLong1(str : S, len : I) == -- We first build the list of lines backwards and then we -- reverse it. - l : List S := nil s : S := "" ls : I := 0 @@ -192851,11 +198065,8 @@ TexFormat(): public == private where l := lineConcat( concat(s,ss), l ) s := "" ls := 0 - lss := #ss - -- place certain tokens on their own lines for clarity - ownLine : Boolean := u : US := segment(1,4)$US (lss > 3) and ("\end" = ss.u) => true @@ -192864,40 +198075,40 @@ TexFormat(): public == private where u := segment(1,6)$US (lss > 5) and (("\right" = ss.u) or ("\begin" = ss.u)) => true false - if ownLine or (ls + lss > len) then if not empty? s then l := lineConcat( s, l ) s := "" ls := 0 - ownLine or lss > len => l := lineConcat( ss, l ) - (lss = 1) and (ss.1 = char "\") => ls := ls + lss + 2 s := concat(s,concat(ss," ")$S)$S - ls := ls + lss + 1 s := concat(s,concat(ss," ")$S)$S - if ls > 0 then l := lineConcat( s, l ) - reverse l + group: S -> S group str == concat ["{",str,"}"] + addBraces: S -> S addBraces str == concat ["\left\{ ",str," \right\}"] + addBrackets: S -> S addBrackets str == concat ["\left[ ",str," \right]"] + parenthesize: S -> S parenthesize str == concat ["\left( ",str," \right)"] + precondition: E -> E precondition expr == outputTran$Lisp expr + formatSpecial: (S,L E, I) -> S formatSpecial(op : S, args : L E, prec : I) : S == arg : E prescript : Boolean := false @@ -192990,6 +198201,7 @@ TexFormat(): public == private where formatTex(first rest args,minPrec),"}"] concat ["not done yet for ",op] + formatPlex: (S,L E, I) -> S formatPlex(op : S, args : L E, prec : I) : S == hold : S p : I := position(op,plexOps) @@ -193001,7 +198213,7 @@ TexFormat(): public == private where op = "SIGMA" => "\sum" op = "SIGMA2" => "\sum" op = "PI" => "\prod" -\getchunk{define PI2} + op = "PI2" => "\prod" op = "INTSIGN" => "\int" op = "INDEFINTEGRAL" => "\int" "????" @@ -193022,6 +198234,7 @@ TexFormat(): public == private where if opPrec < prec then s := parenthesize s group s + formatMatrix: L E -> S formatMatrix(args : L E) : S == -- format for args is [[ROW ...],[ROW ...],[ROW ...]] -- generate string for formatting columns (centered) @@ -193033,13 +198246,16 @@ TexFormat(): public == private where ["\begin{array}",cols,formatNaryNoGroup(" \\ ",args,minPrec), " \end{array} "] + formatFunction: (S,L E, I) -> S formatFunction(op : S, args : L E, prec : I) : S == group concat [op, " ", parenthesize formatNary(",",args,minPrec)] + formatNullary: S -> S formatNullary(op : S) == op = "NOTHING" => "" group concat [op,"()"] + formatUnary: (S, E, I) -> S formatUnary(op : S, arg : E, prec : I) == p : I := position(op,unaryOps) p < 1 => error "unknown Tex unary op" @@ -193049,6 +198265,7 @@ TexFormat(): public == private where op = "-" => s group s + formatBinary: (S,L E, I) -> S formatBinary(op : S, args : L E, prec : I) : S == p : I := position(op,binaryOps) p < 1 => error "unknown Tex binary op" @@ -193072,9 +198289,11 @@ TexFormat(): public == private where opPrec < prec => parenthesize s s + formatNary: (S,L E, I) -> S formatNary(op : S, args : L E, prec : I) : S == group formatNaryNoGroup(op, args, prec) + formatNaryNoGroup: (S,L E, I) -> S formatNaryNoGroup(op : S, args : L E, prec : I) : S == null args => "" p : I := position(op,naryOps) @@ -193094,6 +198313,7 @@ TexFormat(): public == private where opPrec < prec => parenthesize s s + formatTex: (E,I) -> S formatTex(expr,prec) == i,len : Integer intSplitLen : Integer := 20 @@ -193139,22 +198359,17 @@ TexFormat(): public == private where op : S := stringify first l args : L E := rest l nargs : I := #args - -- special cases member?(op, specialOps) => formatSpecial(op,args,prec) member?(op, plexOps) => formatPlex(op,args,prec) - -- nullary case 0 = nargs => formatNullary op - -- unary case (1 = nargs) and member?(op, unaryOps) => formatUnary(op, first args, prec) - -- binary case (2 = nargs) and member?(op, binaryOps) => formatBinary(op, args, prec) - -- nary case member?(op,naryNGOps) => formatNaryNoGroup(op,args, prec) member?(op,naryOps) => formatNary(op,args, prec) @@ -193494,38 +198709,46 @@ TextFile: Cat == Def where fileState: FileState, _ fileIOmode: String) - read_! f == readLine_! f + read! : % -> String + read_! f == readLine_! f + readIfCan! : % -> Union(String,"failed") readIfCan_! f == readLineIfCan_! f + readLine! : % -> String readLine_! f == f.fileIOmode ^= "input" => error "File not in read state" s: String := read_-line(f.fileState)$Lisp PLACEP(s)$Lisp => error "End of file" s + readLineIfCan! : % -> Union(String,"failed") readLineIfCan_! f == f.fileIOmode ^= "input" => error "File not in read state" s: String := read_-line(f.fileState)$Lisp PLACEP(s)$Lisp => "failed" s + write! : (%,String) -> String write_!(f, x) == f.fileIOmode ^= "output" => error "File not in write state" PRINC(x, f.fileState)$Lisp x + writeLine! : % -> String writeLine_! f == f.fileIOmode ^= "output" => error "File not in write state" TERPRI(f.fileState)$Lisp "" + writeLine! : (%,String) -> String writeLine_!(f, x) == f.fileIOmode ^= "output" => error "File not in write state" PRINC(x, f.fileState)$Lisp TERPRI(f.fileState)$Lisp x + endOfFile? : % -> Boolean endOfFile? f == f.fileIOmode = "output" => false (EOFP(f.fileState)$Lisp pretend Boolean) => true @@ -193838,105 +199061,132 @@ TheSymbolTable() : Exports == Implementation where currentSubProgramName : Symbol := MAIN + newEntry : () -> Entry newEntry():Entry == construct(empty()$SymbolTable,["void"]$FSTU,[]::List(Symbol))$Entry + checkIfEntryExists : (Symbol,$) -> Void checkIfEntryExists(name:Symbol,tab:$) : Void == key?(name,tab) => void()$Void setelt(tab,name,newEntry())$Rep void()$Void + returnTypeOf : (Symbol,%) -> Union(fst: FortranScalarType,void: void) returnTypeOf(name:Symbol,tab:$):FSTU == elt(elt(tab,name)$Rep,returnType)$Entry + argumentListOf : (Symbol,%) -> List(Symbol) argumentListOf(name:Symbol,tab:$):List(Symbol) == elt(elt(tab,name)$Rep,argList)$Entry + symbolTableOf : (Symbol,%) -> SymbolTable symbolTableOf(name:Symbol,tab:$):SymbolTable == elt(elt(tab,name)$Rep,symtab)$Entry + coerce : % -> OutputForm coerce(u:$):OutputForm == coerce(u)$Rep + showTheSymbolTable : () -> % showTheSymbolTable():$ == theSymbolTable + clearTheSymbolTable : () -> Void clearTheSymbolTable():Void == theSymbolTable := empty()$Rep void()$Void + clearTheSymbolTable : Symbol -> Void clearTheSymbolTable(u:Symbol):Void == remove!(u,theSymbolTable)$Rep void()$Void + empty : () -> % empty():$ == empty()$Rep + currentSubProgram : () -> Symbol currentSubProgram():Symbol == currentSubProgramName -- If we want to support more complex languages then we should keep -- a list of subprograms / blocks - but for the moment lets stick with -- Fortran. + endSubProgram : () -> Symbol endSubProgram():Symbol == currentSubProgramName := MAIN + newSubProgram : Symbol -> Void newSubProgram(u:Symbol):Void == setelt(theSymbolTable,u,newEntry())$Rep currentSubProgramName := u void()$Void + argumentList! : (Symbol,List(Symbol),%) -> Void argumentList!(u:Symbol,args:List Symbol,symbols:$):Void == checkIfEntryExists(u,symbols) setelt(elt(symbols,u)$Rep,argList,args)$Entry + argumentList! : (Symbol,List(Symbol)) -> Void argumentList!(u:Symbol,args:List Symbol):Void == argumentList!(u,args,theSymbolTable) + argumentList! : List(Symbol) -> Void argumentList!(args:List Symbol):Void == checkIfEntryExists(currentSubProgramName,theSymbolTable) setelt(elt(theSymbolTable,currentSubProgramName)$Rep, _ argList,args)$Entry + returnType! : (Symbol,Union(fst: FortranScalarType,void: void),%) -> Void returnType!(u:Symbol,type:FSTU,symbols:$):Void == checkIfEntryExists(u,symbols) setelt(elt(symbols,u)$Rep,returnType,type)$Entry + returnType! : (Symbol,Union(fst: FortranScalarType,void: void)) -> Void returnType!(u:Symbol,type:FSTU):Void == returnType!(u,type,theSymbolTable) + returnType! : Union(fst: FortranScalarType,void: void) -> Void returnType!(type:FSTU ):Void == checkIfEntryExists(currentSubProgramName,theSymbolTable) setelt(elt(theSymbolTable,currentSubProgramName)$Rep, _ returnType,type)$Entry + declare! : (Symbol,FortranType) -> FortranType declare!(u:Symbol,type:FortranType):FortranType == declare!(u,type,currentSubProgramName,theSymbolTable) + declare! : (Symbol,FortranType,Symbol,%) -> FortranType declare!(u:Symbol,type:FortranType,asp:Symbol,symbols:$):FortranType == checkIfEntryExists(asp,symbols) declare!(u,type, elt(elt(symbols,asp)$Rep,symtab)$Entry)$SymbolTable + declare! : (List(Symbol),FortranType,Symbol,%) -> FortranType declare!(u:List Symbol,type:FortranType,asp:Symbol,syms:$):FortranType == checkIfEntryExists(asp,syms) declare!(u,type, elt(elt(syms,asp)$Rep,symtab)$Entry)$SymbolTable + declare! : (Symbol,FortranType,Symbol) -> FortranType declare!(u:Symbol,type:FortranType,asp:Symbol):FortranType == checkIfEntryExists(asp,theSymbolTable) declare!(u,type,elt(elt(theSymbolTable,asp)$Rep,symtab)$Entry)$SymbolTable + printHeader : (Symbol,%) -> Void printHeader(u:Symbol,symbols:$):Void == entry := elt(symbols,u)$Rep fortFormatHead(elt(entry,returnType)$Entry::OutputForm,u::OutputForm, _ elt(entry,argList)$Entry::OutputForm)$Lisp printTypes(elt(entry,symtab)$Entry)$SymbolTable + printHeader : Symbol -> Void printHeader(u:Symbol):Void == printHeader(u,theSymbolTable) + printHeader : () -> Void printHeader():Void == printHeader(currentSubProgramName,theSymbolTable) + printTypes : Symbol -> Void printTypes(u:Symbol):Void == printTypes(elt(elt(theSymbolTable,u)$Rep,symtab)$Entry)$SymbolTable @@ -194343,6 +199593,7 @@ ThreeDimensionalMatrix(R) : Exports == Implementation where -- function to concatenate two matrices -- the first argument must be a symbol, which is either i,j or k -- to specify the direction in which the concatenation is to take place + matrixConcat3D : (Symbol,%,%) -> % matrixConcat3D(dir : Symbol,mat1 : $,mat2 : $) : $ == ^((dir = (i::Symbol)) or (dir = (j::Symbol)) or (dir = (k::Symbol)))_ => error "the axis of concatenation must be i,j or k" @@ -194357,7 +199608,6 @@ ThreeDimensionalMatrix(R) : Exports == Implementation where matRep1 : (PA PA PA R) := copy(mat1 :: (PA PA PA R))$(PA PA PA R) matRep2 : (PA PA PA R) := copy(mat2 :: (PA PA PA R))$(PA PA PA R) retVal : $ - if (dir = (i::Symbol)) then -- j,k dimensions must agree if (^((jDim1 = jDim2) and (kDim1=kDim2))) @@ -194365,7 +199615,6 @@ ThreeDimensionalMatrix(R) : Exports == Implementation where error "jxk do not agree" else retVal := (coerce(concat(matRep1,matRep2)$(PA PA PA R))$$)@$ - if (dir = (j::Symbol)) then -- i,k dimensions must agree if (^((iDim1 = iDim2) and (kDim1=kDim2))) @@ -194376,7 +199625,6 @@ ThreeDimensionalMatrix(R) : Exports == Implementation where setelt(matRep1,i,(concat(elt(matRep1,i)$(PA PA PA R)_ ,elt(matRep2,i)$(PA PA PA R))$(PA PA R))@(PA PA R))$(PA PA PA R) retVal := (coerce(matRep1)$$)@$ - if (dir = (k::Symbol)) then temp : (PA PA R) -- i,j dimensions must agree @@ -194395,6 +199643,7 @@ ThreeDimensionalMatrix(R) : Exports == Implementation where retVal + matrixDimensions : % -> Vector(NonNegativeInteger) matrixDimensions(mat : $) : Vector NNI == matRep : (PA PA PA R) := mat :: (PA PA PA R) iDim : NNI := (#matRep)$(PA PA PA R) @@ -194408,11 +199657,14 @@ ThreeDimensionalMatrix(R) : Exports == Implementation where retVal.3 := kDim retVal + coerce : PrimitiveArray(PrimitiveArray(PrimitiveArray(R))) -> % coerce(matrixRep : (PA PA PA R)) : $ == matrixRep pretend $ + coerce : % -> PrimitiveArray(PrimitiveArray(PrimitiveArray(R))) coerce(mat : $) : (PA PA PA R) == mat pretend (PA PA PA R) -- i,j,k must be with in the bounds of the matrix + elt : (%,NonNegativeInteger,NonNegativeInteger,NonNegativeInteger) -> R elt(mat : $,i : NNI,j : NNI,k : NNI) : R == matDims := matrixDimensions(mat) iLength := matDims.1 @@ -194424,6 +199676,7 @@ ThreeDimensionalMatrix(R) : Exports == Implementation where matrixRep : PA PA PA R := mat :: (PA PA PA R) elt(elt(elt(matrixRep,i-1)$(PA PA PA R),j-1)$(PA PA R),k-1)$(PA R) + setelt!:(%,NonNegativeInteger,NonNegativeInteger,NonNegativeInteger,R) -> R setelt!(mat : $,i : NNI,j : NNI,k : NNI,val : R)_ : R == matDims := matrixDimensions(mat) @@ -194443,11 +199696,14 @@ ThreeDimensionalMatrix(R) : Exports == Implementation where if R has Ring then + zeroMatrix : (NonNegativeInteger,NonNegativeInteger, + NonNegativeInteger) -> % zeroMatrix(iLength:NNI,jLength:NNI,kLength:NNI) : $ == (new(iLength,_ new(jLength,_ new(kLength,(0$R))$(PA R))$(PA PA R))$(PA PA PA R)) :: $ + identityMatrix : NonNegativeInteger -> % identityMatrix(iLength:NNI) : $ == retValueRep : PA PA PA R := _ zeroMatrix(iLength,iLength,iLength)$$ :: (PA PA PA R) @@ -194463,29 +199719,24 @@ ThreeDimensionalMatrix(R) : Exports == Implementation where setelt(retValueRep,count,copy(row2)$(PA PA R))$(PA PA PA R) retValueRep :: $ - + plus : (%,%) -> % plus(mat1 : $,mat2 :$) : $ == - mat1Dims := matrixDimensions(mat1) iLength1 := mat1Dims.1 jLength1 := mat1Dims.2 kLength1 := mat1Dims.3 - mat2Dims := matrixDimensions(mat2) iLength2 := mat2Dims.1 jLength2 := mat2Dims.2 kLength2 := mat2Dims.3 - -- check that the dimensions are the same (^(iLength1 = iLength2) or ^(jLength1 = jLength2) _ or ^(kLength1 = kLength2))_ => error "error the matrices are different sizes" - sum : R row1 : (PA R) := new(kLength1,0$R)$(PA R) row2 : (PA PA R) := new(jLength1,copy(row1)$(PA R))$(PA PA R) row3 : (PA PA PA R) := new(iLength1,copy(row2)$(PA PA R))$(PA PA PA R) - for i in 1..iLength1 repeat for j in 1..jLength1 repeat for k in 1..kLength1 repeat @@ -194494,20 +199745,17 @@ ThreeDimensionalMatrix(R) : Exports == Implementation where setelt(row1,k-1,sum)$(PA R) setelt(row2,j-1,copy(row1)$(PA R))$(PA PA R) setelt(row3,i-1,copy(row2)$(PA PA R))$(PA PA PA R) - resultMatrix := (row3 pretend $) - resultMatrix + construct : List(List(List(R))) -> % construct(listRep : L L L R) : $ == - (#listRep)$(L L L R) = 0 => error "empty list" (#(listRep.1))$(L L R) = 0 => error "empty list" (#((listRep.1).1))$(L R) = 0 => error "empty list" iLength := (#listRep)$(L L L R) jLength := (#(listRep.1))$(L L R) kLength := (#((listRep.1).1))$(L R) - --first check that the matrix is in the correct form for subList in listRep repeat ^((#subList)$(L L R) = jLength) => error_ @@ -194515,11 +199763,9 @@ ThreeDimensionalMatrix(R) : Exports == Implementation where for subSubList in subList repeat ^((#(subSubList))$(L R) = kLength) => error_ "can not have an irregular shaped matrix" - row1 : (PA R) := new(kLength,((listRep.1).1).1)$(PA R) row2 : (PA PA R) := new(jLength,copy(row1)$(PA R))$(PA PA R) row3 : (PA PA PA R) := new(iLength,copy(row2)$(PA PA R))$(PA PA PA R) - for i in 1..iLength repeat for j in 1..jLength repeat for k in 1..kLength repeat @@ -194528,9 +199774,7 @@ ThreeDimensionalMatrix(R) : Exports == Implementation where setelt(row1,k-1,element)$(PA R) setelt(row2,j-1,copy(row1)$(PA R))$(PA PA R) setelt(row3,i-1,copy(row2)$(PA PA R))$(PA PA PA R) - resultMatrix := (row3 pretend $) - resultMatrix *) @@ -195659,6 +200903,7 @@ ThreeDimensionalViewport(): Exports == Implementation where --%Local Functions + checkViewport : % -> B checkViewport (viewport:%):B == -- checks to see if this viewport still exists -- by sending the key to the viewport manager and @@ -195672,6 +200917,7 @@ ThreeDimensionalViewport(): Exports == Implementation where error "This viewport has already been closed!" true + arcsinTemp : SF -> SF arcsinTemp(x:SF):SF == -- the asin function doesn't exist in the SF domain currently -- to avoid floating point error from SF (ie 1.0 -> 1.00001) @@ -195679,8 +200925,10 @@ ThreeDimensionalViewport(): Exports == Implementation where x <= -1 => 3 * pi()$SF / 2 convert(asin(convert(x)@Float)$Float)@SF + arctanTemp : SF -> SF arctanTemp(x:SF):SF == convert(atan(convert(x)@Float)$Float)@SF + doOptions : Rep -> Void doOptions(v:Rep):Void == v.title := title(v.optionsField,"AXIOM3D") st:S := style(v.optionsField,"wireMesh") @@ -195699,6 +200947,7 @@ ThreeDimensionalViewport(): Exports == Implementation where -- etc - 3D specific stuff... --%Exported Functions : Default Settings + viewport3D : () -> % viewport3D() == [0,typeVIEW3D,"AXIOM3D",[viewPosDefault().1,viewPosDefault().2], _ [viewSizeDefault().1,viewSizeDefault().2], _ @@ -195708,32 +200957,39 @@ ThreeDimensionalViewport(): Exports == Implementation where [yes, EYED, HITHER], [0$SF,1$SF,0$SF,1$SF,0$SF,1$SF,no,yes], _ create3Space()$SPACE3, [] ] + subspace : % -> ThreeSpace(DoubleFloat) subspace viewport == viewport.space3D + subspace : (%,ThreeSpace(DoubleFloat)) -> % subspace(viewport,space) == viewport.space3D := space viewport + options : % -> List(DrawOption) options viewport == viewport.optionsField + options : (%,List(DrawOption)) -> % options(viewport,opts) == viewport.optionsField := opts viewport + makeViewport3D : (ThreeSpace(DoubleFloat),String) -> % makeViewport3D(space:SPACE3,Title:S):% == v := viewport3D() v.space3D := space v.optionsField := [title(Title)] makeViewport3D v + makeViewport3D : (ThreeSpace(DoubleFloat),List(DrawOption)) -> % makeViewport3D(space:SPACE3,opts:L DROP):% == v := viewport3D() v.space3D := space v.optionsField := opts makeViewport3D v + makeViewport3D : % -> % makeViewport3D viewport == --local function to extract and assign optional args for 3D viewports doOptions viewport @@ -195820,37 +201076,47 @@ ThreeDimensionalViewport(): Exports == Implementation where viewport -- the key (now set to 0) should be what the viewport returns - viewThetaDefault == convert(defaultTheta())@F + viewThetaDefault == convert(defaultTheta())@F + viewThetaDefault : Float -> Float viewThetaDefault t == defaultTheta() := convert(t)@SF t - viewPhiDefault == convert(defaultPhi())@F + viewThetaDefault : () -> Float + viewPhiDefault == convert(defaultPhi())@F - viewPhiDefault t == + viewPhiDefault : Float -> Float + viewPhiDefault t == defaultPhi() := convert(t)@SF t - viewZoomDefault == convert(defaultZoom())@F + viewZoomDefault : () -> Float + viewZoomDefault == convert(defaultZoom())@F + viewZoomDefault : Float -> Float viewZoomDefault t == defaultZoom() := convert(t)@SF t + viewDeltaXDefault : () -> Float viewDeltaXDefault == convert(defaultDeltaX())@F + viewDeltaXDefault : Float -> Float viewDeltaXDefault t == defaultDeltaX() := convert(t)@SF t + viewDeltaYDefault : () -> Float viewDeltaYDefault == convert(defaultDeltaY())@F + viewDeltaYDefault : Float -> Float viewDeltaYDefault t == defaultDeltaY() := convert(t)@SF t --Exported Functions: Available features for 3D viewports + lighting : (%,Float,Float,Float) -> Void lighting(viewport,Xlight,Ylight,Zlight) == viewport.lighting.lightX := convert(Xlight)@SF viewport.lighting.lightY := convert(Ylight)@SF @@ -195864,6 +201130,7 @@ ThreeDimensionalViewport(): Exports == Implementation where sendSF(VIEW,viewport.lighting.lightZ)$Lisp getI(VIEW)$Lisp -- acknowledge + axes : (%,String) -> Void axes (viewport,onOff) == if onOff = "on" then viewport.flags.axesOn := yes else viewport.flags.axesOn := no @@ -195874,6 +201141,7 @@ ThreeDimensionalViewport(): Exports == Implementation where sendI(VIEW,viewport.flags.axesOn)$Lisp getI(VIEW)$Lisp -- acknowledge + diagonals : (%,String) -> Void diagonals (viewport,onOff) == if onOff = "on" then viewport.flags.diagonalsOn := yes else viewport.flags.diagonalsOn := no @@ -195884,6 +201152,7 @@ ThreeDimensionalViewport(): Exports == Implementation where sendI(VIEW,viewport.flags.diagonalsOn)$Lisp getI(VIEW)$Lisp -- acknowledge + outlineRender : (%,String) -> Void outlineRender (viewport,onOff) == if onOff = "on" then viewport.flags.outlineRenderOn := yes else viewport.flags.outlineRenderOn := no @@ -195894,6 +201163,7 @@ ThreeDimensionalViewport(): Exports == Implementation where sendI(VIEW,viewport.flags.outlineRenderOn)$Lisp getI(VIEW)$Lisp -- acknowledge + controlPanel : (%,String) -> Void controlPanel (viewport,onOff) == if onOff = "on" then viewport.flags.showCP := yes else viewport.flags.showCP := no @@ -195904,6 +201174,7 @@ ThreeDimensionalViewport(): Exports == Implementation where sendI(VIEW,viewport.flags.showCP)$Lisp getI(VIEW)$Lisp -- acknowledge + drawStyle : (%,String) -> Void drawStyle (viewport,how) == if (how = "shade") then -- render viewport.flags.style := rendered @@ -195920,6 +201191,7 @@ ThreeDimensionalViewport(): Exports == Implementation where checkViewport viewport => getI(VIEW)$Lisp -- acknowledge + reset : % -> Void reset viewport == (key(viewport) ^= 0$I) => sendI(VIEW,typeVIEW3D)$Lisp @@ -195928,6 +201200,7 @@ ThreeDimensionalViewport(): Exports == Implementation where sendI(VIEW,RESET)$Lisp getI(VIEW)$Lisp -- acknowledge + close : % -> Void close viewport == (key(viewport) ^= 0$I) => sendI(VIEW,typeVIEW3D)$Lisp @@ -195936,6 +201209,7 @@ ThreeDimensionalViewport(): Exports == Implementation where getI(VIEW)$Lisp -- acknowledge viewport.key := 0$I + viewpoint : % -> V viewpoint (viewport:%):V == (key(viewport) ^= 0$I) => sendI(VIEW,typeVIEW3D)$Lisp @@ -195955,6 +201229,7 @@ ThreeDimensionalViewport(): Exports == Implementation where deltaX_sf, deltaY_sf ] viewport.viewpoint + viewpoint : (%,V) -> Void viewpoint (viewport:%, viewpt:V):Void == viewport.viewpoint := viewpt (key(viewport) ^= 0$I) => @@ -195971,20 +201246,24 @@ ThreeDimensionalViewport(): Exports == Implementation where sendSF(VIEW,viewport.viewpoint.phi)$Lisp getI(VIEW)$Lisp -- acknowledge + viewpoint : (%,Float,Float,Float,Float,Float) -> Void viewpoint (viewport:%,Theta:F,Phi:F,Scale:F,DeltaX:F,DeltaY:F):Void == viewport.viewpoint := [convert(Theta)@SF,convert(Phi)@SF,convert(Scale)@SF,1$SF,1$SF,1$SF,_ convert(DeltaX)@SF,convert(DeltaY)@SF] + viewpoint : (%,Integer,Integer,Float,Float,Float) -> Void viewpoint (viewport:%,Theta:I,Phi:I,Scale:F,DeltaX:F,DeltaY:F):Void == viewport.viewpoint := _ [convert(Theta)@SF * degreesSF,convert(Phi)@SF * degreesSF,_ convert(Scale)@SF,1$SF,1$SF,1$SF,convert(DeltaX)@SF,convert(DeltaY)@SF] + viewpoint : (%,Float,Float) -> Void viewpoint (viewport:%,Theta:F,Phi:F):Void == viewport.viewpoint.theta := convert(Theta)@SF * degreesSF viewport.viewpoint.phi := convert(Phi)@SF * degreesSF + viewpoint : (%,Float,Float,Float) -> Void viewpoint (viewport:%,X:F,Y:F,Z:F):Void == Theta : F Phi : F @@ -196002,6 +201281,7 @@ ThreeDimensionalViewport(): Exports == Implementation where Phi := atan(Z/R) rotate(viewport, Theta * degrees, Phi * degrees) + title : (%,String) -> Void title (viewport,Title) == viewport.title := Title (key(viewport) ^= 0$I) => @@ -196011,6 +201291,7 @@ ThreeDimensionalViewport(): Exports == Implementation where sendSTR(VIEW,Title)$Lisp getI(VIEW)$Lisp -- acknowledge + colorDef : (%,Color,Color) -> Void colorDef (viewport,HueOffset,HueNumber) == viewport.colors := [h := (hue HueOffset),(hue HueNumber) - h] (key(viewport) ^= 0$I) => @@ -196021,10 +201302,13 @@ ThreeDimensionalViewport(): Exports == Implementation where sendI(VIEW,hue HueNumber)$Lisp getI(VIEW)$Lisp -- acknowledge + dimensions : (%,NonNegativeInteger,NonNegativeInteger,PositiveInteger, + PositiveInteger) -> Void dimensions (viewport,ViewX,ViewY,ViewWidth,ViewHeight) == viewport.moveTo := [ViewX,ViewY] viewport.size := [ViewWidth,ViewHeight] + move : (%,NonNegativeInteger,NonNegativeInteger) -> Void move(viewport,xLoc,yLoc) == viewport.moveTo := [xLoc,yLoc] (key(viewport) ^= 0$I) => @@ -196035,6 +201319,7 @@ ThreeDimensionalViewport(): Exports == Implementation where sendI(VIEW,yLoc)$Lisp getI(VIEW)$Lisp -- acknowledge + resize : (%,PositiveInteger,PositiveInteger) -> Void resize(viewport,xSize,ySize) == viewport.size := [xSize,ySize] (key(viewport) ^= 0$I) => @@ -196045,6 +201330,7 @@ ThreeDimensionalViewport(): Exports == Implementation where sendI(VIEW,ySize)$Lisp getI(VIEW)$Lisp -- acknowledge + coerce : % -> OutputForm coerce viewport == (key(viewport) = 0$I) => hconcat @@ -196052,11 +201338,14 @@ ThreeDimensionalViewport(): Exports == Implementation where (viewport.title)::E] hconcat ["ThreeDimensionalViewport: "::E, (viewport.title)::E] + key : % -> Integer key viewport == viewport.key + rotate : (%,Integer,Integer) -> Void rotate(viewport:%,Theta:I,Phi:I) == rotate(viewport,Theta::F * degrees,Phi::F * degrees) + rotate : (%,Float,Float) -> Void rotate(viewport:%,Theta:F,Phi:F) == viewport.viewpoint.theta := convert(Theta)@SF viewport.viewpoint.phi := convert(Phi)@SF @@ -196068,6 +201357,7 @@ ThreeDimensionalViewport(): Exports == Implementation where sendSF(VIEW,viewport.viewpoint.phi)$Lisp getI(VIEW)$Lisp -- acknowledge + zoom : (%,Float) -> Void zoom(viewport:%,Scale:F) == viewport.viewpoint.scale := convert(Scale)@SF (key(viewport) ^= 0$I) => @@ -196077,6 +201367,7 @@ ThreeDimensionalViewport(): Exports == Implementation where sendSF(VIEW,viewport.viewpoint.scale)$Lisp getI(VIEW)$Lisp -- acknowledge + zoom : (%,Float,Float,Float) -> Void zoom(viewport:%,ScaleX:F,ScaleY:F,ScaleZ:F) == viewport.viewpoint.scaleX := convert(ScaleX)@SF viewport.viewpoint.scaleY := convert(ScaleY)@SF @@ -196090,6 +201381,7 @@ ThreeDimensionalViewport(): Exports == Implementation where sendSF(VIEW,viewport.viewpoint.scaleZ)$Lisp getI(VIEW)$Lisp -- acknowledge + translate : (%,Float,Float) -> Void translate(viewport,DeltaX,DeltaY) == viewport.viewpoint.deltaX := convert(DeltaX)@SF viewport.viewpoint.deltaY := convert(DeltaY)@SF @@ -196101,6 +201393,7 @@ ThreeDimensionalViewport(): Exports == Implementation where sendSF(VIEW,viewport.viewpoint.deltaY)$Lisp getI(VIEW)$Lisp -- acknowledge + intensity : (%,Float) -> Void intensity(viewport,Amount) == if (Amount < 0$F) or (Amount > 1$F) then error "The intensity must be a value between 0 and 1, inclusively." @@ -196112,12 +201405,15 @@ ThreeDimensionalViewport(): Exports == Implementation where sendSF(VIEW,viewport.lighting.translucence)$Lisp getI(VIEW)$Lisp -- acknowledge + write : (%,String,String) -> String write(viewport:%,Filename:S,aThingToWrite:S) == write(viewport,Filename,[aThingToWrite]) + write : (%,String) -> String write(viewport,Filename) == write(viewport,Filename,viewWriteDefault()) + write : (%,String,List(String)) -> String write(viewport:%,Filename:S,thingsToWrite:L S) == stringToSend : S := "" (key(viewport) ^= 0$I) => @@ -196137,6 +201433,7 @@ ThreeDimensionalViewport(): Exports == Implementation where getI(VIEW)$Lisp -- acknowledge Filename + perspective : (%,String) -> Void perspective (viewport,onOff) == if onOff = "on" then viewport.perspective.perspectiveField := yes else viewport.perspective.perspectiveField := no @@ -196147,6 +201444,7 @@ ThreeDimensionalViewport(): Exports == Implementation where sendI(VIEW,viewport.perspective.perspectiveField)$Lisp getI(VIEW)$Lisp -- acknowledge + showRegion : (%,String) -> Void showRegion (viewport,onOff) == if onOff = "on" then viewport.flags.showRegionField := yes else viewport.flags.showRegionField := no @@ -196157,6 +201455,7 @@ ThreeDimensionalViewport(): Exports == Implementation where sendI(VIEW,viewport.flags.showRegionField)$Lisp getI(VIEW)$Lisp -- acknowledge + showClipRegion : (%,String) -> Void showClipRegion (viewport,onOff) == if onOff = "on" then viewport.volume.clipRegionField := yes else viewport.volume.clipRegionField := no @@ -196167,6 +201466,7 @@ ThreeDimensionalViewport(): Exports == Implementation where sendI(VIEW,viewport.volume.clipRegionField)$Lisp getI(VIEW)$Lisp -- acknowledge + clipSurface : (%,String) -> Void clipSurface (viewport,onOff) == if onOff = "on" then viewport.volume.clipSurfaceField := yes else viewport.volume.clipSurfaceField := no @@ -196177,6 +201477,7 @@ ThreeDimensionalViewport(): Exports == Implementation where sendI(VIEW,viewport.volume.clipSurfaceField)$Lisp getI(VIEW)$Lisp -- acknowledge + eyeDistance : (%,Float) -> Void eyeDistance(viewport:%,EyeDistance:F) == viewport.perspective.eyeDistance := convert(EyeDistance)@SF (key(viewport) ^= 0$I) => @@ -196186,6 +201487,7 @@ ThreeDimensionalViewport(): Exports == Implementation where sendSF(VIEW,viewport.perspective.eyeDistance)$Lisp getI(VIEW)$Lisp -- acknowledge + hitherPlane : (%,Float) -> Void hitherPlane(viewport:%,HitherPlane:F) == viewport.perspective.hitherPlane := convert(HitherPlane)@SF (key(viewport) ^= 0$I) => @@ -196195,6 +201497,7 @@ ThreeDimensionalViewport(): Exports == Implementation where sendSF(VIEW,viewport.perspective.hitherPlane)$Lisp getI(VIEW)$Lisp -- acknowledge + modifyPointData : (%,NonNegativeInteger,Point(DoubleFloat)) -> Void modifyPointData(viewport,anIndex,aPoint) == (n := dimension aPoint) < 3 => _ error "The point should have dimension of at least 3" @@ -196763,6 +202066,7 @@ ThreeSpace(R:Ring):Exports == Implementation where --% Exported Functions + polygon : (%,List(Point(R))) -> % polygon(space:%,points:L POINT) == #points < 3 => error "You need at least 3 points to define a polygon" @@ -196774,15 +202078,20 @@ ThreeSpace(R:Ring):Exports == Implementation where space.converted := false space + create3Space : () -> % create3Space() == [ new()$SUBSPACE, [], [ [], [], [], [] ], [0,0,0,0], false ] + create3Space : SubSpace(3,R) -> % create3Space(s) == [ s, [], [ [], [], [], [] ], [0,0,0,0], false ] + numberOfComponents : % -> NonNegativeInteger numberOfComponents(space) == #(children((space::Rep).subspaceField)) + numberOfComposites : % -> NonNegativeInteger numberOfComposites(space) == #((space::Rep).compositesField) + merge : List(%) -> % merge(listOfThreeSpaces) == newspace := _ create3Space(merge([ts.subspaceField for ts in listOfThreeSpaces])) @@ -196791,29 +202100,36 @@ ThreeSpace(R:Ring):Exports == Implementation where append(ts.compositesField,newspace.compositesField) newspace + merge : (%,%) -> % merge(s1,s2) == merge([s1,s2]) + composite : List(%) -> % composite(listOfThreeSpaces) == space := create3Space() space.subspaceField := merge [s.subspaceField for s in listOfThreeSpaces] space.compositesField := [deepCopy space.subspaceField] space + components : % -> List(%) components(space) == [create3Space(s) for s in separate space.subspaceField] + composites : % -> List(%) composites(space) == [create3Space(s) for s in space.compositesField] + copy : % -> % copy(space) == spc := create3Space(deepCopy(space.subspaceField)) spc.compositesField := [deepCopy s for s in space.compositesField] spc + enterPointData : (%,List(Point(R))) -> NonNegativeInteger enterPointData(space,listOfPoints) == for p in listOfPoints repeat addPoint(space.subspaceField,p) #(pointData space.subspaceField) + modifyPointData : (%,NonNegativeInteger,Point(R)) -> % modifyPointData(space,i,p) == modifyPoint(space.subspaceField,i,p) space @@ -196826,6 +202142,7 @@ ThreeSpace(R:Ring):Exports == Implementation where -- xxx(s,q) : add an xxx, convertable from q, to a three space, s -- xxx(s,i) : add an xxx, the data for xxx being indexed by reference + point? : % -> Boolean point?(space:%) == #(c:=children space.subspaceField) > 1$NNI => error "This ThreeSpace has more than one component" @@ -196836,27 +202153,33 @@ ThreeSpace(R:Ring):Exports == Implementation where #(children first kid) = 1$NNI false + point : % -> Point(R) point(space:%) == point? space => _ extractPoint(traverse(space.subspaceField,[1,1,1]::L NNI)) error "This ThreeSpace is not a single point - try the objects() command" + point : Point(R) -> % point(aPoint:POINT) == point(create3Space(),aPoint) + point : (%,Point(R)) -> % point(space:%,aPoint:POINT) == addPoint(space.subspaceField,[],aPoint) space.converted := false space + point : (%,List(R)) -> % point(space:%,l:L R) == pt := point(l) point(space,pt) + point : (%,NonNegativeInteger) -> % point(space:%,i:NNI) == addPoint(space.subspaceField,[],i) space.converted := false space + curve? : % -> Boolean curve?(space:%) == #(c:=children space.subspaceField) > 1$NNI => error "This ThreeSpace has more than one component" @@ -196864,14 +202187,17 @@ ThreeSpace(R:Ring):Exports == Implementation where -- there is only one subcomponent, so it's a list of points #(children first c) = 1$NNI + curve : % -> List(Point(R)) curve(space:%) == curve? space => spc := first children first children space.subspaceField [extractPoint(s) for s in children spc] error "This ThreeSpace is not a curve - try the objects() command" + curve : List(Point(R)) -> % curve(points:L POINT) == curve(create3Space(),points) + curve : (%,List(Point(R))) -> % curve(space:%,points:L POINT) == addPoint(space.subspaceField,[],first points) path : L NNI := [#(children space.subspaceField),1] @@ -196880,10 +202206,12 @@ ThreeSpace(R:Ring):Exports == Implementation where space.converted := false space + curve : (%,List(List(R))) -> % curve(space:%,points:L L R) == pts := map(point,points) curve(space,pts) + closedCurve? : % -> Boolean closedCurve?(space:%) == #(c:=children space.subspaceField) > 1$NNI => error "This ThreeSpace has more than one component" @@ -196893,6 +202221,7 @@ ThreeSpace(R:Ring):Exports == Implementation where extractClosed first kid -- is it a closed curve? false + closedCurve : % -> List(Point(R)) closedCurve(space:%) == closedCurve? space => spc := first children first children space.subspaceField @@ -196901,8 +202230,10 @@ ThreeSpace(R:Ring):Exports == Implementation where -- for now, we are not repeating points... error "This ThreeSpace is not a curve - try the objects() command" + closedCurve : List(Point(R)) -> % closedCurve(points:L POINT) == closedCurve(create3Space(),points) + closedCurve : (%,List(Point(R))) -> % closedCurve(space:%,points:L POINT) == addPoint(space.subspaceField,[],first points) path : L NNI := [#(children space.subspaceField),1] @@ -196912,10 +202243,12 @@ ThreeSpace(R:Ring):Exports == Implementation where space.converted := false space + closedCurve : (%,List(List(R))) -> % closedCurve(space:%,points:L L R) == pts := map(point,points) closedCurve(space,pts) + polygon? : % -> Boolean polygon?(space:%) == #(c:=children space.subspaceField) > 1$NNI => error "This ThreeSpace has more than one component" @@ -196927,6 +202260,7 @@ ThreeSpace(R:Ring):Exports == Implementation where #(children first kid) = 1$NNI and #(children second kid) > 2::NNI false -- => returns Void...? + polygon : % -> List(Point(R)) polygon(space:%) == polygon? space => listOfPoints : L POINT := @@ -196935,12 +202269,15 @@ ThreeSpace(R:Ring):Exports == Implementation where [extractPoint(s) for s in children second cs] error "This ThreeSpace is not a polygon - try the objects() command" + polygon : List(Point(R)) -> % polygon(points:L POINT) == polygon(create3Space(),points) + polygon : (%,List(List(R))) -> % polygon(space:%,points:L L R) == pts := map(point,points) polygon(space,pts) + mesh? : % -> Boolean mesh?(space:%) == #(c:=children space.subspaceField) > 1$NNI => error "This ThreeSpace has more than one component" @@ -196963,6 +202300,7 @@ ThreeSpace(R:Ring):Exports == Implementation where true false + mesh : % -> List(List(Point(R))) mesh(space:%) == mesh? space => llp : L L POINT := [] @@ -196971,15 +202309,20 @@ ThreeSpace(R:Ring):Exports == Implementation where llp error "This ThreeSpace is not a mesh - try the objects() command" + mesh : List(List(Point(R))) -> % mesh(points:L L POINT) == mesh(create3Space(),points,false,false) + mesh : (List(List(Point(R))),Boolean,Boolean) -> % mesh(points:L L POINT,prop1:B,prop2:B) == mesh(create3Space(),points,prop1,prop2) --+ old ones \/ + mesh : (%,List(List(List(R))),Boolean,Boolean) -> % mesh(space:%,llpoints:L L L R,lprops:L PROP,prop:PROP) == pts := [map(point,points) for points in llpoints] mesh(space,pts,lprops,prop) + + mesh : (%,List(List(Point(R))),Boolean,Boolean) -> % mesh(space:%,llp:L L POINT,lprops:L PROP,prop:PROP) == addPoint(space.subspaceField,[],first first llp) defineProperty(space.subspaceField,path:L NNI:=_ @@ -196999,10 +202342,14 @@ ThreeSpace(R:Ring):Exports == Implementation where --+ old ones /\ + mesh : (%,List(List(List(R))),List(SubSpaceComponentProperty), + SubSpaceComponentProperty) -> % mesh(space:%,llpoints:L L L R,prop1:B,prop2:B) == pts := [map(point,points) for points in llpoints] mesh(space,pts,prop1,prop2) + mesh : (%,List(List(Point(R))),List(SubSpaceComponentProperty), + SubSpaceComponentProperty) -> % mesh(space:%,llp:L L POINT,prop1:B,prop2:B) == -- prop2 refers to property of the ends of a surface -- (list of lists of points) @@ -197029,24 +202376,31 @@ ThreeSpace(R:Ring):Exports == Implementation where space.converted := false space + lp : % -> List(Point(R)) lp space == if ^space.converted then space := convertSpace space space.rep3DField.lp + lllip : % -> List(List(List(NonNegativeInteger))) lllip space == if ^space.converted then space := convertSpace space space.rep3DField.llliPt + llprop : % -> List(List(SubSpaceComponentProperty)) llprop space == if ^space.converted then space := convertSpace space space.rep3DField.llProp + lprop : % -> List(SubSpaceComponentProperty) lprop space == if ^space.converted then space := convertSpace space space.rep3DField.lProp -- this function is just to see how this representation really -- does work + objects : % -> Record(points: NonNegativeInteger, + curves: NonNegativeInteger,polygons: NonNegativeInteger, + constructs: NonNegativeInteger) objects space == if ^space.converted then space := convertSpace space numPts := 0$NNI @@ -197070,12 +202424,15 @@ ThreeSpace(R:Ring):Exports == Implementation where -- as other applications need to interpret it [numPts,numCurves,numPolys,numConstructs] + check : % -> % check(s) == ^s.converted => convertSpace s s + subspace : % -> SubSpace(3,R) subspace(s) == s.subspaceField + coerce : % -> OutputForm coerce(s) == if ^s.converted then s := convertSpace s hconcat(["3-Space with "::O, _ @@ -197605,59 +202962,74 @@ Tree(S: SetCategory): T==C where s: S ls: List S + empty? : % -> Boolean empty? t == t case empty + empty : () -> % empty() == ["empty"] + children : % -> List(%) children t == t case empty => error "cannot take the children of an empty tree" (t.node.args)@List(%) + setchildren! : (%,List(%)) -> % setchildren_!(t,lt) == t case empty => error "cannot set children of an empty tree" (t.node.args:=lt;t pretend %) + setvalue! : (%,S) -> S setvalue_!(t,s) == t case empty => error "cannot set value of an empty tree" (t.node.value:=s;s) + count : (S,%) -> NonNegativeInteger count(n, t) == t case empty => 0 i := +/[count(n, c) for c in children t] value t = n => i + 1 i + count : ((S -> Boolean),%) -> NonNegativeInteger count(fn: S -> Boolean, t: %): NonNegativeInteger == t case empty => 0 i := +/[count(fn, c) for c in children t] fn value t => i + 1 i + map : ((S -> S),%) -> % map(fn, t) == t case empty => t tree(fn value t,[map(fn, c) for c in children t]) + map! : ((S -> S),%) -> % map_!(fn, t) == t case empty => t setvalue_!(t, fn value t) for c in children t repeat map_!(fn, c) + tree : (S,List(%)) -> % tree(s,lt) == [[s,lt]] + tree : S -> % tree(s) == [[s,[]]] + tree : List(S) -> % tree(ls) == empty? ls => empty() tree(first ls, [tree s for s in rest ls]) + value : % -> S value t == t case empty => error "cannot take the value of an empty tree" t.node.value + child? : (%,%) -> Boolean child?(t1,t2) == empty? t2 => false "or"/[t1 = t for t in children t2] + distance1 : (%,%) -> Integer distance1(t1: %, t2: %): Integer == t1 = t2 => 0 t2 case empty => -1 @@ -197665,51 +203037,64 @@ Tree(S: SetCategory): T==C where #u > 0 => 1 + "min"/u -1 + distance : (%,%) -> Integer distance(t1,t2) == n := distance1(t1, t2) n >= 0 => n distance1(t2, t1) + node? : (%,%) -> Boolean node?(t1, t2) == t1 = t2 => true t case empty => false "or"/[node?(t1, t) for t in children t2] + leaf? : % -> Boolean leaf? t == t case empty => false empty? children t + leaves : % -> List(S) leaves t == t case empty => empty() leaf? t => [value t] "append"/[leaves c for c in children t] + less? : (%,NonNegativeInteger) -> Boolean less? (t, n) == # t < n + more? : (%,NonNegativeInteger) -> Boolean more?(t, n) == # t > n + nodes : % -> List(%) nodes t == ---buggy t case empty => empty() nl := [nodes c for c in children t] nl = empty() => [t] cons(t,"append"/nl) + size? : (%,NonNegativeInteger) -> Boolean size? (t, n) == # t = n + any? : ((S -> Boolean),%) -> Boolean any?(fn, t) == ---bug fixed t case empty => false fn value t or "or"/[any?(fn, c) for c in children t] + every? : ((S -> Boolean),%) -> Boolean every?(fn, t) == t case empty => true fn value t and "and"/[every?(fn, c) for c in children t] + member? : (S,%) -> Boolean member?(n, t) == t case empty => false n = value t or "or"/[member?(n, c) for c in children t] + members : % -> List(S) members t == parts t + parts : % -> List(S) parts t == --buggy? t case empty => empty() u := [parts c for c in children t] @@ -197719,10 +203104,11 @@ Tree(S: SetCategory): T==C where ---Functions that guard against cycles: =, #, copy------------- -----> = - equal?: (%, %, %, %, Integer) -> Boolean + ?=? : (%,%) -> Boolean t1 = t2 == equal?(t1, t2, t1, t2, 0) + equal?: (%, %, %, %, Integer) -> Boolean equal?(t1, t2, ot1, ot2, k) == k = cycleTreeMax and (cyclic? ot1 or cyclic? ot2) => error "use cyclicEqual? to test equality on cyclic trees" @@ -197731,24 +203117,20 @@ Tree(S: SetCategory): T==C where value t1 = value t2 and (c1 := children t1) = (c2 := children t2) and "and"/[equal?(x,y,ot1, ot2,k + 1) for x in c1 for y in c2] - -----> # - - treeCount: (%, %, NonNegativeInteger) -> NonNegativeInteger - + #? : % -> NonNegativeInteger # t == treeCount(t, t, 0) + treeCount: (%, %, NonNegativeInteger) -> NonNegativeInteger treeCount(t, origTree, k) == k = cycleTreeMax and cyclic? origTree => error "# is not defined on cyclic trees" t case empty => 0 1 + +/[treeCount(c, origTree, k + 1) for c in children t] - -----> copy - - copy1: (%, %, Integer) -> % - + copy : % -> % copy t == copy1(t, t, 0) + copy1: (%, %, Integer) -> % copy1(t, origTree, k) == k = cycleTreeMax and cyclic? origTree => error "use cyclicCopy to copy a cyclic tree" @@ -197757,22 +203139,13 @@ Tree(S: SetCategory): T==C where tree(value t, [copy1(x, origTree, k + 1) for x in children t]) -----------Functions that allow cycles--------------- - --local utility functions: - eqUnion: (List %, List %) -> List % - eqMember?: (%, List %) -> Boolean - eqMemberIndex: (%, List %, Integer) -> Integer - lastNode: List % -> List % - insert: (%, List %) -> List % - -----> coerce to OutputForm if S has SetCategory then - multipleOverbar: (OutputForm, Integer, List %) -> OutputForm - - coerce1: (%, List %, List %) -> OutputForm - + coerce : % -> OutputForm coerce(t:%): OutputForm == coerce1(t, empty()$(List %), cyclicParents t) + coerce1: (%, List %, List %) -> OutputForm coerce1(t,parents, pl) == t case empty => empty()@List(S)::OutputForm eqMember?(t, parents) => @@ -197784,6 +203157,7 @@ Tree(S: SetCategory): T==C where prefix(nodeForm, [coerce1(br,cons(t,parents),pl) for br in children t]) + multipleOverbar: (OutputForm, Integer, List %) -> OutputForm multipleOverbar(x, k, pl) == k < 1 => x #pl = 1 => overbar x @@ -197791,12 +203165,10 @@ Tree(S: SetCategory): T==C where c := s.(1 + ((k - 1) rem 26)) overlabel(c::OutputForm, x) - -----> cyclic? - - cyclic2?: (%, List %) -> Boolean - + cyclic? : % -> Boolean cyclic? t == cyclic2?(t, empty()$(List %)) + cyclic2?: (%, List %) -> Boolean cyclic2?(x,parents) == empty? x => false eqMember?(x, parents) => true @@ -197804,24 +203176,22 @@ Tree(S: SetCategory): T==C where cyclic2?(y,cons(x, parents)) => return true false - -----> cyclicCopy - - cyclicCopy2: (%, List %) -> % - copyCycle2: (%, List %) -> % - copyCycle4: (%, %, %, List %) -> % - + cyclicCopy : % -> % cyclicCopy(t) == cyclicCopy2(t, cyclicEntries t) + cyclicCopy2: (%, List %) -> % cyclicCopy2(t, cycles) == eqMember?(t, cycles) => return copyCycle2(t, cycles) tree(value t, [cyclicCopy2(c, cycles) for c in children t]) + copyCycle2: (%, List %) -> % copyCycle2(cycle, cycleList) == newCycle := tree(value cycle, nil) setchildren!(newCycle, [copyCycle4(c,cycle,newCycle, cycleList) for c in children cycle]) newCycle + copyCycle4: (%, %, %, List %) -> % copyCycle4(t, cycle, newCycle, cycleList) == empty? cycle => empty() eq?(t, cycle) => newCycle @@ -197829,12 +203199,10 @@ Tree(S: SetCategory): T==C where tree(value t, [copyCycle4(c, cycle, newCycle, cycleList) for c in children t]) - -----> cyclicEntries - - cyclicEntries3: (%, List %, List %) -> List % - + cyclicEntries : % -> List(%) cyclicEntries(t) == cyclicEntries3(t, empty()$(List %), empty()$(List %)) + cyclicEntries3: (%, List %, List %) -> List % cyclicEntries3(t, parents, cl) == empty? t => cl eqMember?(t, parents) => insert(t, cl) @@ -197843,16 +203211,14 @@ Tree(S: SetCategory): T==C where cl := cyclicEntries3(t, parents, cl) cl - -----> cyclicEqual? - - cyclicEqual4?: (%, %, List %, List %) -> Boolean - + cyclicEqual? : (%,%) -> Boolean cyclicEqual?(t1, t2) == cp1 := cyclicParents t1 cp2 := cyclicParents t2 #cp1 ^= #cp2 or null cp1 => t1 = t2 cyclicEqual4?(t1, t2, cp1, cp2) + cyclicEqual4?: (%, %, List %, List %) -> Boolean cyclicEqual4?(t1, t2, cp1, cp2) == t1 case empty => t2 case empty t2 case empty => false @@ -197861,12 +203227,10 @@ Tree(S: SetCategory): T==C where "and"/[cyclicEqual4?(x,y,cp1,cp2) for x in children t1 for y in children t2] - -----> cyclicParents t - - cyclicParents3: (%, List %, List %) -> List % - + cyclicParents : % -> List(%) cyclicParents t == cyclicParents3(t, empty()$(List %), empty()$(List %)) + cyclicParents3: (%, List %, List %) -> List % cyclicParents3(x, parents, pl) == empty? x => pl eqMember?(x, parents) => @@ -197877,25 +203241,30 @@ Tree(S: SetCategory): T==C where pl := cyclicParents3(y, parents, pl) pl + insert: (%, List %) -> List % insert(x, l) == eqMember?(x, l) => l cons(x, l) + lastNode: List % -> List % lastNode l == empty? l => error "empty tree has no last node" while not empty? rest l repeat l := rest l l + eqMember?: (%, List %) -> Boolean eqMember?(y,l) == for x in l repeat eq?(x,y) => return true false + eqMemberIndex: (%, List %, Integer) -> Integer eqMemberIndex(x, l, k) == null l => k k := k + 1 eq?(x, first l) => k eqMemberIndex(x, rest l, k) + eqUnion: (List %, List %) -> List % eqUnion(u, v) == null u => v x := first u @@ -198031,16 +203400,22 @@ TubePlot(Curve): Exports == Implementation where Rep := Record(parCurve:Curve,loops:L L Pt,closedTube?:B) + getCurve : % -> Curve getCurve plot == plot.parCurve + listLoops : % -> List(List(Point(DoubleFloat))) listLoops plot == plot.loops + closed? : % -> Boolean closed? plot == plot.closedTube? - open? plot == not plot.closedTube? + open? : % -> Boolean + open? plot == not plot.closedTube? + setClosed : (%,Boolean) -> Boolean setClosed(plot,flag) == plot.closedTube? := flag + tube : (Curve,List(List(Point(DoubleFloat))),Boolean) -> % tube(curve,ll,b) == [curve,ll,b] *) @@ -198181,20 +203556,26 @@ Tuple(S:Type): CoercibleTo(PrimitiveArray S) with Rep := Record(len : NonNegativeInteger, elts : PrimitiveArray S) + coerce : PrimitiveArray(S) -> % coerce(x: PrimitiveArray S): % == [#x, x] + coerce : % -> PrimitiveArray(S) coerce(x:%): PrimitiveArray(S) == x.elts + length : % -> NonNegativeInteger length x == x.len + select : (%,NonNegativeInteger) -> S select(x, n) == n >= x.len => error "Index out of bounds" x.elts.n if S has SetCategory then + ?=? : (%,%) -> Boolean x = y == (x.len = y.len) and (x.elts =$PrimitiveArray(S) y.elts) + coerce : % -> OutputForm coerce(x : %): OutputForm == paren [(x.elts.i)::OutputForm for i in minIndex x.elts .. maxIndex x.elts]$List(OutputForm) @@ -199806,8 +205187,7 @@ TwoDimensionalViewport ():Exports == Implementation where yes, axesColorDefault(), no, unitsColorDefault(), _ yes] - - --% Local Functions + checkViewport : $ -> B checkViewport (viewport:$):B == -- checks to see if this viewport still exists -- by sending the key to the viewport manager and @@ -199821,24 +205201,27 @@ TwoDimensionalViewport ():Exports == Implementation where error "This viewport has already been closed!" true + doOptions : Rep -> Void doOptions(v:Rep):Void == v.title := title(v.optionsField,"AXIOM2D") -- etc - 2D specific stuff... - --% Exported Functions - + options : % -> List(DrawOption) options viewport == viewport.optionsField + options : (%,List(DrawOption)) -> % options(viewport,opts) == viewport.optionsField := opts viewport + putGraph : (%,GraphImage,PositiveInteger) -> Void putGraph (viewport,aGraph,which) == if ((which > maxGRAPHS) or (which < 1)) then error "Trying to put a graph with a negative index or too big an index" viewport.graphsField.which := aGraph + getGraph : (%,PositiveInteger) -> GraphImage getGraph (viewport,which) == if ((which > maxGRAPHS) or (which < 1)) then error "Trying to get a graph with a negative index or too big an index" @@ -199846,17 +205229,25 @@ TwoDimensionalViewport ():Exports == Implementation where error "Graph is undefined!" viewport.graphsField.which::GraphImage - + graphStates : % -> Vector(Record(scaleX: DoubleFloat,scaleY: DoubleFloat, + deltaX: DoubleFloat,deltaY: DoubleFloat,points: Integer, + connect: Integer,spline: Integer,axes: Integer,axesColor: Palette, + units: Integer,unitsColor: Palette,showing: Integer)) graphStates viewport == viewport.graphStatesField - graphs viewport == viewport.graphsField + graphs : % -> Vector(Union(GraphImage,undefined)) + graphs viewport == viewport.graphsField - key viewport == viewport.key + key : % -> Integer + key viewport == viewport.key + dimensions : (%,NonNegativeInteger,NonNegativeInteger,PositiveInteger, + PositiveInteger) -> Void dimensions(viewport,ViewX,ViewY,ViewWidth,ViewHeight) == viewport.moveTo := [ViewX,ViewY] viewport.size := [ViewWidth,ViewHeight] + move : (%,NonNegativeInteger,NonNegativeInteger) -> Void move(viewport,xLoc,yLoc) == viewport.moveTo := [xLoc,yLoc] (key(viewport) ^= 0$I) => @@ -199867,6 +205258,7 @@ TwoDimensionalViewport ():Exports == Implementation where sendI(VIEW,yLoc)$Lisp getI(VIEW)$Lisp -- acknowledge + update : (%,GraphImage,PositiveInteger) -> Void update(viewport,graph,slot) == (key(viewport) ^= 0$I) => sendI(VIEW,typeVIEW2D)$Lisp @@ -199876,6 +205268,7 @@ TwoDimensionalViewport ():Exports == Implementation where sendI(VIEW,slot)$Lisp getI(VIEW)$Lisp -- acknowledge + resize : (%,PositiveInteger,PositiveInteger) -> Void resize(viewport,xSize,ySize) == viewport.size := [xSize,ySize] (key(viewport) ^= 0$I) => @@ -199886,6 +205279,7 @@ TwoDimensionalViewport ():Exports == Implementation where sendI(VIEW,ySize)$Lisp getI(VIEW)$Lisp -- acknowledge + translate : (%,PositiveInteger,Float,Float) -> Void translate(viewport,graphIndex,xTranslateF,yTranslateF) == xTranslate := convert(xTranslateF)@SF yTranslate := convert(yTranslateF)@SF @@ -199902,6 +205296,7 @@ TwoDimensionalViewport ():Exports == Implementation where sendSF(VIEW,yTranslate)$Lisp getI(VIEW)$Lisp -- acknowledge + scale : (%,PositiveInteger,Float,Float) -> Void scale(viewport,graphIndex,xScaleF,yScaleF) == xScale := convert(xScaleF)@SF yScale := convert(yScaleF)@SF @@ -199920,6 +205315,7 @@ TwoDimensionalViewport ():Exports == Implementation where sendSF(VIEW,yScale)$Lisp getI(VIEW)$Lisp -- acknowledge + viewport2D : () -> % viewport2D == [0,new(maxGRAPHS,"undefined"), _ new(maxGRAPHS,copy defaultGS),"AXIOM2D", _ @@ -199927,12 +205323,14 @@ TwoDimensionalViewport ():Exports == Implementation where [viewSizeDefault().1,viewSizeDefault().2], _ [noControl], [] ] + makeViewport2D : (GraphImage,List(DrawOption)) -> % makeViewport2D(g:G,opts:L DROP) == viewport := viewport2D() viewport.graphsField.1 := g viewport.optionsField := opts makeViewport2D viewport + makeViewport2D : % -> % makeViewport2D viewportDollar == viewport := viewportDollar::Rep --local function to extract and assign optional args for 2D viewports @@ -199972,11 +205370,15 @@ TwoDimensionalViewport ():Exports == Implementation where viewport.key := getI(VIEW)$Lisp viewport + graphState : (%,PositiveInteger,DoubleFloat,DoubleFloat,DoubleFloat, + DoubleFloat,Integer,Integer,Integer,Integer,Palette,Integer,Palette, + Integer) -> Void graphState(viewport,num,sX,sY,dX,dY,Points,Lines,Spline, _ Axes,AxesColor,Units,UnitsColor,Showing) == viewport.graphStatesField.num := [sX,sY,dX,dY,Points,Lines,Spline, _ Axes,AxesColor,Units,UnitsColor,Showing] + title : (%,String) -> Void title(viewport,Title) == viewport.title := Title (key(viewport) ^= 0$I) => @@ -199986,6 +205388,7 @@ TwoDimensionalViewport ():Exports == Implementation where sendSTR(VIEW,Title)$Lisp getI(VIEW)$Lisp -- acknowledge + reset : % -> Void reset viewport == (key(viewport) ^= 0$I) => sendI(VIEW,typeVIEW2D)$Lisp @@ -199994,6 +205397,7 @@ TwoDimensionalViewport ():Exports == Implementation where sendI(VIEW,reset2D)$Lisp getI(VIEW)$Lisp -- acknowledge + axes : (%,PositiveInteger,String) -> Void axes (viewport:$,graphIndex:PI,onOff:STR) : Void == if (graphIndex > maxGRAPHS) then error "Referring to a graph with too big an index" @@ -200011,6 +205415,7 @@ TwoDimensionalViewport ():Exports == Implementation where sendI(VIEW,status)$Lisp getI(VIEW)$Lisp -- acknowledge + axes : (%,PositiveInteger,Palette) -> Void axes (viewport:$,graphIndex:PI,color:PAL) : Void == if (graphIndex > maxGRAPHS) then error "Referring to a graph with too big an index" @@ -200024,6 +205429,7 @@ TwoDimensionalViewport ():Exports == Implementation where sendI(VIEW,hueShade)$Lisp getI(VIEW)$Lisp -- acknowledge + units : (%,PositiveInteger,String) -> Void units (viewport:$,graphIndex:PI,onOff:STR) : Void == if (graphIndex > maxGRAPHS) then error "Referring to a graph with too big an index" @@ -200041,6 +205447,7 @@ TwoDimensionalViewport ():Exports == Implementation where sendI(VIEW,status)$Lisp getI(VIEW)$Lisp -- acknowledge + units : (%,PositiveInteger,Palette) -> Void units (viewport:$,graphIndex:PI,color:PAL) : Void == if (graphIndex > maxGRAPHS) then error "Referring to a graph with too big an index" @@ -200054,6 +205461,7 @@ TwoDimensionalViewport ():Exports == Implementation where sendI(VIEW,hueShade)$Lisp getI(VIEW)$Lisp -- acknowledge + connect : (%,PositiveInteger,String) -> Void connect (viewport:$,graphIndex:PI,onOff:STR) : Void == if (graphIndex > maxGRAPHS) then error "Referring to a graph with too big an index" @@ -200071,6 +205479,7 @@ TwoDimensionalViewport ():Exports == Implementation where sendI(VIEW,status)$Lisp getI(VIEW)$Lisp -- acknowledge + points : (%,PositiveInteger,String) -> Void points (viewport:$,graphIndex:PI,onOff:STR) : Void == if (graphIndex > maxGRAPHS) then error "Referring to a graph with too big an index" @@ -200088,6 +205497,7 @@ TwoDimensionalViewport ():Exports == Implementation where sendI(VIEW,status)$Lisp getI(VIEW)$Lisp -- acknowledge + region : (%,PositiveInteger,String) -> Void region (viewport:$,graphIndex:PI,onOff:STR) : Void == if (graphIndex > maxGRAPHS) then error "Referring to a graph with too big an index" @@ -200105,6 +205515,7 @@ TwoDimensionalViewport ():Exports == Implementation where sendI(VIEW,status)$Lisp getI(VIEW)$Lisp -- acknowledge + show : (%,PositiveInteger,String) -> Void show (viewport,graphIndex,onOff) == if (graphIndex > maxGRAPHS) then error "Referring to a graph with too big an index" @@ -200122,6 +205533,7 @@ TwoDimensionalViewport ():Exports == Implementation where sendI(VIEW,status)$Lisp getI(VIEW)$Lisp -- acknowledge + controlPanel : (%,String) -> Void controlPanel (viewport,onOff) == if onOff = "on" then viewport.flags.showCP := yes else viewport.flags.showCP := no @@ -200132,6 +205544,7 @@ TwoDimensionalViewport ():Exports == Implementation where sendI(VIEW,viewport.flags.showCP)$Lisp getI(VIEW)$Lisp -- acknowledge + close : % -> Void close viewport == (key(viewport) ^= 0$I) => sendI(VIEW,typeVIEW2D)$Lisp @@ -200140,18 +205553,22 @@ TwoDimensionalViewport ():Exports == Implementation where getI(VIEW)$Lisp -- acknowledge viewport.key := 0$I + coerce : % -> OutputForm coerce viewport == (key(viewport) = 0$I) => hconcat ["Closed or Undefined TwoDimensionalViewport: "::E, (viewport.title)::E] hconcat ["TwoDimensionalViewport: "::E, (viewport.title)::E] + write : (%,String,String) -> String write(viewport:$,Filename:STR,aThingToWrite:STR) == write(viewport,Filename,[aThingToWrite]) + write : (%,String) -> String write(viewport,Filename) == write(viewport,Filename,viewWriteDefault()) + write : (%,String,List(String)) -> String write(viewport:$,Filename:STR,thingsToWrite:L STR) == stringToSend : STR := "" (key(viewport) ^= 0$I) => @@ -200980,18 +206397,23 @@ UnivariateLaurentSeries(Coef,var,cen): Exports == Implementation where (* UnivariateLaurentSeriesConstructor(Coef,UTS) add + variable : % -> Symbol variable x == var - center x == cen + center : % -> Coef + center x == cen + coerce : Variable(var) -> % coerce(v:Variable(var)) == zero? cen => monomial(1,1) monomial(1,1) + monomial(cen,0) + differentiate : (%,Variable(var)) -> % differentiate(x:%,v:Variable(var)) == differentiate x if Coef has Algebra Fraction Integer then + integrate : (%,Variable(var)) -> % integrate(x:%,v:Variable(var)) == integrate x *) @@ -201852,32 +207274,41 @@ UnivariateLaurentSeriesConstructor(Coef,UTS):_ Rep := Record(expon:I,ps:UTS) getExpon : % -> I - getUTS : % -> UTS - getExpon x == x.expon - getUTS x == x.ps + getUTS : % -> UTS + getUTS x == x.ps --% creation and destruction + laurent : (Integer,UTS) -> % laurent(n,psr) == [n,psr] - taylorRep x == getUTS x + taylorRep : % -> UTS + taylorRep x == getUTS x - degree x == getExpon x + degree : % -> Integer + degree x == getExpon x + 0 : () -> % 0 == laurent(0,0) + 1 : () -> % 1 == laurent(0,1) + monomial : (Coef,Integer) -> % monomial(s,e) == laurent(e,s::UTS) + coerce : UTS -> % coerce(uts:UTS):% == laurent(0,uts) + coerce : Coef -> % coerce(r:Coef):% == r :: UTS :: % - coerce(i:I):% == i :: Coef :: % + coerce : Integer -> % + coerce(i:I):% == i :: Coef :: % + taylorIfCan : % -> Union(UTS,"failed") taylorIfCan uls == n := getExpon uls n < 0 => @@ -201887,6 +207318,7 @@ UnivariateLaurentSeriesConstructor(Coef,UTS):_ n = 0 => getUTS uls getUTS(uls) * monom(1,n :: NNI) + taylor : % -> UTS taylor uls == (uts := taylorIfCan uls) case "failed" => error "taylor: Laurent series has a pole" @@ -201907,6 +207339,7 @@ UnivariateLaurentSeriesConstructor(Coef,UTS):_ zero? (coef := frst st) => recs(rst st,n + 1) concat(rec(n,coef),recs(rst st,n + 1)) + terms : % -> Stream(Record(k: Integer,c: Coef)) terms x == recs(coefficients getUTS x,getExpon x) recsToCoefs: (Stream TERM,I) -> ST @@ -201916,6 +207349,7 @@ UnivariateLaurentSeriesConstructor(Coef,UTS):_ n = ex => concat(termCoef term,recsToCoefs(rst st,n + 1)) concat(0,recsToCoefs(rst st,n + 1)) + series : Stream(Record(k: Integer,c: Coef)) -> % series st == empty? st => 0 ex := termExpon frst st @@ -201923,12 +207357,14 @@ UnivariateLaurentSeriesConstructor(Coef,UTS):_ --% normalizations + removeZeroes : % -> % removeZeroes x == empty? coefficients(xUTS := getUTS x) => 0 coefficient(xUTS,0) = 0 => removeZeroes laurent(getExpon(x) + 1,quoByVar xUTS) x + removeZeroes : (Integer,%) -> % removeZeroes(n,x) == n <= 0 => x empty? coefficients(xUTS := getUTS x) => 0 @@ -201938,6 +207374,7 @@ UnivariateLaurentSeriesConstructor(Coef,UTS):_ --% predicates + ?=? : (%,%) -> Boolean x = y == EQ(x,y)$Lisp => true (expDiff := getExpon(x) - getExpon(y)) = 0 => @@ -201947,6 +207384,7 @@ UnivariateLaurentSeriesConstructor(Coef,UTS):_ getUTS(x) * monom(1,expDiff :: NNI) = getUTS(y) getUTS(y) * monom(1,(- expDiff) :: NNI) = getUTS(x) + pole? : % -> Boolean pole? x == (n := degree x) >= 0 => false x := removeZeroes(-n,x) @@ -201954,32 +207392,38 @@ UnivariateLaurentSeriesConstructor(Coef,UTS):_ --% arithmetic + ?+? : (%,%) -> % x + y == n := getExpon(x) - getExpon(y) n >= 0 => laurent(getExpon y,getUTS(y) + getUTS(x) * monom(1,n::NNI)) laurent(getExpon x,getUTS(x) + getUTS(y) * monom(1,(-n)::NNI)) + ?-? : (%,%) -> % x - y == n := getExpon(x) - getExpon(y) n >= 0 => laurent(getExpon y,getUTS(x) * monom(1,n::NNI) - getUTS(y)) laurent(getExpon x,getUTS(x) - getUTS(y) * monom(1,(-n)::NNI)) + ?*? : (%,%) -> % x:% * y:% == laurent(getExpon x + getExpon y,getUTS x * getUTS y) + ?**? : (%,NonNegativeInteger) -> % x:% ** n:NNI == zero? n => zero? x => error "0 ** 0 is undefined" 1 laurent(n * getExpon(x),getUTS(x) ** n) + recip : % -> Union(%,"failed") recip x == x := removeZeroes(1000,x) zero? coefficient(x,d := degree x) => "failed" (uts := recip getUTS x) case "failed" => "failed" laurent(-d,uts :: UTS) + ?.? : (%,%) -> % elt(uls1:%,uls2:%) == (uts := taylorIfCan uls2) case "failed" => error "elt: second argument must have positive order" @@ -201994,6 +207438,7 @@ UnivariateLaurentSeriesConstructor(Coef,UTS):_ (elt(uts1,uts2) :: %) * (recipr :: %) ** ((-deg) :: NNI) elt(taylor uls1,uts2) :: % + eval : (%,Coef) -> Stream(Coef) eval(uls:%,r:Coef) == if (n := getExpon uls) < 0 then uls := removeZeroes(-n,uls) uts := getUTS uls @@ -202007,29 +207452,37 @@ UnivariateLaurentSeriesConstructor(Coef,UTS):_ --% values + variable : % -> Symbol variable x == variable getUTS x - center x == center getUTS x + center : % -> Coef + center x == center getUTS x + coefficient : (%,Integer) -> Coef coefficient(x,n) == a := n - getExpon(x) a >= 0 => coefficient(getUTS x,a :: NNI) 0 + ?.? : (%,Integer) -> Coef elt(x:%,n:I) == coefficient(x,n) --% other functions + order : % -> Integer order x == getExpon x + order getUTS x + order : (%,Integer) -> Integer order(x,n) == (m := n - (e := getExpon x)) < 0 => n e + order(getUTS x,m :: NNI) + truncate : (%,Integer) -> % truncate(x,n) == (m := n - (e := getExpon x)) < 0 => 0 laurent(e,truncate(getUTS x,m :: NNI)) + truncate : (%,Integer,Integer) -> % truncate(x,n1,n2) == if n2 < n1 then (n1,n2) := (n2,n1) (m1 := n1 - (e := getExpon x)) < 0 => truncate(x,n2) @@ -202037,6 +207490,7 @@ UnivariateLaurentSeriesConstructor(Coef,UTS):_ if Coef has IntegralDomain then + rationalFunction : (%,Integer) -> Fraction(Polynomial(Coef)) rationalFunction(x,n) == (m := n - (e := getExpon x)) < 0 => 0 poly := polynomial(getUTS x,m :: NNI) :: RF @@ -202045,6 +207499,7 @@ UnivariateLaurentSeriesConstructor(Coef,UTS):_ positive? e => poly * (v - c) ** (e :: NNI) poly / (v - c) ** ((-e) :: NNI) + rationalFunction : (%,Integer,Integer) -> Fraction(Polynomial(Coef)) rationalFunction(x,n1,n2) == if n2 < n1 then (n1,n2) := (n2,n1) (m1 := n1 - (e := getExpon x)) < 0 => rationalFunction(x,n2) @@ -202054,6 +207509,7 @@ UnivariateLaurentSeriesConstructor(Coef,UTS):_ positive? e => poly * (v - c) ** (e :: NNI) poly / (v - c) ** ((-e) :: NNI) + exquo : (%,%) -> Union(%,"failed") x exquo y == x := removeZeroes(1000,x) y := removeZeroes(1000,y) @@ -202064,28 +207520,35 @@ UnivariateLaurentSeriesConstructor(Coef,UTS):_ if Coef has coerce: Symbol -> Coef then if Coef has "**": (Coef,I) -> Coef then + approximate : (%,Integer) -> Coef approximate(x,n) == (m := n - (e := getExpon x)) < 0 => 0 app := approximate(getUTS x,m :: NNI) zero? e => app app * ((variable(x) :: Coef) - center(x)) ** e + complete : % -> % complete x == laurent(getExpon x,complete getUTS x) + extend : (%,Integer) -> % extend(x,n) == e := getExpon x (m := n - e) < 0 => x laurent(e,extend(getUTS x,m :: NNI)) + map : ((Coef -> Coef),%) -> % map(f:Coef -> Coef,x:%) == laurent(getExpon x,map(f,getUTS x)) + multiplyCoefficients : ((Integer -> Coef),%) -> % multiplyCoefficients(f,x) == e := getExpon x laurent(e,multiplyCoefficients((z1:I):Coef +-> f(e + z1),getUTS x)) + multiplyExponents : (%,PositiveInteger) -> % multiplyExponents(x,n) == laurent(n * getExpon x,multiplyExponents(getUTS x,n)) + differentiate : % -> % differentiate x == e := getExpon x laurent(e - 1, @@ -202093,19 +207556,24 @@ UnivariateLaurentSeriesConstructor(Coef,UTS):_ if Coef has PartialDifferentialRing(Symbol) then + differentiate : (%,Symbol) -> % differentiate(x:%,s:Symbol) == (s = variable(x)) => differentiate x map((z1:Coef):Coef +-> differentiate(z1,s),x) - differentiate(center x,s)*differentiate(x) + characteristic : () -> NonNegativeInteger characteristic() == characteristic()$Coef if Coef has Field then - retract(x:%):UTS == taylor x + retract : % -> UTS + retract(x:%):UTS == taylor x + retractIfCan : % -> Union(UTS,"failed") retractIfCan(x:%):Union(UTS,"failed") == taylorIfCan x + ?**? : (%,Integer) -> % (x:%) ** (n:I) == zero? n => zero? x => error "0 ** 0 is undefined" @@ -202114,28 +207582,35 @@ UnivariateLaurentSeriesConstructor(Coef,UTS):_ xInv := inv x; minusN := (-n) :: NNI laurent(minusN * getExpon(xInv),getUTS(xInv) ** minusN) + ?*? : (UTS,%) -> % (x:UTS) * (y:%) == (x :: %) * y + ?*? : (%,UTS) -> % (x:%) * (y:UTS) == x * (y :: %) + inv : % -> % inv x == (xInv := recip x) case "failed" => error "multiplicative inverse does not exist" xInv :: % + ?/? : (%,%) -> % (x:%) / (y:%) == (yInv := recip y) case "failed" => error "inv: multiplicative inverse does not exist" x * (yInv :: %) + ?/? : (UTS,UTS) -> % (x:UTS) / (y:UTS) == (x :: %) / (y :: %) + numer : % -> UTS numer x == (n := degree x) >= 0 => taylor x x := removeZeroes(-n,x) (n := degree x) = 0 => taylor x getUTS x + denom : % -> UTS denom x == (n := degree x) >= 0 => 1 x := removeZeroes(-n,x) @@ -202146,61 +207621,90 @@ UnivariateLaurentSeriesConstructor(Coef,UTS):_ if Coef has Algebra Fraction Integer then + coerce : Fraction(Integer) -> % coerce(r:RN) == r :: Coef :: % if Coef has Field then + + ?**? : (%,Fraction(Integer)) -> % (x:%) ** (r:RN) == x **$EFULS r + exp : % -> % exp x == exp(x)$EFULS + log : % -> % log x == log(x)$EFULS + sin : % -> % sin x == sin(x)$EFULS + cos : % -> % cos x == cos(x)$EFULS + tan : % -> % tan x == tan(x)$EFULS + cot : % -> % cot x == cot(x)$EFULS + sec : % -> % sec x == sec(x)$EFULS + csc : % -> % csc x == csc(x)$EFULS + asin : % -> % asin x == asin(x)$EFULS + acos : % -> % acos x == acos(x)$EFULS + atan : % -> % atan x == atan(x)$EFULS + acot : % -> % acot x == acot(x)$EFULS + asec : % -> % asec x == asec(x)$EFULS + acsc : % -> % acsc x == acsc(x)$EFULS + sinh : % -> % sinh x == sinh(x)$EFULS + cosh : % -> % cosh x == cosh(x)$EFULS + tanh : % -> % tanh x == tanh(x)$EFULS + coth : % -> % coth x == coth(x)$EFULS + sech : % -> % sech x == sech(x)$EFULS + csch : % -> % csch x == csch(x)$EFULS + asinh : % -> % asinh x == asinh(x)$EFULS + acosh : % -> % acosh x == acosh(x)$EFULS + atanh : % -> % atanh x == atanh(x)$EFULS + acoth : % -> % acoth x == acoth(x)$EFULS + asech : % -> % asech x == asech(x)$EFULS + acsch : % -> % acsch x == acsch(x)$EFULS ratInv: I -> Coef @@ -202208,6 +207712,7 @@ UnivariateLaurentSeriesConstructor(Coef,UTS):_ zero? n => 1 inv(n :: RN) :: Coef + integrate : % -> % integrate x == not zero? coefficient(x,-1) => error "integrate: series has term of order -1" @@ -202217,6 +207722,7 @@ UnivariateLaurentSeriesConstructor(Coef,UTS):_ if Coef has integrate: (Coef,Symbol) -> Coef and _ Coef has variables: Coef -> List Symbol then + integrate : (%,Symbol) -> % integrate(x:%,s:Symbol) == (s = variable(x)) => integrate x not entry?(s,variables center x) @@ -202233,6 +207739,7 @@ UnivariateLaurentSeriesConstructor(Coef,UTS):_ res case Coef => res :: Coef first(res :: List Coef) + integrate : (%,Symbol) -> % integrate(x:%,s:Symbol) == (s = variable(x)) => integrate x not entry?(s,variables center x) => @@ -202276,6 +207783,7 @@ UnivariateLaurentSeriesConstructor(Coef,UTS):_ empty? l => (0$Coef) :: OUT reduce("+",reverse_! l) + coerce : % -> OutputForm coerce(x:%):OUT == x := removeZeroes(_$streamCount$Lisp,x) m := degree x @@ -203264,8 +208772,10 @@ UnivariatePolynomial(x:Symbol, R:Ring): Rep:=SparseUnivariatePolynomial(R) + coerce : % -> OutputForm coerce(p:%):OutputForm == outputForm(p, outputForm x) + coerce : Variable(x) -> % coerce(v:Variable(x)):% == monomial(1, 1) *) @@ -203715,25 +209225,34 @@ UnivariatePuiseuxSeries(Coef,var,cen): Exports == Implementation where getExpon: % -> RN getExpon pxs == pxs.expon + variable : % -> Symbol variable upxs == var - center upxs == cen + center : % -> Coef + center upxs == cen + coerce : UnivariateTaylorSeries(Coef,var,cen) -> % coerce(uts:UTS) == uts :: ULS :: % + retractIfCan : % -> Union(UnivariateTaylorSeries(Coef,var,cen),"failed") retractIfCan(upxs:%):Union(UTS,"failed") == (ulsIfCan := retractIfCan(upxs)@Union(ULS,"failed")) case "failed" => "failed" retractIfCan(ulsIfCan :: ULS) + coerce : Variable(var) -> % coerce(v:Variable(var)) == zero? cen => monomial(1,1) monomial(1,1) + monomial(cen,0) if Coef has "*": (Fraction Integer, Coef) -> Coef then + + differentiate : (%,Variable(var)) -> % differentiate(upxs:%,v:Variable(var)) == differentiate upxs if Coef has Algebra Fraction Integer then + + integrate : (%,Variable(var)) -> % integrate(upxs:%,v:Variable(var)) == integrate upxs if Coef has coerce: Symbol -> Coef then @@ -203759,6 +209278,7 @@ UnivariatePuiseuxSeries(Coef,var,cen): Exports == Implementation where zero? e => app app * term ** (e :: RN) + approximate : (%,Fraction(Integer)) -> Coef approximate(x,r) == e := rationalPower(x) term := ((variable(x) :: Coef) - center(x)) ** e @@ -203801,6 +209321,7 @@ UnivariatePuiseuxSeries(Coef,var,cen): Exports == Implementation where empty? l => 0 :: OUT reduce("+",reverse_! l) + coerce : % -> OutputForm coerce(upxs:%):OUT == rat := getExpon upxs; uls := laurentRep upxs count : I := _$streamCount$Lisp @@ -204486,43 +210007,54 @@ UnivariatePuiseuxSeriesConstructor(Coef,ULS):_ Rep := Record(expon:RN,lSeries:ULS) getExpon: % -> RN - getULS : % -> ULS - getExpon pxs == pxs.expon + getULS : % -> ULS getULS pxs == pxs.lSeries --% creation and destruction + puiseux : (Fraction(Integer),ULS) -> % puiseux(n,ls) == [n,ls] - laurentRep x == getULS x + laurentRep : % -> ULS + laurentRep x == getULS x + rationalPower : % -> Fraction(Integer) rationalPower x == getExpon x - degree x == getExpon(x) * degree(getULS(x)) + degree : % -> Fraction(Integer) + degree x == getExpon(x) * degree(getULS(x)) + 0 : () -> % 0 == puiseux(1,0) + 1 : () -> % 1 == puiseux(1,1) + monomial : (Coef,Fraction(Integer)) -> % monomial(c,k) == k = 0 => c :: % k < 0 => puiseux(-k,monomial(c,-1)) puiseux(k,monomial(c,1)) + coerce : ULS -> % coerce(ls:ULS) == puiseux(1,ls) + coerce : Coef -> % coerce(r:Coef) == r :: ULS :: % - coerce(i:I) == i :: Coef :: % + coerce : Integer -> % + coerce(i:I) == i :: Coef :: % + laurentIfCan : % -> Union(ULS,"failed") laurentIfCan upxs == r := getExpon upxs (denom r) = 1 => multiplyExponents(getULS upxs,numer(r) :: PI) "failed" + laurent : % -> ULS laurent upxs == (uls := laurentIfCan upxs) case "failed" => error "laurent: Puiseux series has fractional powers" @@ -204531,6 +210063,7 @@ UnivariatePuiseuxSeriesConstructor(Coef,ULS):_ multExp: (RN,LTerm) -> PTerm multExp(r,lTerm) == [r * lTerm.k,lTerm.c] + terms : % -> Stream(Record(k: Fraction(Integer),c: Coef)) terms upxs == map((t1:LTerm):PTerm+->multExp(getExpon upxs,t1),terms getULS upxs)$ST2LP @@ -204540,6 +210073,8 @@ UnivariatePuiseuxSeriesConstructor(Coef,ULS):_ error "series: inappropriate denominator" [int :: I,lTerm.c] + series : + (NonNegativeInteger,Stream(Record(k: Fraction(Integer),c: Coef))) -> % series(n,stream) == str := map((t1:PTerm):LTerm +-> clearDen(n,t1),stream)$ST2PL puiseux(1/n,series str) @@ -204564,6 +210099,7 @@ UnivariatePuiseuxSeriesConstructor(Coef,ULS):_ --% predicates + ?=? : (%,%) -> Boolean upxs1 = upxs2 == r1 := getExpon upxs1; r2 := getExpon upxs2 ls1 := getULS upxs1; ls2 := getULS upxs2 @@ -204573,6 +210109,7 @@ UnivariatePuiseuxSeriesConstructor(Coef,ULS):_ m2 := numer(getExpon(upxs2)/r) pretend PI multiplyExponents(ls1,m1) = multiplyExponents(ls2,m2) + pole? : % -> Boolean pole? upxs == pole? getULS upxs --% arithmetic @@ -204587,14 +210124,19 @@ UnivariatePuiseuxSeriesConstructor(Coef,ULS):_ m2 := numer(getExpon(pxs2)/r) pretend PI puiseux(r,op(multiplyExponents(ls1,m1),multiplyExponents(ls2,m2))) - pxs1 + pxs2 == applyFcn((z1:ULS,z2:ULS):ULS+->z1 +$ULS z2,pxs1,pxs2) + ?+? : (%,%) -> % + pxs1 + pxs2 == applyFcn((z1:ULS,z2:ULS):ULS+->z1 +$ULS z2,pxs1,pxs2) - pxs1 - pxs2 == applyFcn((z1:ULS,z2:ULS):ULS+->z1 -$ULS z2,pxs1,pxs2) + ?-? : (%,%) -> % + pxs1 - pxs2 == applyFcn((z1:ULS,z2:ULS):ULS+->z1 -$ULS z2,pxs1,pxs2) + ?*? : (%,%) -> % pxs1:% * pxs2:% == applyFcn((z1:ULS,z2:ULS):ULS+->z1 *$ULS z2,pxs1,pxs2) + ?**? : (%,NonNegativeInteger) -> % pxs:% ** n:NNI == puiseux(getExpon pxs,getULS(pxs)**n) + recip : % -> Union(%,"failed") recip pxs == rec := recip getULS pxs rec case "failed" => "failed" @@ -204602,6 +210144,7 @@ UnivariatePuiseuxSeriesConstructor(Coef,ULS):_ RATALG : Boolean := Coef has Algebra(Fraction Integer) + ?.? : (%,%) -> % elt(upxs1:%,upxs2:%) == uls1 := laurentRep upxs1; uls2 := laurentRep upxs2 r1 := rationalPower upxs1; r2 := rationalPower upxs2 @@ -204624,12 +210167,15 @@ UnivariatePuiseuxSeriesConstructor(Coef,ULS):_ if Coef has "**": (Coef,Integer) -> Coef and Coef has "**": (Coef, RN) -> Coef then + eval : (%,Coef) -> Stream(Coef) eval(upxs:%,a:Coef) == eval(getULS upxs,a ** getExpon(upxs)) if Coef has Field then + ?/? : (%,%) -> % pxs1:% / pxs2:% == applyFcn((z1:ULS,z2:ULS):ULS+->z1 /$ULS z2,pxs1,pxs2) + inv : % -> % inv upxs == (invUpxs := recip upxs) case "failed" => error "inv: multiplicative inverse does not exist" @@ -204637,15 +210183,19 @@ UnivariatePuiseuxSeriesConstructor(Coef,ULS):_ --% values + variable : % -> Symbol variable upxs == variable getULS upxs - center upxs == center getULS upxs + center : % -> Coef + center upxs == center getULS upxs + coefficient : (%,Fraction(Integer)) -> Coef coefficient(upxs,rn) == (denom(n := rn / getExpon upxs)) = 1 => coefficient(getULS upxs,numer n) 0 + ?.? : (%,Fraction(Integer)) -> Coef elt(upxs:%,rn:RN) == coefficient(upxs,rn) --% other functions @@ -204666,46 +210216,58 @@ UnivariatePuiseuxSeriesConstructor(Coef,ULS):_ positive?(num) => n + 1 n + order : % -> Fraction(Integer) order upxs == getExpon upxs * order getULS upxs + order : (%,Fraction(Integer)) -> Fraction(Integer) order(upxs,r) == e := getExpon upxs ord := order(getULS upxs, n := roundDown(r / e)) ord = n => r ord * e + truncate : (%,Fraction(Integer)) -> % truncate(upxs,r) == e := getExpon upxs puiseux(e,truncate(getULS upxs,roundDown(r / e))) + truncate : (%,Fraction(Integer),Fraction(Integer)) -> % truncate(upxs,r1,r2) == e := getExpon upxs puiseux(e,truncate(getULS upxs,roundUp(r1 / e),roundDown(r2 / e))) + complete : % -> % complete upxs == puiseux(getExpon upxs,complete getULS upxs) + extend : (%,Fraction(Integer)) -> % extend(upxs,r) == e := getExpon upxs puiseux(e,extend(getULS upxs,roundDown(r / e))) + map : ((Coef -> Coef),%) -> % map(fcn,upxs) == puiseux(getExpon upxs,map(fcn,getULS upxs)) + characteristic : () -> NonNegativeInteger characteristic() == characteristic()$Coef + multiplyExponents : (%,Fraction(Integer)) -> % multiplyExponents(upxs:%,n:RN) == puiseux(n * getExpon(upxs),getULS upxs) + multiplyExponents : (%,PositiveInteger) -> % multiplyExponents(upxs:%,n:PI) == puiseux(n * getExpon(upxs),getULS upxs) if Coef has "*": (Fraction Integer, Coef) -> Coef then + differentiate : % -> % differentiate upxs == r := getExpon upxs puiseux(r,differentiate getULS upxs) * monomial(r :: Coef,r-1) if Coef has PartialDifferentialRing(Symbol) then + differentiate : (%,Symbol) -> % differentiate(upxs:%,s:Symbol) == (s = variable(upxs)) => differentiate upxs dcds := differentiate(center upxs,s) @@ -204714,6 +210276,7 @@ UnivariatePuiseuxSeriesConstructor(Coef,ULS):_ if Coef has Algebra Fraction Integer then + coerce : Fraction(Integer) -> % coerce(r:RN) == r :: Coef :: % ratInv: RN -> Coef @@ -204721,6 +210284,7 @@ UnivariatePuiseuxSeriesConstructor(Coef,ULS):_ zero? r => 1 inv(r) :: Coef + integrate : % -> % integrate upxs == not zero? coefficient(upxs,-1) => error "integrate: series has term of order -1" @@ -204732,6 +210296,7 @@ UnivariatePuiseuxSeriesConstructor(Coef,ULS):_ if Coef has integrate: (Coef,Symbol) -> Coef and _ Coef has variables: Coef -> List Symbol then + integrate : (%,Symbol) -> % integrate(upxs:%,s:Symbol) == (s = variable(upxs)) => integrate upxs not entry?(s,variables center upxs) @@ -204748,6 +210313,7 @@ UnivariatePuiseuxSeriesConstructor(Coef,ULS):_ res case Coef => res :: Coef first(res :: List Coef) + integrate : (%,Symbol) -> % integrate(upxs:%,s:Symbol) == (s = variable(upxs)) => integrate upxs not entry?(s,variables center upxs) => @@ -204756,6 +210322,7 @@ UnivariatePuiseuxSeriesConstructor(Coef,ULS):_ if Coef has Field then + ?**? : (%,Fraction(Integer)) -> % (upxs:%) ** (q:RN) == num := numer q; den := denom q den = 1 => upxs ** num @@ -204772,56 +210339,82 @@ UnivariatePuiseuxSeriesConstructor(Coef,ULS):_ applyUnary(fcn,upxs) == puiseux(rationalPower upxs,fcn laurentRep upxs) + exp : % -> % exp upxs == applyUnary(exp,upxs) + log : % -> % log upxs == applyUnary(log,upxs) + sin : % -> % sin upxs == applyUnary(sin,upxs) + cos : % -> % cos upxs == applyUnary(cos,upxs) + tan : % -> % tan upxs == applyUnary(tan,upxs) + cot : % -> % cot upxs == applyUnary(cot,upxs) + sec : % -> % sec upxs == applyUnary(sec,upxs) + csc : % -> % csc upxs == applyUnary(csc,upxs) + asin : % -> % asin upxs == applyUnary(asin,upxs) + acos : % -> % acos upxs == applyUnary(acos,upxs) + atan : % -> % atan upxs == applyUnary(atan,upxs) + acot : % -> % acot upxs == applyUnary(acot,upxs) + asec : % -> % asec upxs == applyUnary(asec,upxs) + acsc : % -> % acsc upxs == applyUnary(acsc,upxs) + sinh : % -> % sinh upxs == applyUnary(sinh,upxs) + cosh : % -> % cosh upxs == applyUnary(cosh,upxs) + tanh : % -> % tanh upxs == applyUnary(tanh,upxs) + coth : % -> % coth upxs == applyUnary(coth,upxs) + sech : % -> % sech upxs == applyUnary(sech,upxs) + csch : % -> % csch upxs == applyUnary(csch,upxs) + asinh : % -> % asinh upxs == applyUnary(asinh,upxs) + acosh : % -> % acosh upxs == applyUnary(acosh,upxs) + atanh : % -> % atanh upxs == applyUnary(atanh,upxs) + acoth : % -> % acoth upxs == applyUnary(acoth,upxs) + asech : % -> % asech upxs == applyUnary(asech,upxs) + acsch : % -> % acsch upxs == applyUnary(acsch,upxs) *) @@ -205269,41 +210862,37 @@ UnivariatePuiseuxSeriesWithExponentialSingularity(R,FE,var,cen):_ (* domain UPXSSING *) (* - makeTerm : (UPXS,EXPUPXS) -> Term - coeff : Term -> UPXS - exponent : Term -> EXPUPXS - exponentTerms : Term -> List PxRec - setExponentTerms_! : (Term,List PxRec) -> List PxRec - computeExponentTerms_! : Term -> List PxRec - terms : % -> List Term - sortAndDiscardTerms: List Term -> TRec - termsWithExtremeLeadingCoef : (L Term,RN,I) -> Union(L Term,"failed") - filterByOrder: (L Term,(RN,RN) -> B) -> Record(%list:L Term,%order:RN) - dominantTermOnList : (L Term,RN,I) -> Union(Term,"failed") - iDominantTerm : L Term -> Union(Record(%term:Term,%type:String),"failed") - + retractIfCan : % -> Union(UnivariatePuiseuxSeries(FE,var,cen),"failed") retractIfCan f == (numberOfMonomials f = 1) and (zero? degree f) => leadingCoefficient f "failed" + recip : % -> Union(%,"failed") recip f == numberOfMonomials f = 1 => monomial(inv leadingCoefficient f,- degree f) "failed" + makeTerm : (UPXS,EXPUPXS) -> Term makeTerm(coef,expon) == [coef,expon,empty()] + coeff : Term -> UPXS coeff term == term.%coef + exponent : Term -> EXPUPXS exponent term == term.%expon + exponentTerms : Term -> List PxRec exponentTerms term == term.%expTerms + setExponentTerms_! : (Term,List PxRec) -> List PxRec setExponentTerms_!(term,list) == term.%expTerms := list + computeExponentTerms_! : Term -> List PxRec computeExponentTerms_! term == setExponentTerms_!(term,entries complete terms exponent term) + terms : % -> List Term terms f == -- terms with a higher order singularity will appear closer to the -- beginning of the list because of the ordering in EXPPUPXS; @@ -205311,6 +210900,7 @@ UnivariatePuiseuxSeriesWithExponentialSingularity(R,FE,var,cen):_ zero? f => empty() concat(makeTerm(leadingCoefficient f,degree f),terms reductum f) + sortAndDiscardTerms: List Term -> TRec sortAndDiscardTerms termList == -- 'termList' is the list of terms of some function f(var), ordered -- so that terms with a higher order singularity occur at the @@ -205378,6 +210968,7 @@ UnivariatePuiseuxSeriesWithExponentialSingularity(R,FE,var,cen):_ -- appear at the beginning of the list [zeroTerms,infiniteTerms,reverse_! failedTerms,pSeries] + termsWithExtremeLeadingCoef : (L Term,RN,I) -> Union(L Term,"failed") termsWithExtremeLeadingCoef(termList,ord,signum) == -- 'termList' consists of terms of the form [g(x),exp(f(x)),...]; -- when 'signum' is +1 (resp. -1), this function filters 'termList' @@ -205395,6 +210986,7 @@ UnivariatePuiseuxSeriesWithExponentialSingularity(R,FE,var,cen):_ (sig :: Integer) = signum => outList := list term outList + filterByOrder: (L Term,(RN,RN) -> B) -> Record(%list:L Term,%order:RN) filterByOrder(termList,predicate) == -- 'termList' consists of terms of the form [g(x),exp(f(x)),expTerms], -- where 'expTerms' is a list containing some of the terms in the @@ -205419,6 +211011,7 @@ UnivariatePuiseuxSeriesWithExponentialSingularity(R,FE,var,cen):_ setExponentTerms_!(term,rest exponentTerms term) [outList,ordExtreme] + dominantTermOnList : (L Term,RN,I) -> Union(Term,"failed") dominantTermOnList(termList,ord0,signum) == -- finds dominant term on 'termList' -- it is known that "exponent terms" of order < 'ord0' are @@ -205434,6 +211027,7 @@ UnivariatePuiseuxSeriesWithExponentialSingularity(R,FE,var,cen):_ empty? rest termList => first termList dominantTermOnList(termList,filtered.%order,signum) + iDominantTerm : L Term -> Union(Record(%term:Term,%type:String),"failed") iDominantTerm termList == termRecord := sortAndDiscardTerms termList zeroTerms := termRecord.%zeroTerms @@ -205458,8 +211052,14 @@ UnivariatePuiseuxSeriesWithExponentialSingularity(R,FE,var,cen):_ return "failed" [dTerm :: Term,"zero"] + dominantTerm : % -> Union(Record( + %term: Record(%coef: UnivariatePuiseuxSeries(FE,var,cen), + %expon: ExponentialOfUnivariatePuiseuxSeries(FE,var,cen), + %expTerms: List(Record(k: Fraction(Integer),c: FE))), + %type: String),"failed") dominantTerm f == iDominantTerm terms f + limitPlus : % -> Union(OrderedCompletion(FE),"failed") limitPlus f == -- list the terms occurring in 'f'; if there are none, then f = 0 empty?(termList := terms f) => 0 @@ -206246,8 +211846,10 @@ UnivariateSkewPolynomial(x:Symbol,R:Ring,sigma:Automorphism R,delta: R -> R): Rep := SparseUnivariateSkewPolynomial(R, sigma, delta) + coerce : Variable(x) -> % coerce(v:Variable(x)):% == monomial(1, 1) + coerce : % -> OutputForm coerce(p:%):OutputForm == outputForm(p, outputForm x)$Rep *) @@ -206812,14 +212414,18 @@ UnivariateTaylorSeries(Coef,var,cen): Exports == Implementation where stream: % -> Stream Coef stream x == x pretend Stream(Coef) + coerce : Variable(var) -> % coerce(v:Variable(var)) == zero? cen => monomial(1,1) monomial(1,1) + monomial(cen,0) - coerce(n:I) == n :: Coef :: % + coerce : Integer -> % + coerce(n:I) == n :: Coef :: % + coerce : Coef -> % if Coef has COMRING coerce(r:Coef) == coerce(r)$STT + monomial : (Coef,NonNegativeInteger) -> % monomial(c,n) == monom(c,n)$STT getExpon: TERM -> NNI @@ -206837,6 +212443,7 @@ UnivariateTaylorSeries(Coef,var,cen): Exports == Implementation where zero? (coef := frst st) => recs(rst st,n + 1) concat(rec(n,coef),recs(rst st,n + 1)) + terms : % -> Stream(Record(k: NonNegativeInteger,c: Coef)) terms x == recs(stream x,0) recsToCoefs: (ST TERM,NNI) -> ST Coef @@ -206846,6 +212453,7 @@ UnivariateTaylorSeries(Coef,var,cen): Exports == Implementation where n = expon => concat(getCoef term,recsToCoefs(rst st,n + 1)) concat(0,recsToCoefs(st,n + 1)) + series : Stream(Record(k: NonNegativeInteger,c: Coef)) -> % series(st: ST TERM) == recsToCoefs(st,0) stToPoly: (ST Coef,P,NNI,NNI) -> P @@ -206853,8 +212461,10 @@ UnivariateTaylorSeries(Coef,var,cen): Exports == Implementation where (n > n0) or (empty? st) => 0 frst(st) * term ** n + stToPoly(rst st,term,n + 1,n0) + polynomial : (%,NonNegativeInteger) -> Polynomial(Coef) polynomial(x,n) == stToPoly(stream x,(var :: P) - (cen :: P),0,n) + polynomial : (%,NonNegativeInteger,NonNegativeInteger) -> Polynomial(Coef) polynomial(x,n1,n2) == if n1 > n2 then (n1,n2) := (n2,n1) stToPoly(rest(stream x,n1),(var :: P) - (cen :: P),n1,n2) @@ -206864,9 +212474,12 @@ UnivariateTaylorSeries(Coef,var,cen): Exports == Implementation where (n > n0) or (empty? st) => 0 frst(st) * term ** n + stToUPoly(rst st,term,n + 1,n0) + univariatePolynomial : (%,NonNegativeInteger) -> + UnivariatePolynomial(var,Coef) univariatePolynomial(x,n) == stToUPoly(stream x,monomial(1,1)$UP - monomial(cen,0)$UP,0,n) + coerce : UnivariatePolynomial(var,Coef) -> % coerce(p:UP) == zero? p => 0 if not zero? cen then @@ -206890,15 +212503,19 @@ UnivariateTaylorSeries(Coef,var,cen): Exports == Implementation where (n > n0) or (empty? st) => 0 frst(st) * term ** n + stToCoef(rst st,term,n + 1,n0) + approximate : (%,NonNegativeInteger) -> Coef approximate(x,n) == stToCoef(stream x,(var :: Coef) - cen,0,n) --% values + variable : % -> Symbol variable x == var - center s == cen + center : % -> Coef + center s == cen + coefficient : (%,NonNegativeInteger) -> Coef coefficient(x,n) == -- Cannot use elt! Should return 0 if stream doesn't have it. u := stream x @@ -206908,43 +212525,59 @@ UnivariateTaylorSeries(Coef,var,cen): Exports == Implementation where empty? u or n ^= 0 => 0 frst u + ?.? : (%,NonNegativeInteger) -> Coef elt(x:%,n:NNI) == coefficient(x,n) --% functions + map : ((Coef -> Coef),%) -> % map(f,x) == map(f,x)$Rep + eval : (%,Coef) -> Stream(Coef) eval(x:%,r:Coef) == eval(stream x,r-cen)$STT + differentiate : % -> % differentiate x == deriv(stream x)$STT + differentiate : (%,Variable(var)) -> % differentiate(x:%,v:Variable(var)) == differentiate x if Coef has PartialDifferentialRing(Symbol) then + differentiate : (%,Symbol) -> % differentiate(x:%,s:Symbol) == (s = variable(x)) => differentiate x map(y +-> differentiate(y,s),x) - differentiate(center x,s)*differentiate(x) + multiplyCoefficients : ((Integer -> Coef),%) -> % multiplyCoefficients(f,x) == gderiv(f,stream x)$STT + lagrange : % -> % lagrange x == lagrange(stream x)$STT + lambert : % -> % lambert x == lambert(stream x)$STT + oddlambert : % -> % oddlambert x == oddlambert(stream x)$STT + evenlambert : % -> % evenlambert x == evenlambert(stream x)$STT + generalLambert : (%,Integer,Integer) -> % generalLambert(x:%,a:I,d:I) == generalLambert(stream x,a,d)$STT + extend : (%,NonNegativeInteger) -> % extend(x,n) == extend(x,n+1)$Rep + complete : % -> % complete x == complete(x)$Rep + truncate : (%,NonNegativeInteger) -> % truncate(x,n) == first(stream x,n + 1)$Rep + truncate : (%,NonNegativeInteger,NonNegativeInteger) -> % truncate(x,n1,n2) == if n2 < n1 then (n1,n2) := (n2,n1) m := (n2 - n1) :: NNI @@ -206952,40 +212585,55 @@ UnivariateTaylorSeries(Coef,var,cen): Exports == Implementation where for i in 1..n1 repeat st := concat(0$Coef,st) st + ?*? : (%,%) -> % elt(x:%,y:%) == compose(stream x,stream y)$STT + revert : % -> % revert x == revert(stream x)$STT + multisect : (Integer,Integer,%) -> % multisect(a,b,x) == multisect(a,b,stream x)$STT + invmultisect : (Integer,Integer,%) -> % invmultisect(a,b,x) == invmultisect(a,b,stream x)$STT + multiplyExponents : (%,PositiveInteger) -> % multiplyExponents(x,n) == invmultisect(n,0,x) + quoByVar : % -> % quoByVar x == (empty? x => 0; rst x) if Coef has IntegralDomain then + + unit? : % -> Boolean unit? x == unit? coefficient(x,0) + if Coef has Field then if Coef is RN then + ?**? : (%,Coef) -> % (x:%) ** (s:Coef) == powern(s,stream x)$STT else + ?**? : (%,Coef) -> % (x:%) ** (s:Coef) == power(s,stream x)$STT if Coef has Algebra Fraction Integer then + coerce : Fraction(Integer) -> % coerce(r:RN) == r :: Coef :: % + integrate : % -> % integrate x == integrate(0,stream x)$STT + integrate : (%,Variable(var)) -> % integrate(x:%,v:Variable(var)) == integrate x if Coef has integrate: (Coef,Symbol) -> Coef and _ Coef has variables: Coef -> List Symbol then + integrate : (%,Symbol) -> % integrate(x:%,s:Symbol) == (s = variable(x)) => integrate x not entry?(s,variables center x) => map(y +-> integrate(y,s),x) @@ -207001,6 +212649,7 @@ UnivariateTaylorSeries(Coef,var,cen): Exports == Implementation where res case Coef => res :: Coef first(res :: List Coef) + integrate : (%,Symbol) -> % integrate(x:%,s:Symbol) == (s = variable(x)) => integrate x not entry?(s,variables center x) => @@ -207550,13 +213199,17 @@ UnivariateTaylorSeriesCZero(Coef,var): Exports == Implementation where stream: % -> Stream Coef stream x == x pretend Stream(Coef) + coerce : Variable(var) -> % coerce(v:Variable(var)) == monomial(1,1) + coerce : Integer -> % coerce(n:I) == n :: Coef :: % + coerce : Coef -> % coerce(r:Coef) == coerce(r)$STT + monomial : (Coef,NonNegativeInteger) -> % monomial(c,n) == monom(c,n)$STT getExpon: TERM -> NNI @@ -207574,6 +213227,7 @@ UnivariateTaylorSeriesCZero(Coef,var): Exports == Implementation where zero? (coef := frst st) => recs(rst st,n + 1) concat(rec(n,coef),recs(rst st,n + 1)) + terms : % -> Stream(Record(k: NonNegativeInteger,c: Coef)) terms x == recs(stream x,0) recsToCoefs: (ST TERM,NNI) -> ST Coef @@ -207583,6 +213237,7 @@ UnivariateTaylorSeriesCZero(Coef,var): Exports == Implementation where n = expon => concat(getCoef term,recsToCoefs(rst st,n + 1)) concat(0,recsToCoefs(st,n + 1)) + series : Stream(Record(k: NonNegativeInteger,c: Coef)) -> % series(st: ST TERM) == recsToCoefs(st,0) stToPoly: (ST Coef,P,NNI,NNI) -> P @@ -207590,8 +213245,10 @@ UnivariateTaylorSeriesCZero(Coef,var): Exports == Implementation where (n > n0) or (empty? st) => 0 frst(st) * term ** n + stToPoly(rst st,term,n + 1,n0) + polynomial : (%,NonNegativeInteger) -> Polynomial(Coef) polynomial(x,n) == stToPoly(stream x,(var :: P),0,n) + polynomial : (%,NonNegativeInteger,NonNegativeInteger) -> Polynomial(Coef) polynomial(x,n1,n2) == if n1 > n2 then (n1,n2) := (n2,n1) stToPoly(rest(stream x,n1),(var :: P),n1,n2) @@ -207601,9 +213258,12 @@ UnivariateTaylorSeriesCZero(Coef,var): Exports == Implementation where (n > n0) or (empty? st) => 0 frst(st) * term ** n + stToUPoly(rst st,term,n + 1,n0) + univariatePolynomial : (%,NonNegativeInteger) -> + UnivariatePolynomial(var,Coef) univariatePolynomial(x,n) == stToUPoly(stream x,monomial(1,1)$UP,0,n) + coerce : UnivariatePolynomial(var,Coef) -> % coerce(p:UP) == zero? p => 0 st : ST Coef := empty() @@ -207625,15 +213285,19 @@ UnivariateTaylorSeriesCZero(Coef,var): Exports == Implementation where (n > n0) or (empty? st) => 0 frst(st) * term ** n + stToCoef(rst st,term,n + 1,n0) + approximate : (%,NonNegativeInteger) -> Coef approximate(x,n) == stToCoef(stream x,(var :: Coef),0,n) --% values + variable : % -> Symbol variable x == var - center x == 0$Coef + center : % -> Coef + center x == 0$Coef + coefficient : (%,NonNegativeInteger) -> Coef coefficient(x,n) == -- Cannot use elt! Should return 0 if stream doesn't have it. u := stream x @@ -207643,42 +213307,58 @@ UnivariateTaylorSeriesCZero(Coef,var): Exports == Implementation where empty? u or n ^= 0 => 0 frst u + ?.? : (%,NonNegativeInteger) -> Coef elt(x:%,n:NNI) == coefficient(x,n) --% functions + map : ((Coef -> Coef),%) -> % map(f,x) == map(f,x)$Rep + eval : (%,Coef) -> Stream(Coef) eval(x:%,r:Coef) == eval(stream x,r)$STT + differentiate : % -> % differentiate x == deriv(stream x)$STT + differentiate : (%,Variable(var)) -> % differentiate(x:%,v:Variable(var)) == differentiate x if Coef has PartialDifferentialRing(Symbol) then + differentiate : (%,Symbol) -> % differentiate(x:%,s:Symbol) == (s = variable(x)) => differentiate x map(differentiate(#1,s),x) - differentiate(0,s)*differentiate(x) + multiplyCoefficients : ((Integer -> Coef),%) -> % multiplyCoefficients(f,x) == gderiv(f,stream x)$STT + lagrange : % -> % lagrange x == lagrange(stream x)$STT + lambert : % -> % lambert x == lambert(stream x)$STT + oddlambert : % -> % oddlambert x == oddlambert(stream x)$STT + evenlambert : % -> % evenlambert x == evenlambert(stream x)$STT + generalLambert : (%,Integer,Integer) -> % generalLambert(x:%,a:I,d:I) == generalLambert(stream x,a,d)$STT + extend : (%,NonNegativeInteger) -> % extend(x,n) == extend(x,n+1)$Rep + complete : % -> % complete x == complete(x)$Rep + truncate : (%,NonNegativeInteger) -> % truncate(x,n) == first(stream x,n + 1)$Rep + truncate : (%,NonNegativeInteger,NonNegativeInteger) -> % truncate(x,n1,n2) == if n2 < n1 then (n1,n2) := (n2,n1) m := (n2 - n1) :: NNI @@ -207686,42 +213366,55 @@ UnivariateTaylorSeriesCZero(Coef,var): Exports == Implementation where for i in 1..n1 repeat st := concat(0$Coef,st) st + ?.? : (%,%) -> % elt(x:%,y:%) == compose(stream x,stream y)$STT + revert : % -> % revert x == revert(stream x)$STT + multisect : (Integer,Integer,%) -> % multisect(a,b,x) == multisect(a,b,stream x)$STT + invmultisect : (Integer,Integer,%) -> % invmultisect(a,b,x) == invmultisect(a,b,stream x)$STT + multiplyExponents : (%,PositiveInteger) -> % multiplyExponents(x,n) == invmultisect(n,0,x) + quoByVar : % -> % quoByVar x == (empty? x => 0; rst x) if Coef has IntegralDomain then + unit? : % -> Boolean if Coef has INTDOM unit? x == unit? coefficient(x,0) if Coef has Field then if Coef is RN then + ?**? : (%,Coef) -> % (x:%) ** (s:Coef) == powern(s,stream x)$STT else + ?**? : (%,Coef) -> % (x:%) ** (s:Coef) == power(s,stream x)$STT if Coef has Algebra Fraction Integer then + coerce : Fraction(Integer) -> % coerce(r:RN) == r :: Coef :: % + integrate : % -> % integrate x == integrate(0,stream x)$STT + integrate : (%,Variable(var)) -> % integrate(x:%,v:Variable(var)) == integrate x if Coef has integrate: (Coef,Symbol) -> Coef and _ Coef has variables: Coef -> List Symbol then + integrate : (%,Symbol) -> % integrate(x:%,s:Symbol) == (s = variable(x)) => integrate x map(integrate(#1,s),x) @@ -207736,6 +213429,7 @@ UnivariateTaylorSeriesCZero(Coef,var): Exports == Implementation where res case Coef => res :: Coef first(res :: List Coef) + integrate : (%,Symbol) -> % integrate(x:%,s:Symbol) == (s = variable(x)) => integrate x map(integrateWithOneAnswer(#1,s),x) @@ -208092,46 +213786,60 @@ UniversalSegment(S: Type): SegmentCategory(S) with i: Integer ls : List % + segment : S -> % segment a == [a, 1]$Rec2 :: Rep + segment : (S,S) -> % segment(a,b) == [a,b,1]$Rec :: Rep + BY : (%,Integer) -> % BY(s,i) == s case Rec => [lo s, hi s, i]$Rec ::Rep [lo s, i]$Rec2 :: Rep + lo : % -> S lo s == s case Rec2 => (s :: Rec2).low (s :: Rec).low + low : % -> S low s == s case Rec2 => (s :: Rec2).low (s :: Rec).low + hasHi : % -> Boolean hasHi s == s case Rec + hi : % -> S hi s == not hasHi(s) => error "hi: segment has no upper bound" (s :: Rec).high + high : % -> S high s == not hasHi(s) => error "high: segment has no upper bound" (s :: Rec).high + incr : % -> Integer incr s == s case Rec2 => (s :: Rec2).incr (s :: Rec).incr + ?SEGMENT : S -> % SEGMENT(a) == segment a + ?..? : (S,S) -> % SEGMENT(a,b) == segment(a,b) + coerce : Segment(S) -> % coerce(sg : SEG): % == segment(lo sg, hi sg) + convert : S -> % convert a == [a,a,1] if S has SetCategory then + ?=? : (%,%) -> Boolean (s1:%) = (s2:%) == s1 case Rec2 => s2 case Rec2 => @@ -208143,6 +213851,7 @@ UniversalSegment(S: Type): SegmentCategory(S) with false false + coerce : % -> OutputForm coerce(s: %): OutputForm == seg := e := (lo s)::OutputForm @@ -208154,16 +213863,19 @@ UniversalSegment(S: Type): SegmentCategory(S) with if S has OrderedRing then - expand(s:%) == expand([s]) + expand : % -> Stream(S) + expand(s:%) == expand([s]) + map : ((S -> S),%) -> Stream(S) map(f:S->S, s:%) == map(f, expand s) + plusInc : (S,S) -> S plusInc(t: S, a: S): S == t + a + expand : List(%) -> Stream(S) expand(ls: List %):Stream S == st:Stream S := empty() null ls => st - lb:List(Segment S) := nil() while not null ls and hasHi first ls repeat s := first ls @@ -208449,30 +214161,43 @@ U8Matrix : MatrixCategory(Integer, Qnew ==> MAKEMATRIXU8$Lisp Qnew1 ==> MAKEMATRIX1U8$Lisp + minRowIndex : % -> Integer minRowIndex x == 0 + minColIndex : % -> Integer minColIndex x == 0 + nrows : % -> NonNegativeInteger nrows x == Qnrows(x) + ncols : % -> NonNegativeInteger ncols x == Qncols(x) + maxRowIndex : % -> Integer maxRowIndex x == Qnrows(x) - 1 + maxColIndex : % -> Integer maxColIndex x == Qncols(x) - 1 + qelt : (%,Integer,Integer) -> Integer qelt(m, i, j) == Qelt2(m, i, j) + elt : (%,Integer,Integer) -> Integer elt(m : %, i : Integer, j : Integer) : R == Qelt2(m, i, j) + qsetelt! : (%,Integer,Integer,Integer) -> Integer qsetelt!(m, i, j, r) == Qsetelt2(m, i, j, r) + setelt : (%,List(Integer),List(Integer),%) -> % setelt(m : %, i : Integer, j : Integer, r : R) == Qsetelt2(m, i, j, r) + empty : () -> % empty() == Qnew(0$Integer, 0$Integer) + qnew : (Integer,Integer) -> % qnew(rows, cols) == Qnew(rows, cols) + new : (NonNegativeInteger,NonNegativeInteger,Integer) -> % new(rows, cols, a) == Qnew1(rows, cols, a) *) @@ -208747,30 +214472,43 @@ U16Matrix : MatrixCategory(Integer, Qnew ==> MAKEMATRIXU16$Lisp Qnew1 ==> MAKEMATRIX1U16$Lisp + minRowIndex : % -> Integer minRowIndex x == 0 + minColIndex : % -> Integer minColIndex x == 0 + nrows : % -> NonNegativeInteger nrows x == Qnrows(x) + ncols : % -> NonNegativeInteger ncols x == Qncols(x) + maxRowIndex : % -> Integer maxRowIndex x == Qnrows(x) - 1 + maxColIndex : % -> Integer maxColIndex x == Qncols(x) - 1 + qelt : (%,Integer,Integer) -> Integer qelt(m, i, j) == Qelt2(m, i, j) + elt : (%,Integer,Integer) -> Integer elt(m : %, i : Integer, j : Integer) : R == Qelt2(m, i, j) + qsetelt! : (%,Integer,Integer,Integer) -> Integer qsetelt!(m, i, j, r) == Qsetelt2(m, i, j, r) + setelt : (%,Integer,Integer,Integer) -> Integer setelt(m : %, i : Integer, j : Integer, r : R) == Qsetelt2(m, i, j, r) + empty : () -> % empty() == Qnew(0$Integer, 0$Integer) + qnew : (Integer,Integer) -> % qnew(rows, cols) == Qnew(rows, cols) + new : (NonNegativeInteger,NonNegativeInteger,Integer) -> % new(rows, cols, a) == Qnew1(rows, cols, a) *) @@ -209045,30 +214783,43 @@ U32Matrix : MatrixCategory(Integer, Qnew ==> MAKEMATRIXU32$Lisp Qnew1 ==> MAKEMATRIX1U32$Lisp + minRowIndex : % -> Integer minRowIndex x == 0 + minColIndex : % -> Integer minColIndex x == 0 + nrows : % -> NonNegativeInteger nrows x == Qnrows(x) + ncols : % -> NonNegativeInteger ncols x == Qncols(x) + maxRowIndex : % -> Integer maxRowIndex x == Qnrows(x) - 1 + maxColIndex : % -> Integer maxColIndex x == Qncols(x) - 1 + qelt : (%,Integer,Integer) -> Integer qelt(m, i, j) == Qelt2(m, i, j) + elt : (%,Integer,Integer) -> Integer elt(m : %, i : Integer, j : Integer) : R == Qelt2(m, i, j) + qsetelt! : (%,Integer,Integer,Integer) -> Integer qsetelt!(m, i, j, r) == Qsetelt2(m, i, j, r) + setelt : (%,List(Integer),List(Integer),%) -> % setelt(m : %, i : Integer, j : Integer, r : R) == Qsetelt2(m, i, j, r) + empty : () -> % empty() == Qnew(0$Integer, 0$Integer) + qnew : (Integer,Integer) -> % qnew(rows, cols) == Qnew(rows, cols) + new : (NonNegativeInteger,NonNegativeInteger,Integer) -> % new(rows, cols, a) == Qnew1(rows, cols, a) *) @@ -209450,6 +215201,71 @@ U8Vector() : OneDimensionalArrayAggregate Integer == add \begin{chunk}{COQ U8VEC} (* domain U8VEC *) (* + Qsize ==> QVLENU8$Lisp + Qelt ==> ELTU8$Lisp + Qsetelt ==> SETELTU8$Lisp + Qnew ==> GETREFVU8$Lisp + + ++ returns the length of the vector + ++ + ++X t1:=new(10,10)$U8Vector + ++X #t1 + #? : % -> NonNegativeInteger + #x == Qsize x + + ++ minIndex returns the minimum index of the vector + ++ + ++X t1:=new(10,10)$U8Vector + ++X minIndex t1 + minIndex : % -> Integer + minIndex x == 0 + + ++ empty() returns a new vector of length 0 + ++ + ++X t1:=empty()$U8Vector + empty : () -> % + empty() == Qnew(0$Lisp, 0$Lisp) + + ++ new(n, x) returns a new vector of length n filled with x + ++ + ++X t1:=new(10,7)$U8Vector + new : (NonNegativeInteger,Integer) -> % + new(n, x) == Qnew (n, x) + + ++ qelt(x, i) returns the i-th element of x + ++ + ++X t1:=new(10,7)$U8Vector + ++X qelt(t1,3) + qelt(x, i) == Qelt(x, i) + + ++ elt(x, i) returns the i-th element of x + ++ + ++X t1:=new(10,7)$U8Vector + ++X elt(t1,3) + ?.? : (%,Integer) -> Integer + elt(x:%, i:Integer) == Qelt(x, i) + + ++ qsetelt(x, i, s) modifies the i-th element of x to be s + ++ + ++X t1:=new(10,7)$U8Vector + ++X qsetelt!(t1,3,9) + qsetelt! : (%,Integer,Integer) -> Integer + qsetelt_!(x, i, s) == Qsetelt(x, i, s) + + ++ setelt(x, i, s) modifies the i-th element of x to be s + ++ + ++X t1:=new(10,7)$U8Vector + ++X setelt(t1,3,9) + setelt : (%,Integer,Integer) -> Integer + setelt(x:%, i:Integer, s:Integer) == Qsetelt(x, i, s) + + ++ fill!(x, s) modifies a vector x so every element has value s + ++ + ++X t1:=new(10,7)$U8Vector + ++X fill!(t1,9) + fill! : (%,Integer) -> % + fill_!(x, s) == (for i in 0..((Qsize x) - 1) repeat Qsetelt(x, i, s); x) + *) \end{chunk} @@ -209829,6 +215645,72 @@ U16Vector() : OneDimensionalArrayAggregate Integer == add \begin{chunk}{COQ U16VEC} (* domain U16VEC *) (* + Qsize ==> QVLENU16$Lisp + Qelt ==> ELTU16$Lisp + Qsetelt ==> SETELTU16$Lisp + Qnew ==> GETREFVU16$Lisp + + ++ returns the length of the vector + ++ + ++X t1:=new(10,10)$U16Vector + ++X #t1 + #? : % -> NonNegativeInteger + #x == Qsize x + + ++ minIndex returns the minimum index of the vector + ++ + ++X t1:=new(10,10)$U16Vector + ++X minIndex t1 + minIndex : % -> Integer + minIndex x == 0 + + ++ empty() returns a new vector of length 0 + ++ + ++X t1:=empty()$U16Vector + empty : () -> % + empty() == Qnew(0$Lisp, 0$Lisp) + + ++ new(n, x) returns a new vector of length n filled with x + ++ + ++X t1:=new(10,7)$U16Vector + new : (NonNegativeInteger,Integer) -> % + new(n, x) == Qnew (n, x) + + ++ qelt(x, i) returns the i-th element of x + ++ + ++X t1:=new(10,7)$U16Vector + ++X qelt(t1,3) + qelt : (%,Integer) -> Integer + qelt(x, i) == Qelt(x, i) + + ++ elt(x, i) returns the i-th element of x + ++ + ++X t1:=new(10,7)$U16Vector + ++X elt(t1,3) + ?.? : (%,Integer) -> Integer + elt(x:%, i:Integer) == Qelt(x, i) + + ++ qsetelt(x, i, s) modifies the i-th element of x to be s + ++ + ++X t1:=new(10,7)$U16Vector + ++X qsetelt!(t1,3,9) + qsetelt! : (%,Integer,Integer) -> Integer + qsetelt_!(x, i, s) == Qsetelt(x, i, s) + + ++ setelt(x, i, s) modifies the i-th element of x to be s + ++ + ++X t1:=new(10,7)$U16Vector + ++X setelt(t1,3,9) + setelt : (%,Integer,Integer) -> Integer + setelt(x:%, i:Integer, s:Integer) == Qsetelt(x, i, s) + + ++ fill!(x, s) modifies a vector x so every element has value s + ++ + ++X t1:=new(10,7)$U16Vector + ++X fill!(t1,9) + fill! : (%,Integer) -> % + fill_!(x, s) == (for i in 0..((Qsize x) - 1) repeat Qsetelt(x, i, s); x) + *) \end{chunk} @@ -210211,6 +216093,72 @@ U32Vector() : OneDimensionalArrayAggregate Integer == add \begin{chunk}{COQ U32VEC} (* domain U32VEC *) (* + Qsize ==> QVLENU32$Lisp + Qelt ==> ELTU32$Lisp + Qsetelt ==> SETELTU32$Lisp + Qnew ==> GETREFVU32$Lisp + + ++ returns the length of the vector + ++ + ++X t1:=new(10,10)$U32Vector + ++X #t1 + #? : % -> NonNegativeInteger + #x == Qsize x + + ++ minIndex returns the minimum index of the vector + ++ + ++X t1:=new(10,10)$U32Vector + ++X minIndex t1 + minIndex : % -> Integer + minIndex x == 0 + + ++ empty() returns a new vector of length 0 + ++ + ++X t1:=empty()$U32Vector + empty : () -> % + empty() == Qnew(0$Lisp, 0$Lisp) + + ++ new(n, x) returns a new vector of length n filled with x + ++ + ++X t1:=new(10,7)$U32Vector + new : (NonNegativeInteger,Integer) -> % + new(n, x) == Qnew (n, x) + + ++ qelt(x, i) returns the i-th element of x + ++ + ++X t1:=new(10,7)$U32Vector + ++X qelt(t1,3) + qelt : (%,Integer) -> Integer + qelt(x, i) == Qelt(x, i) + + ++ elt(x, i) returns the i-th element of x + ++ + ++X t1:=new(10,7)$U32Vector + ++X elt(t1,3) + ?.? : (%,Integer) -> Integer + elt(x:%, i:Integer) == Qelt(x, i) + + ++ qsetelt(x, i, s) modifies the i-th element of x to be s + ++ + ++X t1:=new(10,7)$U32Vector + ++X qsetelt!(t1,3,9) + qsetelt! : (%,Integer,Integer) -> Integer + qsetelt_!(x, i, s) == Qsetelt(x, i, s) + + ++ setelt(x, i, s) modifies the i-th element of x to be s + ++ + ++X t1:=new(10,7)$U32Vector + ++X setelt(t1,3,9) + setelt : (%,Integer,Integer) -> Integer + setelt(x:%, i:Integer, s:Integer) == Qsetelt(x, i, s) + + ++ fill!(x, s) modifies a vector x so every element has value s + ++ + ++X t1:=new(10,7)$U32Vector + ++X fill!(t1,9) + fill! : (%,Integer) -> % + fill_!(x, s) == (for i in 0..((Qsize x) - 1) repeat Qsetelt(x, i, s); x) + *) \end{chunk} @@ -210307,15 +216255,20 @@ Variable(sym:Symbol): Join(SetCategory, CoercibleTo Symbol) with (* domain VARIABLE *) (* - coerce(x:%):Symbol == sym + coerce : % -> Symbol + coerce(x:%):Symbol == sym + coerce : % -> OutputForm coerce(x:%):OutputForm == sym::OutputForm - variable() == sym + variable : () -> Symbol + variable() == sym - x = y == true + ?=? : (%,%) -> Boolean + x = y == true - latex(x:%):String == latex sym + latex : % -> String + latex(x:%):String == latex sym *) @@ -210727,10 +216680,12 @@ Vector(R:Type): Exports == Implementation where (* domain VECTOR *) (* + vector : List(R) -> % vector l == construct l if R has ConvertibleTo InputForm then + convert : % -> InputForm convert(x:%):InputForm == convert [convert("vector"::Symbol)@InputForm, convert(parts x)@InputForm] @@ -210902,8 +216857,10 @@ Void: with Rep := String - void() == voidValue()$Lisp + void : () -> % + void() == voidValue()$Lisp + coerce : % -> OutputForm coerce(v:%) == coerce(v)$Rep *) @@ -211137,6 +217094,7 @@ WeightedPolynomials(R:Ring,VarSet: OrderedSet, E:OrderedAbelianMonoidSup, n:NonNegativeInteger z:Integer + changeWeightLevel : NonNegativeInteger -> Void changeWeightLevel(n) == wtlevel:=n @@ -211146,12 +217104,7 @@ WeightedPolynomials(R:Ring,VarSet: OrderedSet, E:OrderedAbelianMonoidSup, lookupList:=[[v,n] for v in vl for n in wl] - -- local operation - - innercoerce:(p,z) -> $ - lookup:Varset -> NonNegativeInteger - lookup v == l:=lookupList while l ^= [] repeat @@ -211159,6 +217112,7 @@ WeightedPolynomials(R:Ring,VarSet: OrderedSet, E:OrderedAbelianMonoidSup, l:=l.rest 0 + innercoerce:(p,z) -> $ innercoerce(p,z) == z<0 => 0 zero? p => 0 @@ -211181,20 +217135,26 @@ WeightedPolynomials(R:Ring,VarSet: OrderedSet, E:OrderedAbelianMonoidSup, tmp:=reductum tmp ans + coerce : P -> % coerce(p):$ == innercoerce(p,wtlevel) + coerce : % -> P coerce(w):P == "+"/[c for c in coefficients w] + coerce : % -> OutputForm coerce(p:$):OutputForm == zero? p => (0$Integer)::OutputForm degree p = 0 => leadingCoefficient(p):: OutputForm reduce("+",(reverse [paren(c::OutputForm) for c in coefficients p]) ::List OutputForm) + 0 : () -> % 0 == 0$Rep + 1 : () -> % 1 == 1$Rep + ?=? : (%,%) -> Boolean x1 = x2 == -- Note that we must strip out any terms greater than wtlevel while degree x1 > wtlevel repeat @@ -211203,10 +217163,13 @@ WeightedPolynomials(R:Ring,VarSet: OrderedSet, E:OrderedAbelianMonoidSup, x2 := reductum x2 x1 =$Rep x2 + ?+? : (%,%) -> % x1 + x2 == x1 +$Rep x2 + -? : % -> % -x1 == -(x1::Rep) + ?*? : (%,%) -> % x1 * x2 == -- Note that this is probably an extremely inefficient definition w:=x1 *$Rep x2 @@ -211968,13 +217931,17 @@ WuWenTsunTriangularSet(R,E,V,P) : Exports == Implementation where Rep ==> LP + rep : $ -> Rep rep(s:$):Rep == s pretend Rep + per : Rep -> $ per(l:Rep):$ == l pretend $ + removeAssociates : LP -> LP removeAssociates (lp:LP):LP == removeDuplicates [primPartElseUnitCanonical(p) for p in lp] + medialSetWithTrace : (LP,((P,P)->B),((P,P)->P)) -> Union(RBT,"failed") medialSetWithTrace (ps:LP,redOp?:((P,P)->B),redOp:((P,P)->P)):_ Union(RBT,"failed") == qs := rewriteIdealWithQuasiMonicGenerators(ps,redOp?,redOp)$pa @@ -212003,13 +217970,17 @@ WuWenTsunTriangularSet(R,E,V,P) : Exports == Implementation where contradiction => "failed"::Union(RBT,"failed") ([bs,qs]$RBT)::Union(RBT,"failed") + medialSet : (List(P),((P,P) -> Boolean),((P,P) -> P)) -> Union(%,"failed") medialSet(ps:LP,redOp?:((P,P)->B),redOp:((P,P)->P)) == foo: Union(RBT,"failed") := medialSetWithTrace(ps,redOp?,redOp) (foo case "failed") => "failed" :: Union($,"failed") ((foo::RBT).bas) :: Union($,"failed") + medialSet : List(P) -> Union(%,"failed") medialSet(ps:LP) == medialSet(ps,initiallyReduced?,initiallyReduce) + characteristicSetUsingTrace : (LP,((P,P)->B),((P,P)->P)) -> + Union($,"failed") characteristicSetUsingTrace(ps:LP,redOp?:((P,P)->B),redOp:((P,P)->P)):_ Union($,"failed") == ps := removeAssociates ps @@ -212038,12 +218009,16 @@ WuWenTsunTriangularSet(R,E,V,P) : Exports == Implementation where contradiction => "failed"::Union($,"failed") ms::Union($,"failed") + characteristicSet : (List(P),((P,P) -> Boolean),((P,P) -> P)) -> + Union(%,"failed") characteristicSet(ps:LP,redOp?:((P,P)->B),redOp:((P,P)->P)) == characteristicSetUsingTrace(ps,redOp?,redOp) + characteristicSet : List(P) -> Union(%,"failed") characteristicSet(ps:LP) == characteristicSet(ps,initiallyReduced?,initiallyReduce) + characteristicSerie : (List(P),((P,P) -> Boolean),((P,P) -> P)) -> List(%) characteristicSerie(ps:LP,redOp?:((P,P)->B),redOp:((P,P)->P)) == a := [[ps,empty()$$]$NLpT]$ALpT while ((esl := extractSplittingLeaf(a)) case ALpT) repeat @@ -212073,12 +218048,14 @@ WuWenTsunTriangularSet(R,E,V,P) : Exports == Implementation where splitNodeOf!(esl::ALpT,a,ln) remove(empty()$$,conditions(a)) + characteristicSerie : List(P) -> List(%) characteristicSerie(ps:LP) == characteristicSerie (ps,initiallyReduced?,initiallyReduce) if R has GcdDomain then + removeSquares : $ -> Union($,"failed") removeSquares (ts:$):Union($,"failed") == empty?(ts)$$ => ts::Union($,"failed") p := (first ts)::P @@ -212096,6 +218073,7 @@ WuWenTsunTriangularSet(R,E,V,P) : Exports == Implementation where p := squareFreePart(p) (per(cons(unitCanonical(p),rep(newts))))::Union($,"failed") + zeroSetSplit : List(P) -> List(%) zeroSetSplit lp == lts : List $ := _ characteristicSerie(lp,initiallyReduced?,initiallyReduce) @@ -212113,6 +218091,7 @@ WuWenTsunTriangularSet(R,E,V,P) : Exports == Implementation where else + zeroSetSplit : List(P) -> List(%) zeroSetSplit lp == lts : List $ := _ characteristicSerie(lp,initiallyReduced?,initiallyReduce) @@ -212385,24 +218364,21 @@ XDistributedPolynomial(vl:OrderedSet,R:Ring): XDPcat == XDPdef where import( WORD, TERM) - -- Representation Rep := List TERM - -- local functions - shw: (WORD , WORD) -> % -- shuffle de 2 mots - - -- definitions - + mindegTerm : % -> Record(k: OrderedFreeMonoid(vl),c: R) mindegTerm p == last(p)$Rep if R has CommutativeRing then + sh : (%,NonNegativeInteger) -> % sh(p:%, n:NNI):% == n=0 => 1 n=1 => p n1: NNI := (n-$I 1)::NNI sh(p, sh(p,n1)) + sh : (%,%) -> % sh(p1:%, p2:%) == p:% := 0 for t1 in p1 repeat @@ -212410,52 +218386,66 @@ XDistributedPolynomial(vl:OrderedSet,R:Ring): XDPcat == XDPdef where p := p + (t1.c * t2.c) * shw(t1.k,t2.k) p + coerce : vl -> % coerce(v: vl):% == coerce(v::WORD) + ?*? : (vl,%) -> % v:vl * p:% == [[v * t.k , t.c]$TERM for t in p] + mirror : % -> % mirror p == null p => p monom(mirror$WORD leadingMonomial p, leadingCoefficient p) + _ mirror reductum p + degree : % -> NonNegativeInteger degree(p) == length(maxdeg(p))$WORD + trunc : (%,NonNegativeInteger) -> % trunc(p, n) == p = 0 => p degree(p) > n => trunc( reductum p , n) p + varList : % -> List(vl) varList p == constant? p => [] le : List vl := "setUnion"/[varList(t.k) for t in p] sort_!(le) + rquo : (%,OrderedFreeMonoid(vl)) -> % rquo(p:% , w: WORD) == [[r::WORD,t.c]$TERM for t in p | not (r:= rquo(t.k,w)) case "failed" ] + lquo : (%,OrderedFreeMonoid(vl)) -> % lquo(p:% , w: WORD) == [[r::WORD,t.c]$TERM for t in p | not (r:= lquo(t.k,w)) case "failed" ] + rquo : (%,vl) -> % rquo(p:% , v: vl) == [[r::WORD,t.c]$TERM for t in p | not (r:= rquo(t.k,v)) case "failed" ] + lquo : (%,vl) -> % lquo(p:% , v: vl) == [[r::WORD,t.c]$TERM for t in p | not (r:= lquo(t.k,v)) case "failed" ] + shw: (WORD , WORD) -> % -- shuffle de 2 mots shw(w1,w2) == w1 = 1$WORD => w2::% w2 = 1$WORD => w1::% x: vl := first w1 ; y: vl := first w2 x * shw(rest w1,w2) + y * shw(w1,rest w2) + lquo : (%,%) -> % lquo(p:%,q:%):% == +/ [r * t.c for t in q | (r := lquo(p,t.k)) ^= 0] + rquo : (%,%) -> % rquo(p:%,q:%):% == +/ [r * t.c for t in q | (r := rquo(p,t.k)) ^= 0] + coef : (%,%) -> R coef(p:%,q:%):R == p = 0 => 0$R q = 0 => 0$R @@ -213681,62 +219671,59 @@ XPBWPolynomial(VarSet:OrderedSet,R:CommutativeRing): XDPcat == XDPdef where import(TERM) - -- Representation Rep:= LTERMS - -- local functions - prod1: (BASIS, $) -> $ - prod2: ($, BASIS) -> $ - prod : (BASIS, BASIS) -> $ - prod11: (BASIS, $, NNI) -> $ - prod22: ($, BASIS, NNI) -> $ - outForm : TERM -> EX - Dexpand : BASIS -> XDPOLY - Rexpand : BASIS -> XRPOLY - process : (List LWORD, LWORD, List LWORD) -> $ - mirror1 : BASIS -> $ - -- functions locales + outForm : TERM -> EX outForm t == t.c =$R 1 => t.k :: EX t.k =$BASIS 1 => t.c :: EX t.c::EX * t.k ::EX + prod1: (BASIS, $) -> $ prod1(b:BASIS, p:$):$ == +/ [t.c * prod(b, t.k) for t in p] + prod2: ($, BASIS) -> $ prod2(p:$, b:BASIS):$ == +/ [t.c * prod(t.k, b) for t in p] + prod11: (BASIS, $, NNI) -> $ prod11(b,p,n) == limit: I := n -$I length b +/ [t.c * prod(b, t.k) for t in p| length(t.k) :: I <= limit] + prod22: ($, BASIS, NNI) -> $ prod22(p,b,n) == limit: I := n -$I length b +/ [t.c * prod(t.k, b) for t in p| length(t.k) :: I <= limit] + prod : (BASIS, BASIS) -> $ prod(g,d) == d = 1 => monom(g,1) g = 1 => monom(d,1) process(reverse listOfTerms g, first d, rest listOfTerms d) + Dexpand : BASIS -> XDPOLY Dexpand b == b = 1 => 1$XDPOLY */ [LiePoly(l)$LPOLY :: XDPOLY for l in listOfTerms b] + Rexpand : BASIS -> XRPOLY Rexpand b == b = 1 => 1$XRPOLY */ [LiePoly(l)$LPOLY :: XRPOLY for l in listOfTerms b] + mirror1 : BASIS -> $ mirror1(b:BASIS):$ == b = 1 => 1 lp: LPOLY := LiePoly first b lp := mirror lp mirror1(rest b) * lp :: $ + process : (List LWORD, LWORD, List LWORD) -> $ process(gauche, x, droite) == -- algo du "collect process" null gauche => monom( cons(x, droite) pretend BASIS, 1$R) r1, r2 : $ @@ -213757,11 +219744,13 @@ XPBWPolynomial(VarSet:OrderedSet,R:CommutativeRing): XDPcat == XDPdef where for t in r2] r1 + r2 - -- definitions + 1 : () -> % 1 == monom(1$BASIS, 1$R) + coerce : R -> % coerce(r:R):$ == [[1$BASIS , r]$TERM ] + coerce : % -> OutputForm coerce(p:$):EX == null p => (0$R) :: EX le : List EX := nil @@ -213772,44 +219761,55 @@ XPBWPolynomial(VarSet:OrderedSet,R:CommutativeRing): XDPcat == XDPdef where coerce(p: LPOLY):$ == [[t.k :: BASIS , t.c ]$TERM for t in listOfTerms p] + coerce : % -> XDistributedPolynomial(VarSet,R) coerce(p:$):XDPOLY == +/ [t.c * Dexpand t.k for t in p] + coerce : % -> XRecursivePolynomial(VarSet,R) coerce(p:$):XRPOLY == p = 0 => 0$XRPOLY +/ [t.c * Rexpand t.k for t in p] + constant? : % -> Boolean constant? p == (null p) or (leadingMonomial(p) =$BASIS 1) + constant : % -> R constant p == null p => 0$R p.last.k = 1$BASIS => p.last.c 0$R + quasiRegular? : % -> Boolean quasiRegular? p == (p=0) or (p.last.k ^= 1$BASIS) + quasiRegular : % -> % quasiRegular p == p = 0 => p p.last.k = 1$BASIS => delete(p, maxIndex p) p + ?*? : (%,%) -> % x:$ * y:$ == y = 0$$ => 0 +/ [t.c * prod1(t.k, y) for t in x] + varList : % -> List(VarSet) varList p == lv: List VarSet := "setUnion"/ [varList(b.k)$BASIS for b in p] sort(lv) + degree : % -> NonNegativeInteger degree(p) == p=0 => error "null polynomial" length(leadingMonomial p) + trunc : (%,NonNegativeInteger) -> % trunc(p, n) == p = 0 => p degree(p) > n => trunc( reductum p , n) p + product : (%,%,NonNegativeInteger) -> % product(x,y,n) == x = 0 => 0 y = 0 => 0 @@ -213817,6 +219817,7 @@ XPBWPolynomial(VarSet:OrderedSet,R:CommutativeRing): XDPcat == XDPdef where if R has Module(RN) then + exp : (%,NonNegativeInteger) -> % exp (p,n) == p = 0 => 1 not quasiRegular? p => @@ -213829,6 +219830,7 @@ XPBWPolynomial(VarSet:OrderedSet,R:CommutativeRing): XDPcat == XDPdef where r := r + s r + log : (%,NonNegativeInteger) -> % log (p,n) == p = 1 => 0 p1: $ := 1 - p @@ -213842,6 +219844,7 @@ XPBWPolynomial(VarSet:OrderedSet,R:CommutativeRing): XDPcat == XDPdef where r := k2 * s + r r + LiePolyIfCan : % -> Union(LiePolynomial(VarSet,R),"failed") LiePolyIfCan p == p = 0 => 0$LPOLY "and"/ [retractable?(t.k)$BASIS for t in p] => @@ -213850,6 +219853,7 @@ XPBWPolynomial(VarSet:OrderedSet,R:CommutativeRing): XDPcat == XDPdef where lt pretend LPOLY "failed" + mirror : % -> % mirror p == +/ [t.c * mirror1(t.k) for t in p] @@ -214881,54 +220885,62 @@ XPolynomialRing(R:Ring,E:OrderedMonoid): T == C where (* domain XPR *) (* - --representations Rep:= List TERM - --uses - repeatMultExpt: (%,NonNegativeInteger) -> % - - --define - + 1 : () -> % 1 == [[1$E,1$R]] + characteristic : () -> NonNegativeInteger characteristic == characteristic$R + #? : % -> NonNegativeInteger #x == #$Rep x + maxdeg : % -> E maxdeg p == if null p then error " polynome nul !!" else p.first.k + mindeg : % -> E mindeg p == if null p then error " polynome nul !!" else (last p).k + coef : (%,E) -> R coef(p,e) == for tm in p repeat tm.k=e => return tm.c tm.k < e => return 0$R 0$R + constant? : % -> Boolean constant? p == (p = 0) or (maxdeg(p) = 1$E) + constant : % -> R constant p == coef(p,1$E) + quasiRegular? : % -> Boolean quasiRegular? p == (p=0) or (last p).k ^= 1$E + quasiRegular : % -> % quasiRegular p == quasiRegular?(p) => p [t for t in p | not(t.k = 1$E)] + recip : % -> Union(%,"failed") recip(p) == p=0 => "failed" p.first.k > 1$E => "failed" (u:=recip(p.first.c)) case "failed" => "failed" (u::R)::% + coerce : R -> % coerce(r:R) == if r=0$R then 0$% else [[1$E,r]] + coerce : Integer -> % coerce(n:Integer) == (n::R)::% if R has noZeroDivisors then + ?*? : (%,%) -> % p1:% * p2:% == null p1 => 0 null p2 => 0 @@ -214939,6 +220951,7 @@ XPolynomialRing(R:Ring,E:OrderedMonoid): T == C where else + ?*? : (%,%) -> % p1:% * p2:% == null p1 => 0 null p2 => 0 @@ -214947,25 +220960,30 @@ XPolynomialRing(R:Ring,E:OrderedMonoid): T == C where +/[[[t1.k*t2.k,r]$TERM for t2 in p2 | not (r:=t1.c*t2.c) =$R 0] for t1 in p1] + ?**? : (%,NonNegativeInteger) -> % p:% ** nn:NNI == repeatMultExpt(p,nn) + repeatMultExpt: (%,NonNegativeInteger) -> % repeatMultExpt(x,nn) == nn = 0 => 1 y:% := x for i in 2..nn repeat y:= x * y y + outTerm : (R,E) -> EX outTerm(r:R, m:E):EX == r=1 => m::EX m=1 => r::EX r::EX * m::EX + coerce : % -> OutputForm coerce(a:%):EX == empty? a => (0$R)::EX reduce(_+, reverse_! [outTerm(t.c, t.k) for t in a])$List(EX) if R has Field then + ?/? : (%,R) -> % x/r == inv(r)*x *) @@ -215404,19 +221422,12 @@ XRecursivePolynomial(VarSet:OrderedSet,R:Ring): Xcat == Xdef where import(VPOLY) - -- representation Rep := Union(R,VPOLY) - -- local functions construct: LTERMS -> REGPOLY - simplifie: VPOLY -> % - lquo1: (LTERMS,LTERMS) -> % -- a ajouter - coef1: (LTERMS,LTERMS) -> R -- a ajouter - outForm: REGPOLY -> EX - - --define construct(lt) == lt pretend REGPOLY + ?*? : (%,%) -> % p1:% = p2:% == p1 case R => p2 case R => p1 =$R p2 @@ -215424,10 +221435,12 @@ XRecursivePolynomial(VarSet:OrderedSet,R:Ring): Xcat == Xdef where p2 case R => false p1.c0 =$R p2.c0 and p1.reg =$REGPOLY p2.reg + monom : (OrderedFreeMonoid(VarSet),R) -> % monom(w, r) == r =0 => 0 r * w::% + rquo : (%,%) -> % rquo(p1:%, p2:%):% == p2 case R => p1 * p2::R p1 case R => p1 * p2.c0 @@ -215435,6 +221448,7 @@ XRecursivePolynomial(VarSet:OrderedSet,R:Ring): Xcat == Xdef where | (a:= rquo(t.c,p2)) ^= 0$% ]$LTERMS simplifie [coef(p1,p2) , x]$VPOLY + trunc : (%,NonNegativeInteger) -> % trunc(p,n) == n = 0 or (p case R) => (constant p)::% n1: NNI := (n-1)::NNI @@ -215443,6 +221457,7 @@ XRecursivePolynomial(VarSet:OrderedSet,R:Ring): Xcat == Xdef where x: REGPOLY := construct lt simplifie [constant p, x]$VPOLY + unexpand : XDistributedPolynomial(VarSet,R) -> % unexpand p == constant? p => (constant p)::% vl: List VarSet := sort((y,z) +-> y > z, varList p) @@ -215452,6 +221467,7 @@ XRecursivePolynomial(VarSet:OrderedSet,R:Ring): Xcat == Xdef where if R has CommutativeRing then + sh : (%,NonNegativeInteger) -> % sh(p:%, n:NNI):% == n = 0 => 1 p case R => (p::R)** n @@ -215460,6 +221476,7 @@ XRecursivePolynomial(VarSet:OrderedSet,R:Ring): Xcat == Xdef where lt: LTERMS := [[t.k, sh(t.c, p1)]$TERM for t in listOfTerms p.reg] [p.c0 ** n, construct lt]$VPOLY + sh : (%,%) -> % sh(p1:%, p2:%) == p1 case R => p1::R * p2 p2 case R => p1 * p2::R @@ -215468,15 +221485,18 @@ XRecursivePolynomial(VarSet:OrderedSet,R:Ring): Xcat == Xdef where y: REGPOLY := construct [[t.k,sh(p1,t.c)]$TERM for t in lt2] [p1.c0*p2.c0,x + y]$VPOLY + RemainderList : % -> List(Record(k: VarSet,c: %)) RemainderList p == p case R => [] listOfTerms( p.reg)$REGPOLY + lquo : (%,%) -> % lquo(p1:%,p2:%):% == p2 case R => p1 * p2 p1 case R => p1 *$R p2.c0 p1 * p2.c0 +$% lquo1(listOfTerms p1.reg, listOfTerms p2.reg) + lquo1: (LTERMS,LTERMS) -> % -- a ajouter lquo1(x:LTERMS,y:LTERMS):% == null x => 0$% null y => 0$% @@ -215485,11 +221505,13 @@ XRecursivePolynomial(VarSet:OrderedSet,R:Ring): Xcat == Xdef where lquo(x.first.c,y.first.c) + lquo1(x.rest,y.rest) return lquo1(x.rest,y) + coef : (%,%) -> R coef(p1:%, p2:%):R == p1 case R => p1::R * constant p2 p2 case R => p1.c0 * p2::R p1.c0 * p2.c0 +$R coef1(listOfTerms p1.reg, listOfTerms p2.reg) + coef1: (LTERMS,LTERMS) -> R -- a ajouter coef1(x:LTERMS,y:LTERMS):R == null x => 0$R null y => 0$R @@ -215499,40 +221521,52 @@ XRecursivePolynomial(VarSet:OrderedSet,R:Ring): Xcat == Xdef where return coef1(x.rest,y) -------------------------------------------------------------- + outForm: REGPOLY -> EX outForm(p:REGPOLY): EX == le : List EX := [t.k::EX * t.c::EX for t in listOfTerms p] reduce(_+, reverse_! le)$List(EX) + coerce : % -> OutputForm coerce(p:$): EX == p case R => (p::R)::EX p.c0 = 0 => outForm p.reg p.c0::EX + outForm p.reg + 0 : () -> % 0 == 0$R::% + 1 : () -> % 1 == 1$R::% + constant? : % -> Boolean constant? p == p case R + constant : % -> R constant p == p case R => p p.c0 + simplifie: VPOLY -> % simplifie p == p.reg = 0$REGPOLY => (p.c0)::% p + coerce : VarSet -> % coerce (v:VarSet):% == [0$R,coerce(v)$REGPOLY]$VPOLY + coerce : R -> % coerce (r:R):% == r::% + coerce : Integer -> % coerce (n:Integer) == n::R::% + coerce : OrderedFreeMonoid(VarSet) -> % coerce (w:WORD) == w = 1 => 1$R (first w) * coerce(rest w) + expand : % -> XDistributedPolynomial(VarSet,R) expand p == p case R => p::R::XDPOLY lt:LTERMS := listOfTerms(p.reg) @@ -215541,44 +221575,52 @@ XRecursivePolynomial(VarSet:OrderedSet,R:Ring): Xcat == Xdef where ep:= ep + t.k * expand(t.c) ep + -? : % -> % - p:% == p case R => -$R p [- p.c0, - p.reg]$VPOLY + ?+? : (%,%) -> % p1 + p2 == p1 case R and p2 case R => p1 +$R p2 p1 case R => [p1 + p2.c0 , p2.reg]$VPOLY p2 case R => [p2 + p1.c0 , p1.reg]$VPOLY simplifie [p1.c0 + p2.c0 , p1.reg +$REGPOLY p2.reg]$VPOLY + ?-? : (%,%) -> % p1 - p2 == p1 case R and p2 case R => p1 -$R p2 p1 case R => [p1 - p2.c0 , -p2.reg]$VPOLY p2 case R => [p1.c0 - p2 , p1.reg]$VPOLY simplifie [p1.c0 - p2.c0 , p1.reg -$REGPOLY p2.reg]$VPOLY + ?*? : (Integer,%) -> % n:Integer * p:% == n=0 => 0$% p case R => n *$R p -- [ n*p.c0,n*p.reg]$VPOLY simplifie [ n*p.c0,n*p.reg]$VPOLY + ?*? : (R,%) -> % r:R * p:% == r=0 => 0$% p case R => r *$R p -- [ r*p.c0,r*p.reg]$VPOLY simplifie [ r*p.c0,r*p.reg]$VPOLY + ?*? : (%,R) -> % p:% * r:R == r=0 => 0$% p case R => p *$R r -- [ p.c0 * r,p.reg * r]$VPOLY simplifie [ r*p.c0,r*p.reg]$VPOLY + ?*? : (VarSet,%) -> % v:VarSet * p:% == p = 0 => 0$% [0$R, v *$REGPOLY p]$VPOLY + ?*? : (%,%) -> % p1:% * p2:% == p1 case R => p1::R * p2 p2 case R => p1 * p2::R @@ -215587,41 +221629,51 @@ XRecursivePolynomial(VarSet:OrderedSet,R:Ring): Xcat == Xdef where -- [ p1.c0 * p2.c0 , x+y ]$VPOLY simplifie [ p1.c0 * p2.c0 , x+y ]$VPOLY + lquo : (%,VarSet) -> % lquo(p:%, v:VarSet):% == p case R => 0 coefficient(p.reg,v)$REGPOLY + lquo : (%,OrderedFreeMonoid(VarSet)) -> % lquo(p:%, w:WORD):% == w = 1$WORD => p lquo(lquo(p,first w),rest w) + rquo : (%,VarSet) -> % rquo(p:%, v:VarSet):% == p case R => 0 x:REGPOLY := construct [[t.k, a]$TERM for t in listOfTerms(p.reg) | (a:= rquo(t.c,v)) ^= 0 ] simplifie [constant(coefficient(p.reg,v)) , x]$VPOLY + rquo : (%,OrderedFreeMonoid(VarSet)) -> % rquo(p:%, w:WORD):% == w = 1$WORD => p rquo(rquo(p,rest w),first w) + coef : (%,OrderedFreeMonoid(VarSet)) -> R coef(p:%, w:WORD):R == constant lquo(p,w) + quasiRegular? : % -> Boolean quasiRegular? p == p case R => p = 0$R p.c0 = 0$R + quasiRegular : % -> % quasiRegular p == p case R => 0$% [0$R,p.reg]$VPOLY + characteristic : () -> NonNegativeInteger characteristic == characteristic()$R + recip : % -> Union(%,"failed") recip p == p case R => recip(p::R) "failed" + mindeg : % -> OrderedFreeMonoid(VarSet) mindeg p == p case R => p = 0 => error "XRPOLY.mindeg: polynome nul !!" @@ -215629,22 +221681,26 @@ XRecursivePolynomial(VarSet:OrderedSet,R:Ring): Xcat == Xdef where p.c0 ^= 0 => 1$WORD "min"/[(t.k) *$WORD mindeg(t.c) for t in listOfTerms p.reg] + maxdeg : % -> OrderedFreeMonoid(VarSet) maxdeg p == p case R => p = 0 => error "XRPOLY.maxdeg: polynome nul !!" 1$WORD "max"/[(t.k) *$WORD maxdeg(t.c) for t in listOfTerms p.reg] + degree : % -> NonNegativeInteger degree p == p = 0 => error "XRPOLY.degree: polynome nul !!" length(maxdeg p) + map : ((R -> R),%) -> % map(fn,p) == p case R => fn(p::R) x:REGPOLY := construct [[t.k,a]$TERM for t in listOfTerms p.reg |(a := map(fn,t.c)) ^= 0$R] simplifie [fn(p.c0),x]$VPOLY + varList : % -> List(VarSet) varList p == p case R => [] lv: List VarSet:= "setUnion"/[varList(t.c) for t in listOfTerms p.reg] diff --git a/changelog b/changelog index 5b048bb..f9bde24 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,5 @@ +20150912 tpd src/axiom-website/patches.html 20150912.01.tpd.patch +20150912 tpd books/bookvol10.3 add signatures for COQ 20150830 tpd src/axiom-website/patches.html 20150830.01.tpd.patch 20150830 tpd books/bookvolbib add Tanenbaum, Knuth references 20150828 tpd src/axiom-website/patches.html 20150828.01.tpd.patch diff --git a/patch b/patch index 07486a1..951082f 100644 --- a/patch +++ b/patch @@ -1,33 +1,6 @@ -books/bookvolbib add Tanenbaum, Knuth references +books/bookvol10.3 add signatures for COQ Goal: Proving Axiom Correct -@article{Tane76, - author = "Tanenbaum, Andrew S.", - title = "In Defense of Program Testing or Correctness Proofs Considered Harmf journal = "SIGPLAN Notices", - volume = "11", - number = "1", - year = "1976", - pages = "64-68", - paper = "Tane76.pdf", - abstract = "Dijkstra's remark to the effect that testing can only - demonstrate the presence of errors and not their absence is - unquestionably true. This observation, together with the recent - development of techniques for formally proving programs to be correct, - has led some computer scientists to believe that correctness proofs - - can replace testing as a means for insuring that programs do what - they are supposed to do. The purpose of this note is to point out - several reasons why even programs rigorously proven to be correct - should be neertheless thoroughly tested. Correctness proofs can - supplement, but cannot replace comprehensive testing." -} - -@misc{Knut15, - author = "Unknown", - title = "Knuth & Plass line-breaking Revisited", - year = "2015", - url = "http://defoe.sourceforge.net/folio/knuth-plass.html" -} - - +All of the functions in every domain now have signatures. +We are now prepared for the next step in the proof. diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index c8ce761..7223daa 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -5122,6 +5122,8 @@ books/bookvol10.* extract code for COQ proof system
books/bookvol10.4 add signatures to all package functions
20150830.01.tpd.patch books/bookvolbib add Tanenbaum, Knuth references
+20150912.01.tpd.patch +books/bookvol10.3 add signatures for COQ
-- 1.7.5.4