Constants

(* Scale *)
s=7;

Form of Solution

(* Clear vars from this section *)
ClearAll[yp,Dyp,a,b,c];

(* Basic cubic polynomic form *)
yp=a+b*(x*t)^2+c*(x*t)^3;
Dyp=D[yp,x];
Print["(Subscript[y, p])=",yp];
Print["(Subscript[y, p])'=",Dyp];

Derivative Boundaries

ClearAll[a,b,c];

(* Left boundary *)
sol=Solve[(yp/.x->0)==y,a];
a=a/.First[sol];
Print["a=",a];

(* Right derivative boundary *)
sol=Solve[(Dyp/.x->1)==0,c];
c=c/.First[sol];
Print["c=",c];

(* Final solution *)
Print["(Subscript[y, p])=",yp];

Y-Boundary Values @ x=1 (the time dependent part)

(* The model piecewise function at the end of the transition *)
ypRightIdeal=Piecewise[{{0,y<y0-(1/(2s))},{1,y>y0+(1/(2s))}},s*(y-y0)+(1/2)];

(* Determine the actual function to use for right-hand boundaries *)
ypRight=s*(y-y0)+(1/2);
ypRight=y+(ypRight-y)*(3*t^2-2*t^3);

(* Output a plot of the boundary functions *)
Manipulate[
Plot[{ypRightIdeal,ypRight}/.{y0->yy0,t->tt},{y,0,1},PlotRange->{{-.1,1.1},{-.1,1.1}},AspectRatio->1,PlotLabel->"y(1) I/O Mapping",AxesLabel->{"Input y(1)", "Output y(1)"}],
{{yy0,(1/2)},(1/(2s)),1-(1/(2s))},
{{tt,1},0,1}
]

Define the X-Mapping

ClearAll[xp];

xp=(x)^2;
xp=x+(xp-x)*(3*t^2-2*t^3);

Manipulate[
Plot[{xp}/.{t->tt},{x,0,1},PlotRange->{{-.1,1.1},{-.1,1.1}},AspectRatio->1,PlotLabel->"(Subscript[x, p])((Subscript[x, t])) I/O Mapping",AxesLabel->{"Input (Subscript[x, t])", "Output (Subscript[x, p])((Subscript[x, t]))"}],
{{tt,1},0,1}
]

Find (Subscript[y, p]) Solution

ClearAll[b];

(* Apply the boundary function to solve for b *)
sol=Solve[(yp/.x->1)==ypRight,b];
b=b/.First[sol];
Print["b=",b];
Print["yp=",yp];

(* Output a plot of the final transformation function *)
Manipulate[
Show[
Table[Plot[yy,{x,0,1},PlotStyle->{Dashed}],{yy,0,1,(1/s)}],
Table[Plot[yp/.{y0->yy0,y->yy,t->tt},{x,0,1},PlotStyle->{Thick}],{yy,0,1,(1/s)}],
Table[ParametricPlot[{xx,y},{y,0,1},PlotStyle->{Dashed}],{xx,0,1,(1/s)}],
Table[ParametricPlot[{xp/.{x->xx,t->tt},y},{y,0,1},PlotStyle->{Thick}],{xx,0,1,(1/s)}],
PlotRange->{{0,1},{0,1}},AspectRatio->1],
{{yy0,(1/2)},(1/(2s)),1-(1/(2s)),(1/s)},
{{tt,1},0,1}
]

Invert (Subscript[y, p]) To Find (Subscript[y, t])

ClearAll[yt];

(* Solve the vertical equation for the texture positon *)
yt=Simplify[yt/.First[Solve[y==(yp/.y->yt),yt]]];
Print["(Subscript[y, t])=",yt];

Invert (Subscript[x, p]) To Find (Subscript[x, t])

ClearAll[xt];

(* Solve the horizontal equation for the texture position *)
xt=Simplify[xt/.First[Solve[x==(xp/.x->xt),xt]]];
Print["(Subscript[x, t])=",xt];