Handle two new cases in simplifyPartitionCtx (piecewise solution and sum of solutions). PWToPartition also handles the case when simplifyPartitionCtx returns multiple pieces.

#This module implements `Partition`---Hakaru's replacement for Maple's
#endogenous and unwieldy `piecewise`.

#The outer data structure for a Partition is a function, PARTITION(...), (just like it
#is for piecewise.

Partition:= module()

option package;

#This module is essentially an object, but we decided, for now at least, to not
#use Maple's "option object".

global Piece;

local
   diff_,

   Umap := proc(f,x,$)
       f(op(0,x))( map( p -> Piece(f(condOf(p)),f(valOf(p)))
                      , op(1,x)
                      )
                 )
   end proc,

   # could also be named
   # simplifyPartition_by_the_removal_of_particular_singular_points
   simplifyPartition_mergeSinglePts := module()
       local canSimp := c -> valOf(c) :: identical('undefined') and condOf(c) :: `=`
                                  and (lhs(condOf(c)) :: name or rhs(condOf(c)) :: name);

       local mentions_t_hi :=
                t -> bnd -> cl -> has(cl, t<bnd) or has(cl, bnd>t);

       local mentions_t_lo :=
                t -> bnd -> cl -> has(cl, bnd<t) or has(cl, t>bnd);

       local replace_with := t -> bnd -> x ->
                if mentions_t_hi(t)(bnd)(x) then
                    t <= bnd
                elif mentions_t_lo(t)(bnd)(x) then
                    t >= bnd
                else
                    x
                end if;

       local set_xor := proc(a,b,$) (a union b) intersect (a minus b) end proc;

       local tryReplacePieces :=
               proc(replPieces, otherPieces,cmp,$)
                 local rpp := replPieces, otp := otherPieces, nm, val, rp, rpv;

                 for rp in rpp do
                     rp, rpv := op(rp);

                     nm   := `if`(lhs(rp)::name, lhs(rp), rhs(rp));
                     val  := `if`(lhs(rp)::name, rhs(rp), lhs(rp));

                     otp := tryReplacePiece( nm, val, rpv, otp, cmp )
                 end do;

                 otp;

               end proc;

       local the_val := cmp -> xs ->
                evalb( foldl( proc(x,y) if cmp(x,y) then x else NULL end if; end proc, op(xs)) = NULL ) ;

       local tryReplacePiece :=
               proc(vrNm, vrVal, pc0val, pcs, cmp,$)
                 local pcs0 := pcs, pcs1, qs0, qs1, qs2, vrEq := vrNm=vrVal ;
                 pcs1 := subsindets(pcs0, relation, replace_with(vrNm)(vrVal));

                 qs0, qs1 := seq({op(qs)},qs=(pcs0,pcs1));

                 qs2 := set_xor(qs1, qs0);

                 if nops(qs2) = 2 then
                     qs2 := map(condOf, qs2);

                     if not pc0val :: identical('undefined') then
                         qs2 := { pc0val, op(qs2) };
                     end if;

                     qs2 := map(q -> subs(vrEq, q), qs2);

                     if the_val(cmp)(qs2) then
                         pcs1;
                     else
                         [ Piece(vrEq, pc0val), op(pcs0) ] ;
                     end if
                 else
                     [ Piece(vrEq, pc0val), op(pcs0) ] ;
                 end if;

               end proc;

       export ModuleApply := proc(p_,{cmp:=`=`},$)

          local p := p_, r := p, uc, oc;

          # if the partition contains case of the form `x = t', where `t' is a
          # constant (or term??) and `x' is a variable, and the value of that
          # case is `undefined', then we may be able to eliminate it (if another
          # case includes that point)
          r := op(1,r);
          uc, oc := selectremove(canSimp, r);

          # special case: if there is exactly one `undefined' case, and one
          # other case, just get rid of the `undefined' piece
          if nops(uc)=1 and nops(oc)=1 then
              p := PARTITION(oc);
          else
              p := PARTITION(tryReplacePieces(uc, oc, cmp));
          end if;

          return p;

       end proc;

   end module,

   simplifyPartitionCtx := module()

       local is_extra_sol := x -> (x :: `=` and rhs(x)=lhs(x) and lhs(x) :: name);
                               # or (x :: name);

       local preproc_for_solve := proc(ctx, $)
                 ctx;
             end proc;

       local postproc_for_solve := proc(ctx, ctxSlv, $)::{identical(false), list({boolean,relation})};
                 local ctxC := ctxSlv;

                 if ctxC = [] then
                     ctxC := false ;

                 elif nops(ctxC)> 1 then
                     ctxC := map(x -> postproc_for_solve(ctx, [x])[], ctxC);

                 elif nops(ctxC) = 1 then
                     ctxC := op(1,ctxC);

                     if ctxC :: set then
                         ctxC := remove(is_extra_sol, ctxC);

                         if ctxC :: identical('{}') then
                             ctxC := eval(ctx, [`And`=`and`, `Not`=`not`]);
                         else
                             ctxC := `and`(op(ctxC));
                         end if ;

                         ctxC := [ctxC];

                     elif ctxC :: specfunc('piecewise') then
                         ctxC := PWToPartition(ctxC);

                         ctxC := [ seq( map( o -> condOf(c) and o
                                           , postproc_for_solve(ctx, valOf(c)))[]
                                      , c=op(1, ctxC)
                                      )
                                 ] ;
                     else
                         error "simplifyPartitionCtx: don't know what to do with %1", ctxC;
                     end if;
                 else
                     error "simplifyPartitionCtx: don't know what to do with %1", ctxC;

                 end if;

                 ctxC;

             end proc;

       export ModuleApply := proc(ctx, $)
       local ctxC := ctx;

           if ctx :: identical(true) then
               error "simplifyPartitionCtx: don't know what to do with %1", ctxC;
           end if;

           ctxC := solve({ctxC});
           postproc_for_solve(ctx, [ctxC]);

       end proc;

   end module,

   ModuleLoad::static:= proc()
      local prev;

      :-`print/PARTITION`:= proc(SetOfRecords)
      local branch;
         `print/%piecewise`(
            seq([ condOf(eval(branch)), valOf(eval(branch))][], branch= SetOfRecords)
         )
      end proc;

      TypeTools:-AddType(Partition, specfunc(PARTITION));

      # global extensions to maple functionality

      :-`eval/PARTITION` :=
      proc(p, eqs, $)
          local q, r;
          q := Umap(x->eval(x,eqs), p);

          r := eval( PartitionToPW(q), eqs );
          if r :: specfunc('piecewise') then
              q := PWToPartition( r );
          else
              q := r;
          end if;

          q;

      end proc;

      :-`depends/PARTITION` :=
      proc(parts, nms, $)
         local dp := (x -> depends(x, nms));
         `or`(op ( map(p-> dp(condOf(p)) or dp(valOf(p)), parts) ));
      end proc;

      :-`diff/PARTITION` :=
      proc(parts, wrt, $)
          local pw  := PartitionToPW(PARTITION(parts))
              , dpw := diff(pw, wrt)
              , r   := PWToPartition(dpw)
              , r0, r1;
            ;
          r0 := simplifyPartition_mergeSinglePts(r);

          # probably a better way to do this; we really only want to simplify
          # sums and products of integrals and summations
          r1 := subsindets(r0, algebraic, `simplify`);

          userinfo(10, 'disint_trace',
                   printf("  input        : \n\t%a\n\n"
                          "  diff         : \n\t%a\n\n"
                          "  singular pts : \n\t%a\n\n"
                          "  simplified   : \n\t%a\n\n\n"
                          , parts, r, r0, r1 ));

          r1;
      end proc;

      NULL
   end proc,

   ModuleUnload::static:= proc()
      TypeTools:-RemoveType(Partition);
      NULL
   end proc,

   # abstract out all argument checking for map-like functions
   map_check := proc(p)
      local pos, err;
      if p::indexed then
         pos:= op(p);
         if not [pos]::[posint] then
            err := sprintf("Expected positive integer index; received %a", [pos]);
            return err;
         end if
      else
         pos:= 1
      end if;
      if nargs-1 <= pos then
         err := sprintf("Expected at least %d arguments; received %d", pos+1, nargs-1);
         return err;
      end if;
      if not args[pos+2]::Partition then
         err := sprintf("Expected a Partition; received %a", args[pos+2]);
         return err;
      end if;
      return pos;
   end proc
;
export

   condOf := proc(x::specfunc(`Piece`),$)
       op(1,x);
   end proc,

   valOf := proc(x::specfunc(`Piece`),$)
       op(2,x);
   end proc,

   #This is the exported lazy-syntax constructor. The syntax is like piecewise except
   #that there can be no 'otherwise'.
   ModuleApply::static:= proc(Terms::seq(anything))::Partition;
   local pair, s, Pairs, k;
      if nargs::odd then
         error "Expected an even number of arguments"
      end if;
      s:= [ seq(Piece( Terms[k], Terms[k+1]), k= 1..nargs-1, 2) ] ;
      userinfo(3, PARTITION, s);
      PARTITION(s)
   end proc,

   #Deconstructor that returns just the conditions as a set
   Conditions::static:= proc(P::Partition)::set;
   local p;
      {seq(condOf(p), p= op(1,P))}
   end proc,

   #Deconstructor that returns a set of [cond, val] pairs
   Pairs:= proc(P::Partition)::set([anything, anything]);
   local p;
      {seq([condOf(p), valOf(p)], p= op(1,P)) }
   end proc,

   #This is just `map` for Partitions.
   Pmap::static:= proc(
      f::anything #`appliable` not inclusive enough.
      #Allow additional args, just like `map`
   )::Partition;
   local pair,pos,res;
      res := map_check(procname, args);
      if res::string then error res else pos := res; end if;
      PARTITION(
         [seq(
            Piece(
               condOf(pair),
               f(args[2..pos], valOf(pair), args[pos+2..])
            ),
            pair= op(1, args[pos+1])
         )]
      )
   end proc,

   # a more complex mapping combinator which works on all 3 parts
   # not fully general, but made to work with KB
   # also, does not handle extra arguments (on purpose!)
   Amap::static:= proc(
      funcs::[anything, anything, anything], #`appliable` not inclusive enough.
      part::Partition
   )::Partition;
   local pair,pos,f,g,h,doIt;
      (f,g,h) := op(funcs);
      #sigh, we don't have a decent 'let', need to use a local proc
      doIt := proc(pair)
        local kb0 := h(condOf(pair));
        Piece( f(condOf(pair), kb0),
               g(valOf(pair), kb0));
      end proc;
      PARTITION(map(doIt,op(1,part)));
   end proc,

   PartitionToPW := proc(x::Partition)::specfunc(piecewise);
       # piecewise can reduce immediately to not-piecewise which makes the type
       # test fail
       'piecewise'( op( ListTools[Flatten]( [ seq([condOf(p), valOf(p)], p= op(1,x)) ] ) ) );
   end proc,

   # convert a piecewise to a partition, which is straightforward except:
   # - if any of the branches are unreachable, they are removed
   # - if the last clause is (implicitly) `otherwise`, that clause is filled in
   #     appropriately

   # note that if the piecewise does not cover the entire domain,
   #   then this Partition will be 'invalid' (in the sense that it also
   #   will not cover the entire domain) - the 'correct' thing to do would
   #   probably be to add a new clause whose value is 'undefined'

   # the logic of this function is already essentially implemented, by KB
   # in fact, kb_piecewise does something extremely similar to this
   PWToPartition := proc(x::specfunc(piecewise))::Partition;

       # each clause evaluated under the context so far,
       # which is the conjunction of the negations of all clauses
       # so far
       local ctx := true, n := nops(x), cls := [], cnd, ncnd, i, q
           , ctxC, cl
         ;

       userinfo(5, PWToPartition
               , printf("PWToPartition: found %d ops in %a \n ", n, x) );

       # handles all but the `otherwise` case if there is such a case
       for i in seq(q, q = 1 .. iquo(n, 2)) do

           userinfo(3, PWToPartition
                    , printf("PWToPartition: looking at clause %d (op %d) \n ", i, 2*i-1));

           cnd := op(2*i-1,x); # the clause as given

           # if this clause is unreachable, then every subsequent clause will be as well
           if ctx :: identical(false) then
               return PARTITION( cls );
           else
               ctxC := `And`(cnd, ctx);              # the condition, along with the context (which is implicit in pw)
               ctxC := simplifyPartitionCtx(ctxC);

               if cnd :: `=` then
                   ncnd := lhs(cnd) <> rhs(cnd);
               else
                   ncnd := Not(cnd);
               end if;

               ctx  := `And`(ncnd, ctx); # the context for the next clause

               userinfo(3, PWToPartition, printf("PWToPartition: ctx after %d clauses "
                                                 "is %a\n", i, ctx));

               if ctxC :: identical(false) then # this clause is actually unreachable
                   return(PARTITION(cls));
               else
                   cls := [ op(cls)
                          , seq(Piece(cl
                                     ,op(2*i ,x)
                                     )
                               ,cl=ctxC
                               )
                          ];

               end if;

           end if;
       end do;

       # if there is an otherwise case, handle that.
       if n::odd then
           ctx := simplifyPartitionCtx(ctx);
           if not ctx :: identical(false) then
               cls := [ op(cls)
                      , seq(Piece(cl
                                 ,op(n,x)
                                 )
                           ,cl=ctx
                           )
                      ];
           end if;
       end if;

       PARTITION( cls );
   end proc,

   MbAppPartOrPw := proc(chk,f,x::Or(Partition,specfunc(piecewise)))
       local isPr := evalb(x::Partition), pr := `if`(isPr, x, PWToPartition(x));
       if chk(pr) then
           (`if`(isPr, a->a, PartitionToPW))(f(pr));
       else
           FAIL
       end if;
   end proc,

   # applies a function to the arg if arg::Partition,
   # and if arg::piecewise, then converts the piecewise to a partition,
   # applies the function, then converts back to piecewise
   # this mainly acts as a sanity check

   AppPartOrPw := proc(f::anything # TODO better type
                      ,x::Or(Partition,specfunc(piecewise))
                      )
       if x::Partition then
           f(x);
       else
           PartitionToPW(f(PWToPartition(x)));
       end if;
   end proc,

   #Check whether the conditions of a Partition depend on any of a set of names.
   ConditionsDepend:= proc(P::Partition, V::{name, list(name), set(name)}, $)
   local p;
      for p in op(1,P) do if depends(condOf(p), V) then return true end if end do;
      false
   end proc
