login  home  contents  what's new  discussion  bug reports     help  links  subscribe  changes  refresh  edit

Edit detail for SandBoxLinearOperator revision 6 of 15

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
Editor: Bill Page
Time: 2011/05/04 20:28:01 GMT-7
Note: use FreeMonoid operations

changed:
-    -- repeated sum
-    (p:NNI * f:%):% ==
-      p=1 => f
-      q:=subtractIfCan(p,1)
-      q case NNI => q*f + f
-      -- zero map (non-trivial)
-      per coerce [dom f,cod f,0*dat(f).data]
    -- repeated sum (inherit from Ring)
    --(p:NNI * f:%):% ==
    --  p=1 => f
    --  q:=subtractIfCan(p,1)
    --  q case NNI => q*f + f
    --  -- zero map (non-trivial)
    --  per coerce [dom f,cod f,0*dat(f).data]

changed:
-      one? f => g
-      one? g => f
-      per(rep f * rep g)
-
-    -- repeated product
-    (f:% ^ p:NNI):% ==
-      p=1 => f
-      q:=subtractIfCan(p,1)
-      q case NNI => f^q * f
-      1
      --one? f => g
      --one? g => f
      per (rep f * rep g)

    -- repeated product (inherit from Monoid)
    --(f:% ^ p:NNI):% == per rep(f)^p
    --  p=1 => f
    --  q:=subtractIfCan(p,1)
    --  q case NNI => f^q * f
    --  1

changed:
-      I1:L:=[1,1,kroneckerDelta()$T]
-      fs:=factors rep f
-      gs:=factors rep g
-
-      l1:NNI:=0
-      nf := first(fs).exp
-      ng := first(gs).exp
-      if first(fs).gen=I1 then
-        if first(gs).gen=I1 then
-          if nf < ng then
-            l1 := nf
-            ng := (ng - nf) pretend NNI
-            nf := 0
-          else
-            l1 := ng
-            nf := (nf - ng) pretend NNI
-            ng := 0
-        else
-          ng := 0
-      else
-        nf := 0
-      if not first(gs).gen=I1 then
-        ng := 0
      I1 := rep(I)^cod(f)

      nI := hclf(hclf(rep f,rep g),I1)
      nl := nthExpon(nI,1)
      f := per overlap(nI,rep f).rm
      g := per overlap(nI,rep g).rm

      In := hcrf(hcrf(rep f,rep g),I1)
      ln := nthExpon(In,1)
      f := per overlap(rep f,In).lm
      g := per overlap(rep g,In).lm

      nf:=nthExpon(hclf(rep f,I1),1)
      ng:=nthExpon(hclf(rep g,I1),1)
      fn:=nthExpon(hcrf(rep f,I1),1)
      gn:=nthExpon(hcrf(rep g,I1),1)

changed:
-      print(bracket [nf::OutputForm,ng::OutputForm])$OutputForm
-
-      t1:NNI:=0
-      fn := last(fs).exp
-      gn := last(gs).exp
-      if last(fs).gen=I1 then
-        if last(gs).gen=I1 then
-          if fn < gn then
-            t1 := fn
-            gn := (gn - fn) pretend NNI
-            fn := 0
-          else
-            t1 := gn
-            fn := (fn - gn) pretend NNI
-            gn := 0
-        else
-          gn := 0
-      else
-        fn := 0
-      if not last(gs).gen=I1 then
-        gn := 0
-
-      if fn>0 and fn>0 then error "either fn or gn or both must be 0"
-      print(bracket [fn::OutputForm,gn::OutputForm])$OutputForm
-
-      print(bracket [l1::OutputForm,t1::OutputForm])$OutputForm
-
-      -- debugging defeat optimizations
      output("leading [nl,nf,ng] = ",[nl,nf,ng]::OutputForm)$OutputPackage

      if fn>0 and gn>0 then error "either fn or gn or both must be 0"
      output("trailing [ln,fn,gn] = ",[ln,fn,gn]::OutputForm)$OutputPackage

      -- debugging to defeat optimizations

changed:
-      fn:=0; gn:=0
      --fn:=0; gn:=0

removed:
-
-      if l1 > 0 then
-        first(fs).exp := nf 
-        first(gs).exp := ng
-      if t1>0 then
-        last(fs).exp := fn
-        last(gs).exp := gn
-
-      if nf>0 then
-        -- leading input identities (I^n*f)/g
-        fs := last(fs,(#fs-1) pretend NNI)
-      if ng>0 then
-        -- leading output identities g/(I^n*g)
-        gs := last(gs,(#gs-1) pretend NNI)
-      if fn>0 then
-        -- trailing input identities (f*I^n)/g
-        fs := first(fs,(#fs-1) pretend NNI)
-      if gn>0 then
-        -- trailing output identities f/(g*I^n)
-        gs := first(gs,(#gs-1) pretend NNI)
-
-      f := per coerce dats(fs)
-      g := per coerce dats(gs)

changed:
-          -- no leading and no trailing input or output
          output("case 1: no leading and no trailing input or output")$OutputPackage

changed:
-        else if fn>0 then
-          -- trailing input 
        else if fn>0 then 
          output("case 2: trailing input, fn=", fn::OutputForm)$OutputPackage

changed:
-          -- trailing output
          output("case 3: trailing output, gn=", gn::OutputForm)$OutputPackage

changed:
-          r:=reindex(r,concat [[i for i in 1..dom(f)],[dom(f)+gn+i for i in 1..cod(g)],[dom(f)+i for i in 1..gn]])
          p:List Integer:=concat [ _
            [i for i in 1..dom(f)], _
            [dom(f)+gn+i for i in 1..cod(g)], _
            [dom(f)+i for i in 1..gn] ]
          print(p::OutputForm)$OutputForm
          r:=reindex(r,p)

changed:
-            -- leading input
            output("case 4: leading input, nf=", nf::OutputForm)$OutputPackage

changed:
-            p:List Integer:=concat [[dom(f)+i for i in 1..nf],[i for i in 1..dom(f)],[nf+dom(f)+i for i in 1..cod(g)]]
            p:List Integer:=concat [ _
              [dom(f)+i for i in 1..nf], _
              [i for i in 1..dom(f)], _
              [nf+dom(f)+i for i in 1..cod(g)] ]
            print(p::OutputForm)$OutputForm

changed:
-            -- leading input and trailing input
            output("case 5: leading input and trailing input, [nf,fn]=", [nf,fn]::OutputForm)$OutputPackage

changed:
-            r:T := contract(cod(f), dat(f).data,f1, dat(g).data,1)
            r:T := contract(cod(f), dat(f).data,f1, dat(g).data,nf+1)
            p:List Integer:=concat [ _
              [dom(f)+i for i in 1..nf], _
              [i for i in 1..dom(f)], _
              [dom(f)+nf+i for i in 1..fn], _
              [dom(f)+nf+fn+i for i in 1..cod(g)] ]
            print(p::OutputForm)$OutputForm
            r:=reindex(r,p)

changed:
-            -- leading input and trailing output
            output("case 6: leading input and trailing output, [nf,gn]=", [nf,gn]::OutputForm)$OutputPackage

removed:
-            output("rank r = ",rank(r)::OutputForm)$OutputPackage

changed:
-              [dom(f)+i for i in 1..gn]]
              [dom(f)+i for i in 1..gn] ]

changed:
-            -- leading output
            output("case 7: leading output, ng=", ng::OutputForm)$OutputPackage

changed:
-            -- leading output and trailing input
            output("case 8: leading output and trailing input, [ng,fn]=", [ng,fn]::OutputForm)$OutputPackage

changed:
-            r:T := contract(cod(f), dat(f).data,f1, dat(g).data,1)
            r:T := contract(cod(f)-ng, dat(f).data,f1+ng, dat(g).data,1)
            p:List Integer:=concat [ _
              [i for i in 1..dom(f)], _
              [dom(f)+ng+i for i in 1..fn], _
              [dom(f)+i for i in 1..ng], _
              [dom(f)+ng+fn+i for i in 1..cod(g)] ]
            print(p::OutputForm)$OutputForm
            r:=reindex(r,p)

changed:
-            -- leading output and trailing output
            output("case 9: leading output and trailing output, [ng,gn]::OutputForm")$OutputPackage

changed:
-            r:T := contract(cod(f), dat(f).data,f1, dat(g).data,1)
-
-      I^l1 * per coerce [nf+dom(f)+fn,ng+cod(g)+gn,r] * I^t1
            r:T := contract(dom(g), dat(f).data,f1+ng, dat(g).data,1)
            p:List Integer:=concat [ _
              [i for i in 1..dom(f)], _
              [dom(f)+i for i in 1..ng], _
              [dom(f)+ng+gn+i for i in 1..cod(g)], _
              [dom(f)+ng+i for i in 1..gn] ]
            print(p::OutputForm)$OutputForm
            r:=reindex(r,p)

      per nI * per coerce [nf+dom(f)+fn,ng+cod(g)+gn,r] * per In

changed:
-L:=LAZY(2,OVAR [],EXPR INT)
-I:L:=[1]
-X:L:=[2,1]
L := LAZY(2,OVAR [],EXPR INT)
I:L := [1]
test( I*I = [1,2] )
A:L := out [ inp([a11,a12])$L, inp([a21,a22])$L ]
A*A
A^2
X:L := [2,1]
-- printing

added:
I*I*I

added:

Various special cases of composition
\begin{axiom}
-- case 1
test( X/X = [1,2] )
I*I
test( (I*X)/(I*X) = [1,2,3] )
I*I
test( (I*X*I)/(I*X*I) = [1,2,3] )
I*I
-- case 2
test( (X*I*I)/(X*X) = [1,2,4,3] )
I*I
-- case 3
test( (X*X)/(X*I*I) = [1,2,4,3] )
I*I
-- case 4
test ( (I*I*X)/(X*X) = [2,1,3,4] )
I*I
-- case 5
test( (I*X*I)/(X*X) = [3,1,4,2] )
I*I
-- case 6
test( (I*I*X)/(X*I*I)=[2,1,4,3] )
I*I
-- case 6
test( (I*X)/(X*I) = [3,1,2] )
I*I
-- case 6
test( (I*X*I)/(X*I*I)=[3,1,2,4] )
I*I
-- case 7
arity(X*X)
arity(I*I*X)
dom(I*I*X)
cod(I*I*X)
I*I*X
I*I
I^2
I*I*I
I^3
A*A
X*X
I:L := [1]
I*I
test( (X*X)/(I*I*X) = [2,1,3,4] )
-- case 8
test( (X*I)/(I*X) = [2,3,1] )
-- case 9
test( (X*X)/(I*X*I) = [2,4,1,3] )
\end{axiom}

axiom
)lib CARTEN MONAL PROP LIN
CartesianTensor is now explicitly exposed in frame initial CartesianTensor will be automatically loaded when needed from /var/zope2/var/LatexWiki/CARTEN.NRLIB/CARTEN Monoidal is now explicitly exposed in frame initial Monoidal will be automatically loaded when needed from /var/zope2/var/LatexWiki/MONAL.NRLIB/MONAL Prop is now explicitly exposed in frame initial Prop will be automatically loaded when needed from /var/zope2/var/LatexWiki/PROP.NRLIB/PROP LinearOperator is now explicitly exposed in frame initial LinearOperator will be automatically loaded when needed from /var/zope2/var/LatexWiki/LIN.NRLIB/LIN

spad
)abbrev domain LAZY LazyLinearOperator
LazyLinearOperator(dim:NNI,gener:OrderedFinite,K:CommutativeRing): Exports == Implementation where
  NNI ==> NonNegativeInteger
  NAT ==> PositiveInteger
  T ==> CartesianTensor(1,dim,K)
Exports ==> Join(Ring, BiModule(K,K), Monoidal NNI, RetractableTo K) with inp: List K -> % ++ incoming vector inp: List % -> % out: List K -> % ++ output vector out: List % -> % arity: % -> Prop % basisVectors: () -> List % basisForms: () -> List % tensor: % -> T map: (K->K,%) -> % if K has Evalable(K) then Evalable(K) eval: % -> % ravel: % -> List K unravel: (Prop %,List K) -> % coerce:(x:List NAT) -> % ++ identity for composition and permutations of its products coerce:(x:List None) -> % ++ [] = 1 elt: (%,%) -> % elt: (%,NAT) -> % elt: (%,NAT,NAT) -> % elt: (%,NAT,NAT,NAT) -> % _/: (Tuple %,Tuple %) -> % _/: (Tuple %,%) -> % _/: (%,Tuple %) -> % ++ yet another syntax for product ev: NAT -> % ++ (2,0)-tensor for evaluation co: NAT -> % ++ (0,2)-tensor for co-evaluation
Implementation ==> add import List NNI import NAT L ==> Record(domain:NNI, codomain:NNI, data:T) -- FreeMonoid provides unevaluated products Rep == FreeMonoid L RR ==> Record(gen:L,exp:NNI) rep(x:%):Rep == x pretend Rep per(x:Rep):% == x pretend %
-- Prop (arity) dom(f:%):NNI == r:NNI := 0 for y in factors(rep f) repeat r:=r+(y.gen.domain)*(y.exp) return r cod(f:%):NNI == r:NNI := 0 for y in factors(rep f) repeat r:=r+(y.gen.codomain)*(y.exp) return r
prod(f:L,g:L):L == r:T := product(f.data,g.data) -- dom(f) + cod(f) + dom(g) + cod(g) p:List Integer := concat _ [[i for i in 1..(f.domain)], _ [(f.domain)+(f.codomain)+i for i in 1..(g.domain)], _ [(f.domain)+i for i in 1..(f.codomain)], _ [(f.domain)+(g.domain)+(f.codomain)+i for i in 1..(g.codomain)]] -- dom(f) + dom(g) + cod(f) + cod(g) [(f.domain)+(g.domain),(f.codomain)+(g.codomain),reindex(r,p)]
dats(fs:List RR):L == r:L := [0,0,1$T] for y in fs repeat t:L:=y.gen for n in 1..y.exp repeat r:=prod(r,t) return r
dat(f:%):L == dats factors rep f
arity(f:%):Prop % == f::Prop %
eval(f:%):% == per coerce dat(f)
retractIfCan(f:%):Union(K,"failed") == dom(f)=0 and cod(f)=0 => retract(dat(f).data)$T return "failed" retract(f:%):K == dom(f)=0 and cod(f)=0 => retract(dat(f).data)$T error "failed"
-- basis basisVectors():List % == [per coerce [0,1,entries(row(1,i)$SquareMatrix(dim,K))::T] for i in 1..dim] basisForms():List % == [per coerce [1,0,entries(row(1,i)$SquareMatrix(dim,K))::T] for i in 1..dim] ev(n:NAT):% == dx:= basisForms() reduce(_+,[ (dx.i)^n * (dx.i)^n for i in 1..dim]) co(n:NAT):% == Dx:= basisVectors() reduce(_+,[ (Dx.i)^n * (Dx.i)^n for i in 1..dim])
-- manipulation map(f:K->K, g:%):% == per coerce [dom g,cod g,unravel(map(f,ravel dat(g).data))$T] if K has Evalable(K) then eval(g:%,f:List Equation K):% == map((x:K):K+->eval(x,f),g) ravel(g:%):List K == ravel dat(g).data unravel(p:Prop %,r:List K):% == dim^(dom(p)+cod(p)) ~= #r => error "failed" per coerce [dom(p),cod(p),unravel(r)$T] tensor(x:%):T == dat(x).data
-- sum (f:% + g:%):% == dat(f).data=0 => g dat(g).data=0 => f dom(f) ~= dom(g) or cod(f) ~= cod(g) => error "arity" per coerce [dom f,cod f,dat(f).data+dat(g).data]
(f:% - g:%):% == dat(f).data=0 => g dat(g).data=0 => f dom(f) ~= dom(f) or cod(g) ~= cod(g) => error "arity" per coerce [dom f, cod f,dat(f).data-dat(g).data]
_-(f:%):% == per coerce [dom f, cod f,-dat(f).data]
-- repeated sum (inherit from Ring) --(p:NNI * f:%):% == -- p=1 => f -- q:=subtractIfCan(p,1) -- q case NNI => q*f + f -- -- zero map (non-trivial) -- per coerce [dom f,cod f,0*dat(f).data]
-- identity for sum (trivial zero map) 0 == per coerce [0,0,0] zero?(f:%):Boolean == dat(f).data = 0 * dat(f).data -- identity for product --1:% == per coerce [0,0,1] 1:% == per 1 one?(f:%):Boolean == dat(f).data = 1$T -- identity for composition I == per coerce [1,1,kroneckerDelta()$T] (x:% = y:%):Boolean == rep eval x = rep eval y
-- permutations and identities coerce(p:List NAT):% == r:=I^#p #p = 1 and p.1 = 1 => return r p1:List Integer:=[i for i in 1..#p] p2:List Integer:=[#p+i for i in p] p3:=concat(p1,p2) per coerce [#p,#p,reindex(dat(r).data,p3)] coerce(p:List None):% == per coerce [0,0,1] coerce(x:K):% == 1*x
-- product elt(f:%,g:%):% == f * g elt(f:%,g:NAT):% == f * I^g elt(f:%,g1:NAT,g2:NAT):% == f * [g1 @ NAT,g2 @ NAT]::List NAT::% elt(f:%,g1:NAT,g2:NAT,g3:NAT):% == f * [g1 @ NAT,g2 @ NAT,g3 @ NAT]::List NAT::% apply(f:%,g:%):% == f * g (f:% * g:%):% == --one? f => g --one? g => f per (rep f * rep g)
-- repeated product (inherit from Monoid) --(f:% ^ p:NNI):% == per rep(f)^p -- p=1 => f -- q:=subtractIfCan(p,1) -- q case NNI => f^q * f -- 1
-- composition: -- f/g : A^n -> A^p = f:A^n -> A^m / g:A^m -> A^p (ff:% / gg:%):% == g:=gg; f:=ff -- partial application from the left n:=subtractIfCan(cod ff,dom gg) if n case NNI and n>0 then -- apply g on f from the left, pass extra f outputs on the right print(hconcat([message("arity warning: "), _ over(arity(ff)::OutputForm, _ arity(gg)::OutputForm*(arity(I)::OutputForm)^n::OutputForm) ]))$OutputForm g:=gg*I^n m:=subtractIfCan(dom gg, cod ff) -- apply g on f from the left, add extra g inputs on the left if m case NNI and m>0 then print(hconcat([message("arity warning: "), _ over((arity(I)::OutputForm)^m::OutputForm*arity(ff)::OutputForm, _ arity(gg)::OutputForm)]))$OutputForm f:=I^m*ff
-- optimize leading and trailing identities I1 := rep(I)^cod(f)
nI := hclf(hclf(rep f,rep g),I1) nl := nthExpon(nI,1) f := per overlap(nI,rep f).rm g := per overlap(nI,rep g).rm
In := hcrf(hcrf(rep f,rep g),I1) ln := nthExpon(In,1) f := per overlap(rep f,In).lm g := per overlap(rep g,In).lm
nf:=nthExpon(hclf(rep f,I1),1) ng:=nthExpon(hclf(rep g,I1),1) fn:=nthExpon(hcrf(rep f,I1),1) gn:=nthExpon(hcrf(rep g,I1),1)
if nf>0 and ng>0 then error "either nf or ng or both must be 0" output("leading [nl,nf,ng] = ",[nl,nf,ng]::OutputForm)$OutputPackage
if fn>0 and gn>0 then error "either fn or gn or both must be 0" output("trailing [ln,fn,gn] = ",[ln,fn,gn]::OutputForm)$OutputPackage
-- debugging to defeat optimizations --nf:=0; ng:=0 --fn:=0; gn:=0 --l1:=0; t1:=0
if nf=0 and ng=0 then if fn=0 and gn=0 then output("case 1: no leading and no trailing input or output")$OutputPackage f1:Integer:=dom(f)+1 r:T := contract(cod(f), dat(f).data,f1, dat(g).data,1) -- no need to reindex else if fn>0 then output("case 2: trailing input, fn=", fn::OutputForm)$OutputPackage f1:Integer:=dom(f)+1 r:T := contract(cod(f), dat(f).data,f1, dat(g).data,1) -- no need to reindex else output("case 3: trailing output, gn=", gn::OutputForm)$OutputPackage f1:Integer:=dom(f)+1 r:T := contract(dom(g), dat(f).data,f1, dat(g).data,1) -- all f'f inputs then f's extra outputs after g's outputs p:List Integer:=concat [ _ [i for i in 1..dom(f)], _ [dom(f)+gn+i for i in 1..cod(g)], _ [dom(f)+i for i in 1..gn] ] print(p::OutputForm)$OutputForm r:=reindex(r,p) else if nf>0 then if fn=0 and gn=0 then output("case 4: leading input, nf=", nf::OutputForm)$OutputPackage r:T := contract(cod(f), dat(f).data,dom(f)+1, dat(g).data,nf+1) -- g's extra inputs before f's then all g's outputs p:List Integer:=concat [ _ [dom(f)+i for i in 1..nf], _ [i for i in 1..dom(f)], _ [nf+dom(f)+i for i in 1..cod(g)] ] print(p::OutputForm)$OutputForm r:=reindex(r,p) else if fn>0 then output("case 5: leading input and trailing input, [nf,fn]=", [nf,fn]::OutputForm)$OutputPackage f1:Integer:=dom(f)+1 r:T := contract(cod(f), dat(f).data,f1, dat(g).data,nf+1) p:List Integer:=concat [ _ [dom(f)+i for i in 1..nf], _ [i for i in 1..dom(f)], _ [dom(f)+nf+i for i in 1..fn], _ [dom(f)+nf+fn+i for i in 1..cod(g)] ] print(p::OutputForm)$OutputForm r:=reindex(r,p) else output("case 6: leading input and trailing output, [nf,gn]=", [nf,gn]::OutputForm)$OutputPackage f1:Integer:=dom(f)+1 r:T := contract(cod(f)-gn, dat(f).data,f1, dat(g).data,nf+1) -- g's extra inputs before f's inputs, f's extra outputs after g's outputs p:List Integer:=concat [ _ [dom(f)+gn+i for i in 1..nf], _ [i for i in 1..dom(f)], _ [dom(f)+nf+gn+i for i in 1..cod(g)], _ [dom(f)+i for i in 1..gn] ] print(p::OutputForm)$OutputForm r:=reindex(r,p) else if fn=0 and gn=0 then output("case 7: leading output, ng=", ng::OutputForm)$OutputPackage f1:Integer:=dom(f)+1 r:T := contract(dom(g), dat(f).data,f1+ng, dat(g).data,1) -- no need to reindex else if fn>0 then output("case 8: leading output and trailing input, [ng,fn]=", [ng,fn]::OutputForm)$OutputPackage f1:Integer:=dom(f)+1 r:T := contract(cod(f)-ng, dat(f).data,f1+ng, dat(g).data,1) p:List Integer:=concat [ _ [i for i in 1..dom(f)], _ [dom(f)+ng+i for i in 1..fn], _ [dom(f)+i for i in 1..ng], _ [dom(f)+ng+fn+i for i in 1..cod(g)] ] print(p::OutputForm)$OutputForm r:=reindex(r,p) else output("case 9: leading output and trailing output, [ng,gn]::OutputForm")$OutputPackage f1:Integer:=dom(f)+1 r:T := contract(dom(g), dat(f).data,f1+ng, dat(g).data,1) p:List Integer:=concat [ _ [i for i in 1..dom(f)], _ [dom(f)+i for i in 1..ng], _ [dom(f)+ng+gn+i for i in 1..cod(g)], _ [dom(f)+ng+i for i in 1..gn] ] print(p::OutputForm)$OutputForm r:=reindex(r,p)
per nI * per coerce [nf+dom(f)+fn,ng+cod(g)+gn,r] * per In
-- another notation for composition of products (t:Tuple % / x:%):% == t / construct([x])$PrimitiveArray(%)::Tuple(%) (x:% / t:Tuple %):% == construct([x])$PrimitiveArray(%)::Tuple(%) / t (f:Tuple % / g:Tuple %):% == fs:List % := [select(f,i) for i in 0..length(f)-1] gs:List % := [select(g,i) for i in 0..length(g)-1] fr:=reduce(elt@(%,%)->%,fs,1) gr:=reduce(elt@(%,%)->%,gs,1) fr / gr
(x:K * y:%):% == per coerce [dom y, cod y,x*dat(y).data] (x:% * y:K):% == per coerce [dom x,cod x,dat(x).data*y] (x:Integer * y:%):% == per coerce [dom y,cod y,x*dat(y).data]
-- constructors inp(x:List K):% == per coerce [1,0,entries(x)::T] inp(x:List %):% == #removeDuplicates([dom(y) for y in x]) ~= 1 or #removeDuplicates([cod(y) for y in x]) ~= 1 => error "arity" per coerce [dom(first x)+1, cod(first x), [dat(y).data for y in x]::T]$L out(x:List K):% == per coerce [0,1,entries(x)::T] out(x:List %):% == #removeDuplicates([dom(y) for y in x])~=1 or #removeDuplicates([cod(y) for y in x])~=1 => error "arity" per coerce [dom(first x), cod(first x)+1, [dat(y).data for y in x]::T]$L
-- display operators using basis show(x:%):OutputForm == dom(x)=0 and cod(x)=0 => return (dat(x).data)::OutputForm if size()$gener > 0 then gens:List OutputForm:=[index(i::PositiveInteger)$gener::OutputForm for i in 1..dim] else -- default to numeric indices gens:List OutputForm:=[i::OutputForm for i in 1..dim] -- input basis inps:List OutputForm := [] for i in 1..dom(x) repeat empty? inps => inps:=gens inps:=concat [[(inps.k * gens.j) for j in 1..dim] for k in 1..#inps] -- output basis outs:List OutputForm := [] for i in 1..cod(x) repeat empty? outs => outs:=gens outs:=concat [[(outs.k * gens.j) for j in 1..dim] for k in 1..#outs] -- combine input (superscripts) and/or output(subscripts) to form basis symbols bases:List OutputForm if #inps > 0 and #outs > 0 then bases:=concat([[ scripts(message("|"),[i,j]) for i in outs] for j in inps]) else if #inps > 0 then bases:=[super(message("|"),i) for i in inps] else if #outs > 0 then bases:=[sub(message("|"),j) for j in outs] else bases:List OutputForm:= [] -- merge bases with data to form term list terms:=[(k=1 => base;k::OutputForm*base) for base in bases for k in ravel dat(x).data | k~=0] empty? terms => return 0::OutputForm -- combine the terms return reduce(_+,terms)
coerce(x:%):OutputForm == r:OutputForm := empty() for y in factors(rep x) repeat if y.exp = 1 then if size rep x = 1 then r := show per coerce y.gen else r:=r*paren(list show per coerce y.gen) else r:=r*paren(list show per coerce y.gen)^(y.exp::OutputForm) return r
spad
   Compiling FriCAS source code from file 
      /var/zope2/var/LatexWiki/674384337385656402-25px002.spad using 
      old system compiler.
   LAZY abbreviates domain LazyLinearOperator 
------------------------------------------------------------------------
   initializing NRLIB LAZY for LazyLinearOperator 
   compiling into NRLIB LAZY 
   importing List NonNegativeInteger
   importing PositiveInteger
   processing macro definition L ==> Record(domain: NonNegativeInteger,codomain: NonNegativeInteger,data: CartesianTensor(One,dim,K)) 
   processing macro definition RR ==> Record(gen: Record(domain: NonNegativeInteger,codomain: NonNegativeInteger,data: CartesianTensor(One,dim,K)),exp: NonNegativeInteger) 
   compiling local rep : $ -> FreeMonoid Record(domain: NonNegativeInteger,codomain: NonNegativeInteger,data: CartesianTensor(One,dim,K))
      LAZY;rep is replaced by x 
Time: 0.13 SEC.
compiling local per : FreeMonoid Record(domain: NonNegativeInteger,codomain: NonNegativeInteger,data: CartesianTensor(One,dim,K)) -> $ LAZY;per is replaced by x Time: 0 SEC.
compiling exported dom : $ -> NonNegativeInteger Time: 0.02 SEC.
compiling exported cod : $ -> NonNegativeInteger Time: 0.01 SEC.
compiling local prod : (Record(domain: NonNegativeInteger,codomain: NonNegativeInteger,data: CartesianTensor(One,dim,K)),Record(domain: NonNegativeInteger,codomain: NonNegativeInteger,data: CartesianTensor(One,dim,K))) -> Record(domain: NonNegativeInteger,codomain: NonNegativeInteger,data: CartesianTensor(One,dim,K)) Time: 0.07 SEC.
compiling local dats : List Record(gen: Record(domain: NonNegativeInteger,codomain: NonNegativeInteger,data: CartesianTensor(One,dim,K)),exp: NonNegativeInteger) -> Record(domain: NonNegativeInteger,codomain: NonNegativeInteger,data: CartesianTensor(One,dim,K)) Time: 0.02 SEC.
compiling local dat : $ -> Record(domain: NonNegativeInteger,codomain: NonNegativeInteger,data: CartesianTensor(One,dim,K)) Time: 0.01 SEC.
compiling exported arity : $ -> Prop $ Time: 0 SEC.
compiling exported eval : $ -> $ Time: 0.01 SEC.
compiling exported retractIfCan : $ -> Union(K,failed) Time: 0 SEC.
compiling exported retract : $ -> K Time: 0.12 SEC.
compiling exported basisVectors : () -> List $ Time: 0.02 SEC.
compiling exported basisForms : () -> List $ Time: 0.02 SEC.
compiling exported ev : PositiveInteger -> $ Time: 0.14 SEC.
compiling exported co : PositiveInteger -> $ Time: 0.03 SEC.
compiling exported map : (K -> K,$) -> $ Time: 0.03 SEC.
****** Domain: K already in scope augmenting K: (Evalable K) compiling exported eval : ($,List Equation K) -> $ Time: 0.01 SEC.
compiling exported ravel : $ -> List K Time: 0 SEC.
compiling exported unravel : (Prop $,List K) -> $ Time: 0.02 SEC.
compiling exported tensor : $ -> CartesianTensor(One,dim,K) Time: 0.01 SEC.
compiling exported + : ($,$) -> $ Time: 0.13 SEC.
compiling exported - : ($,$) -> $ Time: 0.02 SEC.
compiling exported - : $ -> $ Time: 0 SEC.
compiling exported Zero : () -> $ Time: 0 SEC.
compiling exported zero? : $ -> Boolean Time: 0.02 SEC.
compiling exported One : () -> $ Time: 0.01 SEC.
compiling exported one? : $ -> Boolean Time: 0 SEC.
compiling exported = : ($,$) -> Boolean Time: 0 SEC.
compiling exported coerce : List PositiveInteger -> $ Time: 0.15 SEC.
compiling exported coerce : List None -> $ Time: 0.01 SEC.
compiling exported coerce : K -> $ Time: 0 SEC.
compiling exported elt : ($,$) -> $ Time: 0 SEC.
compiling exported elt : ($,PositiveInteger) -> $ Time: 0 SEC.
compiling exported elt : ($,PositiveInteger,PositiveInteger) -> $ Time: 0 SEC.
compiling exported elt : ($,PositiveInteger,PositiveInteger,PositiveInteger) -> $ Time: 0 SEC.
compiling exported apply : ($,$) -> $ Time: 0 SEC.
compiling exported * : ($,$) -> $ Time: 0 SEC.
compiling exported / : ($,$) -> $ Time: 1.36 SEC.
compiling exported / : (Tuple $,$) -> $ Time: 0.03 SEC.
compiling exported / : ($,Tuple $) -> $ Time: 0 SEC.
compiling exported / : (Tuple $,Tuple $) -> $ Time: 0.01 SEC.
compiling exported * : (K,$) -> $ Time: 0.01 SEC.
compiling exported * : ($,K) -> $ Time: 0 SEC.
compiling exported * : (Integer,$) -> $ Time: 0 SEC.
compiling exported inp : List K -> $ Time: 0 SEC.
compiling exported inp : List $ -> $ Time: 0.02 SEC.
compiling exported out : List K -> $ Time: 0.01 SEC.
compiling exported out : List $ -> $ Time: 0.07 SEC.
compiling local show : $ -> OutputForm Time: 0.07 SEC.
compiling exported coerce : $ -> OutputForm Time: 0.02 SEC.
****** Domain: K already in scope augmenting K: (Evalable K) (time taken in buildFunctor: 10)
;;; *** |LazyLinearOperator| REDEFINED
;;; *** |LazyLinearOperator| REDEFINED Time: 0.02 SEC.
Warnings: [1] dom: domain has no value [2] cod: codomain has no value
Cumulative Statistics for Constructor LazyLinearOperator Time: 2.63 seconds
finalizing NRLIB LAZY Processing LazyLinearOperator for Browser database: --------(inp (% (List K)))--------- --->-->LazyLinearOperator((inp (% (List %)))): Not documented!!!! --------(out (% (List K)))--------- --->-->LazyLinearOperator((out (% (List %)))): Not documented!!!! --->-->LazyLinearOperator((arity ((Prop %) %))): Not documented!!!! --->-->LazyLinearOperator((basisVectors ((List %)))): Not documented!!!! --->-->LazyLinearOperator((basisForms ((List %)))): Not documented!!!! --->-->LazyLinearOperator((tensor (T$ %))): Not documented!!!! --->-->LazyLinearOperator((map (% (Mapping K K) %))): Not documented!!!! --->-->LazyLinearOperator((eval (% %))): Not documented!!!! --->-->LazyLinearOperator((ravel ((List K) %))): Not documented!!!! --->-->LazyLinearOperator((unravel (% (Prop %) (List K)))): Not documented!!!! --------(coerce (% (List NAT)))--------- --->-->LazyLinearOperator((coerce (% (List NAT)))): Improper first word in comments: identity "identity for composition and permutations of its products" --------(coerce (% (List (None))))--------- --->-->LazyLinearOperator((coerce (% (List (None))))): Improper first word in comments: [] "[] = 1" --->-->LazyLinearOperator((elt (% % %))): Not documented!!!! --->-->LazyLinearOperator((elt (% % NAT))): Not documented!!!! --->-->LazyLinearOperator((elt (% % NAT NAT))): Not documented!!!! --->-->LazyLinearOperator((elt (% % NAT NAT NAT))): Not documented!!!! --->-->LazyLinearOperator((/ (% (Tuple %) (Tuple %)))): Not documented!!!! --->-->LazyLinearOperator((/ (% (Tuple %) %))): Not documented!!!! --------(/ (% % (Tuple %)))--------- --->-->LazyLinearOperator((/ (% % (Tuple %)))): Improper first word in comments: yet "yet another syntax for product" --------(ev (% NAT))--------- --->-->LazyLinearOperator((ev (% NAT))): Improper first word in comments: "(2,{}0)-tensor for evaluation" --------(co (% NAT))--------- --->-->LazyLinearOperator((co (% NAT))): Improper first word in comments: "(0,{}2)-tensor for co-evaluation" --->-->LazyLinearOperator(constructor): Not documented!!!! --->-->LazyLinearOperator(): Missing Description ; compiling file "/var/zope2/var/LatexWiki/LAZY.NRLIB/LAZY.lsp" (written 04 MAY 2011 08:26:58 PM):
; /var/zope2/var/LatexWiki/LAZY.NRLIB/LAZY.fasl written ; compilation finished in 0:00:51.147 ------------------------------------------------------------------------ LazyLinearOperator is now explicitly exposed in frame initial LazyLinearOperator will be automatically loaded when needed from /var/zope2/var/LatexWiki/LAZY.NRLIB/LAZY
>> System error: The bounding indices 163 and 162 are bad for a sequence of length 162. See also: The ANSI Standard, Glossary entry for "bounding index designator" The ANSI Standard, writeup for Issue SUBSEQ-OUT-OF-BOUNDS:IS-AN-ERROR

Tests

axiom
L := LAZY(2,OVAR [],EXPR INT)

\label{eq1}\hbox{\axiomType{LazyLinearOperator}\ } (2, \hbox{\axiomType{OrderedVariableList}\ } ([ ]) , \hbox{\axiomType{Expression}\ } (\hbox{\axiomType{Integer}\ }))(1)
Type: Type
axiom
I:L := [1]

\label{eq2}{|_{1}^{1}}+{|_{2}^{2}}(2)
Type: LazyLinearOperator?(2,OrderedVariableList?([]),Expression(Integer))
axiom
test( I*I = [1,2] )

\label{eq3} \mbox{\rm true} (3)
Type: Boolean
axiom
A:L := out [ inp([a11,a12])$L, inp([a21,a22])$L ]

\label{eq4}{a 11 \ {|_{1}^{1}}}+{a 12 \ {|_{2}^{1}}}+{a 21 \ {|_{1}^{2}}}+{a 22 \ {|_{2}^{2}}}(4)
Type: LazyLinearOperator?(2,OrderedVariableList?([]),Expression(Integer))
axiom
A*A

\label{eq5}\ {{\left({{a 11 \ {|_{1}^{1}}}+{a 12 \ {|_{2}^{1}}}+{a 21 \ {|_{1}^{2}}}+{a 22 \ {|_{2}^{2}}}}\right)}^2}(5)
Type: LazyLinearOperator?(2,OrderedVariableList?([]),Expression(Integer))
axiom
A^2

\label{eq6}\ {{\left({{a 11 \ {|_{1}^{1}}}+{a 12 \ {|_{2}^{1}}}+{a 21 \ {|_{1}^{2}}}+{a 22 \ {|_{2}^{2}}}}\right)}^2}(6)
Type: LazyLinearOperator?(2,OrderedVariableList?([]),Expression(Integer))
axiom
X:L := [2,1]

\label{eq7}{|_{1 \  1}^{1 \  1}}+{|_{2 \  1}^{1 \  2}}+{|_{1 \  2}^{2 \  1}}+{|_{2 \  2}^{2 \  2}}(7)
Type: LazyLinearOperator?(2,OrderedVariableList?([]),Expression(Integer))
axiom
-- printing
I*X*X*I

\label{eq8}\ {\left({{|_{1}^{1}}+{|_{2}^{2}}}\right)}\ {{\left({{|_{1 \  1}^{1 \  1}}+{|_{2 \  1}^{1 \  2}}+{|_{1 \  2}^{2 \  1}}+{|_{2 \  2}^{2 \  2}}}\right)}^2}\ {\left({{|_{1}^{1}}+{|_{2}^{2}}}\right)}(8)
Type: LazyLinearOperator?(2,OrderedVariableList?([]),Expression(Integer))
axiom
-- braid
B3:=(I*X)/(X*I)
>> Error detected within library code: index out of range

Various special cases of composition

axiom
-- case 1
test( X/X = [1,2] )
>> Error detected within library code: index out of range