No longer needed

No longer needed

# Apply a domain to an expression.
# Apply will perform certain 'simplifications' to make sure the
# domain application is well-formed. e.g.,
#   DOMAIN( DBound( [x,y], [xt,yt] ), DConstrain(..) )
#      is the same as
#   DOMAIN(        ..               , DInto(x,xt,DInto(y,yt,DConstrain(..))) )
# basically, when we see an 'unbound' variable in the 'RHS' , we should bind
# it with the default 'DInto'.
export Apply := module ()
       export ModuleApply :=
         proc(dom :: HDomain_mb, kb0 :: t_kb
             ,f_into := "default"
             ,f_body := "default", $)
           local vs, sh, ctx;
           if dom :: DomNoSol then
               error "cannot apply %1", dom;
           end if;
           vs, sh := op(dom);
           vs := Domain:-Bound:-withVarsIxs(vs);
           ctx := [ kb0,
              `if`(f_into="default",`do_mk`,f_into),
              `if`(f_body="default",`do_body`,f_body) ];
           (e->do_apply({}, e, vs, sh, ctx));
       end proc;

       export Shape := proc(dsh :: DomShape, e, $) ModuleApply( DOMAIN( [], dsh ), e ) end proc;
       export Bound := proc(dbn :: DomBound, e, $) ModuleApply( DOMAIN( dbn, DConstrain() ), e ) end proc;

       # main loop of the apply function
       # done_  := variables already integrated
       # e      := expr
       # vs     := domain bounds
       # sh     := domain shape
       # ctx[0] := KB (context for f_into/f_body)
       # f_into := how to make a DomInto
       # f_body := how to make the expression body
       local do_apply := proc(done__, e, vs, sh_, ctx, $)
           local sh := sh_, done_ := done__
               , r, cond, mk_cond, vn, vt, shv, vars, deps, ctx1, rn;
           # If the solution is a constraint, and the constraint is true,
           # then just produce the expression. If it isn't necessarily true
           # (i.e. trivial) then produce a Partition with the constraint as a
           # guard.
           if sh :: DomConstrain then
               cond := remove(is, sh);
               if cond = DConstrain() then
                   mk_cond := x->x;
               else
                   cond := bool_And(op(cond));
                   mk_cond := x->PARTITION([Piece(cond,x), Piece(Not(cond),0)]);
               end if;
               # if there are still integrals which have not been applied, apply
               # them now
               do_mks(e, (r,kb1) -> mk_cond(op(3,ctx)(r, kb1)),
                      {op(Domain:-Bound:-varsOf(vs))} minus done_, vs, ctx);
           # if the solution is a sum of solutions, produce the algebraic sum
           # of each summand of the solution applied to the expression.
           elif sh :: DomSum then
               `+`(seq(do_apply(done_, e, vs, s, ctx), s=sh))
           # if the solution is a split solution, just make `do_apply' over
           # the values of the Partition (the subsolutions)
           elif sh :: DomSplit then
               Partition:-Amap(
                 [ (c,_)->c
                 , (p,c)->do_apply(done_, e, vs, p, applyop(kb->KB:-assert(c,kb),1,ctx))
                 , c->c ], op(1, sh) );
           # performs the 'make' on the expression after recursively
           # applying the solution
           elif sh :: DomInto then
               # deconstruction
               vn, vt, shv := op(sh);
               # extract bounds which have not been applied upon which this
               # bound depends. Those are applied after this one, so are not
               # in 'scope' in the recursive call
               vars := {op(Domain:-Bound:-varsOf(vs))};
               deps := (indets(vt, DomBoundVar) intersect vars) minus done_ ;
               deps := `union`(deps, {vn});
               done_ := `union`(done_, deps) ;

               # build this integral, and the other this one depended on, then
               # recursively apply
               do_mks(e, (r,kb1) -> do_apply(done_, r, vs, shv, subsop(1=kb1,ctx)),
                      deps, Domain:-Bound:-upd(vs, vn, vt), ctx);
           else
               error "don't know how to apply %1", sh
           end if;
       end proc;

       export do_mk := proc(mk, e, vn, ty_, _kb)
           Domain:-ExtBound[mk]:-DoMk(e, vn, ty_);
       end proc;

       export do_body := proc(e, _kb) e end proc;

       # Move into an integral by augmenting the KB with the variables bound by
       # that integral.
       local into_mk := proc(dbnd::DomBound, vn, vt, ctx, $)
           local kb, v_i, v_k, vn_, kb1, rn;
           kb := op(1,ctx); if kb :: t_not_a_kb then return KB:-NotAKB() end if;

           v_i := Domain:-Bound:-varIx(dbnd, vn);
           v_k := op([1,v_i,3], dbnd);
           vn_, kb1 := Domain:-ExtBound[v_k]:-MakeKB(vn, Domain:-ExtBound[v_k]:-SplitRange(vt), kb);

           rn := `if`(evalb(vn=vn_), [], [vn=vn_]);
           subsop(1=kb1, ctx), rn;
       end proc;

       local do_mks := proc(e, kont, todo::({list,set})(DomBoundVar), dbnd :: DomBound, ctx, $)
           local vs, v_td, i, vt, kb0, v_mk, _, ctx1, rn, r := e;

           if todo :: set then
             vs := select(v->v in todo,Domain:-Bound:-varsOf(dbnd));
             vs := ListTools[Reverse](vs);
           else
             vs := todo;
           end if;

           if nops(vs)=0 then
             return kont(r,op(1,ctx));
           end if;

           v_td := op(1,vs);
           vs   := subsop(1=NULL,vs);
           i    := Domain:-Bound:-varIx(dbnd, v_td);
           _,vt,v_mk := op(op([1,i], dbnd));

           ctx1, rn := into_mk(dbnd, v_td, vt, ctx);
           if rn <> [] then
             r := subs(rn,r);
           end if;

           r := do_mks(r, kont, vs, dbnd, ctx1);
           op(2,ctx)(v_mk, r, v_td, vt, op(1,ctx));
       end proc;
end module;

# Apply a domain to an expression.
# Apply will perform certain 'simplifications' to make sure the
# domain application is well-formed. e.g.,
#   DOMAIN( DBound( [x,y], [xt,yt] ), DConstrain(..) )
#      is the same as
#   DOMAIN(        ..               , DInto(x,xt,DInto(y,yt,DConstrain(..))) )
# basically, when we see an 'unbound' variable in the 'RHS' , we should bind
# it with the default 'DInto'.
export Apply := module ()
       export ModuleApply :=
         proc(dom :: HDomain_mb, kb0 :: t_kb
             ,f_into := "default"
             ,f_body := "default", $)
           local vs, sh, ctx;
           if dom :: DomNoSol then
               error "cannot apply %1", dom;
           end if;
           vs, sh := op(dom);
           vs := Domain:-Bound:-withVarsIxs(vs);
           ctx := [ kb0,
              `if`(f_into="default",`do_mk`,f_into),
              `if`(f_body="default",`do_body`,f_body) ];
           (e->do_apply({}, e, vs, sh, ctx));
       end proc;

       export Shape := proc(dsh :: DomShape, e, $) ModuleApply( DOMAIN( [], dsh ), e ) end proc;
       export Bound := proc(dbn :: DomBound, e, $) ModuleApply( DOMAIN( dbn, DConstrain() ), e ) end proc;

       # main loop of the apply function
       # done_  := variables already integrated
       # e      := expr
       # vs     := domain bounds
       # sh     := domain shape
       # ctx[0] := KB (context for f_into/f_body)
       # f_into := how to make a DomInto
       # f_body := how to make the expression body
       local do_apply := proc(done__, e, vs, sh_, ctx, $)
           local sh := sh_, done_ := done__
               , r, cond, mk_cond, vn, vt, shv, vars, deps, ctx1, rn;
           # If the solution is a constraint, and the constraint is true,
           # then just produce the expression. If it isn't necessarily true
           # (i.e. trivial) then produce a Partition with the constraint as a
           # guard.
           if sh :: DomConstrain then
               cond := remove(is, sh);
               if cond = DConstrain() then
                   mk_cond := x->x;
               else
                   cond := bool_And(op(cond));
                   mk_cond := x->PARTITION([Piece(cond,x), Piece(Not(cond),0)]);
               end if;
               # if there are still integrals which have not been applied, apply
               # them now
               do_mks(e, (r,kb1) -> mk_cond(op(3,ctx)(r, kb1)),
                      {op(Domain:-Bound:-varsOf(vs))} minus done_, vs, ctx);
           # if the solution is a sum of solutions, produce the algebraic sum
           # of each summand of the solution applied to the expression.
           elif sh :: DomSum then
               `+`(seq(do_apply(done_, e, vs, s, ctx), s=sh))
           # if the solution is a split solution, just make `do_apply' over
           # the values of the Partition (the subsolutions)
           elif sh :: DomSplit then
               Partition:-Amap(
                 [ (c,_)->c
                 , (p,c)->do_apply(done_, e, vs, p, applyop(kb->KB:-assert(c,kb),1,ctx))
                 , c->c ], op(1, sh) );
           # performs the 'make' on the expression after recursively
           # applying the solution
           elif sh :: DomInto then
               # deconstruction
               vn, vt, shv := op(sh);
               # extract bounds which have not been applied upon which this
               # bound depends. Those are applied after this one, so are not
               # in 'scope' in the recursive call
               vars := {op(Domain:-Bound:-varsOf(vs))};
               deps := (indets(vt, DomBoundVar) intersect vars) minus done_ ;
               deps := `union`(deps, {vn});
               done_ := `union`(done_, deps) ;

               # build this integral, and the other this one depended on, then
               # recursively apply
               do_mks(e, (r,kb1) -> do_apply(done_, r, vs, shv, subsop(1=kb1,ctx)),
                      deps, Domain:-Bound:-upd(vs, vn, vt), ctx);
           else
               error "don't know how to apply %1", sh
           end if;
       end proc;

       export do_mk := proc(mk, e, vn, ty_, _kb)
           Domain:-ExtBound[mk]:-DoMk(e, vn, ty_);
       end proc;

       export do_body := proc(e, _kb) e end proc;

       # Move into an integral by augmenting the KB with the variables bound by
       # that integral.
       local into_mk := proc(dbnd::DomBound, vn, vt, ctx, $)
           local kb, v_i, v_k, vn_, kb1, rn;
           kb := op(1,ctx); if kb :: t_not_a_kb then return KB:-NotAKB() end if;

           v_i := Domain:-Bound:-varIx(dbnd, vn);
           v_k := op([1,v_i,3], dbnd);
           vn_, kb1 := Domain:-ExtBound[v_k]:-MakeKB(vn, Domain:-ExtBound[v_k]:-SplitRange(vt), kb);

           rn := `if`(evalb(vn=vn_), [], [vn=vn_]);
           subsop(1=kb1, ctx), rn;
       end proc;

       local do_mks := proc(e, kont, todo::({list,set})(DomBoundVar), dbnd :: DomBound, ctx, $)
           local vs, v_td, i, vt, kb0, v_mk, _, ctx1, rn, r := e;

           if todo :: set then
             vs := select(v->v in todo,Domain:-Bound:-varsOf(dbnd));
             vs := ListTools[Reverse](vs);
           else
             vs := todo;
           end if;

           if nops(vs)=0 then
             return kont(r,op(1,ctx));
           end if;

           v_td := op(1,vs);
           vs   := subsop(1=NULL,vs);
           i    := Domain:-Bound:-varIx(dbnd, v_td);
           _,vt,v_mk := op(op([1,i], dbnd));

           ctx1, rn := into_mk(dbnd, v_td, vt, ctx);
           if rn <> [] then
             r := %subs(rn,r);
           end if;

           r := do_mks(r, kont, vs, dbnd, ctx1);
           op(2,ctx)(v_mk, r, v_td, vt, op(1,ctx));
       end proc;
end module;


A basic implementation of partition sum

A basic implementation of partition sum

#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
   Umap := proc(f,x,$)
       f(op(0,x))( map( p -> Piece(f(condOf(p)),f(valOf(p)))
                      , op(1,x) ))
   end proc,

   isPartitionPieceOf := proc( p, elem_t := anything )
      type(p, 'Piece(PartitionCond, elem_t)');
   end proc,

   isPartitionOf := proc( e, elem_t := anything )
      type(e, 'PARTITION(list(PartitionPiece(elem_t)))' );
   end proc,

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

      TypeTools:-AddType(PartitionCond, {relation, boolean, `::`, specfunc({`And`,`Or`,`Not`}), `and`, `or`, `not`});
      TypeTools:-AddType(PartitionPiece, isPartitionPieceOf);
      TypeTools:-AddType(Partition, isPartitionOf);

      # global extensions to maple functionality
      :-`eval/PARTITION` :=
      proc(p, eqs, $)
          Partition:-Simpl(Umap(x->eval(x,eqs), p));
      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, 'do_solve')
              , r0, r1;
            ;
          r0 := Simpl:-singular_pts(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;

      :-`simplify/PARTITION` := Simpl;

      NULL
   end proc,

   ModuleUnload::static:= proc()
      TypeTools:-RemoveType(Partition);
      TypeTools:-RemoveType(PartitionPiece);
      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,

   extr_conjs := proc(x,$)
       if x::{specfunc(`And`), `and`} then
           map(extr_conjs, [op(x)])[];
       else
           x
       end if
   end proc,

   pw_cond_ctx := proc(ctx_, p, $)
       local ps, ctx, ctxN, cond, ncond;
       ps, ctx := op(ctx_); cond := condOf(p);
       cond := {extr_conjs(cond)};
       cond := remove(x->x in ctx, cond);
       ncond := `if`(nops(cond)=1
                     , KB:-negate_rel(op(1,cond))
                     , `Not`(bool_And(op(cond))) );
       cond := bool_And(op(cond));
       ctx := ctx union { ncond };
       [ [ op(ps), Piece(cond, valOf(p)) ], ctx ]
   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,

   Pieces := proc(cs0,es0)::list(PartitionPiece);
       local es, cs;
       if es0 :: {set,list} then
           es := es0;
       else
           es := {es0};
       end if;
       if cs0 :: {set,list,specfunc(`And`),`and`} then
           cs := cs0;
       else
           cs := {cs0};
       end if;
       [seq(seq(Piece(c,e),c=cs),e=es)];
   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,

   Foldr := proc( cons, nil, prt :: Partition, $ )
       foldr( proc(p, x) cons(condOf(p), valOf(p), x); end proc
            , nil
            , op(op(1, prt))
            );
   end proc,

   Foldr_mb := proc( cons, nil, prt, $ )
       if prt :: Partition then
           Foldr(_passed);
       else
           cons( true, prt, nil )
       end if;
   end proc,

   PartitionToPW_mb := proc(x, $)
       if x :: Partition then PartitionToPW(x) else x end if;
   end proc,

   PartitionToPW := proc(x::Partition, $)
       local parts := op(1,x);
       if nops(parts) = 1 and is(op([1,1],parts)) then return op([1,2], parts) end if;
       parts := foldl(pw_cond_ctx, [ [], {} ], op(parts) );
       parts := [seq([condOf(p), valOf(p)][], p=op(1,parts))];
       if op(-2, parts) :: identical(true) then
           parts := subsop(-2=NULL, parts);
       end if;
       piecewise(op(parts));
   end proc,

   Flatten := module()
     export ModuleApply;
     local unpiece, unpart, unpartProd;

     ModuleApply := proc(pr0, { _with := [ 'Partition', unpart ] } )
       local ty, un_ty, pr1, pr2;
       ty, un_ty := op(_with);

       pr1 := subsindets(pr0, ty, un_ty);
       if pr0 <> pr1 then
         ModuleApply(pr1, _with=[ Or('Partiton',`*`), unpartProd ]);
       else
         pr0
       end if;
     end proc;

     # like Piece, but tries to not be a Piece
     unpiece := proc(c, pr, $)
       if pr :: Partition then
         map(q -> applyop(z->bool_And(z,c),1,q), op(1,pr))[]
       else
         Piece(c, pr)
       end if
     end proc;

     unpart := proc(pr, $)
       if pr :: Partition then
         PARTITION(map(q -> unpiece(condOf(q),valOf(q)), op(1,pr)))
       else
         pr
       end if
     end proc:

     unpartProd := proc(pr, $)
       local ps, ws;
       if pr :: `*` then
         ps, ws := selectremove(q->type(q,Partition), [op(pr)]);
         if nops(ps) = 1 then
           Pmap(x->`*`(op(ws),x), unpartProd(op(1,ps)));
         else
           pr;
         end if;
       else
         unpart(pr);
       end if;
     end proc;
   end module,

   isShape := kind -> module()
     option record;

     export MakeCtx := proc(p0,$)
       local p := p0, pw, p1, wps, ws, vs, cs, w, ps;

       if kind='piecewise' then
         p := Partition:-PWToPartition(p);
       end if;

       w, p1 := Partition:-Simpl:-single_nonzero_piece(p);
       if not w :: identical(true) or p1 <> p then
           [ w, p1 ]
       else
           ps := op(1, p);
           wps := map(x->Domain:-Extract:-Shape(valOf(x), 'no_simpl'), ps);
           ws, vs, cs := map2(op, 1, wps), map2(op, 2, wps), map(condOf, ps);
           if nops(vs) > 0 and
              andmap(v->op(1,vs)=v, vs) and
              ormap(a->a<>{}, ws)
           then
               [ `bool_Or`( op( zip(`bool_And`, ws, cs) ) ) , op(1,vs) ];
           else
               [ true, p0 ];
           end if;
       end if;
     end proc;
     export MapleType := `if`(kind=`PARTITION`,'Partition','specfunc(piecewise)');
   end module,

   # 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 := Simpl:-condition(ctxC, _rest);

               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 ctx :: identical(false,[]) then # this clause is actually unreachable
                   return(PARTITION(cls));
               else
                   cls := [ op(cls), op(Pieces(ctxC,[op(2*i,x)])) ];
               end if;
           end if;

       end do;

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

       if nops(cls) = 0 then
           error "PWToPartition: the piecewise  %1  produced an empty partition\n", x;
       end if;

       PARTITION( cls );
   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,

   PSum := proc(p0::Partition,p1::Partition,{_add := `+`})::Partition;
     local ps0, ps1, cs, rs, rs0, rs1;
     ps0,ps1 := map(ps -> sort(op(1,ps), key=(z->condOf(z))), [p0,p1])[];
     cs := zip(proc(p0,p1)
                 if condOf(p0)=condOf(p1) then
                   Piece(condOf(p0),_add(valOf(p0),valOf(p1))) ;
                 else [p0,p1];
                 end if;
               end proc, ps0,ps1);
     rs, cs := selectremove(c->type(c,list),cs);
     rs0, rs1 := map(k->map(r->op(k,r),rs),[1,2])[];
     rs := map(r0->map(r1->
               Piece( bool_And(condOf(r0),condOf(r1)), _add(valOf(r0),valOf(r1)) )
              ,rs1)[],rs0);
     PARTITION([op(cs),op(rs)]);
   end proc,

   Simpl := module()
       export ModuleApply := proc(p, $)
         local ps, qs, qs1;
         if p :: Partition then
           single_branch(remove_false_pieces(p));
         elif p :: `+` then
           qs := convert(p, 'list', `+`);
           ps, qs := selectremove(type, qs, Partition);
           if nops(ps)=0 then return p end if;
           ps := map(Simpl, ps);
           ps, qs1 := selectremove(type, ps, Partition);
           if nops(ps)=0 then return p end if;
           `+`(op(qs),foldr(Partition:-PSum,op(ps)));
         else
           subsindets(p,{Partition,`+`},Simpl);
         end if;
       end proc;

       export single_nonzero_piece_cps := proc(k)
           local r,p; r, p := single_nonzero_piece(_rest);
           if r :: identical(true) then
               args[2]
           else
               k(r, p);
           end if;
       end proc;

       export single_nonzero_piece := proc(e, { _testzero := Testzero })
           local zs, nzs;
           if e :: Partition then
               zs, nzs := selectremove(p -> _testzero(valOf(p)), op(1, e));
               if nops(nzs) = 1 then
                   return condOf(op(1,nzs)) , valOf(op(1,nzs))
               end if;
           end if;
           true, e
       end proc;

       export remove_false_pieces := proc(e::Partition, $)
           PARTITION(remove(p -> not(coulditbe(condOf(p))), op(1, e)));
       end proc;

       export single_branch := proc(e::Partition, $)
           if nops(op(1,e)) = 1 then
               op([1,1,2], e)
           else
               e
           end if;
       end proc;

       # Removal of singular points from partitions
       export singular_pts := module()
           # we can simplify the pieces which are equalities and whose LHS or
           # RHS is a name.
           local canSimp := c -> condOf(c) :: `=` and (lhs(condOf(c)) :: name or rhs(condOf(c)) :: name);

           # determines if a given variable `t' has the given upper/lower `bnd'.
           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);

           # replace bounds with what we would get if the equality can be
           # integrated into other pieces
           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 := ((a,b)->(a union b) intersect (a minus b));

           # this loops over the pieces to replace, keeping a state consisting of
           # the "rest" of the pieces
           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 do_eval_for_cmp := proc(eval_cmp, ev, x, $)
             local r;
             try
               r := eval_cmp(subs(ev,x));
             catch "numeric exception: division by zero":
               r := eval_cmp(limit(x, ev));
             end try;
             subsindets(r,And(specfunc(NewSLO:-applyintegrand),anyfunc(anything, identical(0))),_->0);
           end proc;

           local tryReplacePiece := proc(vrNm, vrVal, pc0val, pcs, eval_cmp,$)
             local pcs0 := pcs, pcs1, qs0, qs1, qs2, vrEq := vrNm=vrVal, vs2, ret, q, q_i;
             ret := [ Piece(vrEq, pc0val), op(pcs0) ] ;
             # speculatively replace the conditions
             pcs1 := subsindets(pcs0, relation, replace_with(vrNm)(vrVal));
             # convert to sets and take the "set xor", which will contain
             # only those elements which are not common to both sets.
             qs0, qs1 := seq({op(qs)},qs=(pcs0,pcs1));
             qs2 := set_xor(qs1, qs0);
             # if we have updated precisely two pieces (an upper and lower bound)
             if nops(qs2) = 2 then
               # get the values of those pieces, and the value of the
               # piece to be replaced, if that isn't undefined
               vs2 := map(valOf, qs2);
               if not pc0val :: identical('undefined') then
                 vs2 := { pc0val, op(vs2) };
               end if;
               # substitute the equality over the piece values
               vs2 := map(x->do_eval_for_cmp(eval_cmp,vrEq,x), vs2);
               # if they are identically equal, return the original
               # "guess"
               if nops(vs2) = 1 then
                 # arbitrarily pick the first candidate to be the one to
                 # be replaced
                 q := op(1,qs2);
                 q_i := seq(`if`(op(i,pcs1)=q,[i],[])[],i=1..nops(pcs1));
                 ret := subsop(q_i=op(q_i,pcs0), pcs1);
               end if;
             end if;
             ret;
           end proc;

           export ModuleApply := proc(p_,{eval_cmp:='value'},$)
              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);
              PARTITION(tryReplacePieces(uc, oc, eval_cmp));
           end proc;
       end module; # singular_pts

       export condition := module()
           local is_extra_sol := x -> (x :: `=` and rhs(x)=lhs(x) and lhs(x) :: name);

           local postproc_for_solve := proc(ctx, ctxSlv)
                                    ::{identical(false), list({boolean,relation,specfunc(boolean,And),`and`(boolean)})};
               local ctxC := ctxSlv;
               if ctxC = [] then
                   ctxC := [] ;
               elif nops(ctxC)> 1 then
                   ctxC := map(x -> postproc_for_solve(ctx, [x], _rest)[], ctxC);
               elif nops(ctxC) = 1 then
                   ctxC := op(1,ctxC);
                   if ctxC :: set then
                       if ctxC :: identical('{}') then
                           ctxC := NULL;
                       else
                           ctxC := remove(is_extra_sol, ctxC);
                           ctxC := bool_And(op(ctxC));
                       end if ;
                       ctxC := [ctxC];
                   elif ctxC :: specfunc('piecewise') then
                       ctxC := PWToPartition(ctxC, _rest);
                       ctxC := [ seq( map( o -> condOf(c) and o
                                         , postproc_for_solve(ctx, valOf(c), _rest))[]
                                    , c=op(1, ctxC) )] ;
                   else
                       ctxC := FAIL;
                   end if;
               else
                   ctxC := FAIL;
               end if;
               if ctxC = FAIL then
                   error "don't know what to do with %1", ctxSlv;
               else
                   ctxC;
               end if;
           end proc;

           export ModuleApply := proc(ctx)::list(PartitionCond);
               local ctxC := ctx;

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

               if 'do_solve' in {_rest} then
                   ctxC := solve({ctxC}, 'useassumptions'=true);
                   if ctxC = NULL and indets(ctx, specfunc(`exp`)) <> {} then
                       ctxC := [ctx];
                   else
                       ctxC := postproc_for_solve(ctx, [ctxC], _rest);
                   end if;
                   if indets(ctxC, specfunc({`Or`, `or`})) <> {} then
                       userinfo(10, 'Simpl:-condition',
                           printf("output: \n"
                                  "  %a\n\n"
                                  , ctxC )
                          );
                   end if;
               else
                   ctxC := Domain:-simpl_relation(ctxC, norty='DNF');
                   ctxC := eval(ctxC,`And`=bool_And);
                   if ctxC :: specfunc(`Or`) then
                       ctxC := [op(ctxC)]
                   else
                       ctxC := [ctxC];
                   end if;
               end if;
               ctxC;
           end proc;
       end module; #Simpl:-condition
   end module, #Simpl

   SamePartition := proc(eqCond, eqPart, $) proc(p0 :: Partition, p1 :: Partition, $)
     local ps0, ps1, pc0, the;
     ps0, ps1 := seq(op(1,p),p=(p0,p1));

     if nops(ps0) <> nops(ps1) then
         return false;
     end if;

     for pc0 in ps0 do
         the, ps1 :=
           selectremove(pc1 -> eqCond( condOf(pc1), condOf(pc0) ) and
                               eqPart( valOf(pc1) , valOf(pc0)  )
                       ,ps1);
         if nops(the) <> 1 then
             return false;
         end if;
     end do;

     true;
   end proc; 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
   Umap := proc(f,x,$)
       f(op(0,x))( map( p -> Piece(f(condOf(p)),f(valOf(p)))
                      , op(1,x) ))
   end proc,

   isPartitionPieceOf := proc( p, elem_t := anything )
      type(p, 'Piece(PartitionCond, elem_t)');
   end proc,

   isPartitionOf := proc( e, elem_t := anything )
      type(e, 'PARTITION(list(PartitionPiece(elem_t)))' );
   end proc,

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

      TypeTools:-AddType(PartitionCond, {relation, boolean, `::`, specfunc({`And`,`Or`,`Not`}), `and`, `or`, `not`});
      TypeTools:-AddType(PartitionPiece, isPartitionPieceOf);
      TypeTools:-AddType(Partition, isPartitionOf);

      # global extensions to maple functionality
      :-`eval/PARTITION` :=
      proc(p, eqs, $)
          Partition:-Simpl(Umap(x->eval(x,eqs), p));
      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, 'do_solve')
              , r0, r1;
            ;
          r0 := Simpl:-singular_pts(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;

      :-`simplify/PARTITION` := Simpl;

      NULL
   end proc,

   ModuleUnload::static:= proc()
      TypeTools:-RemoveType(Partition);
      TypeTools:-RemoveType(PartitionPiece);
      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,

   extr_conjs := proc(x,$)
       if x::{specfunc(`And`), `and`} then
           map(extr_conjs, [op(x)])[];
       else
           x
       end if
   end proc,

   pw_cond_ctx := proc(ctx_, p, $)
       local ps, ctx, ctxN, cond, ncond;
       ps, ctx := op(ctx_); cond := condOf(p);
       cond := {extr_conjs(cond)};
       cond := remove(x->x in ctx, cond);
       ncond := `if`(nops(cond)=1
                     , KB:-negate_rel(op(1,cond))
                     , `Not`(bool_And(op(cond))) );
       cond := bool_And(op(cond));
       ctx := ctx union { ncond };
       [ [ op(ps), Piece(cond, valOf(p)) ], ctx ]
   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,

   Pieces := proc(cs0,es0)::list(PartitionPiece);
       local es, cs;
       if es0 :: {set,list} then
           es := es0;
       else
           es := {es0};
       end if;
       if cs0 :: {set,list,specfunc(`And`),`and`} then
           cs := cs0;
       else
           cs := {cs0};
       end if;
       [seq(seq(Piece(c,e),c=cs),e=es)];
   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,

   Foldr := proc( cons, nil, prt :: Partition, $ )
       foldr( proc(p, x) cons(condOf(p), valOf(p), x); end proc
            , nil
            , op(op(1, prt))
            );
   end proc,

   Foldr_mb := proc( cons, nil, prt, $ )
       if prt :: Partition then
           Foldr(_passed);
       else
           cons( true, prt, nil )
       end if;
   end proc,

   PartitionToPW_mb := proc(x, $)
       if x :: Partition then PartitionToPW(x) else x end if;
   end proc,

   PartitionToPW := proc(x::Partition, $)
       local parts := op(1,x);
       if nops(parts) = 1 and is(op([1,1],parts)) then return op([1,2], parts) end if;
       parts := foldl(pw_cond_ctx, [ [], {} ], op(parts) );
       parts := [seq([condOf(p), valOf(p)][], p=op(1,parts))];
       if op(-2, parts) :: identical(true) then
           parts := subsop(-2=NULL, parts);
       end if;
       piecewise(op(parts));
   end proc,

   Flatten := module()
     export ModuleApply;
     local unpiece, unpart, unpartProd;

     ModuleApply := proc(pr0, { _with := [ 'Partition', unpart ] } )
       local ty, un_ty, pr1, pr2;
       ty, un_ty := op(_with);

       pr1 := subsindets(pr0, ty, un_ty);
       if pr0 <> pr1 then
         ModuleApply(pr1, _with=[ Or('Partiton',`*`), unpartProd ]);
       else
         pr0
       end if;
     end proc;

     # like Piece, but tries to not be a Piece
     unpiece := proc(c, pr, $)
       if pr :: Partition then
         map(q -> applyop(z->bool_And(z,c),1,q), op(1,pr))[]
       else
         Piece(c, pr)
       end if
     end proc;

     unpart := proc(pr, $)
       if pr :: Partition then
         PARTITION(map(q -> unpiece(condOf(q),valOf(q)), op(1,pr)))
       else
         pr
       end if
     end proc:

     unpartProd := proc(pr, $)
       local ps, ws;
       if pr :: `*` then
         ps, ws := selectremove(q->type(q,Partition), [op(pr)]);
         if nops(ps) = 1 then
           Pmap(x->`*`(op(ws),x), unpartProd(op(1,ps)));
         else
           pr;
         end if;
       else
         unpart(pr);
       end if;
     end proc;
   end module,

   isShape := kind -> module()
     option record;

     export MakeCtx := proc(p0,$)
       local p := p0, pw, p1, wps, ws, vs, cs, w, ps;

       if kind='piecewise' then
         p := Partition:-PWToPartition(p);
       end if;

       w, p1 := Partition:-Simpl:-single_nonzero_piece(p);
       if not w :: identical(true) or p1 <> p then
           [ w, p1 ]
       else
           ps := op(1, p);
           wps := map(x->Domain:-Extract:-Shape(valOf(x), 'no_simpl'), ps);
           ws, vs, cs := map2(op, 1, wps), map2(op, 2, wps), map(condOf, ps);
           if nops(vs) > 0 and
              andmap(v->op(1,vs)=v, vs) and
              ormap(a->a<>{}, ws)
           then
               [ `bool_Or`( op( zip(`bool_And`, ws, cs) ) ) , op(1,vs) ];
           else
               [ true, p0 ];
           end if;
       end if;
     end proc;
     export MapleType := `if`(kind=`PARTITION`,'Partition','specfunc(piecewise)');
   end module,

   # 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 := Simpl:-condition(ctxC, _rest);

               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 ctx :: identical(false,[]) then # this clause is actually unreachable
                   return(PARTITION(cls));
               else
                   cls := [ op(cls), op(Pieces(ctxC,[op(2*i,x)])) ];
               end if;
           end if;

       end do;

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

       if nops(cls) = 0 then
           error "PWToPartition: the piecewise  %1  produced an empty partition\n", x;
       end if;

       PARTITION( cls );
   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,

   Simpl := module()
       export ModuleApply := (single_branch@remove_false_pieces);

       export single_nonzero_piece_cps := proc(k)
           local r,p; r, p := single_nonzero_piece(_rest);
           if r :: identical(true) then
               args[2]
           else
               k(r, p);
           end if;
       end proc;

       export single_nonzero_piece := proc(e, { _testzero := Testzero })
           local zs, nzs;
           if e :: Partition then
               zs, nzs := selectremove(p -> _testzero(valOf(p)), op(1, e));
               if nops(nzs) = 1 then
                   return condOf(op(1,nzs)) , valOf(op(1,nzs))
               end if;
           end if;
           true, e
       end proc;

       export remove_false_pieces := proc(e::Partition, $)
           PARTITION(remove(p -> not(coulditbe(condOf(p))), op(1, e)));
       end proc;

       export single_branch := proc(e::Partition, $)
           if nops(op(1,e)) = 1 then
               op([1,1,2], e)
           else
               e
           end if;
       end proc;

       # Removal of singular points from partitions
       export singular_pts := module()
           # we can simplify the pieces which are equalities and whose LHS or
           # RHS is a name.
           local canSimp := c -> condOf(c) :: `=` and (lhs(condOf(c)) :: name or rhs(condOf(c)) :: name);

           # determines if a given variable `t' has the given upper/lower `bnd'.
           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);

           # replace bounds with what we would get if the equality can be
           # integrated into other pieces
           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 := ((a,b)->(a union b) intersect (a minus b));

           # this loops over the pieces to replace, keeping a state consisting of
           # the "rest" of the pieces
           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 do_eval_for_cmp := proc(eval_cmp, ev, x, $)
             local r;
             try
               r := eval_cmp(subs(ev,x));
             catch "numeric exception: division by zero":
               r := eval_cmp(limit(x, ev));
             end try;
             subsindets(r,And(specfunc(NewSLO:-applyintegrand),anyfunc(anything, identical(0))),_->0);
           end proc;

           local tryReplacePiece := proc(vrNm, vrVal, pc0val, pcs, eval_cmp,$)
             local pcs0 := pcs, pcs1, qs0, qs1, qs2, vrEq := vrNm=vrVal, vs2, ret, q, q_i;
             ret := [ Piece(vrEq, pc0val), op(pcs0) ] ;
             # speculatively replace the conditions
             pcs1 := subsindets(pcs0, relation, replace_with(vrNm)(vrVal));
             # convert to sets and take the "set xor", which will contain
             # only those elements which are not common to both sets.
             qs0, qs1 := seq({op(qs)},qs=(pcs0,pcs1));
             qs2 := set_xor(qs1, qs0);
             # if we have updated precisely two pieces (an upper and lower bound)
             if nops(qs2) = 2 then
               # get the values of those pieces, and the value of the
               # piece to be replaced, if that isn't undefined
               vs2 := map(valOf, qs2);
               if not pc0val :: identical('undefined') then
                 vs2 := { pc0val, op(vs2) };
               end if;
               # substitute the equality over the piece values
               vs2 := map(x->do_eval_for_cmp(eval_cmp,vrEq,x), vs2);
               # if they are identically equal, return the original
               # "guess"
               if nops(vs2) = 1 then
                 # arbitrarily pick the first candidate to be the one to
                 # be replaced
                 q := op(1,qs2);
                 q_i := seq(`if`(op(i,pcs1)=q,[i],[])[],i=1..nops(pcs1));
                 ret := subsop(q_i=op(q_i,pcs0), pcs1);
               end if;
             end if;
             ret;
           end proc;

           export ModuleApply := proc(p_,{eval_cmp:='value'},$)
              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);
              PARTITION(tryReplacePieces(uc, oc, eval_cmp));
           end proc;
       end module; # singular_pts

       export condition := module()
           local is_extra_sol := x -> (x :: `=` and rhs(x)=lhs(x) and lhs(x) :: name);

           local postproc_for_solve := proc(ctx, ctxSlv)
                                    ::{identical(false), list({boolean,relation,specfunc(boolean,And),`and`(boolean)})};
               local ctxC := ctxSlv;
               if ctxC = [] then
                   ctxC := [] ;
               elif nops(ctxC)> 1 then
                   ctxC := map(x -> postproc_for_solve(ctx, [x], _rest)[], ctxC);
               elif nops(ctxC) = 1 then
                   ctxC := op(1,ctxC);
                   if ctxC :: set then
                       if ctxC :: identical('{}') then
                           ctxC := NULL;
                       else
                           ctxC := remove(is_extra_sol, ctxC);
                           ctxC := bool_And(op(ctxC));
                       end if ;
                       ctxC := [ctxC];
                   elif ctxC :: specfunc('piecewise') then
                       ctxC := PWToPartition(ctxC, _rest);
                       ctxC := [ seq( map( o -> condOf(c) and o
                                         , postproc_for_solve(ctx, valOf(c), _rest))[]
                                    , c=op(1, ctxC) )] ;
                   else
                       ctxC := FAIL;
                   end if;
               else
                   ctxC := FAIL;
               end if;
               if ctxC = FAIL then
                   error "don't know what to do with %1", ctxSlv;
               else
                   ctxC;
               end if;
           end proc;

           export ModuleApply := proc(ctx)::list(PartitionCond);
               local ctxC := ctx;

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

               if 'do_solve' in {_rest} then
                   ctxC := solve({ctxC}, 'useassumptions'=true);
                   if ctxC = NULL and indets(ctx, specfunc(`exp`)) <> {} then
                       ctxC := [ctx];
                   else
                       ctxC := postproc_for_solve(ctx, [ctxC], _rest);
                   end if;
                   if indets(ctxC, specfunc({`Or`, `or`})) <> {} then
                       userinfo(10, 'Simpl:-condition',
                           printf("output: \n"
                                  "  %a\n\n"
                                  , ctxC )
                          );
                   end if;
               else
                   ctxC := Domain:-simpl_relation(ctxC, norty='DNF');
                   ctxC := eval(ctxC,`And`=bool_And);
                   if ctxC :: specfunc(`Or`) then
                       ctxC := [op(ctxC)]
                   else
                       ctxC := [ctxC];
                   end if;
               end if;
               ctxC;
           end proc;
       end module; #Simpl:-condition
   end module, #Simpl

   SamePartition := proc(eqCond, eqPart, $) proc(p0 :: Partition, p1 :: Partition, $)
     local ps0, ps1, pc0, the;
     ps0, ps1 := seq(op(1,p),p=(p0,p1));

     if nops(ps0) <> nops(ps1) then
         return false;
     end if;

     for pc0 in ps0 do
         the, ps1 :=
           selectremove(pc1 -> eqCond( condOf(pc1), condOf(pc0) ) and
                               eqPart( valOf(pc1) , valOf(pc0)  )
                       ,ps1);
         if nops(the) <> 1 then
             return false;
         end if;
     end do;

     true;
   end proc; end proc

;

uses Hakaru;

   ModuleLoad()
end module:


Correct implementation(?)

Correct implementation(?)

#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);

          PARTITION(tryReplacePieces(uc, oc, cmp));

       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 eval_ctrs := ctx -> eval(ctx, [`And`=`and`, `Not`=`not`]);

       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_ctrs(ctx);
                         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, $)::list;
       local ctxC := ctx;

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

           ctxC := solve({ctxC});
           if ctxC = NULL then return [ctx] end if;

           ctxC := postproc_for_solve(ctx, [ctxC]);

           if indets(ctxC, specfunc({`Or`, `or`})) <> {} then
               userinfo(10, 'simplifyPartitionCtx',
                   printf("output: \n"
                          "  %a\n\n"
                          , ctxC )
                  );
           end if;

           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;

      :-`simplify/PARTITION` :=
       proc(e,$)
           subsindets(e
                     , specfunc('PARTITION')
                     , x -> Simpl:-single_branch
                             (Simpl:-remove_false_pieces(x))
                     );
       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;

       if nops(cls) = 0 then
           error "PWToPartition: the piecewise  %1  produced an empty partition\n", x;
       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,

   Simpl := module()
       export single_nonzero_piece := proc(e, $)
               local zs, nzs, nz;
               if e :: Partition then
                   zs, nzs := selectremove(p -> Testzero(valOf(p)), op(1, e));

                   if nops(nzs) = 1 then
                       nz := op(1,nzs);
                       {condOf(nz)} , valOf(nz)
                   else
                       {}, e
                   end if;
               else
                   {}, e
               end if;
       end proc;

       export remove_false_pieces := proc(e::Partition, $)
                  local ps := op(1, e);

                  ps := remove(p -> not(coulditbe(condOf(p))), ps);

                  PARTITION(ps);

                  # e;
                  # local ps0 := op(1, e); local ps, rs;

                  # ps, rs := selectremove(p -> coulditbe(condOf(p)), ps0);

                  # if nops(ps) = 0 then
                  #     error "remove_false_pieces: the partition  %1  reduced to an empty partition\n", e;
                  # end if;

                  # PARTITION(rs);
       end proc;

       export single_branch := proc(e::Partition, $)
                  if nops(op(1,e)) = 1 then
                      op([1,1,2], e)
                  else
                      e
                  end if;
       end proc;

   end module,

   SamePartition := proc(eqCond, eqPart, $) proc(p0 :: Partition, p1 :: Partition, $)
     local ps0, ps1, pc0, the;
     ps0, ps1 := seq(op(1,p),p=(p0,p1));

     if nops(ps0) <> nops(ps1) then
         return false;
     end if;

     for pc0 in ps0 do
         the, ps1 :=
           selectremove(pc1 -> eqCond( condOf(pc1), condOf(pc0) ) and
                               eqPart( valOf(pc1) , valOf(pc0)  )
                       ,ps1);
         if nops(the) <> 1 then
             return false;
         end if;
     end do;

     true;
   end proc; 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);

          PARTITION(tryReplacePieces(uc, oc, cmp));

       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 eval_ctrs := ctx -> eval(ctx, [`And`=`and`, `Not`=`not`]);

       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_ctrs(ctx);
                         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, $)::list;
       local ctxC := ctx;

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

           ctxC := solve({ctxC});
           if ctxC = NULL then return [ctx] end if;

           ctxC := postproc_for_solve(ctx, [ctxC]);

           if indets(ctxC, specfunc({`Or`, `or`})) <> {} then
               userinfo(10, 'simplifyPartitionCtx',
                   printf("output: \n"
                          "  %a\n\n"
                          , ctxC )
                  );
           end if;

           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;

      :-`simplify/PARTITION` :=
       proc(e,$)
           subsindets(e
                     , specfunc('PARTITION')
                     , x -> Simpl:-single_branch
                             (Simpl:-remove_false_pieces(x))
                     );
       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;

       if nops(cls) = 0 then
           error "PWToPartition: the piecewise  %1  produced an empty partition\n", x;
       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,

   Simpl := module()
       export single_nonzero_piece := proc(e, $)
               local zs, nzs, nz;
               if e :: Partition then
                   zs, nzs := selectremove(p -> Testzero(valOf(p)), op(1, e));

                   if nops(nzs) = 1 then
                       nz := op(1,nzs);
                       {condOf(nz)} , valOf(nz)
                   else
                       {}, e
                   end if;
               else
                   {}, e
               end if;
       end proc;

       export remove_false_pieces := proc(e::Partition, $)
                  local ps0 := op(1, e); local rs;

                  ps, rs := selectremove(p -> coulditbe(condOf(p)), ps0);

                  if nops(ps) = 0 then
                      error "remove_false_pieces: the partition  %1  reduced to an empty partition\n", e;
                  end if;

                  PARTITION(ps);
       end proc;

       export single_branch := proc(e::Partition, $)
                  if nops(op(1,e)) = 1 then
                      op([1,1,2], e)
                  else
                      e
                  end if;
       end proc;

   end module,

   SamePartition := proc(eqCond, eqPart, $) proc(p0 :: Partition, p1 :: Partition, $)
     local ps0, ps1, pc0, the;
     ps0, ps1 := seq(op(1,p),p=(p0,p1));

     if nops(ps0) <> nops(ps1) then
         return false;
     end if;

     for pc0 in ps0 do
         the, ps1 :=
           selectremove(pc1 -> eqCond( condOf(pc1), condOf(pc0) ) and
                               eqPart( valOf(pc1) , valOf(pc0)  )
                       ,ps1);
         if nops(the) <> 1 then
             return false;
         end if;
     end do;

     true;
   end proc; end proc

;

uses Hakaru;

   ModuleLoad()
end module: