Cómo hacer que ImageTransformation produzca una versión anamórfica de la imagen

Question

Estoy experimentando con la función ImageTransformation para intentar hacer versiones anamórficas de imágenes, pero con un progreso limitado hasta el momento. Estoy buscando los resultados que obtienes al usar la imagen reflejada en un espejo cilíndrico, donde la imagen se curva alrededor del espejo central unos 270 grados. El wikipedia article tiene un par de buenos ejemplos (y también les pedí prestado el cráneo de Holbein).

i = Import["../Desktop/Holbein_Skull.jpg"]; 

i = ImageResize[i, 120] 
f[x_, y_] := {(2 (y - 0.3) Cos [1.5 x]), (2 (y - 0.3) Sin [1.5 x])}; 
ImageTransformation[i, f[#[[1]], #[[2]]] &, Padding -> White] 

Pero no puedo persuadir a Mathematica para mostrarme toda la imagen, o para doblar correctamente. La imagen anamórfica debe rodear el espejo colocado "dentro" del centro de la imagen, pero no será así. Encontré los valores adecuados para las constantes poniéndolo dentro de un manipular (y bajando la resolución :). Estoy usando la fórmula:

x1 = a(y + b) cos(kx) 
y1 = a(y + b) sin(kx) 

Cualquier ayuda que produce un mejor resultado sería muy apreciada!

Answer 1

En ImageTransformation[f,img], la función f es tal que un punto de {x,y} en la imagen resultante corresponde a f[{x,y}] en img. Dado que la imagen resultante es básicamente la transformación polar de img, f debería ser la transformación polar inversa, por lo que podría hacer algo como

anamorphic[img_, angle_: 270 Degree] := 
    Module[{dim = ImageDimensions[img], rInner = 1, rOuter}, 
    rOuter = rInner (1 + angle dim[[2]]/dim[[1]]); 
    ImageTransformation[img, 
     Function[{pt}, {ArcTan[-#2, #1] & @@ pt, Norm[pt]}], 
     DataRange -> {{-angle/2, angle/2}, {rInner, rOuter}}, 
     PlotRange -> {{-rOuter, rOuter}, {-rOuter, rOuter}}, 
     Padding -> White 
    ] 
    ] 

La imagen resultante se ve algo así como

anamorphic[ExampleData[{"TestImage", "Lena"}]] 

Tenga en cuenta que puede obtener un resultado similar con ParametricPlot y TextureCoordinateFunction, por ejemplo

anamorphic2[img_Image, angle_: 270 Degree] := 
    Module[{rInner = 1,rOuter}, 
    rOuter = rInner (1 + angle #2/#1 & @@ ImageDimensions[img]); 
    ParametricPlot[{r Sin[t], -r Cos[t]}, {t, -angle/2, angle/2}, 
     {r, rInner, rOuter}, 
     TextureCoordinateFunction -> ({#3, #4} &), 
     PlotStyle -> {Opacity[1], Texture[img]}, 
     Mesh -> None, Axes -> False, 
     BoundaryStyle -> None, 
     Frame -> False 
    ] 
    ] 
anamorphic2[ExampleData[{"TestImage", "Lena"}]] 

Editar

En respuesta a la pregunta de Mr.Wizard, si usted no tiene acceso a ImageTransformation o Texture se podía transformar los datos de imagen con la mano haciendo algo como

anamorph3[img_, angle_: 270 Degree, imgWidth_: 512] := 
Module[{data, f, matrix, dim, rOuter, rInner = 1.}, 
    dim = ImageDimensions[img]; 
    rOuter = rInner (1 + angle #2/#1 & @@ dim); 
    data = Table[ 
     ListInterpolation[#[[All, All, i]], 
     {{rOuter, rInner}, {-angle/2, angle/2}}], {i, 3}] &@ImageData[img]; 
    f[i_, j_] := If[Abs[j] <= angle/2 && rInner <= i <= rOuter, 
    Through[data[i, j]], {1., 1., 1.}]; 
    Image@Table[f[Sqrt[i^2 + j^2], ArcTan[i, -j]], 
    {i, -rOuter, rOuter, 2 rOuter/(imgWidth - 1)}, 
    {j, -rOuter, rOuter, 2 rOuter/(imgWidth - 1)}]] 

Tenga en cuenta que esto supone que img tiene tres canales. Si la imagen tiene menos canales o más, debe adaptar el código.