Message Boards Message Boards

Representing or encrypting text with Truchet tiling. Can we reverse or simplify the encryption?

Posted 7 months ago

Representing or encrypting text with Truchet tiling - the visualization

Attachments:
POSTED BY: Vitaliy Kaurov
2 Replies

enter image description here -- you have earned Featured Contributor Badge enter image description here Your exceptional post has been selected for our editorial column Staff Picks http://wolfr.am/StaffPicks and Your Profile is now distinguished by a Featured Contributor Badge and is displayed on the Featured Contributor Board. Thank you!

POSTED BY: EDITORIAL BOARD

Dear Vitaliy,

what a neat idea encrypting text with Truchet tiling! Or another expression for this might be "steganography". Here is my approach for reversing that process - it is a nice little task. I found that getting the correct partitions of the final image being the main problem: here I did not have any better idea than simply trying different partitions - not really clever, unfortunately. But it should work on other tilings of that kind as well.The full code:

ClearAll["Global`*"]
a = Characters[StringPadLeft[IntegerString[#, 2], 8, "0"]] & /@ ToCharacterCode["hello world"];
i = Binarize /@ Flatten[Table[{#, ColorNegate@#} &@ Rasterize[Graphics[Disk[#, 1/2] & /@ k, PlotRange -> {{0, 1}, {0, 1}}], ImageSize -> 
        100], {k, {{{0, 0}, {1, 1}}, {{0, 1}, {1, 0}}}}]];
rules = {{x_, y_} /; EvenQ[x + y] && a[[x, y]] == "0" :> 
    i[[4]], {x_, y_} /; EvenQ[x + y] && a[[x, y]] == "1" :> 
    i[[1]], {x_, y_} /; OddQ[x + y] && a[[x, y]] == "0" :> 
    i[[3]], {x_, y_} /; OddQ[x + y] && a[[x, y]] == "1" :> i[[2]]};
img = ImageAssemble[ReplacePart[a, rules]];

(*  above: Vitaliy's code -- below: my approach for decryption  *)

(* possible partitions in terms of numbers: *)
partitions = Flatten[Table[{px, py}, {py, 6, 12}, {px, 4, 10}], 1];
dims = ImageDimensions[img];
(* possible partitions in terms of pixels: *)
pixdims = dims/# & /@ partitions;
imgParts = Flatten[ImagePartition[img, #], 1] & /@ pixdims;
(* trying to find clusters of similar partitions: *)
clusters = FindClusters /@ imgParts;

(* helper function for similarity within a cluster: *)
similarity[scl_List] := Module[{prodimg, meanimg, prod, mean},
  prodimg = Times @@ scl;
  meanimg = Mean[scl];
  prod = Total@Flatten@ImageData[prodimg];
  mean = Total@Flatten@ImageData[meanimg];
  prod/mean
  ]

(* with the correct partition 4 clusters are expected: *)
indx = First /@ Position[Length /@ clusters, 4];
(* there might be more clusters of length 4,
    ... then the winning index is: *)
windx = indx[[First @ PositionLargest[Times @@@ Map[similarity, clusters[[indx]], {2}]]]];

(* now - knowing the correct partitions - doing the precedure backwards: *)

partedImg = ImagePartition[img, pixdims[[windx]]];
nf = FeatureNearest[MapIndexed[#1 -> First[#2] &, i]];
matrix0 = Map[First@*nf, partedImg, {2}];
FromCharacterCode@FromDigits[#, 2] & /@ MapIndexed[If[EvenQ@Total[#2], If[#1 == 4, 0, 1], If[#1 == 3, 0, 1]] &, matrix0, {2}]
POSTED BY: Henrik Schachner
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract