{NotebookFileName[],DateString[]}

Introduction

style[
t_
]:=
Style[t,Bold,FontSize->14,FontFamily->"Arial"]

f1[
x_
]:=
x+4(E^x)

g1[
y_
]:=
(y^5)+3y

ContourPlot[f1[x]==g1[y],{x,-10,10},{y,-2,10}
,PlotPoints->100
,Frame->{{True,False},{True,False}}
,FrameLabel->{{style["y"],None},{style["x"],None}}
]

D[f1[x]-g1[y[x]],x]

Solve[0==D[f1[x]-g1[y[x]],x],y'[x]]

y'[x]/.Solve[0==D[f1[x]-g1[y[x]],x],y'[x]][[1]]//TraditionalForm

Block[{xmin=-10,xmax=10,ymin=-2,ymax=10,p0={0,1},dx=2,p1,p2,m0},
m0=y'[x]/.Solve[0==D[f1[x]-g1[y[x]],x],y'[x]][[1]]//.{x->p0[[1]],y[0]->p0[[2]]};
p1=p0-{dx,m0 dx};
p2=p0+{dx,m0 dx};
ContourPlot[f1[x]==g1[y],{x,xmin,xmax},{y,ymin,ymax}
,PlotPoints->100
,Epilog->{
PointSize[Large],Thick,
Point[{p0}],Line[{p1,p2}]
}
]
]

With[{is=400,xmin=-10,xmax=10},
Manipulate[
Module[{ymin=-2,ymax=10,p0={0,1},xx,dx=2,p1,p2,y,yval,yy,m0},
yval=yy/.FindRoot[f1[x]==g1[yy],{yy,0.0}][[1]];
p0={x,yval};
m0=y'[xx]/.Solve[0==D[f1[xx]-g1[y[xx]],xx],y'[xx]][[1]]//.{xx->p0[[1]],y[p0[[1]]]->p0[[2]]};

p1=p0-{dx,m0 dx};
p2=p0+{dx,m0 dx};
Column[{
ContourPlot[f1[x]==g1[y],{x,xmin,xmax},{y,ymin,ymax}
,PlotPoints->100
,Epilog->{
PointSize[Large],Thick,
Point[{p0}],Line[{p1,p2}]
}
,ImageSize->is
],
"x = "<>ToString[x]<>", y = "<>ToString[yval]<>", y' = "<>ToString[m0]
}]
],
{{x,0},xmin,xmax,Appearance->"Labeled"}
]
]

Solve[f1[x]==g1[y],y, Reals]

g1[y]==f1[x]

Curves

ContourPlot[x==(y^2),{x,-1.2,1.2},{y,-1.2,1.2}
,PlotLabel->style["x=(y^2)"]
]

ContourPlot[(x^2)+(y^2)==1,{x,-1.2,1.2},{y,-1.2,1.2}
,PlotLabel->style["(x^2)+(y^2)=1"]
]

Expand[(x-y)((x^2)+(y^2)-1)]//TraditionalForm

ContourPlot[(x-y)((x^2)+(y^2)-1)==0,{x,-1.2,1.2},{y,-1.2,1.2}
,PlotPoints->100
,PlotLabel->style["(x^3)-(x^2)y+x (y^2)(y^3)+y-x=0"]
]

ContourPlot[(x^2)+(y^3)==1,{x,-10,10},{y,-10,10}
,PlotLabel->style["(x^2)+(y^3)=1"]
]

ContourPlot[(x^2)+(y^3)==y,{x,-10,10},{y,-10,10}
,PlotLabel->style["(x^2)+(y^3)=y"]
]

ContourPlot[(x^2)+(y^3)-y,{x,-1.5,1.5},{y,-1.5,1.5}
,ContourLabels->True
,Contours->20
]

ContourPlot[(x^2)+(y^3)-3(y^2),{x,-10,10},{y,-10,10}
,ContourLabels->True
,Contours->20
]

ContourPlot[(x^2)+(y^3)-3(y^2)==0,{x,-10,10},{y,-5,5}
,PlotLabel->style["(x^2)+(y^3)-3(y^2)=0"]
]

ContourPlot[(y^4)-4(x^2) y+(x^4)==1,{x,-2.5,2.5},{y,-1,2.2}
,PlotLabel->style["(x^4)+(y^4)-4(x^2)y=1"]
]

ContourPlot[Cos[x]+x Sin[y]==y,{x,-15,15},{y,-15,15}
,PlotLabel->style["cos(x)+x sin(y)=y"]
]

Explicit solution

Solve[(x^4)-(y^3)-y==1,y]//TraditionalForm

D[(((y^3)-y+1)^(1/4)),y]

D[(((y^3)-y+1)^(1/4)),y]/.y->0

The loop

eqloop1=((x^2)+(y^3)-3(y^2)==0)

ContourPlot[Evaluate@eqloop1,{x,-10,10},{y,-4,3}
,PlotLabel->style["(x^2)+(y^3)-3(y^2)=0"]
]

Solve[Evaluate@eqloop1,y,Reals]//TraditionalForm

Solve[Evaluate@eqloop1,y]//TraditionalForm

TraditionalForm[Solve[eqloop1,y][[1,1]]]

TraditionalForm/@Flatten[Solve[eqloop1,y][[2;;3]]]//Column

D[(x^2)+((y[x])^3)-3((y[x])^2),x]

2 x-6 y[x] y'[x]+3 ((y[x])^2) y'[x],y'[x]

Solve[0==2 x-6 y[x] y'[x]+3 ((y[x])^2) y'[x],y'[x]]//Simplify

eqloop1/.{x->0,y->3}

Solve[eqloop1/.x->2,y]

FindRoot[eqloop1/.y->2.7,{x,1.5}]

Block[{xmin=-10,xmax=10,ymin=-4,ymax=4,p0={1.47885,2.7},dx=2,p1,p2,m0},
m0=((2p0[[1]])/(6p0[[2]]-3((p0[[2]])^2)));
p1=p0-{dx,m0 dx};
p2=p0+{dx,m0 dx};
ContourPlot[Evaluate@eqloop1,{x,xmin,xmax},{y,ymin,ymax}
,PlotPoints->100
,PlotLabel->style["(x^2)+(y^3)-3(y^2)=0"]
,Epilog->{
PointSize[Large],Thick,
Point[{p0}],Line[{p1,p2}],
Text[style["(1.47885, 2.7)"],p0,{-1,-1}],
Text[style["y ="<>ToString[m0]<>"(x-1.47885) + 2.7"],p2,{1.1,-1}]
}
]
]

Suppose we are near the crossing, with x and y very small. The curve has slope m at the crossing. So then I should have y=m x near the crossing. Then I would expect to have

m=((2x)/(6y-3(y^2)))
≈((2x)/(6m x-3(m^2)(x^2)))
≈(2/(6m))
6(m^2)=2
m=±(Sqrt[(1/3)])

Block[{xmin=-10,xmax=10,ymin=-4,ymax=4,p0={0,0},dx=2,p1,p2,m0},
m0=(Sqrt[(1/3)]);
p1=p0-{dx,m0 dx};
p2=p0+{dx,m0 dx};
ContourPlot[Evaluate@eqloop1,{x,xmin,xmax},{y,ymin,ymax}
,PlotPoints->100
,PlotLabel->style["(x^2)+(y^3)-3(y^2)=0"]
,Epilog->{
PointSize[Large],Thick,
Point[{p0}],Line[{p1,p2}],
Text[style["(1.47885, 2.7)"],p0,{-1,-1}],
Text[style["y ="<>ToString[m0]<>"(x-1.47885) + 2.7"],p2,{1.1,-1}]
}
]
]

Inverse functions

D[Exp[y[x]],x]

D[y[Exp[x]],x]

D[f[fi[x]],x]

Solve[D[f[fi[x]],x]==1,fi'[x]]

Solve[D[fi[f[x]],x]==1,fi'[f[x]]]

Solve[D[fi[f[x]],x]==1,fi'[f[x]]]/.{x->fi[y]}

Solve[D[fi[f[x]],x]==1,fi'[f[x]]]//.{x->fi[y],f[fi[y_]]:>y}

Related rates problem: enzyme kinetics

We have an enzyme that catalyzes a metabolic reaction in bacterial cells. We also have a competitive inhibitor of this enzyme. (Note: Maud Menten got her MD from U of Toronto. But couldn’t find a job in Canada, so became a prof in the USA.) The reaction velocity is given by

v1[
s_,
kmv_:Km,
vmv_:Vm
]:=
(vmv/(kmv+s));
v1[s]

kmapp1[
i_,
kiv_:Ki,
kmv_:Km
]:=
kmv(1+(i/kiv));
kmapp1[i]

v1[s,kmapp1[i]]

For noncompetitive inhibition,

vmapp1[
i_,
kiv_:Ki,
vmv_:Vm
]:=
(vmv/(1+(i/kiv)));
vmapp1[i]

v1[s,Km,vmapp1[i]]

((Quantity[8,"Picomoles"])/(2×(10^8)Quantity[1,(("Micrometers")^3)]))

UnitConvert[((Quantity[0.8,"Picomoles"])/(2×(10^8)Quantity[1,(("Micrometers")^3)])),"MicroMolar"]

((Quantity[20,(("Micrograms")/("Milliliters"))])/(Quantity[839,(("Grams")/("Moles"))]))

UnitConvert[((Quantity[20,(("Micrograms")/("Milliliters"))])/(Quantity[839,(("Grams")/("Moles"))])),"MicroMolar"]//N

v1[s,Kmapp[t],1]

D[v1[s,Kmapp[t],1],t]

v1[s,kmapp1[p[t],Ki],1]

D[v1[s,kmapp1[p[t],Ki],1],t]

params1={p[t]->0,Km->4,s->4,Ki->24}

D[v1[s,kmapp1[p[t],Ki],1],t]/.params1

Reduce[(D[v1[s,kmapp1[p[t],Ki],1],t]/.params1)≤-0.02]

The unit circle

Solve[(x^2)+(y^2)==1,y]

fucm[
x_
]:=Evaluate[
y/.Solve[(x^2)+(y^2)==1,y][[1]]
];
{fucm[x],fucm'[x]}//TraditionalForm

fucp[
x_
]:=Evaluate[
y/.Solve[(x^2)+(y^2)==1,y][[2]]
];
{fucp[x], fucp'[x]}//TraditionalForm

Block[{xmin=-1.2,xmax=1.2,ymin=-1.2,ymax=1.2,p0={-0.6,0.8},dx=0.3,p1,p2,m0},
m0=-((p0[[1]])/(p0[[2]]));
p1=p0-{dx,m0 dx};
p2=p0+{dx,m0 dx};
ContourPlot[(x^2)+(y^2)==1,{x,xmin,xmax},{y,ymin,ymax}
,PlotPoints->100
,PlotLabel->style["(x^2)+(y^2) = 1"]
,Epilog->{
PointSize[Large],Thick,
Point[{p0}],Line[{p1,p2}],
Text[style["(-0.6, 0.8)"],p0,{-1,1}],
Text[style["y =0.75(x+0.6) + 0.8"],p2,{-1,-1}]
}
]
]

Inverse functions

D[ArcSin[x],x]

D[ArcCos[x],x]

Donnan equilibrium

cb1=n[s]-p-c[s];
de1=n[s]c[s]-(s^2)

eqs1={cb1,de1}

Thread[0==eqs1]

Solve[Thread[0==eqs1],{c[s],n[s]}]

sol1=Solve[Thread[0==eqs1],{c[s],n[s]}][[2]]

{c[s],n[s]}/.sol1/.{p->100,s->150}

{c[s],n[s]}/.sol1/.{p->100,s->150}//N

{c[s],n[s],c[s]+n[s]}/.sol1/.{p->100,s->150}//N

50{(Sqrt[10])-1,(Sqrt[10])+1}//N

D[eqs1,s]

sol2=Solve[Thread[0==D[eqs1,s]],{c'[s],n'[s]}][[1]]

{c'[s],n'[s]}/.sol2/.sol1/.{p->100,s->150}

{c'[s],n'[s]}/.sol2/.sol1/.{p->100,s->150}//N

{c[s],n[s]}/.sol1

D[{c[s],n[s]}/.sol1,s]

c[s]+n[s]/.sol1//Simplify