(* ::Package:: *)

(* ::Title:: *)
(*Utility Functions*)


(* ::Section:: *)
(*Purpose*)


(* ::Text:: *)
(*The functions in this notebook are should be loaded into the topic-related notebooks before calculations are attempted. They provide various useful functions and shortcuts.*)


(* ::Section:: *)
(*Tools and techniques useful for calculations and manipulations of equations*)


(* ::Subsection:: *)
(*Operations on equations*)


(* ::Text:: *)
(*ER converts an equation into a rule, RE converts a rule into an equation*)


(* ::Input::Initialization:: *)
Clear[ER, RE];
ER[expr_] := expr /. Equal -> Rule;
RE[expr_] := expr /. Rule -> Equal;


(* ::Text:: *)
(*Example*)


(* ::Input:: *)
(*{a == b // ER, a -> b // RE}*)


(* ::Text:: *)
(*MapEqn maps a function onto both sides of an an equation or a list of equation*)


(* ::Input::Initialization:: *)
Clear[MapEqn];
MapEqn[Fcn_, expr_List] := MapEqn[Fcn, #]& /@ expr;
MapEqn[Fcn_, lhs_ == rhs_] :=Fcn[lhs] == Fcn[rhs];


(* ::Text:: *)
(*Example*)


(* ::Input:: *)
(*{MapEqn[F,a == b],Map[F, a == b, 2],*)
(* MapEqn[F,{a==b,c==d}]}*)


(* ::Text:: *)
(*MapEqn is just a naming convention used to make notebook calculations easier to read. The same actions can be accomplished with Mathematica's flexible Map function. *)


(* ::Text:: *)
(*For example, *)


(* ::Input:: *)
(*{{MapEqn[F,a == b],Map[F, a == b, 2]},*)
(* {MapEqn[F,{a==b,c==d}], Map[F, {a==b,c==d},{2}]}}// ColumnForm*)


(* ::Text:: *)
(*Other applications of Map useful for manipulating equations.*)
(*Suppose you want to Map a function over each term on both sides of an equation. *)


(* ::Input:: *)
(*Map[F, a + b + c == d + e + f, {2}]*)


(* ::Text:: *)
(*MapAt is also very useful when performing operations (such as Simplify) on specific parts of an equation. There are usually multiple ways of accomplishing the same operation. *)


(* ::Input:: *)
(*Module[{unevaluated},*)
(*unevaluated = {Inactivate@MapAt[F, a + b == c + d,1],Inactivate@MapAt[F, a + b == c + d,2],Inactivate@MapAt[F, a + b == c + d,{1}],Inactivate@MapAt[F, a + b == c + d,{2}],Inactivate@MapAt[F, a + b == c + d,{1,1}],Inactivate@MapAt[F, a + b == c + d,{2,2}]};*)
(*Grid[Transpose[{unevaluated, unevaluated // Activate}], Frame -> All]]*)


(* ::Subsection:: *)
(*Writing equations in a "standard form."*)


(* ::Text:: *)
(*StandardizeEqn is just a convenience for rewriting an equation so that zero is on the right hand side*)


(* ::Input::Initialization:: *)
Clear[StandardizeEqn];
StandardizeEqn[lhs_ == rhs_] := lhs - rhs == 0;


(* ::Text:: *)
(*Example*)


(* ::Input:: *)
(*a+ b == c + d // StandardizeEqn*)


(* ::Text:: *)
(*The same effect could be accomplished with a pattern matching rule*)


(* ::Input:: *)
(*a + b == c + d /. lhs_ == rhs_ -> lhs - rhs == 0 *)


(* ::Subsection:: *)
(*Simplifying equation by canceling constants*)


(* ::Text:: *)
(*CancelCommonConstants is a convenience for canceling common constants that appear in an equation. It is supported by the predicate ConstantQ that identifies constant terms*)


(* ::Input::Initialization:: *)
Clear[ConstantQ, CancelCommonConstants];
(* Does the expression contain any of the terms in vars? *)
ConstantQ[expr_Plus, vars_List] := expr;
ConstantQ[expr_, vars_List] :=
Module[{tests},
tests = FreeQ[expr, #, \[Infinity]]& /@ vars;
FreeQ[tests, False]];
(* Cancel terms on the LHS if they don't depend on items in vars *)
CancelCommonConstants[lhs_Times == 0, vars_List] :=
Module[{w = lhs,terms, constants},
terms = List @@lhs;
constants = Select[terms,ConstantQ[#, vars]&];
Simplify[lhs/(Times @@ constants)] == 0];
(* handle the case lhs \[Equal] rhs *)
CancelCommonConstants[lhs_Times == rhs_Times, vars_List] :=
CancelCommonConstants[Factor[lhs - rhs] == 0, vars]


(* ::Text:: *)
(*Example*)


(* ::Input:: *)
(*CancelCommonConstants[a b (c[x] + d[y])== a b e[x] f[y], {x, y}]*)


(* ::Input:: *)
(*CancelCommonConstants[-4 c^2 *)
(*\!\(\*SuperscriptBox[\(u\), *)
(*TagBox[*)
(*RowBox[{"(", *)
(*RowBox[{"1", ",", "1"}], ")"}],*)
(*Derivative],*)
(*MultilineFunction->None]\)[c t+x,-c t+x]==0, {x, t}]*)


(* ::Text:: *)
(*Examples for ConstantQ*)


(* ::Input:: *)
(*ConstantQ[#, {x, y}]& /@ {2, a,a b c, f[x], D[g[y], y],x y, 1 + x} *)


(* ::Subsection:: *)
(*Short cut for Solve*)


(* ::Text:: *)
(*The normal use of Solve generates some annoying brackets. *)


(* ::Input:: *)
(*Solve[y == m x + b, x] *)


(* ::Text:: *)
(*Sol is just a convenient shortcut. *)


(* ::Input::Initialization:: *)
Clear[Sol];
Sol[eqn_, var_] := Solve[eqn, var][[1,1]] ;


(* ::Text:: *)
(*Example*)


(* ::Input:: *)
(*{Sol[y == m x + b, x],Sub[y == m x + b, x]}*)


(* ::Text:: *)
(*Example   Suppose you are working in a domain (plasma physics in this case) where there are commonly used terms. You could set up definitions for these quantities at the beginning of your notebook*)


(* ::Input:: *)
(* (*plasma frequency*)*)
(*def[Subscript[\[Omega], pi]] = Subscript[\[Omega], pi]^2 == (4 \[Pi] Subscript[n, 0] e^2)/Subscript[m, i];*)
(*(*thermal velocity*) def[Subscript[v, thi]]= \!\( *)
(*\*SubsuperscriptBox[\(v\), \(thi\), \(2\)]\  == \ \(\[Kappa]\ *)
(*\*SubscriptBox[\(T\), \(i\)]/*)
(*\*SubscriptBox[\(m\), \(i\)]\)\);*)


(* ::Text:: *)
(*Then, in the course of some calculation, you arrive at the expression*)


(* ::Input:: *)
(*((4 (e^2)  Subscript[n, 0] \[Pi] )/(\[Omega]^2 Subscript[m, i]-k^2 \[Gamma] \[Kappa] Subscript[T, i])) *)


(* ::Text:: *)
(*This could be re-expressed in terms of defined quantities with*)


(* ::Input:: *)
(* (4 (e^2)  Subscript[n, 0] \[Pi] )/(\[Omega]^2 Subscript[m, i]-k^2 \[Gamma] \[Kappa] Subscript[T, i])  /.  Sol[def[Subscript[v, thi]], Subscript[T, i]] /. Sol[def[Subscript[\[Omega], pi]],Subscript[m, i]] // Simplify*)


(* ::Subsection:: *)
(*Tools for rearranging equations*)


(* ::Text:: *)
(*Sometimes, you just want to rearrange an equation for aesthetic purposes. This is a convenience tool for manipulating equations by moving terms from one side of an equation to the other.*)


(* ::Input::Initialization:: *)
Clear[MoveTermsToRHS, MoveTermsToLHS];
MoveTermsToRHS[lhs_ == rhs_, posListLeft_] :=
Module[{lhsNew, rhsNew, term},
term = lhs [[posListLeft]];
{lhsNew, rhsNew} = {lhs - term, rhs - term};
lhsNew == rhsNew] ;
MoveTermsToLHS[lhs_ == rhs_, posListRight_] :=
Module[{lhsNew, rhsNew, term},
term = rhs [[posListRight]];
{lhsNew, rhsNew} = {lhs - term, rhs - term};
lhsNew == rhsNew] 


(* ::Text:: *)
(*Examples*)


(* ::Input:: *)
(*(* Move the 2nd term on lhs *) MoveTermsToRHS[ a+ b + c== 0, 2]*)


(* ::Input:: *)
(*(* Move the 2nd and 3rd term on lhs *) MoveTermsToRHS[ a+ b + c== 0, {2,3}]*)


(* ::Input:: *)
(*(* Move the 3rd and 4nd terms on rhs *) MoveTermsToLHS[ a+ b + c==  d +e + f + g, {3,4}]*)


(* ::Subsection:: *)
(*Display of expressions involving partial derivatives*)


(* ::Text:: *)
(*To give credit, I think this very convenient functions was first developed by Vitaliy Kaurov of Wolfram.*)
(*See also http://mathematica.stackexchange.com/questions/15153/simplify-function-notation*)


(* ::Input::Initialization:: *)
Clear[pdConv, PhysicsForm];
pdConv[f_] := 
TraditionalForm[
f /. Derivative[inds__][g_][vars__] :> 
Apply[Defer[D[g[vars],##]]&,
Transpose[{{vars},{inds}}] /. 
{{var_, 0} :> Sequence[], {var_,1}:> {var}}]];

PhysicsForm[f_] := pdConv[f]


(* ::Text:: *)
(*Example*)


(* ::Input:: *)
(*{\[ScriptCapitalC][x]D[T[x,t], t] == Inactive[D][\[Kappa][x]D[T[x,t],x],x] + S[x,t],\[ScriptCapitalC][x]D[T[x,t], t] == Inactive[D][\[Kappa][x]D[T[x,t],x],x] + S[x,t] // PhysicsForm}*)


(* ::Section:: *)
(*Tools for visual display*)


(* ::Text:: *)
(*Stl is just a convenience for styling labels, annotations, etc.*)


(* ::Input::Initialization:: *)
Clear[Stl];
Stl[x_] := Style[x, Bold, FontFamily -> "Helvetica"]


(* ::Input:: *)
(*{"This is some text.",Stl["This is some text."],Stl@"This is some text.", "This is some text." // Stl}*)


(* ::Text:: *)
(*Some convenient function for formatting dates*)


(* ::Input::Initialization:: *)
QDt[x_] := DateString[x, {"Month","-","Day","-", "YearShort"}];
QDt2[x_] := DateString[x, {"MonthNameShort"," ","Day",", ", "Year"}];
QDt3[x_] := DateString[x, {"YearShort","-","Month","-","Day", " ","Hour24",":","Minute"}];
QN2[x_] := NumberForm[x, {5,2}];


(* ::Input:: *)
(*With[{now = Date[]},{now,QDt[now],QDt2[now],QDt3[now]}]*)


(* ::Text:: *)
(*Some convenient function for formatting numbers*)


(* ::Input::Initialization:: *)
NF[x_, {w_, d_}] :=If[Abs[x] < 0.00001, Round[x], NumberForm[x, {w,d}]];
NF1[x_] := NF[x, {5,1}];
NF2[x_] := NF[x, {5,2}];
NF3[x_] := NF[x, {6,3}];
NF4[x_] := NF[x, {7,4}];
NF5[x_] := NF[x, {8,5}];


(* ::Input:: *)
(*With[{pi = N[\[Pi], 10]},StringForm["`` `` ``  ``  ``  ``  ``",Round[pi],NF1[pi],NF2[pi],NF3[pi],NF4[pi],NF5[pi], pi]]*)


(* ::Text:: *)
(*LGrid is a convenience for displaying tabular data*)


(* ::Input::Initialization:: *)
Clear[LGrid];
LGrid[data_, lab_] := 
Labeled[Grid[data, Frame -> All,
BaseStyle->{FontFamily->"Helvetica", FontSize -> 10, FontWeight -> Bold}, Background -> RGBColor @@ {"LemonChiffon",{255,250,205}/255}[[2]]],
Stl[lab], Top]


(* ::Input:: *)
(*{LGrid[{{"A", "B", "C"}, {1,2,3}}, "Display 1"],*)
(*LGrid[Transpose@{{"A", "B", "C"}, {1,2,3}}, "Display 2"]}*)


(* ::Text:: *)
(*ParameterTable, ParameterTableV2, are conveniences for displaying tabular data*)


(* ::Input::Initialization:: *)
Clear[ParameterTable];
ParameterTable[pList_] :=
Module[{i, nList = {}, name, value, description, format, NF, SN},
SN[x_] := Style[x, 10,  Bold,FontFamily -> "Helvetica"];
NF[x_,f_] := 
Which[StringQ[x], x,
f[[2]] == 0, Round[x],
True, NumberForm[x,f]];
For[i = 1, i <= Length[pList], i++,
{name, value, format} = pList[[i]];
AppendTo[nList, 
{Item[SN[name]], Item[SN[NF[value, format]], Alignment -> Right]}]]; 
Grid[nList,
Dividers -> {{2 -> True}, Center}, Spacings -> {{1, {2}},1/3}]]


(* ::Input:: *)
(*Module[{S0 = 100, K = 100, H = 150,R = 0,r = 0.05, q = 0, \[Sigma] = 0.2, today,expireDate, results,info, params,rules, g},*)
(*today = DateList[][[1;;3]];*)
(*expireDate = DatePlus[today, 365];*)
(*results = FinancialDerivative[{"BarrierUpOut","European","Call"}, {"StrikePrice"-> K, "Expiration"->expireDate, "Barrier" -> H, "Rebate" -> R},  {"InterestRate"-> r, "Volatility" -> \[Sigma], "CurrentPrice"-> S0, "Dividend"->q},{"Value", "Greeks"}];*)
(*rules = results[[2;;-1]][[1]];*)
(*info = {{"Fair Value", results[[1]] , {5,2}},*)
(*{"Delta", "Delta" /. rules, {5,3}},*)
(*{"Gamma", "Gamma" /. rules, {5,4}},*)
(*{"Vega", "Vega" /. rules, {5,2}},{"Theta", "Theta" /. rules, {5,1}},*)
(*{"Rho", "Rho" /. rules, {5,1}}};*)
(*g[1] = ParameterTable[info];*)
(*params = {{"Spot", S0 , {5,2}}, {"K", K , {5,2}},*)
(*{"H", H , {5,2}}, {"Rebate", R , {5,2}}, {"r", r , {5,3}}, {"q", q , {5,3}}};*)
(*g[2] = ParameterTable[params];*)
(*Grid[{{g[1],g[2]}}]]*)


(* ::Input::Initialization:: *)
Clear[ParameterTableV2];
ParameterTableV2[pList_, lab_] :=
Module[{i, nList = {}, name, value, description, format, NF, SN},
SN[x_, size_] := Style[x, size,  Bold,FontFamily -> "Helvetica"];
NF[x_,f_] := 
Which[StringQ[x], x,
f[[2]] == 0, Round[x],
True, NumberForm[x,f]];
For[i = 1, i <= Length[pList], i++,
{name, value, format} = pList[[i]];
AppendTo[nList, 
{Item[SN[name,10]], Item[SN[NF[value, format],10], Alignment -> Right]}]];
PrependTo[nList, {SN[lab, 12], SpanFromLeft}]; 
Grid[nList,GRIDSEQ, FrameStyle->Directive[GrayLevel[0.7], Thin]]]


(* ::Input:: *)
(*Module[{S0 = 100, K = 100, H = 150,R = 0,r = 0.05, q = 0, \[Sigma] = 0.2, today,expireDate, results,info, params,rules, g},*)
(*today = DateList[][[1;;3]];*)
(*expireDate = DatePlus[today, 365];*)
(*results = FinancialDerivative[{"BarrierUpOut","European","Call"}, {"StrikePrice"-> K, "Expiration"->expireDate, "Barrier" -> H, "Rebate" -> R},  {"InterestRate"-> r, "Volatility" -> \[Sigma], "CurrentPrice"-> S0, "Dividend"->q},{"Value", "Greeks"}];*)
(*rules = results[[2;;-1]][[1]];*)
(*info = {{"Fair Value", results[[1]] , {5,2}},*)
(*{"Delta", "Delta" /. rules, {5,3}},*)
(*{"Gamma", "Gamma" /. rules, {5,4}},*)
(*{"Vega", "Vega" /. rules, {5,2}},{"Theta", "Theta" /. rules, {5,1}},*)
(*{"Rho", "Rho" /. rules, {5,1}}};*)
(*g[1] = ParameterTableV2[info, "Up and Out Barrier Option"];*)
(*params = {{"Spot", S0 , {5,2}}, {"K", K , {5,2}},*)
(*{"H", H , {5,2}}, {"Rebate", R , {5,2}}, {"r", r , {5,3}}, {"q", q , {5,3}}};*)
(*g[2] = ParameterTableV2[params, "Parameters"];*)
(*Grid[{{g[1],g[2]}}]]*)


(* ::Text:: *)
(*Other conveniences*)


(* ::Input::Initialization:: *)
BLACK = Directive[Thick,Black];
BLUE = Directive[Thick,Blue];
RED = Directive[Thick,Red];
GREEN = Directive[Thick,Green];
DARKGREEN = Directive[Darker[Green,0.6], Thick];
GRAY = GrayLevel[0.8];
DASHED = Directive[Dashed, Black];


(* ::Input:: *)
(*Graphics[{Circle[{0,0},1], {DARKGREEN, Circle[{0,0},0.5]}, {DASHED, Circle[{0,0},0.25]}, {RED,Text["circles",{0,0}]}}, ImageSize-> Small]*)


(* ::Text:: *)
(*Some nice markers for plot*)


(* ::Input::Initialization:: *)
Clear[OpenCircle];
OpenCircle[pt_] := 
Module[{blackDisk, circle}, 
blackDisk = {GrayLevel[1], Disk[pt, Offset[{3, 3}]]};
circle = Circle[pt, Offset[{3, 3}]];
{blackDisk, circle}]


(* ::Input::Initialization:: *)
Clear[OC];
OC[pt_, color_] :=
Module[{blackDisk, circle},
blackDisk={GrayLevel[1],Disk[pt,Offset[{3,3}]]};
circle={color,Circle[pt,Offset[{3,3}]]};
{blackDisk, circle}]


(* ::Input::Initialization:: *)
Clear[OTriangle];
OTriangle[pt_, color_] := 
Module[{backgroundTriangle, triangle, tDef},
tDef = 0.05{{1,-(1/Sqrt[3])},{0,Sqrt[3]-1/Sqrt[3]},{-1,-(1/Sqrt[3])}};
backgroundTriangle = {GrayLevel[1], Polygon[{pt, pt, pt}+ tDef]};
triangle = {EdgeForm[Black],color, Polygon[{pt, pt, pt} + tDef]};
{backgroundTriangle, triangle}];


(* ::Input:: *)
(*Module[{dat},*)
(*dat = ({#,#})& /@ Range[0, 10];*)
(*Grid[{{Graphics[OpenCircle[#]& /@dat, Axes -> Automatic,ImageSize -> Small],*)
(*Graphics[OC[#, Blue]& /@dat, Axes -> Automatic,ImageSize -> Small],*)
(*Graphics[OTriangle[#, Red]& /@dat, Axes -> Automatic,ImageSize -> Small]}}]]*)


(* ::Section::Closed:: *)
(*Polar form of complex number*)


(* ::Text:: *)
(*Sometimes you need a polar representation for a complex quantity*)


(* ::Input::Initialization:: *)
Clear[PolarForm];
PolarForm[z_] :=
Module[{x, y, term},
{x, y} = {Re[z], Im[z]};
term = Sqrt[x^2+y^2]Exp[I ArcTan[y/x]]]


(* ::Text:: *)
(*Example*)


(* ::Input:: *)
(*{PolarForm[(1/2-I/2)], PolarForm[x + I y] // Simplify[#, {x \[Element] Reals, y \[Element] Reals}]&}*)
