Skip to content

Instantly share code, notes, and snippets.

@lshifr
Created December 12, 2012 09:59
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save lshifr/4266516 to your computer and use it in GitHub Desktop.
A generic object implementing operations on trees of rules for Mathematica
{
"author"->
{
"name" -> "lshifr",
"email" -> "lshifr@gmail.com",
"url" -> "http://www.mathprogramming-intro.org"
},
"name" -> "RuleTreeInfo",
"mathematica_version" -> "8.0+",
"description" -> "A generic object implementing operations on trees of rules for Mathematica",
"url" -> "https://gist.github.com/4266516"
}
(* Mathematica Package *)
BeginPackage["RuleTreeInfo`", { "OO`"}]
(* Exported symbols added here with SymbolName::usage *)
RuleTreeInfo;
Begin["`Private`"] (* Begin Private Context *)
ClearAll[getFile];
getFile[fullName_String?FileExistsQ] :=
With[{fcont = Quiet@Import[fullName, "String"]},
fcont /; fcont =!= $Failed];
getFile[file_String] :=
ThrowError[getFile, file, "file_does_not_exist"];
getFile[___] := ThrowError[getFile];
ClearAll[stringify];
stringify[s_String] := StringJoin["\"", s, "\""];
ClearAll[optionQ];
optionQ[opt_] := MatchQ[opt, _Rule | _RuleDelayed];
ClearAll[mergeOptions];
mergeOptions[x_, y_] := mergeOptions[Null, x, y];
mergeOptions[x_, y_, x_] := y
mergeOptions[x_, fopt_?optionQ, sopts_] :=
mergeOptions[x, {fopt}, sopts];
mergeOptions[x_, fopts_, sopt_?optionQ] :=
mergeOptions[x, fopts, {sopt}];
mergeOptions[_, fopts : {___?optionQ}, sopts : {___?optionQ}] :=
Map[# -> mergeOptions[#, # /. fopts, # /. sopts] &,
DeleteDuplicates@Join[fopts[[All, 1]], sopts[[All, 1]]]];
mergeOptions[_, x_, y_] := y;
mergeOptions[___] := ThrowError[mergeOptions];
ClearAll[removeOptions];
removeOptions[x_, y_] := removeOptions[Null, x, y];
removeOptions[x_, y_, x_] := y;
removeOptions[x_, opt_?optionQ, rem_] := removeOptions[x, {opt}, rem];
removeOptions[x_, opts_, rem : Except[_List]] :=
removeOptions[x, opts, {rem}];
removeOptions[_, opts : {___?optionQ}, rem_List] :=
With[{remBranches = Cases[rem, _Rule]},
With[{names = Flatten[Cases[rem, s_String :> {s}]]},
Map[# -> removeOptions[#, # /. opts, # /. remBranches] &,
DeleteCases[opts[[All, 1]], Alternatives @@ names]
]]
];
removeOptions[_, x_, y_] := y;
removeOptions[___] := ThrowError[removeOptions];
ClearAll[fileToExpression];
fileToExpression[file_String] :=
With[{strconts = getFile[file]},
If[! SyntaxQ[strconts],
ThrowError[fileToExpression, "malformed_file", file]
];
ReleaseHold[
DeleteCases[
ToExpression[strconts, InputForm, Hold],
Null]
] /; strconts =!= $Failed];
fileToExpression[file_String] :=
ThrowError[fileToExpression, "unimportable_file", file];
fileToExpression[___] := ThrowError[fileToExpression];
(* pretty-printer for the project file *)
ClearAll[toCodeString];
toCodeString[rules : {___Rule}] :=
With[{result = toCodeString[rules, 0]},
Block[{stringContainer = StringJoin}, result]
];
toCodeString[rules : {___Rule}, tab_] :=
stringContainer[
toCodeString[stringContainer["{", "\n"], tab],
stringContainer[##, "\n"] & @@
Riffle[Map[stringContainer[toCodeString[#, tab + 1]] &, rules],
",\n"],
toCodeString[stringContainer["}"], tab]
];
toCodeString[s_String -> rules : {___Rule}, tab_] :=
toCodeString[
stringContainer[
stringify@s, "->", "\n",
toCodeString[rules, tab + 1]
], tab];
toCodeString[s_String -> rhs : (_String | _?NumericQ | Null), tab_] :=
toCodeString[
stringContainer[
stringify@s,
" -> ",
stringify@ToString[rhs]
], tab];
toCodeString[sc_stringContainer, tab_] :=
stringContainer[Sequence @@ Table["\t", {tab}], sc];
toCodeString[___] :=
ThrowError[toCodeString];
ClearAll[propertyQ];
propertyQ[_String] := True;
propertyQ[_String -> _?propertyQ] := True;
propertyQ[_String -> _String | _?NumericQ] := True;
propertyQ[__] := False;
ClearAll[getProperty];
getProperty[tree_, prop_] :=
Quiet@Check[
OptionValue[tree, prop],
$Failed,
{OptionValue::optnf}
];
DeclareType[RuleTreeInfo][
OO`Methods`get[prop_?propertyQ] :=
With[{result = getProperty[$content, prop]},
result /; result =!= $Failed]
,
OO`Methods`get[prop_] := $Failed
,
OO`Methods`normal[] := $content
,
OO`Methods`toString[] := toCodeString[$self@OO`Methods`normal[]]
,
OO`Methods`delete[prop_?propertyQ] :=
$content = removeOptions[$content, prop]
,
OO`Methods`replace[changeTree_] :=
$content = mergeOptions[$content, changeTree]
,
OO`Methods`bindToFile[file_String] :=
$self@AddMethods[
OO`Methods`read[] := (
$content = fileToExpression[file];
$self@OO`Methods`normal[]
),
OO`Methods`save[] :=
Quiet@Export[file, $self@OO`Methods`toString[], "String"],
OO`Methods`getFileName[] := file
]
]
End[] (* End Private Context *)
EndPackage[]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment