Hilbertify an image

Question

I like the Hilbert Curve.

---

Your task for this challenge is to take an image (strictly a square image where all the sides are a power of two pixels wide) and unravel it line by line in a zig-zagging fashion and ravel it back up in a pseudo-Hilbert curve.

Unraveling

To unravel you will start with the pixel in the upper left hand corner and travel right until you arrive at the edge of the image. Once you have hit the edge of the image you will move down to the next row and begin traveling left until you hit the edge again. You will continue unraveling row by row switching the direction each time so you get one continuous curve. This should look like a well played game of snake

The result of unraveling should be an order of pixels that includes every pixel exactly once

Reraveling

Once you have an order for the pixels you will rearrange them on a new equally sized canvas following the path of a pseudo-Hilbert curve. For a 2**n sized square image you should use the nth iteration of the pseudo-hilbert curve. Each pixel will be placed in exactly one spot on the new canvas. You should reravel the image so that the point originally in the top left (the start of our snake curve) will remain there and point in the bottom right (the end of our snake curve) will be placed in the top right.

I/O

Your program or function should take in an image of specified constraints via standard methods and output another image via standard methods.

Scoring

This is code-golf program with the fewest bytes wins.

Examples

Input

Output

---

Input

Output

---

Input

Output

---

I also recommend testing on a blank white or solid color image to make sure you are not missing any pixels.

Feel free to include your own results in your answers!

Answer 1

Mathematica, 286 273 bytes

Image[Array[1,{l=Length@#,l}]~ReplacePart~Thread[#&@@@Split[#&@@@FoldList[Switch[#2,"-",#{1,I},"+",#/{1,I},"F",#+{ReIm@Last@#,0},_,#]&,{{1,1},I},Characters@Nest[StringReplace@{"L"->"+RF-LFL-FR+","R"->"-LF+RFR+FL-"},"L",Log2@l]]]->Join@@MapAt[Reverse,#,2;;;;2]]]&@*ImageData

Phew! Challenging but fun!

Explanation

ImageData

Convert an Image into an array of RGB values.

Array[1,{l=Length@#,l}]

Generate an l by l array with head 1, where the l is the length of the input (i.e. the width of the image).

This yields {{1[1, 1], 1[1, 2], ..., 1[1, L]}, {1[2, 1], ..., 1[2, L]}, ..., {1[L, 1], ..., 1[L, L]}} (l written in caps to reduce confusion)

StringReplace@{"L"->"+RF-LFL-FR+","R"->"-LF+RFR+FL-"}

A StringReplace function that replaces every "L" with "+RF-LFL-FR+" and "R" with "-LF+RFR+FL-"

Nest[ ... ,"L",Log2@l]

Apply the StringReplace function to the String "L", Log2[l] times.

Characters

Convert the resulting String into a List of characters.

Switch[#2,"-",#{1,I},"+",#/{1,I},"F",#+{ReIm@Last@#,0},_,#]&

An unnamed function that:

• If the second input is "-", multiply the second element of the first input by I.
• If the second input is "+", divide the second element of the first input by I.
• If the second input is "F", increase the first input by the ReIm (separates the real and imaginary part of the input) of the second input.

FoldList[ ... ,{{1,1},I}, ... ]

Starting with {{1,1},I}, cumulatively apply the above unnamed function, using each element of the List of characters as the second input. This code yields the outputs of all iterations.

#&@@@Split[#&@@@ ... ]

Get rid of the second elements of each List and delete duplicates. (The steps up to this point generate a List of coordinates of the Hilbert curve)

Join@@MapAt[Reverse,#,2;;;;2]

Unravel the input RGB array (reverses every other row and flattens).

Thread[ ... -> ... ]

Create Rule objects, such that the first element in the first input (the coordinates of the Hilbert curve) is paired with the the first element of the second input (the unraveled image), the second element with the second input, and so on.

... ~ReplacePart~ ...

Apply those replacement Rules to the Array from the second step.

Image

Convert to the array of RGB values into an Image.

Sample in/out

Input:

Output:

---

Input:

Output:

Inverse function (266 253 bytes)

Image[MapAt[Reverse,Extract[#,#&@@@Split[#&@@@FoldList[Switch[#2,"-",#{1,I},"+",#/{1,I},"F",#+{ReIm@Last@b,0},_,#]&,{{1,1},I},Characters@Nest[StringReplace@{"L"->"+RF-LFL-FR+","R"->"-LF+RFR+FL-"},"L",Log2[l=Length@#]]]]]~Partition~l,2;;;;2]]&@*ImageData

Answer 2

Octave 234 Bytes

I=imread(input(''));w=rows(I);X=[0,3;1,2];for k=2:log2(w);n=numel(X);X=[X',rot90(X',2)+3*n;X+n,X+2*n];end;for k = 1:3;I(2:2:end,:,k)=fliplr(I(2:2:end,:,k));end[~,S]=sort(X(:));I(S+(0:w^2:2*w^2))=permute(I,[2 1 3]);imwrite(I,input(''))

File names of input and output images should be provided form standard input. size of code without input/output is 194 bytes.
Explanation:

The base pattern of indices is:

X =
  0 3
  1 2

In each iteration 4 copies from result of the previous iteration made and some transformation applied to each copy then all blocks concatenated to form the current result.

X =[0,3;1,2];
for k = 2:log2(s)
    n=numel(X);
    X = [X',rot90(X',2)+3*n;X+n,X+2*n];
end

so we have:

block(1,1): X' 
block(1,2): rot90(X',2)+3*n 
block(2,1): X+n
block(2,2): X+2*n

0    1  | 14   15
3    2  | 13   12
--------|--------
4    7  |  8   11
5    6  |  9   10

Hilbert indices sorted and indexes of sorted elements returned:

[~,S]=sort(X(:));

Unraveling applied flipping all even rows:

for k = 1:3
    I(2:2:end,:,k) = fliplr(I(2:2:end,:,k));
end

Reraveling applied :
-S repeted for each channel
-permutation applied since in Octave data arranged column wise

I(S+(0:w^2:2*w^2))=permute(I,[2 1 3]);

Example images: