Преобразование изображения наизнанку

Question

После изучения превосходного ответа Хайке на мой предыдущий вопрос об анаморфных превращениях я в конечном итоге захотел увидеть изображение полностью вывернутым наизнанку.

Идея состоит в том, что вместо того, чтобы просто растягивать изображение с помощью анаморфного преобразования, как будто вы вытягиваете края бумаги, вы можете фактически перевернуть бумагу "наизнанку". Внутренние «пиксели» будут вытянуты к краям (сильно искажены / растянуты), а внешние пиксели будут сдавлены внутрь к центру (сильно сжаты).

Я не могу это проиллюстрировать, но другой способ попытаться описать это на этом рисунке:

Итак, чем больше красных пикселей, тем больше они преобразуются в края (и наоборот).

Я попробовал FindGeometricTransform, но, похоже, он ни к чему не привел.

Это было нелегко для Google, и я еще не нашел никаких подсказок в Mathematica о том, что такое разрушительное преобразование возможно. Это что-то вроде 2.5D перепроецирования.

Что ты думаешь? Возможно ли это?

Редактировать

Итак, благодаря вашим великолепным ответам я теперь могу правильно проиллюстрировать свой вопрос:

Вот знаменитый Аном Асиль Леонардо, результат того, что бедная Лиза подверглась трансформации изнутри наружу ():

и вот Пражский Орлой:

Практическое использование для этого будет скоро, э-э, скоро ...

Спасибо!

Answer 1

Возможно что-то вроде этого:

f[x_, y_] := {x, y} (1/Norm@{x, y} - 1);
GraphicsGrid[{{ 
       p = Rasterize[Graphics[ {Black, Disk[{0, 0}, 5],
                                Red,   Disk[{0, 0}, 3],
                                Blue,  Disk[{0, 0}, 2]}]],
       ImageTransformation[p, f[#[[1]], #[[2]]] &, 
                           DataRange -> {{-1, 1}, {-1, 1}}]}}, 
       Frame -> All]

Редактировать

Используя f Хейке, функция является биективной, и ее собственная обратная функция:

f[x_, y_] := {x, y} (1/Norm[{x, y}, Infinity] - 1);
g[x_]:=ImageTransformation[x, f[#[[1]], #[[2]]] &,DataRange ->{{-1, 1}, {-1, 1}}]

GraphicsGrid[{{i, g@i, g@g@i}}, Frame -> All]

Редактировать

Окружение:

f[x_, y_, t_] := {x, y} ((1/Norm[{x, y}, Infinity] - 1 ) t + (1 - t));

Answer 2

Если встроенные функции преобразования не учитывают это за один проход, вы, вероятно, могли бы получить то, что хотели, преобразовав изображение в полярные координаты, а затем инвертировав данные радиуса. Надеюсь, Хайке скоро придет, чтобы починить тебя. ; -)

---

Вопреки моему здравому суждению, вот мой грубый и неприятный код в качестве примера. Нулевая избыточная выборка, плохо продуманные, магические числа и вообще бесполезные. Но Велисарий попросил об этом, и вот оно!

Начиная с img = это изображение:

dat = ImageData[img];

atan2[0., 0.] := 0
atan2[a_, b_] := ArcTan[a, b]

coords = Array[
   Round@{# Cos[#2], # Sin[#2]} + 144 &[(144 - Norm[{#, #2}]), 
       atan2[#2, #]] &[N@#, N@#2] &, {289, 289}, -144];

Image@Apply[dat[[##]] &, coords, {2}]

Получает это пиксельное злодеяние: