How to achieve faster performance on plotting complex valued functions
Here's a quick idea of what I had in mind in my comment:
plot = ParametricPlot[r {Cos[t], Sin[t]}, {r, 0, 1}, {t, 0, 2 Pi},
PlotPoints -> {35, 201}, Mesh -> 11, Axes -> False, Frame -> False,
ColorFunction -> (Hue[#4] &)];
{gc} = Cases[plot, _GraphicsComplex];
xf[c_] := ReIm@((# - c)/(Conjugate[c] # - 1) &)@(#.{1, I}) &;
Manipulate[
Graphics@MapAt[xf[c.{1, I}], gc, 1],
{{c, {0, 0}}, {-1, -1}, {1, 1},
TrackingFunction -> ((c = #/Max[1, 1.1 Norm[#]]) &)}
]
It could be made even quicker with a more efficient initial image plot
.
Update:
Here's a more efficient gc
, using single polygons for each block:
ClearAll[polarRect];
polarRect[{r1_, r2_}, {t1_, t2_}, n_: 60] := Polygon@Join[
Table[
r2 {Cos[t], Sin[t]}, {t, Subdivide[t1, t2, 2 + Round[n*r2/(t2 - t1)]]}],
Rest@Table[r {Cos[t2], Sin[t2]}, {r, r2, r1, (r1 - r2)/Round[n/4]}],
{r1 {Cos[t2], Sin[t2]}},
If[r1 == 0, {},
Table[
r1 {Cos[t], Sin[t]}, {t, Subdivide[t2, t1, 2 + Round[n*r2/(t2 - t1)]]}]],
Rest@Table[r {Cos[t1], Sin[t1]}, {r, r1, r2, (r2 - r1)/Round[n/4]}]
];
With[{dr = 1/10, dt = Pi/4},
base = {EdgeForm[Directive[Thin, Black]],
Table[
{Hue[t/2/Pi],
N@polarRect[{r, r + dr}, {t, t + dt}]},
{r, 0, 1 - dr, dr}, {t, 0, 2 Pi - dt, dt}
]
}
];
coords = DeleteDuplicates@
Developer`ToPackedArray[
Flatten[Cases[base, Polygon[p_] :> p, Infinity], 1], Real];
nf = Nearest[coords -> "Index"];
gc = GraphicsComplex[coords, base /. Polygon -> Polygon@*Flatten@*nf];
image=Import["https://i.stack.imgur.com/GZcUT.jpg"]
c=1/2;
ImageForwardTransformation[image,
Through[{Re,Im}[((#[[1]]+I #[[2]])-c)/(Conjugate[c]*(#[[1]]+I #[[2]])-1)]]&,
Background->1,DataRange->{{-1,1},{-1,1}},PlotRange->{{-1,1},{-1,1}}]//AbsoluteTiming
Compile transformation function
expr=ReIm[((#[[1]]+I #[[2]])-c)/(Conjugate[c]*(#[[1]]+I #[[2]])-1)]&[{x,y}]//
ComplexExpand//Simplify
cf=With[{expr=expr},Compile[{{v,_Real,1}},Block[{x=v[[1]],y=v[[2]]},expr]]];
ImageForwardTransformation[image,cf,
Background->1,DataRange->{{-1,1},{-1,1}},PlotRange->{{-1,1},{-1,1}}]//AbsoluteTiming
Using ParametricPlot
with Texture
ParametricPlot[expr,{x,-1,1},{y,-1,1},
PlotStyle->{Opacity[1],Texture[image]},ImageSize->ImageDimensions[image],
BoundaryStyle->None,Axes->False,Frame->False,PlotRange->1]//AbsoluteTiming