;

uses Hakaru;

   ModuleLoad()
end module:

#This module implements `Partition`---Hakaru's replacement for Maple's
#endogenous and unwieldy `piecewise`.

#The outer data structure for a Partition is a function, PARTITION(...), (just like it
#is for piecewise.

Partition:= module()

option package;

#This module is essentially an object, but we decided, for now at least, to not
#use Maple's "option object".

global Piece;

local
   diff_,

   Umap := proc(f,x,$)
       f(op(0,x))( map( p -> Piece(f(condOf(p)),f(valOf(p)))
                      , op(1,x)
                      )
                 )
   end proc,

   # could also be named
   # simplifyPartition_by_the_removal_of_particular_singular_points
   simplifyPartition_mergeSinglePts := module()
       local canSimp := c -> valOf(c) :: identical('undefined') and condOf(c) :: `=`
                                  and (lhs(condOf(c)) :: name or rhs(condOf(c)) :: name);

       local mentions_t_hi :=
                t -> bnd -> cl -> has(cl, t<bnd) or has(cl, bnd>t);

       local mentions_t_lo :=
                t -> bnd -> cl -> has(cl, bnd<t) or has(cl, t>bnd);

       local replace_with := t -> bnd -> x ->
                if mentions_t_hi(t)(bnd)(x) then
                    t <= bnd
                elif mentions_t_lo(t)(bnd)(x) then
                    t >= bnd
                else
                    x
                end if;

       local set_xor := proc(a,b,$) (a union b) intersect (a minus b) end proc;

       local tryReplacePieces :=
               proc(replPieces, otherPieces,cmp,$)
                 local rpp := replPieces, otp := otherPieces, nm, val, rp, rpv;

                 for rp in rpp do
                     rp, rpv := op(rp);

                     nm   := `if`(lhs(rp)::name, lhs(rp), rhs(rp));
                     val  := `if`(lhs(rp)::name, rhs(rp), lhs(rp));

                     otp := tryReplacePiece( nm, val, rpv, otp, cmp )
                 end do;

                 otp;

               end proc;

       local the_val := cmp -> xs ->
                evalb( foldl( proc(x,y) if cmp(x,y) then x else NULL end if; end proc, op(xs)) = NULL ) ;

       local tryReplacePiece :=
               proc(vrNm, vrVal, pc0val, pcs, cmp,$)
                 local pcs0 := pcs, pcs1, qs0, qs1, qs2, vrEq := vrNm=vrVal ;
                 pcs1 := subsindets(pcs0, relation, replace_with(vrNm)(vrVal));

                 qs0, qs1 := seq({op(qs)},qs=(pcs0,pcs1));

                 qs2 := set_xor(qs1, qs0);

                 if nops(qs2) = 2 then
                     qs2 := map(condOf, qs2);

                     if not pc0val :: identical('undefined') then
                         qs2 := { pc0val, op(qs2) };
                     end if;

                     qs2 := map(q -> subs(vrEq, q), qs2);

                     if the_val(cmp)(qs2) then
                         pcs1;
                     else
                         [ Piece(vrEq, pc0val), op(pcs0) ] ;
                     end if
                 else
                     [ Piece(vrEq, pc0val), op(pcs0) ] ;
                 end if;

               end proc;

       export ModuleApply := proc(p_,{cmp:=`=`},$)

          local p := p_, r := p, uc, oc;

          # if the partition contains case of the form `x = t', where `t' is a
          # constant (or term??) and `x' is a variable, and the value of that
          # case is `undefined', then we may be able to eliminate it (if another
          # case includes that point)
          r := op(1,r);
          uc, oc := selectremove(canSimp, r);

          # special case: if there is exactly one `undefined' case, and one
          # other case, just get rid of the `undefined' piece
          if nops(uc)=1 and nops(oc)=1 then
              p := PARTITION(oc);
          else
              p := PARTITION(tryReplacePieces(uc, oc, cmp));
          end if;

          return p;

       end proc;

   end module,

   simplifyPartitionCtx := proc(ctx, $)
       local ctxC := ctx;
       ctxC := solve({ctxC});
       if ctxC = NULL then
           ctxC := false;
       elif ctxC :: set then
           ctxC := remove(x -> x :: `=` and rhs(x)=lhs(x) and lhs(x) :: name, ctxC);
           if ctxC :: identical('{}') then
               ctxC := eval(ctx, [`And`=`and`, `Not`=`not`]);
           else
               ctxC := `and`(op(ctxC));
           end if ;

       # elif nops([ctxC])> 1 then
       #     ctxC := [ctxC];
       else
           error "simplifyPartitionCtx: don't know what to do with %1", ctxC;
       end if;

       if ctx :: identical(true) then
           error "simplifyPartitionCtx: don't know what to do with %1", ctxC;
       end if;

       ctxC;
   end proc,

   ModuleLoad::static:= proc()
      local prev;

      :-`print/PARTITION`:= proc(SetOfRecords)
      local branch;
         `print/%piecewise`(
            seq([ condOf(eval(branch)), valOf(eval(branch))][], branch= SetOfRecords)
         )
      end proc;

      TypeTools:-AddType(Partition, specfunc(PARTITION));

      # global extensions to maple functionality

      :-`eval/PARTITION` :=
      proc(p, eqs, $)
          local q, r;
          q := Umap(x->eval(x,eqs), p);

          r := eval( PartitionToPW(q), eqs );
          if r :: specfunc('piecewise') then
              q := PWToPartition( r );
          else
              q := r;
          end if;

          q;

      end proc;

      :-`depends/PARTITION` :=
      proc(parts, nms, $)
         local dp := (x -> depends(x, nms));
         `or`(op ( map(p-> dp(condOf(p)) or dp(valOf(p)), parts) ));
      end proc;

      :-`diff/PARTITION` :=
      proc(parts, wrt, $)
          local pw  := PartitionToPW(PARTITION(parts))
              , dpw := diff(pw, wrt)
              , r   := PWToPartition(dpw)
              , r0, r1;
            ;
          r0 := simplifyPartition_mergeSinglePts(r);

          # probably a better way to do this; we really only want to simplify
          # sums and products of integrals and summations
          r1 := subsindets(r0, algebraic, `simplify`);

          userinfo(10, 'disint_trace',
                   printf("  input        : \n\t%a\n\n"
                          "  diff         : \n\t%a\n\n"
                          "  singular pts : \n\t%a\n\n"
                          "  simplified   : \n\t%a\n\n\n"
                          , parts, r, r0, r1 ));

          r1;
      end proc;

      NULL
   end proc,

   ModuleUnload::static:= proc()
      TypeTools:-RemoveType(Partition);
      NULL
   end proc,

   # abstract out all argument checking for map-like functions
   map_check := proc(p)
      local pos, err;
      if p::indexed then
         pos:= op(p);
         if not [pos]::[posint] then
            err := sprintf("Expected positive integer index; received %a", [pos]);
            return err;
         end if
      else
         pos:= 1
      end if;
      if nargs-1 <= pos then
         err := sprintf("Expected at least %d arguments; received %d", pos+1, nargs-1);
         return err;
      end if;
      if not args[pos+2]::Partition then
         err := sprintf("Expected a Partition; received %a", args[pos+2]);
         return err;
      end if;
      return pos;
   end proc
