How do I nondimensionalize differential equations? [closed]

Question

What procedure may I use to non-dimensionalize and solve differential equations in Mathematica? I would like to be presented with different dimensionless Pi groups and have the ability to choose how the variables are normalized. At the end of the solution, I would like it to reversible to recover the dimensional solution. What have I tried? See my answer below.

Answer 1

Define some differential equations, possibly with initial conditions.

eqns@1={D[#@z==#2 Cos[#3*z],z],#@0==#2 #4}&@@@
Transpose@{{u,v},{a,b},{q,q},{1/2,3/4}}//Flatten
(*{u'[z]==-(a*q*Sin[q*z]),u[0]==a/2,
v'[z]==-(b*q*Sin[q*z]),v[0]==(3*b)/4}*)

Express the dimensions of your variables. If you read the code at the end, you'll notice you don't have to go all the way down to the basic dimensions of current, length, mass, temperature, time, and luminous intensity. There are some other supported dimensions that are automatically broken down further, such as force, stiffness, acceleration, and velocity.

reps@1={u|v|a|b->Length,z->Time,q->1/Time}; 

Obtain some candidate dimensionless pi groups.

reps@2=piGroups[eqns@1,"\[Alpha]",reps@1]
(*{α->a/v,β->b/v,γ->q*z,δ->u/v}*)

Rearrange these groups to your liking.

reps@3={U->\[Delta]/\[Alpha],V->1/\[Beta],Z->\[Gamma]}/.reps@2
(*{U->u/a,V->v/b,Z->q*z}*)

Nondimensionalize your variables. This will apply the relevant chain rules, causing constants to pop out of variables, functions, and their derivatives.

eqns@2=nonDimensionalize[eqns@1,{{u,U},{v,V}},{z,Z},reps@3,{}]
(*{a*q*U'[Z]==-(a*q*Sin[Z]),a*U[0]==a/2,
b*q*V'[Z]==-(b*q*Sin[Z]),b*V[0]==(3*b)/4}*)

Rearrange to make it clear that the constants divide out and that your equations are now dimensionless.

sols@2=Solve[eqns@2,{U'@Z,U@0,V'@Z,V@0}]
(*{{U'[Z]->-Sin[Z],U[0]->1/2,V'[Z]->-Sin[Z],V[0]->3/4}}*)

Solve the dimensionless differential equations.

eqns@3=ExpandAll@Thread[{U@Z,V@Z}==({U@Z,V@Z}/.
First@DSolve[Equal@@@Flatten@sols@2,{U,V},Z])]
(*{U[Z]==-1/2+Cos[Z],V[Z]==-1/4+Cos[Z]}*)

You can re-dimensionalize the solution by reversing the arguments to the nonDimensionalize call. Inverse constants will pop out of the dimensionless variables.

eqns@4=nonDimensionalize[eqns@3,{{U,u},{V,v}},{Z,z},reps@3,{}]
(*{u[z]/a==-1/2+Cos[q*z],v[z]/b==-1/4+Cos[q*z]}*)

Rearrange if you would like to isolate the dependent functions from the independent variables.

eqns@5=Simplify@Solve[eqns@4,{u@z,v@z}]
(*{{u[z]->-a/2+a*Cos[q*z],v[z]->-b/4+b*Cos[q*z]}}*)

Here is the relevant code.

getVariableDimensionPower[varDims_,requestedDim_]/;
 !FreeQ[varDims,requestedDim]:=
varDims/.{Power[requestedDim,exp:_:1]->exp,
Current|Length|Mass|Temperature|Time|LuminousIntensity->1};
getVariableDimensionPower[__]=0;

piGroups::fdmg="Failed to create dimensionless groups.";
piGroups[deqns:{__},startChar_String?(StringLength@#\[Equal]1&),
dimensionRules:{__Rule}]:= Module[{vars, 
dimensionReps,varDimensions,dimensionsInPlay,
piSpace,pigroups,comboPiGroups,ndsubs},
vars=Reverse@Union[Cases[deqns,symb_Symbol/;
 !NumericQ@symb&&Context@symb=!="System`",
Infinity,Heads->True]];
dimensionReps={Force->Mass Acceleration,
Stiffness->Force/Length,Acceleration->Length/Time^2,
Velocity->Length/Time,Sequence@@dimensionRules};
varDimensions=vars//.dimensionReps;
dimensionsInPlay=Variables@varDimensions;
piSpace=NullSpace@Transpose@Outer[
getVariableDimensionPower,varDimensions,
dimensionsInPlay];
If[!MatchQ[Times@@Power[varDimensions,#]&/@
piSpace,{(1)...}],Message[piGroups::fdmg]];
comboPiGroups=DeleteCases[
Times@@Power[vars,#]&/@piSpace,_Symbol];
ndsubs=Thread[Symbol@FromCharacterCode@#&/@(
First@ToCharacterCode@startChar-1+
Range@Length@comboPiGroups)->comboPiGroups];
ndsubs]

solveInc[dR:{(Rule|Equal)[_,_]..},l_List]:=Solve[Cases[
Equal@@@dR,e_/;!FreeQ[e,Alternatives@@l]],l];

fSol[xpr_,dR:{__Rule},l:_List:{}]:=xpr/.
solveInc[dR,If[l=={},{xpr},l]][[1]];

nonDimensionalize[xpr_,deps:{{_,_}..},
{t_,T_},reps:{__Rule},elims:_List:{}]:=
fSol[xpr/.Apply[Function[{x,X},x->Function@@
{t,fSol[x,reps]/.X->X@T@t}],deps,{1}]/.
T->Function@@{t,fSol[T,reps]},reps,
{t,Sequence@@deps[[All,1]],Sequence@@elims}]