Correct an expected output

Correct an expected output

kernelopts(assertlevel=2): # be strict on all assertions while testing
kernelopts(opaquemodules=false): # allow testing of internal routines
if not (NewSLO :: `module`) then
  WARNING("loading NewSLO failed");
  `quit`(3);
end if;

with(Hakaru):
with(NewSLO):
with(TestWrapper):
with(Partition):

#####################################################################
#
# disintegration tests
#
#####################################################################

# this uses a *global* name 't'.
# assume(t::real);
`t`:

TestDisint := MakeTest(
 proc(
  M::{t_Hakaru, list({algebraic, name=list})}, #args to disint, or just 1st arg
  n::set({t_Hakaru, identical(NULL)}), #desired return
  {ctx::list:= []}, #context: assumptions, "knowledge"
  {TLim::{positive, identical(-1)}:= 80} #timelimit
)
  local m;
  m:= `if`(M::list, M, [M, :-t])[], :-ctx= ctx;

  timelimit(
       TLim,
       CodeTools[Test]({disint(m)}, n, '`subset`(measure(simplify))', _rest)
  );
end proc
 , testGroup = "Disint" ):

# End of the possibly statistically meaningless tests.

d1 := Bind(Lebesgue(-infinity,infinity), x, Ret(Pair(-5*x,3/x))):
d1r := {Weight(1/5,Ret(-15/t))}:

# should try d2 with 1/c as well
d2 := Bind(Lebesgue(-infinity,infinity), x, Ret(Pair((-1/7)*x-1,3))):
d2r := {Weight(7, Ret(3))}:

#The next two tests are simplified versions of the Borel-Kolmogorov paradox.
#https://en.wikipedia.org/wiki/Borel-Kolmogorov_paradox
d3 := Bind(Uniform(0,1), x, Bind(Uniform(0,1), y, Ret(Pair(x-y,f(x,y))))):
d3r := {
  PARTITION([Piece(t <= -1
                  ,Msum())
            ,Piece(t <= 0 and -1 < t
                  ,Weight(t+1,Bind(Uniform(-t,1),`y`,Ret(f(t+`y`,`y`)))))
            ,Piece(t <= 1 and 0 < t
                  ,Weight(1-t,Bind(Uniform(0,1-t),`y`,Ret(f(t+`y`,`y`)))))
            ,Piece(1 < t
                  ,Msum())
            ]) ,
  PARTITION([Piece(t <= -1
                  ,Msum())
            ,Piece(t <= 0 and -1 < t
                  ,Weight(t+1,Bind(Uniform(0,t+1),`x`,Ret(f(`x`,-t+`x`)))))
            ,Piece(t <= 1 and 0 < t
                  ,Weight(1-t,Bind(Uniform(t,1),`x`,Ret(f(`x`,-t+`x`)))))
            ,Piece(1 < t,Msum())
            ])
}:

d4 := Bind(Uniform(0,1), x, Bind(Uniform(0,1), y, Ret(Pair(x/y,x)))):
d4r := {
  Weight(1/abs(t)^2,
    Bind(Uniform(0,1),x,
         piecewise(x < t,Weight(x,Ret(x)),Msum()))),
  piecewise(0 < t,
    Bind(Uniform(0,1),y,
         piecewise(t < 1/y,
           Weight(y,Ret(t*y)),
           Msum())),
    Msum()),
  PARTITION([Piece(t <  0,Msum())
           , Piece(t =  0,undefined)
           , Piece(t <= 1 and 0 < t,Weight(1/t,Bind(Uniform(0,t),x,Weight(x,Ret(x)))))
           , Piece(1 < t,Weight(1/2/t^2,BetaD(2,1)))])
}:

d5 := Bind(Gaussian(0,1), x, Bind(Gaussian(x,1), y, Ret(Pair(y,x)))):
d5r := {Weight((1/2)*exp(-(1/4)*t^2)/Pi^(1/2), Gaussian((1/2)*t, (1/2)*2^(1/2)))}:

d6 := Bind(Gaussian(0,1), x, Bind(Gaussian(x,1), y, Ret(Pair(x,y)))):
d6r := {Weight(1/2*2^(1/2)/Pi^(1/2)*exp(-1/2*t^2),Gaussian(t,1))}:

# note (y+y), which gives trouble for a syntactic approach
normalFB1 :=
  Bind(Gaussian(0,1), x,
  Bind(Gaussian(x,1), y,
  Ret(Pair((y+y)+x, _Unit)))):

normalFB1r := {Weight(1/26*exp(-1/26*t^2)/Pi^(1/2)*13^(1/2)*2^(1/2),Ret(_Unit))}:

# tests taken from haskell/Tests/Disintegrate.hs
# use same names, to be clearer
norm0a :=
  Bind(Gaussian(0,1), x,
  Bind(Gaussian(x,1), y,
  Ret(Pair(y, x)))):
  # note that the answer below is much nicer than the one expected in Haskell
norm0r := {Weight(1/2*exp(-1/4*t^2)/Pi^(1/2),Gaussian(t/2,sqrt(2)/2))}:

norm1a :=
  Bind(Gaussian(3,2), x,Ret(piecewise(x<0, Pair(-x, _Unit), Pair(x, _Unit)))):
norm1b :=
  Bind(Gaussian(3,2), x,piecewise(x<0, Ret(Pair(-x, _Unit)), Ret(Pair(x, _Unit)))):

norm1r := {
  piecewise(t < 0 , Weight(0, Ret(_Unit))
           ,0 <= t, Weight((1/4)*sqrt(2)*exp(-9/8)*((exp(t))^(3/4)/(exp(t^2))^(1/8)+1/((exp(t^2))^(1/8)*(exp(t))^(3/4)))/sqrt(Pi)
                          , Ret(_Unit))) ,
  PARTITION([Piece(t < 0 , Weight(0, Ret(_Unit)))
            ,Piece(0 <= t, Weight((1/4)*sqrt(2)*exp(-9/8)*((exp(t))^(3/4)/(exp(t^2))^(1/8)+1/((exp(t^2))^(1/8)*(exp(t))^(3/4)))/sqrt(Pi)
                          , Ret(_Unit)))
            ])
}: #Desired output unknown(?)

assume(s::real, noiseT >= 3, noiseT <= 8, noiseE >= 1, noiseE <= 8);
easyRoad:= [
  Bind(Uniform(3, 8), noiseT,
  Bind(Uniform(1, 4), noiseE,
  Bind(Gaussian(0, noiseT), x1,
  Bind(Gaussian(x1, noiseE), m1,
  Bind(Gaussian(x1, noiseT), x2,
  Bind(Gaussian(x2, noiseE), m2,
  Ret(Pair(Pair(m1,m2), Pair(noiseT,noiseE)))
  )))))),
  Pair(s,t)
]:
#The first expression below comes from the actual output of disint, hand-
#simplified 1) to bring factors into the innnermost integral, 2) to combine
#products of exps, and 3) to express the polynomial arg of exp in a logical way
#by sub-factoring.
easyRoadr:= {
  Weight(                #Weight 1
    Pi/8,
    Bind(                #Bind 1
      Uniform(3, 8), noiseT,
      Weight(            #Weight 2
        1/noiseT^2,
        Bind(            #Bind 2
          Uniform(1, 4), noiseE,
          Weight(        #Weight 3
            int(         #Int 1
              int(       #Int 2
                exp(
                  -(x2^2/2 - x1*x2 + x1^2)/noiseT^2 -
                  ((t-x2)^2 + (s-x1)^2)/noiseE^2
                )*2/Pi/noiseE,
                x2= -infinity..infinity
              ),         #-Int 2
              x1= -infinity..infinity
            ),           #-Int 1
            Ret(Pair(noiseT, noiseE))
          )              #-Weight 3
        )                #-Bind 2
      )                  #-Weight 2
    )                    #-Bind 1
  ),                     #-Weight 1

  #Hopefully, that's equivalent to...
  Bind(Uniform(3, 8), noiseT,
  Bind(Uniform(1, 4), noiseE,
  Bind(Gaussian(0, noiseT), x1,
  Bind(Weight(density[Gaussian](x1, noiseE)(s), Ret(_Unit)), _,
  Bind(Gaussian(x1, noiseT), x2,
  Weight(density[Gaussian](x2, noiseE)(t), Ret(Pair(noiseT, noiseE)))
  )))))
}:
helloWorld:= [
  Bind(Gaussian(0,1), mu,
  Bind(Plate(n, k, Gaussian(mu, 1)), nu,
  Ret(Pair(nu, mu))
  )),
  :-t,
  ctx= [n::integer, n > 0]
]:
helloWorldr:= {
  Bind(Gaussian(0,1), mu,
  Plate(n, i, Weight(density[Gaussian](mu, 1)(idx(t,i)), Ret(mu)))
  )
}:

#This first block of tests is to test the basic functionality of disint, and,
#to some extent, the system as a whole. These tests may be meaningless to you,
#the statistician and end user of this Hakaru product; they aren't meant to
#have any statistical meaning.--Carl 2016Oct04

TestDisint(
     [Ret(Pair(sqrt(Pi), x)), t &M Ret(7)],
     {Msum()},
     label= "(d0_2) `Dirac` test 1"
);

TestDisint(
     [Ret(Pair(sqrt(Pi), x^2)), t &M Ret(sqrt(Pi))],
     {Ret(x^2)},
     label= "(d0_3) `Dirac` test 2"
);

TestDisint(
     [Bind(Lebesgue((-1,1)*~infinity), x, Ret(Pair(sqrt(Pi), x^2))),
      t &M Ret(sqrt(Pi))
     ],
     {Bind(Lebesgue((-1,1)*~infinity), x1, Ret(x1^2))},
     label= "(d0_4) `Dirac` test with `Bind`"
);

TestDisint(d1, d1r, label = "(d1) Disintegrate linear function");
TestDisint(d2, d2r, label = "(d2) Disintegrate linear function II");
TestDisint(d5, d5r, label = "(d5) Disintegrate N(0,1)*N(x,1), over y");
TestDisint(d6, d6r, label = "(d6) Disintegrate N(0,1)*N(x,1), over x");
TestDisint(norm0a, norm0r,
     label = "(norm0a) U(0,1) >>= \x -> U(x,1) >>= \y -> Ret(y,x)"
);

## This one is kind of cosmetic; it would be 'fixed' properly if the
## disintegration process did not use 'improve' to do "domain information
## discovery", but rather had a specific function (and then improve could
## indeed do this integral).
# should work now
TestDisint( normalFB1, normalFB1r,
     label = "(d7_normalFB1) Disintegrate N(0,1)*N(x,1), over (y+y)+x"
            );

######################################################################
#
# These tests fail, and are expected to.  Move them up when they
# start passing (and are expected to).
#
# They are, however, roughly in order of what we'd like to have work.
#

# change of variables
TestDisint(d3, d3r, label = "(d3) Disintegrate U(0,1) twice, over x-y");
TestDisint(d4, d4r, label = "(d4) Disintegrate U(0,1) twice, over x/y");