;
export

   condOf := proc(x::specfunc(`Piece`),$)
       op(1,x);
   end proc,

   valOf := proc(x::specfunc(`Piece`),$)
       op(2,x);
   end proc,

   #This is the exported lazy-syntax constructor. The syntax is like piecewise except
   #that there can be no 'otherwise'.
   ModuleApply::static:= proc(Terms::seq(anything))::Partition;
   local pair, s, Pairs, k;
      if nargs::odd then
         error "Expected an even number of arguments"
      end if;
      s:= [ seq(Piece( Terms[k], Terms[k+1]), k= 1..nargs-1, 2) ] ;
      userinfo(3, PARTITION, s);
      PARTITION(s)
   end proc,

   #Deconstructor that returns just the conditions as a set
   Conditions::static:= proc(P::Partition)::set;
   local p;
      {seq(condOf(p), p= op(1,P))}
   end proc,

   #Deconstructor that returns a set of [cond, val] pairs
   Pairs:= proc(P::Partition)::set([anything, anything]);
   local p;
      {seq([condOf(p), valOf(p)], p= op(1,P)) }
   end proc,

   #This is just `map` for Partitions.
   Pmap::static:= proc(
      f::anything #`appliable` not inclusive enough.
      #Allow additional args, just like `map`
   )::Partition;
   local pair,pos,res;
      res := map_check(procname, args);
      if res::string then error res else pos := res; end if;
      PARTITION(
         [seq(
            Piece(
               condOf(pair),
               f(args[2..pos], valOf(pair), args[pos+2..])
            ),
            pair= op(1, args[pos+1])
         )]
      )
   end proc,

   # a more complex mapping combinator which works on all 3 parts
   # not fully general, but made to work with KB
   # also, does not handle extra arguments (on purpose!)
   Amap::static:= proc(
      funcs::[anything, anything, anything], #`appliable` not inclusive enough.
      part::Partition
   )::Partition;
   local pair,pos,f,g,h,doIt;
      (f,g,h) := op(funcs);
      #sigh, we don't have a decent 'let', need to use a local proc
      doIt := proc(pair)
        local kb0 := h(condOf(pair));
        Piece( f(condOf(pair), kb0),
               g(valOf(pair), kb0));
      end proc;
      PARTITION(map(doIt,op(1,part)));
   end proc,

   PartitionToPW := proc(x::Partition)::specfunc(piecewise);
       # piecewise can reduce immediately to not-piecewise which makes the type
       # test fail
       'piecewise'( op( ListTools[Flatten]( [ seq([condOf(p), valOf(p)], p= op(1,x)) ] ) ) );
   end proc,

   # convert a piecewise to a partition, which is straightforward except:
   # - if any of the branches are unreachable, they are removed
   # - if the last clause is (implicitly) `otherwise`, that clause is filled in
   #     appropriately

   # note that if the piecewise does not cover the entire domain,
   #   then this Partition will be 'invalid' (in the sense that it also
   #   will not cover the entire domain) - the 'correct' thing to do would
   #   probably be to add a new clause whose value is 'undefined'

   # the logic of this function is already essentially implemented, by KB
   # in fact, kb_piecewise does something extremely similar to this
   PWToPartition := proc(x::specfunc(piecewise))::Partition;

       # each clause evaluated under the context so far,
       # which is the conjunction of the negations of all clauses
       # so far
       local ctx := true, n := nops(x), cls := [], cnd, ncnd, i, q
           , ctxC
         ;

       userinfo(5, PWToPartition
               , printf("PWToPartition: found %d ops in %a \n ", n, x) );

       # handles all but the `otherwise` case if there is such a case
       for i in seq(q, q = 1 .. iquo(n, 2)) do

           userinfo(3, PWToPartition
                    , printf("PWToPartition: looking at clause %d (op %d) \n ", i, 2*i-1));

           cnd := op(2*i-1,x); # the clause as given

           # if this clause is unreachable, then every subsequent clause will be as well
           if ctx :: identical(false) then
               return PARTITION( cls );
           else
               ctxC := `And`(cnd, ctx);              # the condition, along with the context (which is implicit in pw)
               ctxC := simplifyPartitionCtx(ctxC);

               if cnd :: `=` then
                   ncnd := lhs(cnd) <> rhs(cnd);
               else
                   ncnd := Not(cnd);
               end if;

               ctx  := `And`(ncnd, ctx); # the context for the next clause

               userinfo(3, PWToPartition, printf("PWToPartition: ctx after %d clauses "
                                                 "is %a\n", i, ctx));

               if ctxC :: identical(false) then # this clause is actually unreachable
                   return(PARTITION(cls));
               else
                   cls := [ op(cls)
                          , Piece(ctxC
                                 ,op(2*i ,x)
                                 )
                          ];

               end if;

           end if;
       end do;

       # if there is an otherwise case, handle that.
       if n::odd then
           ctx := simplifyPartitionCtx(ctx);
           if not ctx :: identical(false) then
               cls := [ op(cls)
                      , Piece(ctx
                             ,op(n,x)
                             )
                      ];
           end if;
       end if;

       PARTITION( cls );
   end proc,

   MbAppPartOrPw := proc(chk,f,x::Or(Partition,specfunc(piecewise)))
       local isPr := evalb(x::Partition), pr := `if`(isPr, x, PWToPartition(x));
       if chk(pr) then
           (`if`(isPr, a->a, PartitionToPW))(f(pr));
       else
           FAIL
       end if;
   end proc,

   # applies a function to the arg if arg::Partition,
   # and if arg::piecewise, then converts the piecewise to a partition,
   # applies the function, then converts back to piecewise
   # this mainly acts as a sanity check

   AppPartOrPw := proc(f::anything # TODO better type
                      ,x::Or(Partition,specfunc(piecewise))
                      )
       if x::Partition then
           f(x);
       else
           PartitionToPW(f(PWToPartition(x)));
       end if;
   end proc,

   #Check whether the conditions of a Partition depend on any of a set of names.
   ConditionsDepend:= proc(P::Partition, V::{name, list(name), set(name)}, $)
   local p;
      for p in op(1,P) do if depends(condOf(p), V) then return true end if end do;
      false
   end proc
;

uses Hakaru;

   ModuleLoad()
end module:


Added 5 failing tests

Added 5 failing tests

#
#     Test Suite for Reparam---integral and sum 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`)

)
local
     LOform:= toLO(e_in)  #preprocessed input
;
     printf("\n");  #It reads better when the test results have a blank line between them.
     :-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
               :-infolevel[reparam]:= infolevels[2];
               return CodeTools:-Test(reparam(LOform, :-ctx= ctx), e_out, ver, boolout, _rest)
          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`
]):

#
#   The tests
#

#Constant multiple in integral
TestReparam(
     Bind(Lebesgue(-infinity,infinity), x, Weight(2, Ret(2*x))),
     Lebesgue(-infinity,infinity),
     equal &under fromLO,
     infolevels= [infinity$2],
     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,
     infolevels= [infinity$2],
     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],
     infolevels= [infinity$2],
     label= "(t1) Symbolic affine transformation with Gaussian" #passing
);

#(t2) ChiSquare with constant multiplier to Gamma
#This fails due to ChiSquare not being implemented yet.
TestReparam(
     ChiSquare(2*b),
     GammaD(b,2),
     equal &under (fromLO, _ctx= foldr(assert, empty, b > 0)),
     ctx= [b > 0],
     infolevels= [2,2],
     label=
          "(t2) ChiSquare with constant multiplier to Gamma "
          "(currently failing)"
);

#(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],
     infolevels= [infinity$2],
     label= "(t3) Symbolic constant multiple with Gamma" #passing
);

#(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],
     infolevels= [infinity$2],
     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
#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.
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
#Since neither Bernoulli nor Binomial are implemented, this is difficult to
#test. A Bernoulli is a Categorical with two categories. Categorical is
#implemented.

#(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,
     infolevels= [0,2],
     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.
(*********** #Test commented out.
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
#We have no Exponential. I can represent it as Gamma.
#This currently fails because it's two variable.
TestReparam(
     Bind(GammaD(1,b), x1, Bind(GammaD(1,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!!! It should be Weibull(a,1) to Exponential(1/a).
#Since neither Weibull nor Exponential is implemented in NewSLO, there's
#not much that I can do here.
(*********** #Test commented out
TestReparam(
     #Doesn't use reparam in any meaningful way.
     Weibull(a,1),
     GammaD(1, 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(ChiSquare) to StudentT
#Fails because ChiSquare isn't implemented.
TestReparam(
     Bind(Gaussian(0,1), x, Bind(ChiSquare(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)"
);

#
#     Test Suite for Reparam---integral and sum 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`)

)
local
     LOform:= toLO(e_in)  #preprocessed input
