5
$\begingroup$

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.

$\endgroup$

closed as unclear what you're asking by corey979, m_goldberg, Johu, dr.blochwave, rhermans Sep 27 '18 at 16:20

Please clarify your specific problem or add additional details to highlight exactly what you need. As it's currently written, it’s hard to tell exactly what you're asking. See the How to Ask page for help clarifying this question. If this question can be reworded to fit the rules in the help center, please edit the question.

  • 1
    $\begingroup$ Use this answer about mimicking Maple's dchange function. $\endgroup$ – march Sep 26 '18 at 3:38
  • $\begingroup$ You need to explain better what is the question and the required answer. I see that you have answered your own question, which is perfectly fine, but if the only point of this post is to share your solution people need to be able to find and understand the question that motivates it. $\endgroup$ – rhermans Sep 27 '18 at 16:20
6
$\begingroup$

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}]
$\endgroup$

Not the answer you're looking for? Browse other questions tagged or ask your own question.