# funky piecewise
TestDisint(norm1a, norm1r,
     label = "(norm1a) U(0,1) into Ret of pw"
);
TestDisint(norm1b, norm1r,
     label = "(norm1b) U(0,1) into pw of Ret"
);
#In this one the function in the inequality, x+x^3, is injective but nonlinear.
TestDisint(
     Bind(Gaussian(0,1), x, Ret(Pair(x+x^3, f(x)))),
     {}, #I don't know what to expect.
     label= "(d0_5) Injective nonlinear inequality"
);
# takes too long.
TestDisint(
     easyRoad, easyRoadr,
     label= "(easyRoad) Combo of Normals with distinct Uniform noises",
     TLim= 5 #takes 6 - 8 minutes to `improve` on an Intel i7
);

#This one is a basic test of the Counting wrt-var type.
#This one gives the Weight(-1, ...) error
assume(n_, integer);
TestDisint(
     [Bind(PoissonD(2), n, Ret(Pair(3,n))), n_ &M Counting((-1,1)*~infinity)],
     {},  #I don't know what to expect.
     ctx= [n::integer, n >= 0],
     label= "(d0_1) `Counting` test; `Weight` bug (currently failing)"
);

TestDisint(
     helloWorld, helloWorldr,
     label= "(helloWorld) Plate of Normals",
     ctx= [n::integer, n > 0]
);

kernelopts(assertlevel=2): # be strict on all assertions while testing
kernelopts(opaquemodules=false): # allow testing of internal routines
if not (NewSLO :: `module`) then
  WARNING("loading NewSLO failed");
  `quit`(3);
end if;

with(Hakaru):
with(NewSLO):
with(TestWrapper):
with(Partition):

#####################################################################
#
# disintegration tests
#
#####################################################################

# this uses a *global* name 't'.
# assume(t::real);
`t`:

TestDisint := MakeTest(
 proc(
  M::{t_Hakaru, list({algebraic, name=list})}, #args to disint, or just 1st arg
  n::set({t_Hakaru, identical(NULL)}), #desired return
  {ctx::list:= []}, #context: assumptions, "knowledge"
  {TLim::{positive, identical(-1)}:= 80} #timelimit
)
  local m;
  m:= `if`(M::list, M, [M, :-t])[], :-ctx= ctx;

  timelimit(
       TLim,
       CodeTools[Test]({disint(m)}, n, '`subset`(measure(simplify))', _rest)
  );
end proc
 , testGroup = "Disint" ):

# End of the possibly statistically meaningless tests.

d1 := Bind(Lebesgue(-infinity,infinity), x, Ret(Pair(-5*x,3/x))):
d1r := {Weight(1/5,Ret(-15/t))}:

# should try d2 with 1/c as well
d2 := Bind(Lebesgue(-infinity,infinity), x, Ret(Pair((-1/7)*x-1,3))):
d2r := {Weight(7, Ret(3))}:

#The next two tests are simplified versions of the Borel-Kolmogorov paradox.
#https://en.wikipedia.org/wiki/Borel-Kolmogorov_paradox
d3 := Bind(Uniform(0,1), x, Bind(Uniform(0,1), y, Ret(Pair(x-y,f(x,y))))):
d3r := {
  PARTITION([Piece(t <= -1
                  ,Msum())
            ,Piece(t <= 0 and -1 < t
                  ,Weight(t+1,Bind(Uniform(-t,1),`y`,Ret(f(t+`y`,`y`)))))
            ,Piece(t <= 1 and 0 < t
                  ,Weight(1-t,Bind(Uniform(0,1-t),`y`,Ret(f(t+`y`,`y`)))))
            ,Piece(1 < t
                  ,Msum())
            ]) ,
  PARTITION([Piece(t <= -1
                  ,Msum())
            ,Piece(t <= 0 and -1 < t
                  ,Weight(t+1,Bind(Uniform(0,t+1),`x`,Ret(f(`x`,-t+`x`)))))
            ,Piece(t <= 1 and 0 < t
                  ,Weight(1-t,Bind(Uniform(t,1),`x`,Ret(f(`x`,-t+`x`)))))
            ,Piece(1 < t,Msum())
            ])
}:

d4 := Bind(Uniform(0,1), x, Bind(Uniform(0,1), y, Ret(Pair(x/y,x)))):
d4r := {
  Weight(1/abs(t)^2,
    Bind(Uniform(0,1),x,
         piecewise(x < t,Weight(x,Ret(x)),Msum()))),
  piecewise(0 < t,
    Bind(Uniform(0,1),y,
         piecewise(t < 1/y,
           Weight(y,Ret(t*y)),
           Msum())),
    Msum()),
  PARTITION([Piece(t <= 0,Msum())
           , Piece(t <= 1 and 0 < t,Weight(1/t,Bind(Uniform(0,t),x,Weight(x,Ret(x)))))
           , Piece(1 < t,Weight(1/2/t^2,BetaD(2,1)))])
}:

d5 := Bind(Gaussian(0,1), x, Bind(Gaussian(x,1), y, Ret(Pair(y,x)))):
d5r := {Weight((1/2)*exp(-(1/4)*t^2)/Pi^(1/2), Gaussian((1/2)*t, (1/2)*2^(1/2)))}:

d6 := Bind(Gaussian(0,1), x, Bind(Gaussian(x,1), y, Ret(Pair(x,y)))):
d6r := {Weight(1/2*2^(1/2)/Pi^(1/2)*exp(-1/2*t^2),Gaussian(t,1))}:

# note (y+y), which gives trouble for a syntactic approach
normalFB1 :=
  Bind(Gaussian(0,1), x,
  Bind(Gaussian(x,1), y,
  Ret(Pair((y+y)+x, _Unit)))):

normalFB1r := {Weight(1/26*exp(-1/26*t^2)/Pi^(1/2)*13^(1/2)*2^(1/2),Ret(_Unit))}:

# tests taken from haskell/Tests/Disintegrate.hs
# use same names, to be clearer
norm0a :=
  Bind(Gaussian(0,1), x,
  Bind(Gaussian(x,1), y,
  Ret(Pair(y, x)))):
  # note that the answer below is much nicer than the one expected in Haskell
norm0r := {Weight(1/2*exp(-1/4*t^2)/Pi^(1/2),Gaussian(t/2,sqrt(2)/2))}:

norm1a :=
  Bind(Gaussian(3,2), x,Ret(piecewise(x<0, Pair(-x, _Unit), Pair(x, _Unit)))):
norm1b :=
  Bind(Gaussian(3,2), x,piecewise(x<0, Ret(Pair(-x, _Unit)), Ret(Pair(x, _Unit)))):

norm1r := {
  piecewise(t < 0 , Weight(0, Ret(_Unit))
           ,0 <= t, Weight((1/4)*sqrt(2)*exp(-9/8)*((exp(t))^(3/4)/(exp(t^2))^(1/8)+1/((exp(t^2))^(1/8)*(exp(t))^(3/4)))/sqrt(Pi)
                          , Ret(_Unit))) ,
  PARTITION([Piece(t < 0 , Weight(0, Ret(_Unit)))
            ,Piece(0 <= t, Weight((1/4)*sqrt(2)*exp(-9/8)*((exp(t))^(3/4)/(exp(t^2))^(1/8)+1/((exp(t^2))^(1/8)*(exp(t))^(3/4)))/sqrt(Pi)
                          , Ret(_Unit)))
            ])
}: #Desired output unknown(?)

assume(s::real, noiseT >= 3, noiseT <= 8, noiseE >= 1, noiseE <= 8);
easyRoad:= [
  Bind(Uniform(3, 8), noiseT,
  Bind(Uniform(1, 4), noiseE,
  Bind(Gaussian(0, noiseT), x1,
  Bind(Gaussian(x1, noiseE), m1,
  Bind(Gaussian(x1, noiseT), x2,
  Bind(Gaussian(x2, noiseE), m2,
  Ret(Pair(Pair(m1,m2), Pair(noiseT,noiseE)))
  )))))),
  Pair(s,t)
]:
#The first expression below comes from the actual output of disint, hand-
#simplified 1) to bring factors into the innnermost integral, 2) to combine
#products of exps, and 3) to express the polynomial arg of exp in a logical way
#by sub-factoring.
easyRoadr:= {
  Weight(                #Weight 1
    Pi/8,
    Bind(                #Bind 1
      Uniform(3, 8), noiseT,
      Weight(            #Weight 2
        1/noiseT^2,
        Bind(            #Bind 2
          Uniform(1, 4), noiseE,
          Weight(        #Weight 3
            int(         #Int 1
              int(       #Int 2
                exp(
                  -(x2^2/2 - x1*x2 + x1^2)/noiseT^2 -
                  ((t-x2)^2 + (s-x1)^2)/noiseE^2
                )*2/Pi/noiseE,
                x2= -infinity..infinity
              ),         #-Int 2
              x1= -infinity..infinity
            ),           #-Int 1
            Ret(Pair(noiseT, noiseE))
          )              #-Weight 3
        )                #-Bind 2
      )                  #-Weight 2
    )                    #-Bind 1
  ),                     #-Weight 1

  #Hopefully, that's equivalent to...
  Bind(Uniform(3, 8), noiseT,
  Bind(Uniform(1, 4), noiseE,
  Bind(Gaussian(0, noiseT), x1,
  Bind(Weight(density[Gaussian](x1, noiseE)(s), Ret(_Unit)), _,
  Bind(Gaussian(x1, noiseT), x2,
  Weight(density[Gaussian](x2, noiseE)(t), Ret(Pair(noiseT, noiseE)))
  )))))
}:
helloWorld:= [
  Bind(Gaussian(0,1), mu,
  Bind(Plate(n, k, Gaussian(mu, 1)), nu,
  Ret(Pair(nu, mu))
  )),
  :-t,
  ctx= [n::integer, n > 0]
]:
helloWorldr:= {
  Bind(Gaussian(0,1), mu,
  Plate(n, i, Weight(density[Gaussian](mu, 1)(idx(t,i)), Ret(mu)))
  )
}:

#This first block of tests is to test the basic functionality of disint, and,
#to some extent, the system as a whole. These tests may be meaningless to you,
#the statistician and end user of this Hakaru product; they aren't meant to
#have any statistical meaning.--Carl 2016Oct04

TestDisint(
     [Ret(Pair(sqrt(Pi), x)), t &M Ret(7)],
     {Msum()},
     label= "(d0_2) `Dirac` test 1"
);

TestDisint(
     [Ret(Pair(sqrt(Pi), x^2)), t &M Ret(sqrt(Pi))],
     {Ret(x^2)},
     label= "(d0_3) `Dirac` test 2"
);

TestDisint(
     [Bind(Lebesgue((-1,1)*~infinity), x, Ret(Pair(sqrt(Pi), x^2))),
      t &M Ret(sqrt(Pi))
     ],
     {Bind(Lebesgue((-1,1)*~infinity), x1, Ret(x1^2))},
     label= "(d0_4) `Dirac` test with `Bind`"
);

TestDisint(d1, d1r, label = "(d1) Disintegrate linear function");
TestDisint(d2, d2r, label = "(d2) Disintegrate linear function II");
TestDisint(d5, d5r, label = "(d5) Disintegrate N(0,1)*N(x,1), over y");
TestDisint(d6, d6r, label = "(d6) Disintegrate N(0,1)*N(x,1), over x");
TestDisint(norm0a, norm0r,
     label = "(norm0a) U(0,1) >>= \x -> U(x,1) >>= \y -> Ret(y,x)"
);

## This one is kind of cosmetic; it would be 'fixed' properly if the
## disintegration process did not use 'improve' to do "domain information
## discovery", but rather had a specific function (and then improve could
## indeed do this integral).
# should work now
TestDisint( normalFB1, normalFB1r,
     label = "(d7_normalFB1) Disintegrate N(0,1)*N(x,1), over (y+y)+x"
            );

######################################################################
#
# These tests fail, and are expected to.  Move them up when they
# start passing (and are expected to).
#
# They are, however, roughly in order of what we'd like to have work.
#

# change of variables
TestDisint(d3, d3r, label = "(d3) Disintegrate U(0,1) twice, over x-y");
TestDisint(d4, d4r, label = "(d4) Disintegrate U(0,1) twice, over x/y");

# funky piecewise
TestDisint(norm1a, norm1r,
     label = "(norm1a) U(0,1) into Ret of pw"
);
TestDisint(norm1b, norm1r,
     label = "(norm1b) U(0,1) into pw of Ret"
);
#In this one the function in the inequality, x+x^3, is injective but nonlinear.
TestDisint(
     Bind(Gaussian(0,1), x, Ret(Pair(x+x^3, f(x)))),
     {}, #I don't know what to expect.
     label= "(d0_5) Injective nonlinear inequality"
);
# takes too long.
TestDisint(
     easyRoad, easyRoadr,
     label= "(easyRoad) Combo of Normals with distinct Uniform noises",
     TLim= 5 #takes 6 - 8 minutes to `improve` on an Intel i7
);

#This one is a basic test of the Counting wrt-var type.
#This one gives the Weight(-1, ...) error
assume(n_, integer);
TestDisint(
     [Bind(PoissonD(2), n, Ret(Pair(3,n))), n_ &M Counting((-1,1)*~infinity)],
     {},  #I don't know what to expect.
     ctx= [n::integer, n >= 0],
     label= "(d0_1) `Counting` test; `Weight` bug (currently failing)"
);

TestDisint(
     helloWorld, helloWorldr,
     label= "(helloWorld) Plate of Normals",
     ctx= [n::integer, n > 0]
);


Corrected infolevels of infinity, which unfortunately don't work, in ReparamT.mpl.

#
#     Test Suite for Reparam---integration and summation changes of variables
#
#Created by Carl 17Jun2016.

#common header for Hakaru-Maple test suites
kernelopts(assertlevel= 2): # be strict on all assertions while testing
kernelopts(opaquemodules= false): # allow testing of internal routines
if not NewSLO :: `module` then
  WARNING("loading NewSLO failed");
  `quit`(3)
end if:

with(Hakaru):
with(KB):
with(NewSLO):
########################

#common procedures for these tests.

TestReparam:= proc(
     e_in,
     e_out,   #Expected output, after postprocessing by `verify` and `&under`
     #`&under` is defined below.
     #Type `verification` is slightly modified (below) from its standard definition.
     ver::verification,
     #First infolevel is for initial test; second is for retest after failure.
     #Infinity isn't allowed; 99 is arbitrary large value.
     {infolevels::[nonnegint, nonnegint]:= [0, 99]},
     {ctx::list:= []}   #Assumptions (not necessarily to be passed to `assuming`)
)
# For 'production' runs, we want things to be as quiet
# as possible.  We would like to do
# maple -q < ReparamT.mpl | grep -v "passed"
# and get 0 lines of output. If global `pretty`	is true, some extra lines are
# printed for readability. You may want to set this in a worksheet session.
local
     LOform:= toLO(e_in),  #preprocess input
     r
;
     if :-pretty then printf("\n") end if;
     :-infolevel[reparam]:= infolevels[1];
     if not CodeTools:-Test(reparam(LOform, :-ctx= ctx), e_out, ver, boolout, _rest) then
          #If test fails, do same test with diagnostic infolevel setting.
          if infolevels[2] > infolevels[1] then
               printf("\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@"  );
               printf("\n*** Rerun at higher infolevel: ***\n");
               :-infolevel[reparam]:= infolevels[2];
               r:= CodeTools:-Test(reparam(LOform, :-ctx= ctx), e_out, ver, boolout, _rest);
               printf(  "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n");
               return r
          else
               return false
          end if
     else
          return
     end if
end proc:

#VerifyTools is an undocumented Maple library package similiar to TypeTools.
#Add a verification &under analogous to type &under.
VerifyTools:-AddVerification(`&under`= ((e1,e2,Ver,f)-> verify(f(e1,_rest), e2, Ver))):

#Need to overload Maple library `type/verification` so that expressions of the form 'v &under f'
#are considered verifications.
`type/verification/MapleLibrary`:= eval(`type/verification`):
`type/verification`:= overload([
     proc(Under::specfunc(`&under`))
     option overload;
          type(op(1,Under), `verification/MapleLibrary`)
     end proc,

     `type/verification/MapleLibrary`
]):

#Automatic simplifications: When an easy transformation can be used to
#transform a distribution that we don't support to one that we do, then a
#procedure in this section does it. These may be moved to NewSLO.

#Bernoulli
Bern:= proc(p)
     local i;
     Bind(Counting(0,1), i, Weight(idx([p,1-p],i) * Ret(i)))
end proc:

#Exponential
Exponential:= mu-> GammaD(1,mu):

#Control printing of extra lines for readability.
if not assigned(pretty) then pretty:= false end if:

#
#   The tests
#

#Constant multiple in integral
TestReparam(
     Bind(Lebesgue(-infinity,infinity), x, Weight(2, Ret(2*x))),
     Lebesgue(-infinity,infinity),
     equal &under fromLO,
     label= "(t0a) Constant multiple with Lebesgue" #passing
):

#Logarithm with Uniform
TestReparam(
     Bind(Uniform(0,1), x, Ret(-log(x))),
     GammaD(1,1),
     equal &under fromLO,
     label= "(t0b) Logarithm with Uniform" #passing
):

#(t1) Symbolic affine transformation with Gaussian
TestReparam(
     Bind(Gaussian(mu,sigma), x, Ret((x-mu)/sigma)),
     Gaussian(0,1),
     equal &under fromLO,
     ctx= [sigma > 0],
     label= "(t1) Symbolic affine transformation with Gaussian" #passing
):

#(t2) ChiSquared to Gamma
#(inverse of relationship given in Relationships.hs)
# Special case of Gamma now recognized as being ChiSquared
TestReparam(
     ChiSquared(2*b),
     GammaD(b,2),
     equal &under (fromLO, _ctx= foldr(assert, empty, b > 0)),
     ctx= [b > 0],
     label= "(t2) ChiSquared to Gamma" #passing
):

#(t3) Symbolic constant multiple with Gamma
TestReparam(
     Bind(GammaD(alpha,beta), x, Ret(2*x/beta)),
     GammaD(alpha, 2),
     equal &under (fromLO, _ctx= foldr(assert, empty, alpha > 0, beta > 0)),
     ctx= [alpha > 0, beta > 0],
     label= "(t3) Symbolic constant multiple with Gamma"
):

#(t4) Two-variable LFT with Gamma
#This fails due to multivariate changes of variable not being implemented yet.
TestReparam(
     Bind(GammaD(a,t), x1, Bind(GammaD(b,t), x2, Ret(x1/(x1+x2)))),
     BetaD(a,b),
     equal &under fromLO,
     infolevels= [2,2],
     label= "(t4) Two-variable LFT with Gamma (currently failing)"
):

#(t5) Logarithm with symbolic constant multiplier and Uniform
TestReparam(
     Bind(Uniform(0,1), x, Ret(-alpha*log(x))),
     GammaD(1,alpha),
     equal &under fromLO,
     ctx= [alpha >= 0],
     label= "(t5) Logarithm with symbolic constant multiplier and Uniform"
     #passing
):

#(t6) Poisson(mu) -> ? as mu -> infinity
#The concept of taking the limit at infinity of a distribution parameter isn't
#implemented yet.

#(t7) Quotient of standard normals to standard Cauchy
#Fails because it's multivariate.
#This should be the first multivariate integration to implement, due to
#simplicity; it might work as a simple multivariate substitution.
TestReparam(
     Bind(Gaussian(0,1), x1, Bind(Gaussian(0,1), x2, Ret(x1/x2))),
     Cauchy(0,1),
     equal &under fromLO,
     infolevels= [2,2],
     label=
          "(t7) Quotient of standard normals to standard Cauchy "
          "(currently failing)"
):

#(t8) Affine translation of quotient of standard normals to Cauchy
#This is a trivial variation of t7.
#Fails because it's multivariate.
TestReparam(
     Bind(Gaussian(0,1), x1, Bind(Gaussian(0,1), x2, Ret(a+alpha*x1/x2))),
     Cauchy(a,alpha),
     equal &under (fromLO, _ctx= foldr(assert, empty, alpha > 0)),
     ctx= [alpha > 0],
     infolevels= [2,2],
     label=
          "(t8) Affine translation of quotient of standard normals to Cauchy "
          "(currently failing)"
):

#(t9) Bernoulli to Binomial with n=1
#Fails because Binomial isn't implemented.
#Doesn't use reparam in a meaningful way.
TestReparam(
     Bern(p),
     Binomial(1,p),
     equal &under (fromLO, _ctx= foldr(assert, empty, 0 <= p, p <= 1)),
     ctx= [0 <= p, p <= 1],
     infolevels= [2,2],
     label= "(t9) Bernoulli to Binomial with n=1 (currently failing)"
):

#(t10) Beta(1,1) to Uniform(0,1)
#This one doesn't require reparam, but it passes using reparam.
TestReparam(
     #Note: No use of `Bind`. This passes by direct recognition by fromLO
     #without any meaningful use of reparam, although reparam is called.
     BetaD(1,1),
     Uniform(0,1),
     equal &under fromLO,
     label= "(t10) Beta(1,1) to Uniform(0,1)" #passing
):

#(t11) Laplace to difference of Gammas
#This one fails because Laplace isn't implemented. Also, there's nothing that
#reparam can do with this. It's up to fromLO to recognize the compound
#expression.
#Perhaps this should be an automatic simplification.
TestReparam(
     Laplace(a1,a2),
     Bind(GammaD(1,a1), x1, Bind(GammaD(1,a2), x2, Ret(x1-x2))),
     equal &under (fromLO, _ctx= foldr(assert, empty, a1 > 0, a2 > 0)),
     ctx= [a1 > 0, a2 > 0],
     infolevels= [2,2],
     label= "(t11) Laplace to difference of Gammas (currently failing)"
):

#(t12) Sum of iid Exponentials to Gamma
#This currently fails because it's multivariate.
TestReparam(
     Bind(Exponential(b), x1, Bind(Exponential(b), x2, Ret(x1+x2))),
     GammaD(2,b),
     equal &under (fromLO, _ctx= foldr(assert, empty, b > 0)),
     ctx= [b > 0],
     infolevels= [2,2],
     label= "(t12) Sum of iid Exponentials to Gamma (currently failing)"
):

#(t13) Weibull(1,b) to Exponential(1/b)
#This test is wrong in Relationships.hs!
#It should be Weibull(a,1) to Exponential(1/a).
#Fails because Weibull isn't implemented.
TestReparam(
     #Straightforward recognition; doesn't use reparam in a meaningful way.
     Weibull(a,1),
     Exponential(1/a),
     equal &under (fromLO, _ctx= foldr(assert, empty, a > 0)),
     ctx= [a > 0],
     infolevels= [2,2],
     label= "(t13) Weibull(a,1) to Exponential(1/a) (currently failing)"
):

#(t14) Standard normal over sqrt(ChiSquared) to StudentT
#Fails because it's multivariate.
TestReparam(
     Bind(Gaussian(0,1), x, Bind(ChiSquared(nu), y, Ret(x/sqrt(y/nu)))),
     StudentT(nu, 0, 1),
     equal &under (fromLO, _ctx= foldr(assert, empty, nu > 0)),
     ctx= [nu > 0],
     infolevels= [2,2],
     label= "(t14) Std normal over sqrt(Chi2) to StudentT (currently failing)"
):

#(t15) 1/InverseGamma(k,1/t) to GammaD(k,t)
#Fails because InverseGamma isn't implemented.
TestReparam(
     Bind(InverseGammaD(k, 1/t), x, Ret(1/x)),
     GammaD(k,t),
     equal &under (fromLO, _ctx= foldr(assert, empty, k > 0, t > 0)),
     ctx= [k > 0, t > 0],
     infolevels= [2,2],
     label= "(t15) 1/InverseGammaD(k,1/t) to GammaD(k,t) (currently failing)"
):

#(t16) Sum of std normals to normal(0,sqrt(2))
#Fails because it requires a multivariate change of vars.
TestReparam(
     Bind(Gaussian(0,1), x1, Bind(Gaussian(0,1), x2, Ret(x1+x2))),
     Gaussian(0,sqrt(2)),
     equal &under fromLO,
     infolevels= [2,2],
     label= "(t16) Sum of std normals to normal(0,sqrt(2)) (currently failing)"
):

#(t17) Sum of std normal and normal to normal
#Fails because it requires a multivariate change of vars.
TestReparam(
     Bind(Gaussian(0,1), x1, Bind(Gaussian(mu,sigma), x2, Ret(x1+x2))),
     Gaussian(mu, sqrt(1+sigma^2)),
     equal &under (fromLO, _ctx= foldr(assert, empty, sigma > 0)),
     ctx= [sigma > 0],
     infolevels= [2,2],
     label= "(t17) Sum of std normal and normal to normal (currently failing)"
):

#(t18) Sum of symbolic multiples of std normals to normal
#Fails because it requires a multivariate change of vars.
TestReparam(
     Bind(Gaussian(0,1), x1, Bind(Gaussian(0,1), x2, Ret(a1*x1 + a2*x2))),
     Gaussian(0, sqrt(a1^2 + a2^2)),
     equal &under fromLO,
     infolevels= [2,2],
     label=
          "(t18) Sum of symbolic multiples of std normals to normal "
          "(currently failing)"
):

#(t19) Sum of equiprobable binomials to binomial
#Fails for three reasons: it's multivariate, it's discrete, and Binomial isn't
#implemented.
TestReparam(
     Bind(Binomial(n1,p), x1, Bind(Binomial(n2,p), x2, Ret(x1+x2))),
     Binomial(n1+n2, p),
     equal &under (fromLO,
          _ctx= foldr(
               assert, empty,
               n1::integer, n1 > 0, n2::integer, n2 > 0, 0 <= p, p <= 1
          )
     ),
     ctx= [n1::integer, n1 > 0, n2::integer, n2 > 0, 0 <= p, p <= 1],
     infolevels= [2,2],
     label=
          "(t19) Sum of equiprobable binomials to binomial "
          "(currently failing)"
):

#(t20) Sum of n Bernoullis to Binomial
#Fails because Binomial isn't implemented.
TestReparam(
     Bind(Plate(n, i, Bern(p)), xs, Ret(sum(idx(xs,i),i=0..n-1))),
     Binomial(n,p),
     equal &under (fromLO,
          _ctx= foldr(assert, empty, n::integer, n > 0, 0 <= p, p <= 1)
     ),
     ctx= [n::integer, n > 0, 0 <= p, p <= 1],
     infolevels= [2,2],
     label= "(t20) Sum of n Bernoullis to Binomial (currently failing)"
):

#(t21) Sum of Poissons to Poisson
#Fails because reparam doesn't yet handle summations.
TestReparam(
     Bind(PoissonD(lambda1), x1, Bind(PoissonD(lambda2), x2, Ret(x1+x2))),
     PoissonD(lambda1 + lambda2),
     equal &under (fromLO,
          _ctx= foldr(assert, empty, lambda1 > 0, lambda2 > 0)
     ),
     ctx= [lambda1 > 0, lambda2 > 0],
     infolevels= [2,2],
     label= "(t21) Sum of Poissons to Poisson (currently failing)"
):

#(t22) Sum of Gammas to Gamma
#Fails because it's multivariate.
TestReparam(
     Bind(GammaD(a1,b), x1, Bind(GammaD(a2,b), x2, Ret(x1+x2))),
     GammaD(a1+a2, b),
     equal &under (fromLO, _ctx= foldr(assert, empty, a1 > 0, a2 > 0, b > 0)),
     ctx= [a1 > 0, a2 > 0, a3 > 0],
     infolevels= [2,2],
     label= "(t22) Sum of Gammas to Gamma (currently failing)"
):

#(t23) Sum of n Exponentials to Gamma
#Fails because it involves a Plate.
TestReparam(
     Bind(Plate(n, i, Exponential(b)), xs, Ret(sum(idx(xs,i), i= 0..n-1))),
     GammaD(n,b),
     equal &under (fromLO, _ctx= foldr(assert, empty, n::integer, n > 0, b > 0)),
     ctx= [n::integer, n > 0, b > 0],
     infolevels= [2,2],
     label= "(t23) Sum of n Exponentials to Gamma (currently failing)"
):

#(t24) Weibull "scaling" property.
#I can find no evidence that this is true; indeed, it seems trivial to disprove
#it.

#(t25) Product of lognormals is lognormal
#Fails because it's multivariate.
TestReparam(
     Bind(
          Gaussian(mu1,sigma1), x1,
          Bind(Gaussian(mu2,sigma2), x2, Ret(exp(x1)*exp(x2)))
     ),
     Bind(Gaussian(mu1+mu2, sqrt(sigma1^2 + sigma2^2)), x3, Ret(exp(x3))),
     equal &under (fromLO, _ctx= foldr(assert, empty, sigma1 > 0, sigma2 > 0)),
     ctx= [sigma1 > 0, sigma2 > 0],
     infolevels= [2,2],
     label= "(t25) Product of lognormals is lognormal (currently failing)"
):

#(t26) Cauchy of reciprocal to Cauchy
#Fails due to improper handling of the discontinuity in the substitution.
TestReparam(
     Bind(Cauchy(0, sigma), x, Ret(1/x)),
     Cauchy(0, 1/sigma),
     equal &under (fromLO, _ctx= foldr(assert, empty, sigma > 0)),
     ctx= [sigma > 0],
     infolevels= [2,2],
     label= "(t26) Cauchy of reciprocal to Cauchy (currently failing)"
):

#(t27) Symbolic constant multiple of Gamma to Gamma
TestReparam(
     Bind(GammaD(r,lambda), x, Ret(a*x)),
     GammaD(r, a*lambda),
     equal &under (fromLO,
          _ctx= foldr(assert, empty, r > 0, lambda > 0, a > 0)
     ),
     ctx= [r > 0, lambda > 0, a > 0],
     label= "(t27) Symbolic constant multiple of Gamma to Gamma" #passing
):

#(t28) Beta of 1-x to Beta
TestReparam(
     Bind(BetaD(a,b), x, Ret(1-x)),
     BetaD(b,a),
     equal &under (fromLO, _ctx= foldr(assert, empty, a > 0, b > 0)),
     ctx= [a > 0, b > 0],
     label= "(t28) Beta with 1-x to Beta" #passing
):

#(t29) Binomial of n-x to Binomial
#Fails because Binomial isn't implemented.
TestReparam(
     Bind(Binomial(n,p), x, Ret(n-x)),
     Binomial(n, 1-p),
     equal &under (fromLO,
          _ctx= foldr(assert, empty, n::integer, n > 0, 0 <= p, p <= 1)
     ),
     ctx= [n::integer, n > 0, 0 <= p, p <= 1],
     infolevels= [2,2],
     label= "(t29) Binomial of n-x to Binomial (currently failing)"
):

#(t30) Square of std normal to ChiSquared(1)
#Fails due to non-invertibility of substitution u= x^2.
TestReparam(
     Bind(Gaussian(0,1), x, Ret(x^2)),
     ChiSquared(1),
     equal &under fromLO,
     infolevels= [2,2],
     label= "(t30) Square of std normal to ChiSquared(1) (currently failing)"
):

#(t31) Sum of squares of n iid std normals to ChiSquared(n)
#Fails because it involves a Plate.
TestReparam(
     Bind(Plate(n, i, Gaussian(0,1)), xs, Ret(sum(idx(xs,i)^2, i= 0..n-1))),
     ChiSquared(n),
     equal &under (fromLO, _ctx= foldr(assert, empty, n::integer, n > 0)),
     ctx= [n::integer, n > 0],
     infolevels= [2,2],
     label=
          "(t31) Sum of squares of n iid std normals to ChiSquared(n) "
          "(currently failing)"
):

#(t32) Sum of ChiSquareds is ChiSquared
#Fails because it's multivariate.
TestReparam(
     Bind(ChiSquared(k1), x1, Bind(ChiSquared(k2), x2, Ret(x1+x2))),
     ChiSquared(k1+k2),
     equal &under (fromLO, _ctx= foldr(assert, empty, k1 > 0, k2 > 0)),
     ctx= [k1 > 0, k2 > 0],
     infolevels= [2,2],
     label= "(t32) Sum of ChiSquareds is ChiSquared (currently failing)"
):

#
#     Test Suite for Reparam---integration and summation changes of variables
#
#Created by Carl 17Jun2016.

#common header for Hakaru-Maple test suites
kernelopts(assertlevel= 2): # be strict on all assertions while testing
kernelopts(opaquemodules= false): # allow testing of internal routines
if not NewSLO :: `module` then
  WARNING("loading NewSLO failed");
  `quit`(3)
end if:

with(Hakaru):
with(KB):
with(NewSLO):
########################

#common procedures for these tests.

TestReparam:= proc(
     e_in,
     e_out,   #Expected output, after postprocessing by `verify` and `&under`
     #`verification` is slightly modified (below) from its standard definition.
     # &under is defined below.
     ver::verification,
     #First infolevel is for initial test; second is for retest after failure.
     {infolevels::[{nonnegint,identical(infinity)},{nonnegint, identical(infinity)}]:= [0,infinity]},
     {ctx::list:= []}   #Assumptions (not necessarily to be passed to `assuming`)
)
# For 'production' runs, we want things to be as quiet
# as possible.  We would like to do
# maple -q < ReparamT.mpl | grep -v "passed"
# and get 0 lines of output. If global `pretty`	is true, some extra lines are
# printed for readability. You may want to set this in a worksheet session.
local
     LOform:= toLO(e_in),  #preprocess input
     r
;
     if :-pretty then printf("\n") end if;
     :-infolevel[reparam]:= infolevels[1];
     if not CodeTools:-Test(reparam(LOform, :-ctx= ctx), e_out, ver, boolout, _rest) then
          #If test fails, do same test with diagnostic infolevel setting.
          if infolevels[2] > infolevels[1] then
               printf("\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@"  );
               printf("\n*** Rerun at higher infolevel: ***\n");
               :-infolevel[reparam]:= infolevels[2];
               r:= CodeTools:-Test(reparam(LOform, :-ctx= ctx), e_out, ver, boolout, _rest);
               printf(  "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n");
               return r
          else
               return false
          end if
     else
          return
     end if
end proc:

#VerifyTools is an undocumented Maple library package similiar to TypeTools.
#Add a verification &under analogous to type &under.
VerifyTools:-AddVerification(`&under`= ((e1,e2,Ver,f)-> verify(f(e1,_rest), e2, Ver))):

#Need to overload Maple library `type/verification` so that expressions of the form 'v &under f'
#are considered verifications.
`type/verification/MapleLibrary`:= eval(`type/verification`):
`type/verification`:= overload([
     proc(Under::specfunc(`&under`))
     option overload;
          type(op(1,Under), `verification/MapleLibrary`)
     end proc,

     `type/verification/MapleLibrary`
]):

#Automatic simplifications: When an easy transformation can be used to
#transform a distribution that we don't support to one that we do, then a
#procedure in this section does it. These may be moved to NewSLO.

#Bernoulli
Bern:= proc(p)
     local i;
     Bind(Counting(0,1), i, Weight(idx([p,1-p],i) * Ret(i)))
end proc:

#Exponential
Exponential:= mu-> GammaD(1,mu):

#Control printing of extra lines for readability.
if not assigned(pretty) then pretty:= false end if:

#
#   The tests
#

#Constant multiple in integral
TestReparam(
     Bind(Lebesgue(-infinity,infinity), x, Weight(2, Ret(2*x))),
     Lebesgue(-infinity,infinity),
     equal &under fromLO,
     label= "(t0a) Constant multiple with Lebesgue" #passing
):

#Logarithm with Uniform
TestReparam(
     Bind(Uniform(0,1), x, Ret(-log(x))),
     GammaD(1,1),
     equal &under fromLO,
     label= "(t0b) Logarithm with Uniform" #passing
):

#(t1) Symbolic affine transformation with Gaussian
TestReparam(
     Bind(Gaussian(mu,sigma), x, Ret((x-mu)/sigma)),
     Gaussian(0,1),
     equal &under fromLO,
     ctx= [sigma > 0],
     label= "(t1) Symbolic affine transformation with Gaussian" #passing
):

#(t2) ChiSquared to Gamma
#(inverse of relationship given in Relationships.hs)
# Special case of Gamma now recognized as being ChiSquared
TestReparam(
     ChiSquared(2*b),
     GammaD(b,2),
     equal &under (fromLO, _ctx= foldr(assert, empty, b > 0)),
     ctx= [b > 0],
     label= "(t2) ChiSquared to Gamma" #passing
):

#(t3) Symbolic constant multiple with Gamma
TestReparam(
     Bind(GammaD(alpha,beta), x, Ret(2*x/beta)),
     GammaD(alpha, 2),
     equal &under (fromLO, _ctx= foldr(assert, empty, alpha > 0, beta > 0)),
     ctx= [alpha > 0, beta > 0],
     label= "(t3) Symbolic constant multiple with Gamma"
):

#(t4) Two-variable LFT with Gamma
#This fails due to multivariate changes of variable not being implemented yet.
TestReparam(
     Bind(GammaD(a,t), x1, Bind(GammaD(b,t), x2, Ret(x1/(x1+x2)))),
     BetaD(a,b),
     equal &under fromLO,
     infolevels= [infinity$2],
     label= "(t4) Two-variable LFT with Gamma (currently failing)"
):

#(t5) Logarithm with symbolic constant multiplier and Uniform
TestReparam(
     Bind(Uniform(0,1), x, Ret(-alpha*log(x))),
     GammaD(1,alpha),
     equal &under fromLO,
     ctx= [alpha >= 0],
     label= "(t5) Logarithm with symbolic constant multiplier and Uniform"
     #passing
):

#(t6) Poisson(mu) -> ? as mu -> infinity
#The concept of taking the limit at infinity of a distribution parameter isn't
#implemented yet.

#(t7) Quotient of standard normals to standard Cauchy
#Fails because it's multivariate.
#This should be the first multivariate integration to implement, due to
#simplicity; it might work as a simple multivariate substitution.
TestReparam(
     Bind(Gaussian(0,1), x1, Bind(Gaussian(0,1), x2, Ret(x1/x2))),
     Cauchy(0,1),
     equal &under fromLO,
     infolevels= [2,2],
     label=
          "(t7) Quotient of standard normals to standard Cauchy "
          "(currently failing)"
):

#(t8) Affine translation of quotient of standard normals to Cauchy
#This is a trivial variation of t7.
#Fails because it's multivariate.
TestReparam(
     Bind(Gaussian(0,1), x1, Bind(Gaussian(0,1), x2, Ret(a+alpha*x1/x2))),
     Cauchy(a,alpha),
     equal &under (fromLO, _ctx= foldr(assert, empty, alpha > 0)),
     ctx= [alpha > 0],
     infolevels= [2,2],
     label=
          "(t8) Affine translation of quotient of standard normals to Cauchy "
          "(currently failing)"
):

#(t9) Bernoulli to Binomial with n=1
#Fails because Binomial isn't implemented.
#Doesn't use reparam in a meaningful way.
TestReparam(
     Bern(p),
     Binomial(1,p),
     equal &under (fromLO, _ctx= foldr(assert, empty, 0 <= p, p <= 1)),
     ctx= [0 <= p, p <= 1],
     infolevels= [2,2],
     label= "(t9) Bernoulli to Binomial with n=1 (currently failing)"
):

#(t10) Beta(1,1) to Uniform(0,1)
#This one doesn't require reparam, but it passes using reparam.
TestReparam(
     #Note: No use of `Bind`. This passes by direct recognition by fromLO
     #without any meaningful use of reparam, although reparam is called.
     BetaD(1,1),
     Uniform(0,1),
     equal &under fromLO,
     label= "(t10) Beta(1,1) to Uniform(0,1)" #passing
):

#(t11) Laplace to difference of Gammas
#This one fails because Laplace isn't implemented. Also, there's nothing that
#reparam can do with this. It's up to fromLO to recognize the compound
#expression.
#Perhaps this should be an automatic simplification.
TestReparam(
     Laplace(a1,a2),
     Bind(GammaD(1,a1), x1, Bind(GammaD(1,a2), x2, Ret(x1-x2))),
     equal &under (fromLO, _ctx= foldr(assert, empty, a1 > 0, a2 > 0)),
     ctx= [a1 > 0, a2 > 0],
     infolevels= [2,2],
     label= "(t11) Laplace to difference of Gammas (currently failing)"
):

#(t12) Sum of iid Exponentials to Gamma
#This currently fails because it's multivariate.
TestReparam(
     Bind(Exponential(b), x1, Bind(Exponential(b), x2, Ret(x1+x2))),
     GammaD(2,b),
     equal &under (fromLO, _ctx= foldr(assert, empty, b > 0)),
     ctx= [b > 0],
     infolevels= [2,2],
     label= "(t12) Sum of iid Exponentials to Gamma (currently failing)"
):

#(t13) Weibull(1,b) to Exponential(1/b)
#This test is wrong in Relationships.hs!
#It should be Weibull(a,1) to Exponential(1/a).
#Fails because Weibull isn't implemented.
TestReparam(
     #Straightforward recognition; doesn't use reparam in a meaningful way.
     Weibull(a,1),
     Exponential(1/a),
     equal &under (fromLO, _ctx= foldr(assert, empty, a > 0)),
     ctx= [a > 0],
     infolevels= [2,2],
     label= "(t13) Weibull(a,1) to Exponential(1/a) (currently failing)"
):

#(t14) Standard normal over sqrt(ChiSquared) to StudentT
#Fails because it's multivariate.
TestReparam(
     Bind(Gaussian(0,1), x, Bind(ChiSquared(nu), y, Ret(x/sqrt(y/nu)))),
     StudentT(nu, 0, 1),
     equal &under (fromLO, _ctx= foldr(assert, empty, nu > 0)),
     ctx= [nu > 0],
     infolevels= [2,2],
     label= "(t14) Std normal over sqrt(Chi2) to StudentT (currently failing)"
):

#(t15) 1/InverseGamma(k,1/t) to GammaD(k,t)
#Fails because InverseGamma isn't implemented.
TestReparam(
     Bind(InverseGammaD(k, 1/t), x, Ret(1/x)),
     GammaD(k,t),
     equal &under (fromLO, _ctx= foldr(assert, empty, k > 0, t > 0)),
     ctx= [k > 0, t > 0],
     infolevels= [2,2],
     label= "(t15) 1/InverseGammaD(k,1/t) to GammaD(k,t) (currently failing)"
):

#(t16) Sum of std normals to normal(0,sqrt(2))
#Fails because it requires a multivariate change of vars.
TestReparam(
     Bind(Gaussian(0,1), x1, Bind(Gaussian(0,1), x2, Ret(x1+x2))),
     Gaussian(0,sqrt(2)),
     equal &under fromLO,
     infolevels= [2,2],
     label= "(t16) Sum of std normals to normal(0,sqrt(2)) (currently failing)"
):

#(t17) Sum of std normal and normal to normal
#Fails because it requires a multivariate change of vars.
TestReparam(
     Bind(Gaussian(0,1), x1, Bind(Gaussian(mu,sigma), x2, Ret(x1+x2))),
     Gaussian(mu, sqrt(1+sigma^2)),
     equal &under (fromLO, _ctx= foldr(assert, empty, sigma > 0)),
     ctx= [sigma > 0],
     infolevels= [2,2],
     label= "(t17) Sum of std normal and normal to normal (currently failing)"
):

#(t18) Sum of symbolic multiples of std normals to normal
#Fails because it requires a multivariate change of vars.
TestReparam(
     Bind(Gaussian(0,1), x1, Bind(Gaussian(0,1), x2, Ret(a1*x1 + a2*x2))),
     Gaussian(0, sqrt(a1^2 + a2^2)),
     equal &under fromLO,
     infolevels= [2,2],
     label=
          "(t18) Sum of symbolic multiples of std normals to normal "
          "(currently failing)"
):

#(t19) Sum of equiprobable binomials to binomial
#Fails for three reasons: it's multivariate, it's discrete, and Binomial isn't
#implemented.
TestReparam(
     Bind(Binomial(n1,p), x1, Bind(Binomial(n2,p), x2, Ret(x1+x2))),
     Binomial(n1+n2, p),
     equal &under (fromLO,
          _ctx= foldr(
               assert, empty,
               n1::integer, n1 > 0, n2::integer, n2 > 0, 0 <= p, p <= 1
          )
     ),
     ctx= [n1::integer, n1 > 0, n2::integer, n2 > 0, 0 <= p, p <= 1],
     infolevels= [2,2],
     label=
          "(t19) Sum of equiprobable binomials to binomial "
          "(currently failing)"
):

#(t20) Sum of n Bernoullis to Binomial
#Fails because Binomial isn't implemented.
TestReparam(
     Bind(Plate(n, i, Bern(p)), xs, Ret(sum(idx(xs,i),i=0..n-1))),
     Binomial(n,p),
     equal &under (fromLO,
          _ctx= foldr(assert, empty, n::integer, n > 0, 0 <= p, p <= 1)
     ),
     ctx= [n::integer, n > 0, 0 <= p, p <= 1],
     infolevels= [2,2],
     label= "(t20) Sum of n Bernoullis to Binomial (currently failing)"
):

#(t21) Sum of Poissons to Poisson
#Fails because reparam doesn't yet handle summations.
TestReparam(
     Bind(PoissonD(lambda1), x1, Bind(PoissonD(lambda2), x2, Ret(x1+x2))),
     PoissonD(lambda1 + lambda2),
     equal &under (fromLO,
          _ctx= foldr(assert, empty, lambda1 > 0, lambda2 > 0)
     ),
     ctx= [lambda1 > 0, lambda2 > 0],
     infolevels= [2,2],
     label= "(t21) Sum of Poissons to Poisson (currently failing)"
):

#(t22) Sum of Gammas to Gamma
#Fails because it's multivariate.
TestReparam(
     Bind(GammaD(a1,b), x1, Bind(GammaD(a2,b), x2, Ret(x1+x2))),
     GammaD(a1+a2, b),
     equal &under (fromLO, _ctx= foldr(assert, empty, a1 > 0, a2 > 0, b > 0)),
     ctx= [a1 > 0, a2 > 0, a3 > 0],
     infolevels= [2,2],
     label= "(t22) Sum of Gammas to Gamma (currently failing)"
):

#(t23) Sum of n Exponentials to Gamma
#Fails because it involves a Plate.
TestReparam(
     Bind(Plate(n, i, Exponential(b)), xs, Ret(sum(idx(xs,i), i= 0..n-1))),
     GammaD(n,b),
     equal &under (fromLO, _ctx= foldr(assert, empty, n::integer, n > 0, b > 0)),
     ctx= [n::integer, n > 0, b > 0],
     infolevels= [2,2],
     label= "(t23) Sum of n Exponentials to Gamma (currently failing)"
):

#(t24) Weibull "scaling" property.
#I can find no evidence that this is true; indeed, it seems trivial to disprove
#it.

#(t25) Product of lognormals is lognormal
#Fails because it's multivariate.
TestReparam(
     Bind(
          Gaussian(mu1,sigma1), x1,
          Bind(Gaussian(mu2,sigma2), x2, Ret(exp(x1)*exp(x2)))
     ),
     Bind(Gaussian(mu1+mu2, sqrt(sigma1^2 + sigma2^2)), x3, Ret(exp(x3))),
     equal &under (fromLO, _ctx= foldr(assert, empty, sigma1 > 0, sigma2 > 0)),
     ctx= [sigma1 > 0, sigma2 > 0],
     infolevels= [2,2],
     label= "(t25) Product of lognormals is lognormal (currently failing)"
):

#(t26) Cauchy of reciprocal to Cauchy
#Fails due to improper handling of the discontinuity in the substitution.
TestReparam(
     Bind(Cauchy(0, sigma), x, Ret(1/x)),
     Cauchy(0, 1/sigma),
     equal &under (fromLO, _ctx= foldr(assert, empty, sigma > 0)),
     ctx= [sigma > 0],
     infolevels= [2,2],
     label= "(t26) Cauchy of reciprocal to Cauchy (currently failing)"
):

#(t27) Symbolic constant multiple of Gamma to Gamma
TestReparam(
     Bind(GammaD(r,lambda), x, Ret(a*x)),
     GammaD(r, a*lambda),
     equal &under (fromLO,
          _ctx= foldr(assert, empty, r > 0, lambda > 0, a > 0)
     ),
     ctx= [r > 0, lambda > 0, a > 0],
     label= "(t27) Symbolic constant multiple of Gamma to Gamma" #passing
):

#(t28) Beta of 1-x to Beta
TestReparam(
     Bind(BetaD(a,b), x, Ret(1-x)),
     BetaD(b,a),
     equal &under (fromLO, _ctx= foldr(assert, empty, a > 0, b > 0)),
     ctx= [a > 0, b > 0],
     label= "(t28) Beta with 1-x to Beta" #passing
):

#(t29) Binomial of n-x to Binomial
#Fails because Binomial isn't implemented.
TestReparam(
     Bind(Binomial(n,p), x, Ret(n-x)),
     Binomial(n, 1-p),
     equal &under (fromLO,
          _ctx= foldr(assert, empty, n::integer, n > 0, 0 <= p, p <= 1)
     ),
     ctx= [n::integer, n > 0, 0 <= p, p <= 1],
     infolevels= [2,2],
     label= "(t29) Binomial of n-x to Binomial (currently failing)"
):

#(t30) Square of std normal to ChiSquared(1)
#Fails due to non-invertibility of substitution u= x^2.
TestReparam(
     Bind(Gaussian(0,1), x, Ret(x^2)),
     ChiSquared(1),
     equal &under fromLO,
     infolevels= [infinity$2],
     label= "(t30) Square of std normal to ChiSquared(1) (currently failing)"
):

#(t31) Sum of squares of n iid std normals to ChiSquared(n)
#Fails because it involves a Plate.
TestReparam(
     Bind(Plate(n, i, Gaussian(0,1)), xs, Ret(sum(idx(xs,i)^2, i= 0..n-1))),
     ChiSquared(n),
     equal &under (fromLO, _ctx= foldr(assert, empty, n::integer, n > 0)),
     ctx= [n::integer, n > 0],
     infolevels= [2,2],
     label=
          "(t31) Sum of squares of n iid std normals to ChiSquared(n) "
          "(currently failing)"
):

#(t32) Sum of ChiSquareds is ChiSquared
#Fails because it's multivariate.
TestReparam(
     Bind(ChiSquared(k1), x1, Bind(ChiSquared(k2), x2, Ret(x1+x2))),
     ChiSquared(k1+k2),
     equal &under (fromLO, _ctx= foldr(assert, empty, k1 > 0, k2 > 0)),
     ctx= [k1 > 0, k2 > 0],
     infolevels= [infinity$2],
     label= "(t32) Sum of ChiSquareds is ChiSquared (currently failing)"
):


Fix a very subtle bug which occurs in piecewise_if.

For input like `piecewise_if(cond, th, piecewise(cond1,th1))' it could produce
`piecewise(cond,th, cond1,th1)' which is not equivalent to the original
expression, since `piecewise(c,t)' has an implicit `otherwise -> 0' case.

