Skip to content

New Binary Tree Operations (Prune, Contract) #3

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
reid-g wants to merge 6 commits into
base: master
Choose a base branch
from
Open

New Binary Tree Operations (Prune, Contract) #3

Changes from 1 commit
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
5ebd6ba
New Binary Tree Operations (Prune, Contract)
reid-g Feb 27, 2023
4ee560c
Fixed Binary Ops, Add BTreeQ, Listable
reid-g Feb 27, 2023
57ae574
Split BTrees in separate files
Steven-Roberts Feb 28, 2023
fe6254a
Merge branch 'master' into Feature_BTreeOperations
Steven-Roberts Feb 28, 2023
bdce4f4
Removed Linearization Property, Other Updates
reid-g Apr 4, 2023
be7e168
Bug Fix for Contract
reid-g Apr 10, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
105 changes: 105 additions & 0 deletions src/Kernel/BTrees.wl
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -21,6 +21,14 @@ BTreeAlpha::usage = "BTreeAlpha[t] computes the number of monotonic labelings of
BTreeGamma::usage = "BTreeGamma[t] computes the density of the tree t.";
BTreeSigma::usage = "BTreeSigma[t] computes the number of symmetries of the tree t.";

BTreePrune::usage = "Get all prunings of tree T with tree S and get its Forest Space";
BTreeContract::usage = "Get all cuts of tree T which contract to tree S and get its Forest Space";
BTreeSubTrees::usage = "Get All Subtrees of a Tree as a List";
BTreeRoot::usage = "Get the root node of a tree";
BTreeChildren::usage = "Get children of a tree and return as a Forest Space";

BTreeFormalForm::usage = "Get the Formal Representation of the Tree";


(* ::Section:: *)
(*Private Members*)
Expand All @@ -38,6 +46,24 @@ kron[x__] := KroneckerProduct[x];
(* Generates all sets of subtrees with at least minSubtrees elements and p total vertices *)
subtrees[head_, p_, minSubtrees_:1] := DeleteDuplicates[Flatten[kron @@@ Map[head, IntegerPartitions[p, {minSubtrees, p}], {2}]]];

(*Inner sub tree function for only formal expansions*)
innerBSubtrees[t_]:=Complement[DeleteDuplicates[butcherSubtrees[t]], {t}];

(*Expand out power terms in a list to individual terms*)
listPowerRemove[x_]:=Flatten[Replace[x,{Power[y_,p_] :>ConstantArray[y,p]},{0,1}]];

(*Flatten a Forest Space into a flat List *)
linearCombToList[x_Plus]:=Flatten[Replace[List@@x,{Times[c_Integer,y_] :>ConstantArray[y,c]},{0,1}]];
linearCombToList[Times[y_Integer,x_]]:=ConstantArray[x,y];
linearCombToList[x_]:={x};

(*Generalized Outer Product on two list with a Cofactor Expansion applied where there are no alternating signs*)
outerACE[op_,t_List /;Length[t] ==2,k_List /;Length[k] ==2]:=op[t[[1]],k[[1]]]*op[t[[2]],k[[2]]] + op[t[[1]],k[[2]]]*op[t[[2]],k[[1]]];
outerACE[op_,t_List,k_List] := Sum[op[First[t],k[[i]]]*outerACE[op,Drop[t,1],Delete[k,i]],{i,1,Length[k]}];

(*Given a list of trees with powers in entries get the factorial of each power and product*)
factorialProd[t_]:=Times@@(#!&/@Replace[Cases[t,_Power,{0,1}],{Power[y_,p_] :>p},{0,1}]);


(* ::Subsection:: *)
(*B-Trees*)
Expand Down Expand Up @@ -106,6 +132,56 @@ treeSigma[Power[t_, p_]] := Factorial[p] * treeSigma[t]^p;
treeSigma[t_Times] := Map[treeSigma, t];
treeSigma[r:_[t_]] := treeSigma[r] = treeSigma[t];

getRoot[t_Symbol]:=t;
getRoot[t_Subscript]:=t;
getRoot[t_Power]:=0;
getRoot[t_Times]:=0;
getRoot[t_Plus]:=0;
getRoot[t_]:=Head[t];

getChildren[_Symbol | _Subscript | _Power | _Times | _Plus]:=0;
getChildren[t_[h_]]:=h;

subTrees[k_]:={k};
subTrees[k_[t_]]:=Append[Map[k,subTrees[t]],k];
subTrees[t_Times]:=Times@@@Most[Tuples[Map[Append[subTrees[#],1]&,List@@t]]];
subTrees[t_^p_]:=Times@@@Most[Tuples[Append[subTrees[t],1],p]];


(* ::Subsection:: *)
(*Tree Functions (Binary)*)


prune[t_,t_]:=1;
prune[t_,k_]:=0;
prune[t_,1]:=t;
prune[t_[u_],t_]:=u;
prune[t_[u_],t_[g_]]:=prune[u,g];
prune[t_Times, k_]:=Sum[prune[t[[i]],k]*(Length[t] - 1)!*Delete[t,i],{i,1,Length[t]}];
prune[t_,k_Times]:=0;
prune[t_Times, k_Times]:=With[{tpad = listPowerRemove[List@@t], kpad =listPowerRemove[List@@k] },If[Length[tpad]>=Length[kpad],(1/factorialProd[List@@k])*outerACE[prune,tpad,PadRight[kpad,Length[tpad],1]],0]];
prune[t_^p_,k_Times]:=With[{kpad = listPowerRemove[List@@k]},If[p>=Length[kpad],(p! /factorialProd[List@@k] )*Product[prune[t,kpad[[i]]],{i,1,Length[kpad]}]*prune[t,1]^(p-Length[kpad]),0]];
prune[t_Times,k_^q_]:=With[{tpad=listPowerRemove[List@@t]},If[Length[tpad]>=q,(1/q!)*outerACE[prune,tpad,PadRight[ConstantArray[k,q],Length[tpad],1]],0]];
prune[t_^p_,k_]:=p*prune[t,k]*prune[t,1]^(p-1);
prune[t_^p_,k_^q_]:=If[p>=q,Binomial[p,q]*prune[t,k]^(q)*prune[t,1]^(p-q),0];

contract[t_,k_]:=If[getRoot[t]===getRoot[k],t,0];
contract[t_,k_[u_]]:=If[getRoot[t]===k,Total[#*innerTreeSub[ Flatten[linearCombFlattenToList[Expand[prune[t,#]]]],u]&/@innerBSubtrees[t],2],0];
innerContract[tl_,u_]:=contract[#,u]&/@tl;
contract[t_Times,k_]:=0;
contract[t_,k_Times]:=0;
contract[t_Times,k_[u_]]:=0;
contract[t_[w_],k_Times]:=0;
contract[t_^p_,k_]:=0;
contract[t_,k_^q_]:=0;
contract[t_^p_,k_[u_]]:=0;
contract[t_[w_],k_^q_]:=0;
contract[t_Times,k_Times]:=With[{tpad = listPowerRemove[List@@t],kpad=listPowerRemove[List@@k]},If[Length[tpad]==Length[kpad],(1/factorialProd[List@@k])*outerACE[contract,tpad,kpad],0]];
contract[t_Times,k_^q_]:=With[{tpad=listPowerRemove[List@@t]},If[Length[tpad]==q,Product[contract[tpad[[i]],k],{i,1,Length[tpad]}],0]];
contract[t_^p_,k_Times]:=With[{kpad = listPowerRemove[List @@k]},If[p==Length[kpad],(p!/factorialProd[List@@k])*Product[contract[t,kpad[[i]]],{i,1,Length[kpad]}],0]];
contract[t_^p_,k_^q_]:=If[p==q,contract[t,k]^p,0];



(* ::Subsection:: *)
(*Conversions*)
Expand Down Expand Up @@ -184,6 +260,22 @@ BTreeDAE[p:_Integer?Positive | {_Integer?NonNegative}, OptionsPattern[]] := With
BTreeDAE /: Tree[HoldPattern[BTreeDAE[t_, _Integer]]] := toTree[t];
BTreeDAE /: MakeBoxes[HoldPattern[BTreeDAE[t_, _Integer]], format_] := toBoxes[t, format];

(*Linearization Properties*)
BTree[t_ + s_]:= BTree[t] + BTree[s];
BTree[t_*s_/;NumberQ[t]]:=t*BTree[s];
BTree[t_*s_]:=BTree[t]*BTree[s];
BTree[t_^q_]:=BTree[t]^q;

BTreeN[t_ + s_,p__]:= BTreeN[t,p] + BTreeN[s,p];
BTree[t_*s_/;NumberQ[t],p__]:=t*BTreeN[s,p];
BTreeN[t_*s_,p__]:=BTreeN[t,p]*BTreeN[s,p];
BTreeN[t_^q_/;NumberQ[q],p__]:=BTreeN[t,p]^q;

BTreeDAE[t_ + s_,p__]:= BTreeDAE[t,p] + BTreeDAE[s,p];
BTreeDAE[t_*s_/;NumberQ[t],p__]:=t*BTreeDAE[s,p];
BTreeDAE[t_*s_,p__]:=BTreeDAE[t,p]*BTreeDAE[s,p];
BTreeDAE[t_^q_/;NumberQ[q],p__]:=BTreeDAE[t,p]^q;

BTreeOrder[(BTree | BTreeN | BTreeDAE)[t_, ___]] := treeOrder[t];
SetAttributes[BTreeOrder, Listable];

Expand All @@ -196,6 +288,19 @@ SetAttributes[BTreeGamma, Listable];
BTreeSigma[(BTree | BTreeN | BTreeDAE)[t_, ___]] := treeSigma[t];
SetAttributes[BTreeSigma, Listable];

BTreePrune[h_[t_,p__],h_[t_,p__]]/;(AnyTrue[{BTree,BTreeN,BTreeDAE},h===#&]):=h[\[FormalY],p];
BTreePrune[h_[t_,p__],h_[k_,p__]]/;(AnyTrue[{BTree,BTreeN,BTreeDAE},h===#&]):=h[Expand[prune[t,k]],p];

BTreeContract[h_[t_,p__],h_[k_,p__]]/;(AnyTrue[{BTree,BTreeN,BTreeDAE},h===#&]):=h[Expand[contract[t,k]],p];

BTreeSubTrees[h_[t_,p__]]/;(AnyTrue[{BTree,BTreeN,BTreeDAE},h===#&]):=Map[h[#,p]&,Complement[DeleteDuplicates[subTrees[t]], {t}]];

BTreeRoot[h_[t_,p__]]/;(AnyTrue[{BTree,BTreeN,BTreeDAE},h===#&]):=h[getRoot[t],p];

BTreeChildren[h_[t_,p__]]/;(AnyTrue[{BTree,BTreeN,BTreeDAE},h===#&]):=h[getChildren[t],p];

BTreeFormalForm[h_[t_,___]]/;(AnyTrue[{BTree,BTreeN,BTreeDAE},h===#&]):=t;


(* ::Section:: *)
(*End Package*)
Expand Down