;
     :-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
               :-infolevel[Reparam]:= infolevels[2];
               return CodeTools:-Test(reparam(LOform, :-ctx= ctx), e_out, ver, boolout, _rest)
          else
               return false
          end if
     else
          return #If passed, quiet 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`
]):

#
#   The tests
#

#Constant multiple in integral
TestReparam(
     Bind(Lebesgue(-infinity,infinity), x, Weight(2, Ret(2*x))),
     Lebesgue(-infinity,infinity),
     equal &under fromLO,
     infolevels= [infinity$2],
     label= "Constant multiple with Lebesgue" #passing
);

#Logarithm with Uniform
TestReparam(
     Bind(Uniform(0,1), x, Ret(-log(x))),
     GammaD(1,1),
     equal &under fromLO,
     infolevels= [infinity$2],
     label= "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],
     infolevels= [infinity$2],
     label= "(t1) Symbolic affine transformation with Gaussian" #passing
);

#(t2) ChiSquare with constant multiplier to Gamma
#This fails due to ChiSquare not being implemented yet.
TestReparam(
     ChiSquare(2*b),
     GammaD(b,2),
     equal &under fromLO,
     infolevels= [0,2],
     label=
          "(t2) ChiSquare with constant multiplier to Gamma "
          "(currently failing)"
);

#(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],
     infolevels= [infinity$2],
     label= "(t3) Symbolic constant multiple with Gamma" #passing
);

#(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],
     infolevels= [infinity$2],
     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
#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= [0,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.
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= [0,2],
     label=
          "(t8) Affine translation of quotient of standard normals to Cauchy "
          "(currently failing)"
);

#(t9) Bernoulli to Binomial with n=1
#Since neither Bernoulli or Binomial are implemented, this is difficult to test.
#A Bernoulli is a Categorical with two categories. Categorical is implemented.

#(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,
     infolevels= [0,2],
     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.
(*********** #Test commented out.
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= [0,2],
     label= "(t11) Laplace to difference of Gammas (currently failing)"
);
***********)

#(t12) Sum of iid Exponentials to Gamma
#We have no Exponential. I can represent it as Gamma.
#This currently fails because it's two variable.
TestReparam(
     Bind(GammaD(1,b), x1, Bind(GammaD(1,b), x2, Ret(x1+x2))),
     GammaD(2,b),
     equal &under (fromLO, _ctx= foldr(assert, empty, b > 0)),
     ctx= [b > 0],
     infolevel= [0,2],
     label= "(t12) Sum of iid Exponentials to Gamma (currently failing)"
);