# Step 2 of 3: computer algebra

  improve := proc(lo :: LO(name, anything), {_ctx :: t_kb := empty}, opts := [], $)
  local r, `&context`;
       userinfo(5, improve, "input: ", print(lo &context _ctx));
       r:= LO(op(1,lo), reduce(op(2,lo), op(1,lo), _ctx, opts));
       userinfo(5, improve, "output: ", print(r));
       r
  end proc;

  # Walk through integrals and simplify, recursing through grammar
  # h - name of the linear operator above us
  # kb - domain information
  reduce := proc(ee, h :: name, kb :: t_kb, opts := [], $)
    local e, elim, subintegral, w, ww, x, c, kb1, with_kb1, dom_specw, dom_specb
         , body, dom_spec, ed, mkDom, vars, rr
         , do_domain := evalb( not ( "no_domain" in {op(opts)} ) ) ;
    e := ee;

    if do_domain then
      rr := reduce_Integrals(e, h, kb, opts);
      if rr <> FAIL then return rr end if;
    end if;
    if e :: 'applyintegrand(anything, anything)' then
      map(simplify_assuming, e, kb)
    elif e :: `+` then
      map(reduce, e, h, kb, opts)
    elif e :: `*` then
      (subintegral, w) := selectremove(depends, e, h);
      if subintegral :: `*` then error "Nonlinear integral %1", e end if;
      subintegral := convert(reduce(subintegral, h, kb, opts), 'list', `*`);
      (subintegral, ww) := selectremove(depends, subintegral, h);
      nub_piecewise(simplify_factor_assuming(`*`(w, op(ww)), kb))
        * `*`(op(subintegral));
    elif e :: Or(Partition,t_pw) then
      if e :: t_pw then e := PWToPartition(e); end if;
      e := Partition:-Flatten(e);
      e := kb_Partition(e, kb, simplify_assuming,
                        ((rhs, kb) -> %reduce(rhs, h, kb, opts)));
      e := eval(e, %reduce=reduce);
      # big hammer: simplify knows about bound variables, amongst many
      # other things
      Testzero := x -> evalb(simplify(x) = 0);
      e := PartitionToPW(e);
      e := nub_piecewise(e);
      if ee::Partition and e :: t_pw then
        e := Partition:-PWToPartition(e,'do_solve');
      end if;
      e;
    elif e :: t_case then
      subsop(2=map(proc(b :: Branch(anything, anything))
                     eval(subsop(2='reduce'(op(2,b),x,c,opts),b),
                          {x=h, c=kb})
                   end proc,
                   op(2,e)),
             e);
    elif e :: 'Context(anything, anything)' then
      kb1 := assert(op(1,e), kb);
      # A contradictory `Context' implies anything, so produce 'anything'
      # In particular, 42 :: t_Hakaru = false, so a term under a false
      # assumption should never be inspected in any way.
      if kb1 :: t_not_a_kb then
          return 42
      end if;
      applyop(reduce, 2, e, h, kb1, opts);
    elif e :: 'toLO:-integrate(anything, Integrand(name, anything), list)' then
      x := gensym(op([2,1],e));
      # If we had HType information for op(1,e),
      # then we could use it to tell kb about x.
      subsop(2=Integrand(x, reduce(subs(op([2,1],e)=x, op([2,2],e)), h, kb, opts)), e)
    else
      simplify_assuming(e, kb)
    end if;
  end proc;

  reduce_Integrals_post := proc(h,kb,opts,dvars,mkDom,body)
    local vars, e
      , ed := mkDom(body)
      , ee := subsindets(ed, specfunc(ELIMED), x->op(1,x))
      , do_r :=
          op(1,
           [ map(x->op(2,x),select(x->x::list and op(1,x)="reduce_on", opts))[]
           , reduce_on_prod ]);
    if ed = ee then
      vars := indets(Domain:-Bound:-varsOf(dvars), name);
      ed := do_r(mkDom, body, vars, kb);
      kb_assuming_mb(x->subsindets(x, Partition, Partition:-Simpl))(ed, kb, x->x);
    else
      reduce(ee,h,kb,opts);
    end if
  end proc;

  # "Integrals" refers to any types of "integrals" understood by domain (Int,
  # Sum currently)
  reduce_Integrals := proc(expr, h, kb, opts, $)
    local rr;
    rr := Domain:-Fold(expr, kb
      ,proc() elim_intsum:-for_Domain(h,args) end proc
      ,((x,kb1)->reduce(x,h,kb1,opts))
      , proc() reduce_Integrals_post(h,kb,opts,args) end proc
      ,(_->:-DOM_FAIL));

    if has(rr, :-DOM_FAIL) then
      return FAIL;
    elif has(rr, FAIL) then
      error "Something strange happened in reduce_Integral(%a, %a, %a, %a)\n%a"
          , expr, kb, kb, opts, rr;
    else
      return rr;
    end if
  end proc;

  # Helper function for performing reductions
  # given an "ee" and a "var", pulls the portion
  # of "ee" not depending on "var" out, and applies "f"
  # to the portion depending on "var".
  # the 'weights' (factors not depending on "var") are simplified
  # under the given assumption context, "kb0"
  reduce_on_sum := proc(f,ee,var,kb0,$)
    `+`(map(s->reduce_on_prod(f,s,var,kb0), convert(expand(ee), 'list', `+`))[]);
  end proc;
  reduce_on_prod := proc(f,ee, var:: {name, list(name), set(name)} ,kb0::t_kb,$)
      local e := ee, w;
      e, w := selectremove(x->depends(x,var) or x :: realcons, list_of_mul(e));
      nub_piecewise(simplify_factor_assuming(`*`(op(w)), kb0)) * f(`*`(op(e))) ;
  end proc;

  int_assuming := proc(e, v::name=anything, kb::t_kb, $)
    simplify_factor_assuming('int'(e, v), kb);
  end proc;

  sum_assuming := proc(e, v::name=anything, kb::t_kb)
    simplify_factor_assuming('sum'(e, v), kb);
  end proc;

  nub_piecewise := proc(pw, $) # pw may or may not be piecewise
    foldr_piecewise(piecewise_if, 0, pw)
  end proc;

  piecewise_if := proc(cond, th, el, $)
    # piecewise_if should be equivalent to `if`, but it produces
    # 'piecewise' and optimizes for when the 3rd argument is 'piecewise'
    if cond = true then
      th
    elif cond = false or Testzero(th - el) then
      el
    elif el :: t_pw then
      if nops(el) >= 2 and Testzero(th - op(2,el)) then
        applyop(Or, 1, el, cond)
      elif nops(el) = 2 then
        piecewise(cond, th, op(el), 0)
      else
        piecewise(cond, th, op(el))
      end if
    elif Testzero(el) then
      piecewise(cond, th)
    else
      piecewise(cond, th, el)
    end if
  end proc;

  # Int( .., var=var_ty ) == var &X var_ty
  isBound_IntSum := kind -> module()
    option record;

    export MakeKB := (`if`(kind=Sum,KB:-genSummation,KB:-genLebesgue));
    export ExtractVar := (e->op(1,e));
    export ExtractRange := (e->op(2,e));
    export MakeRange := `..`;
    export SplitRange := (e->op(e));
    export Constrain := `if`(kind=Sum,`<=`,`<`);
    export DoMk := ((e,v,t)->kind(e,v=t));
    export EvalInCtx    := `if`(kind=Sum,'sum_assuming','int_assuming');
    export Min := `min`; export Max := `max`;
    export VarType := 'name';
    export RangeType := 'range';
    export MapleType := 'And'('specfunc'(kind), 'anyfunc(anything,name=range)');
    export BoundType := `if`(kind=Sum,'integer','real');
  end module;

  # Ints( .., var::name, var_ty::range, dims::list(name=range) ) ==
  #        [ var   , map(lhs,dims) ] :: list(name)  &X
  #        [ var_ty, map(rhs,dims) ] :: list(range)
  isBound_IntsSums := kind -> module()
    option record;

    export MakeKB := proc(vars, lo, hi, kb, $)
      local var, dims, ty, rngs, x, kb1;
      var  := op(1, vars);
      rngs := zip(`..`,lo,hi);
      ty   := op(1, rngs);
      dims := subsop(1=NULL,zip(`=`,vars,rngs));

      x, kb1 := genType(var,
                        mk_HArray(`if`(kind=Ints,
                                       HReal(open_bounds(ty)),
                                       HInt(closed_bounds(ty))),
                                  dims),kb);
      if nops(dims) > 0 then
        kb1 := assert(size(x)=op([-1,2,2],dims)-op([-1,2,1],dims)+1, kb1);
      end if;
      x, kb1;
    end proc;
    export ExtractVar   := ((v,t,d)->[v,map(lhs,d)[]]);
    export ExtractRange := ((v,t,d)->[t,map(rhs,d)[]]);
    export MakeRange    := ((a,b)->zip(`..`,a,b));
    export SplitRange   := (rs->(map(x->op(1,x),rs), map(x->op(2,x),rs)));
    export Constrain    := ((a,b)->zip(`if`(kind=Ints, `<`, `<=`),a,b)[]);
    export DoMk         := ((e,v,t)->kind( e,op(1,v),op(1,t), subsop(1=NULL,zip(`=`,v,t)) ));
    export EvalInCtx    := `if`(kind=Ints,'ints','sums');
    export Min          := ((a,b)->zip(`min`,a,b));
    export Max          := ((a,b)->zip(`max`,a,b));
    export VarType      := 'And(list(name),satisfies(x->x<>[]))';
    export RangeType    := 'And(list(range),satisfies(x->x<>[]))';
    export MapleType    := 'And'('specfunc'(kind),'anyfunc'('anything', 'name', 'range', 'list(name=range)'));
    export BoundType    := TopProp;
  end module;

  # Try to find an eliminate (by evaluation, or simplification) integrals which
  # are free of `applyintegrand`s.
  elim_intsum := module ()
    export ModuleApply := proc(inert0, h :: name, kb :: t_kb, $)
       local ex, un_elim, e1, inert := inert0, done_e := false;

       un_elim := subsindets(inert, specfunc('ELIMED'), x->op(1,x));
       if un_elim <> inert then
         inert := un_elim; done_e := true;
       end if;

       ex := extract_elim(inert, h);
       e1 := apply_elim(h, kb, ex);
       e1 := check_elim(inert, e1);
       if e1 = FAIL then
         `if`(done_e,ELIMED,_->_)(inert)
       else
         ELIMED(e1)
       end if
    end proc;

    export for_Domain := proc(h, kind, e, vn, vt, kb, $)
       ModuleApply(Domain:-Apply:-do_mk(args[2..-1]), h, kb);
    end proc;

    local extract_elim := proc(e, h::name, $)
      local t, intapps, var, f, e_k, e_args;
      t := 'applyintegrand'('identical'(h), 'anything');
      intapps := indets(op(1,e), t);
      if intapps = {} then
        return FAIL;
      end if;
      e_k := op(0,e); e_args := op([2..-1],e);

      if Domain:-Has:-Bound(e) then
        var := Domain:-ExtBound[e_k]:-ExtractVar(e_args);
        ASSERT(var::DomBoundVar);
        if var :: list then var := op(1,var) end if;

        if not depends(intapps, var) then
          f := Domain:-ExtBound[e_k]:-EvalInCtx;
        else
          return FAIL;
        end if;
      end if;

      [ op(1,e), f, var, [e_args] ];
    end proc;

    local apply_elim := proc(h::name,kb::t_kb,todo::{list,identical(FAIL)})
      local body, f, var, rrest;
      if todo = FAIL then return FAIL; end if;
      body, f, var, rrest := op(todo);
      banish(body, h, kb, infinity, var,
             proc (kb1,g,$) do_elim_intsum(kb1, f, g, op(rrest)) end proc);
    end proc;

    local check_elim := proc(e, elim,$)
      if has(elim, {MeijerG, undefined, FAIL}) or e = elim or elim :: SymbolicInfinity then
        return FAIL;
      end if;
      return elim;
    end proc;

    local do_elim_intsum := proc(kb, f, ee, v::{name,name=anything})
      local w, e, x, g, t, r;
      w, e := op(Domain:-Extract:-Shape(ee));
      w := Domain:-Shape:-toConstraints(w);
      e := piecewise_And(w, e, 0);
      e := f(e,v,_rest,kb);
      x := `if`(v::name, v, lhs(v));
      g := '{sum, sum_assuming, sums}';
      if f in g then
        t := {'identical'(x),
              'identical'(x) = 'Not(range(Not({SymbolicInfinity, undefined})))'};
      else
        g := '{int, int_assuming, ints}';
        t := {'identical'(x),
              'identical'(x) = 'anything'};
        if not f in g then g := {f} end if;
      end if;
      for r in indets(e, 'specfunc'(g)) do
        if 1<nops(r) and op(2,r)::t then return FAIL end if
      end do;
      e
    end proc;

  end module;

# Step 2 of 3: computer algebra

  improve := proc(lo :: LO(name, anything), {_ctx :: t_kb := empty}, opts := [], $)
  local r, `&context`;
       userinfo(5, improve, "input: ", print(lo &context _ctx));
       r:= LO(op(1,lo), reduce(op(2,lo), op(1,lo), _ctx, opts));
       userinfo(5, improve, "output: ", print(r));
       r
  end proc;

  # Walk through integrals and simplify, recursing through grammar
  # h - name of the linear operator above us
  # kb - domain information
  reduce := proc(ee, h :: name, kb :: t_kb, opts := [], $)
    local e, elim, subintegral, w, ww, x, c, kb1, with_kb1, dom_specw, dom_specb
         , body, dom_spec, ed, mkDom, vars, rr
         , do_domain := evalb( not ( "no_domain" in {op(opts)} ) ) ;
    e := ee;

    if do_domain then
      rr := reduce_Integrals(e, h, kb, opts);
      if rr <> FAIL then return rr end if;
    end if;
    if e :: 'applyintegrand(anything, anything)' then
      map(simplify_assuming, e, kb)
    elif e :: `+` then
      map(reduce, e, h, kb, opts)
    elif e :: `*` then
      (subintegral, w) := selectremove(depends, e, h);
      if subintegral :: `*` then error "Nonlinear integral %1", e end if;
      subintegral := convert(reduce(subintegral, h, kb, opts), 'list', `*`);
      (subintegral, ww) := selectremove(depends, subintegral, h);
      nub_piecewise(simplify_factor_assuming(`*`(w, op(ww)), kb))
        * `*`(op(subintegral));
    elif e :: Or(Partition,t_pw) then
      if e :: t_pw then e := PWToPartition(e); end if;
      e := Partition:-Flatten(e);
      e := kb_Partition(e, kb, simplify_assuming,
                        ((rhs, kb) -> %reduce(rhs, h, kb, opts)));
      e := eval(e, %reduce=reduce);
      # big hammer: simplify knows about bound variables, amongst many
      # other things
      Testzero := x -> evalb(simplify(x) = 0);
      e := PartitionToPW(e);
      e := nub_piecewise(e);
      if ee::Partition and e :: t_pw then
        e := Partition:-PWToPartition(e,'do_solve');
      end if;
      e;
    elif e :: t_case then
      subsop(2=map(proc(b :: Branch(anything, anything))
                     eval(subsop(2='reduce'(op(2,b),x,c,opts),b),
                          {x=h, c=kb})
                   end proc,
                   op(2,e)),
             e);
    elif e :: 'Context(anything, anything)' then
      kb1 := assert(op(1,e), kb);
      # A contradictory `Context' implies anything, so produce 'anything'
      # In particular, 42 :: t_Hakaru = false, so a term under a false
      # assumption should never be inspected in any way.
      if kb1 :: t_not_a_kb then
          return 42
      end if;
      applyop(reduce, 2, e, h, kb1, opts);
    elif e :: 'toLO:-integrate(anything, Integrand(name, anything), list)' then
      x := gensym(op([2,1],e));
      # If we had HType information for op(1,e),
      # then we could use it to tell kb about x.
      subsop(2=Integrand(x, reduce(subs(op([2,1],e)=x, op([2,2],e)), h, kb, opts)), e)
    else
      simplify_assuming(e, kb)
    end if;
  end proc;

  reduce_Integrals_post := proc(h,kb,opts,dvars,mkDom,body)
    local vars, e
      , ed := mkDom(body)
      , ee := subsindets(ed, specfunc(ELIMED), x->op(1,x))
      , do_r :=
          op(1,
           [ map(x->op(2,x),select(x->x::list and op(1,x)="reduce_on", opts))[]
           , reduce_on_prod ]);
    if ed = ee then
      vars := indets(Domain:-Bound:-varsOf(dvars), name);
      ed := do_r(mkDom, body, vars, kb);
      kb_assuming_mb(x->subsindets(x, Partition, Partition:-Simpl))(ed, kb, x->x);
    else
      reduce(ee,h,kb,opts);
    end if
  end proc;

  # "Integrals" refers to any types of "integrals" understood by domain (Int,
  # Sum currently)
  reduce_Integrals := proc(expr, h, kb, opts, $)
    local rr;
    rr := Domain:-Fold(expr, kb
      ,proc() elim_intsum:-for_Domain(h,args) end proc
      ,((x,kb1)->reduce(x,h,kb1,opts))
      , proc() reduce_Integrals_post(h,kb,opts,args) end proc
      ,(_->:-DOM_FAIL));

    if has(rr, :-DOM_FAIL) then
      return FAIL;
    elif has(rr, FAIL) then
      error "Something strange happened in reduce_Integral(%a, %a, %a, %a)\n%a"
          , expr, kb, kb, opts, rr;
    else
      return rr;
    end if
  end proc;

  # Helper function for performing reductions
  # given an "ee" and a "var", pulls the portion
  # of "ee" not depending on "var" out, and applies "f"
  # to the portion depending on "var".
  # the 'weights' (factors not depending on "var") are simplified
  # under the given assumption context, "kb0"
  reduce_on_sum := proc(f,ee,var,kb0,$)
    `+`(map(s->reduce_on_prod(f,s,var,kb0), convert(expand(ee), 'list', `+`))[]);
  end proc;
  reduce_on_prod := proc(f,ee, var:: {name, list(name), set(name)} ,kb0::t_kb,$)
      local e := ee, w;
      e, w := selectremove(x->depends(x,var) or x :: realcons, list_of_mul(e));
      nub_piecewise(simplify_factor_assuming(`*`(op(w)), kb0)) * f(`*`(op(e))) ;
  end proc;

  int_assuming := proc(e, v::name=anything, kb::t_kb, $)
    simplify_factor_assuming('int'(e, v), kb);
  end proc;

  sum_assuming := proc(e, v::name=anything, kb::t_kb)
    simplify_factor_assuming('sum'(e, v), kb);
  end proc;

  nub_piecewise := proc(pw, $) # pw may or may not be piecewise
    foldr_piecewise(piecewise_if, 0, pw)
  end proc;

  piecewise_if := proc(cond, th, el, $)
    # piecewise_if should be equivalent to `if`, but it produces
    # 'piecewise' and optimizes for when the 3rd argument is 'piecewise'
    if cond = true then
      th
    elif cond = false or Testzero(th - el) then
      el
    elif el :: t_pw then
      if nops(el) >= 2 and Testzero(th - op(2,el)) then
        applyop(Or, 1, el, cond)
      else
        piecewise(cond, th, op(el))
      end if
    elif Testzero(el) then
      piecewise(cond, th)
    else
      piecewise(cond, th, el)
    end if
  end proc;

  # Int( .., var=var_ty ) == var &X var_ty
  isBound_IntSum := kind -> module()
    option record;

    export MakeKB := (`if`(kind=Sum,KB:-genSummation,KB:-genLebesgue));
    export ExtractVar := (e->op(1,e));
    export ExtractRange := (e->op(2,e));
    export MakeRange := `..`;
    export SplitRange := (e->op(e));
    export Constrain := `if`(kind=Sum,`<=`,`<`);
    export DoMk := ((e,v,t)->kind(e,v=t));
    export EvalInCtx    := `if`(kind=Sum,'sum_assuming','int_assuming');
    export Min := `min`; export Max := `max`;
    export VarType := 'name';
    export RangeType := 'range';
    export MapleType := 'And'('specfunc'(kind), 'anyfunc(anything,name=range)');
    export BoundType := `if`(kind=Sum,'integer','real');
  end module;

  # Ints( .., var::name, var_ty::range, dims::list(name=range) ) ==
  #        [ var   , map(lhs,dims) ] :: list(name)  &X
  #        [ var_ty, map(rhs,dims) ] :: list(range)
  isBound_IntsSums := kind -> module()
    option record;

    export MakeKB := proc(vars, lo, hi, kb, $)
      local var, dims, ty, rngs, x, kb1;
      var  := op(1, vars);
      rngs := zip(`..`,lo,hi);
      ty   := op(1, rngs);
      dims := subsop(1=NULL,zip(`=`,vars,rngs));

      x, kb1 := genType(var,
                        mk_HArray(`if`(kind=Ints,
                                       HReal(open_bounds(ty)),
                                       HInt(closed_bounds(ty))),
                                  dims),kb);
      if nops(dims) > 0 then
        kb1 := assert(size(x)=op([-1,2,2],dims)-op([-1,2,1],dims)+1, kb1);
      end if;
      x, kb1;
    end proc;
    export ExtractVar   := ((v,t,d)->[v,map(lhs,d)[]]);
    export ExtractRange := ((v,t,d)->[t,map(rhs,d)[]]);
    export MakeRange    := ((a,b)->zip(`..`,a,b));
    export SplitRange   := (rs->(map(x->op(1,x),rs), map(x->op(2,x),rs)));
    export Constrain    := ((a,b)->zip(`if`(kind=Ints, `<`, `<=`),a,b)[]);
    export DoMk         := ((e,v,t)->kind( e,op(1,v),op(1,t), subsop(1=NULL,zip(`=`,v,t)) ));
    export EvalInCtx    := `if`(kind=Ints,'ints','sums');
    export Min          := ((a,b)->zip(`min`,a,b));
    export Max          := ((a,b)->zip(`max`,a,b));
    export VarType      := 'And(list(name),satisfies(x->x<>[]))';
    export RangeType    := 'And(list(range),satisfies(x->x<>[]))';
    export MapleType    := 'And'('specfunc'(kind),'anyfunc'('anything', 'name', 'range', 'list(name=range)'));
    export BoundType    := TopProp;
  end module;

  # Try to find an eliminate (by evaluation, or simplification) integrals which
  # are free of `applyintegrand`s.
  elim_intsum := module ()
    export ModuleApply := proc(inert0, h :: name, kb :: t_kb, $)
       local ex, un_elim, e1, inert := inert0, done_e := false;

       un_elim := subsindets(inert, specfunc('ELIMED'), x->op(1,x));
       if un_elim <> inert then
         inert := un_elim; done_e := true;
       end if;

       ex := extract_elim(inert, h);
       e1 := apply_elim(h, kb, ex);
       e1 := check_elim(inert, e1);
       if e1 = FAIL then
         `if`(done_e,ELIMED,_->_)(inert)
       else
         ELIMED(e1)
       end if
    end proc;

    export for_Domain := proc(h, kind, e, vn, vt, kb, $)
       ModuleApply(Domain:-Apply:-do_mk(args[2..-1]), h, kb);
    end proc;

    local extract_elim := proc(e, h::name, $)
      local t, intapps, var, f, e_k, e_args;
      t := 'applyintegrand'('identical'(h), 'anything');
      intapps := indets(op(1,e), t);
      if intapps = {} then
        return FAIL;
      end if;
      e_k := op(0,e); e_args := op([2..-1],e);

      if Domain:-Has:-Bound(e) then
        var := Domain:-ExtBound[e_k]:-ExtractVar(e_args);
        ASSERT(var::DomBoundVar);
        if var :: list then var := op(1,var) end if;

        if not depends(intapps, var) then
          f := Domain:-ExtBound[e_k]:-EvalInCtx;
        else
          return FAIL;
        end if;
      end if;

      [ op(1,e), f, var, [e_args] ];
    end proc;

    local apply_elim := proc(h::name,kb::t_kb,todo::{list,identical(FAIL)})
      local body, f, var, rrest;
      if todo = FAIL then return FAIL; end if;
      body, f, var, rrest := op(todo);
      banish(body, h, kb, infinity, var,
             proc (kb1,g,$) do_elim_intsum(kb1, f, g, op(rrest)) end proc);
    end proc;

    local check_elim := proc(e, elim,$)
      if has(elim, {MeijerG, undefined, FAIL}) or e = elim or elim :: SymbolicInfinity then
        return FAIL;
      end if;
      return elim;
    end proc;

    local do_elim_intsum := proc(kb, f, ee, v::{name,name=anything})
      local w, e, x, g, t, r;
      w, e := op(Domain:-Extract:-Shape(ee));
      w := Domain:-Shape:-toConstraints(w);
      e := piecewise_And(w, e, 0);
      e := f(e,v,_rest,kb);
      x := `if`(v::name, v, lhs(v));
      g := '{sum, sum_assuming, sums}';
      if f in g then
        t := {'identical'(x),
              'identical'(x) = 'Not(range(Not({SymbolicInfinity, undefined})))'};
      else
        g := '{int, int_assuming, ints}';
        t := {'identical'(x),
              'identical'(x) = 'anything'};
        if not f in g then g := {f} end if;
      end if;
      for r in indets(e, 'specfunc'(g)) do
        if 1<nops(r) and op(2,r)::t then return FAIL end if
      end do;
      e
    end proc;

  end module;