10
$\begingroup$

How can we transform text in order to achieve ROT13 and flip text using Wolfram Mathematica?

1. ROT13

enter image description here

2. Flip text

enter image description here

$\endgroup$
13
$\begingroup$

1. ROT13

rotN[str_String, n_Integer: 13] := Module[
  {
   rule = Flatten@Normal[
      AssociationThread[#, RotateRight[#, n]] & /@ {
        CharacterRange["a", "z"],
        CharacterRange["A", "Z"]
        }
      ]
   }
  , StringReplace[str, rule]
  ]

Example

rotN["Mathematica Stackexchange, Zngurzngvpn Fgnpxrkpunatr"]

"Zngurzngvpn Fgnpxrkpunatr, Mathematica Stackexchange"

2. Flip text

flipText[str_String] := Module[
  {
   rule = Normal@AssociationThread[
      Characters[
       "abcdefghijklmnopqrstuvwxyz.,ɐqɔpǝɟƃɥıɾʞlɯuodbɹsʇnʌʍxʎz˙'"],
      Characters[
       "ɐqɔpǝɟƃɥıɾʞlɯuodbɹsʇnʌʍxʎz˙'abcdefghijklmnopqrstuvwxyz.,"]
      ]
   },
  StringReplace[StringReverse[ToLowerCase[str]], rule]
  ]

Example

flipText["Mathematica Stackexchange"]

"ǝƃuɐɥɔxǝʞɔɐʇs ɐɔıʇɐɯǝɥʇɐɯ"

$\endgroup$
  • 1
    $\begingroup$ What alphabet / charset did you pull the flip text from, or is it from something external to Mathematica? (Just found that CharacterName["ʍ"] gives "LatinSmallLetterTurnedW") $\endgroup$ – b3m2a1 Jun 7 '17 at 18:27
  • 1
    $\begingroup$ they are built-in eg FromCharacterCode[607] is upside down "f" .. $\endgroup$ – george2079 Jun 7 '17 at 19:31
  • $\begingroup$ @george2079 I know. I was wondering if there was a built-in translation table, though. $\endgroup$ – b3m2a1 Jun 7 '17 at 19:32
  • $\begingroup$ @b3m2a1 I used text from text-filter.com. The rules are not simple, see at the Wikipedia Page $\endgroup$ – rhermans Jun 8 '17 at 9:47
  • $\begingroup$ Here's an alternative rot13 only (no flip) that works w/ lowercase alphanumeric hashes: rot13LowerAlphanumeric[ str_] := (CharacterRange["a", "z"]~ Join~ CharacterRange["0", "9"]) // Query[{Identity, RotateRight[#, 13]&}] // Apply[AssociationThread] // Normal // StringReplace[str, #]&; $\endgroup$ – alancalvitti Oct 4 '17 at 17:26
5
$\begingroup$

keeping it simple the rotation can be done just like this:

Rotate[#, Pi] &@"Hello World"
Rotate[Text[Style[#, FontSize -> 30]], Pi] &@"Hello World"

enter image description here

$\endgroup$
4
$\begingroup$

As a follow up on a comment I made, here's a way I tried to convert from an arbitrary character to a flipped equivalent (which can maybe be extended by someone more knowledgeable about the subject). Unfortunately it isn't so simple to do.

First pull in the base unicode table and write a function that tries to find the version with / without "TURNED", to use as the flipped variant:

If[! StringQ@$unicodeText,
  $unicodeText :=
   $unicodeText = 
    Import["ftp://ftp.unicode.org/Public/UNIDATA/UnicodeData.txt", 
     "Text"]
  ];
If[! AssociationQ@$unicodeTable,
  $unicodeTable :=
   $unicodeTable =
    First@# -> Rest@# & /@ 
      StringSplit[StringSplit[$unicodeText, "\n"], ";"] // 
     Association
  ];

unicodeNameSelect[name_] :=
  Select[$unicodeTable,
   StringMatchQ[First@#, name] &
   ];
unicodeLongFlip[charName_] :=

  With[{chunks = StringSplit[charName]},
   If[MemberQ[chunks, "TURNED"],
    unicodeNameSelect[StringRiffle@DeleteCases[chunks, "TURNED"]],
    Select[
     unicodeNameSelect[
      StringExpression @@ Riffle[chunks, " TURNED " | " "]],
     First@# =!= charName &
     ]
    ]
   ];
unicodeFlip[char : _String | _Integer] :=
 Replace[
  FromCharacterCode@FromDigits[#, 16] & /@ 
   Keys@unicodeLongFlip@CharacterName[char, "UnicodeName"], {
   {f_} :> f,
   {} -> None
   }]

Then we'll write something that tries to flip based on this (but with caching):

If[! AssociationQ@$flipEncoding, $flipEncoding = <||>];
flipEncode[char_String?(StringLength[#] == 1 &)] :=

  Lookup[$flipEncoding, char,
   $flipEncoding[char] =
    $flipEncoding[First@ToCharacterCode@char] =
     unicodeFlip[char]
   ];
flipEncode[char_Integer] :=
  Lookup[$flipEncoding, char,
   $flipEncoding[char] =
    $flipEncoding[FromCharacterCode@char] =
     unicodeFlip[char]
   ];
flipEncode[string : {(_String | _Integer) ..}] :=

  Replace[flipEncode[#], None :> "_"] & /@ string;
flipEncode[string_String] :=

 flipEncode[ToCharacterCode@string] // StringJoin

Then try to convert the alphabet:

In[181]:= flipEncode@StringJoin@{ToUpperCase@Alphabet[], Alphabet[]}

Out[181]= "Ɐ______Ɥ__ꞰꞀƜ______Ʇ_Ʌ____ɐ___ǝ_ᵷɥᴉ_ʞꞁɯ____ɹ_ʇ_ʌʍ_ʎ_"

And we'll see we have an atrocious success rate. That's largely because it seems most flips just use a different Latin character.

Plus there are some weird missing characters like turned capital k:

In[191]:= $unicodeTable["A7B0"]

Out[191]= {"LATIN CAPITAL LETTER TURNED K", "Lu", "0", "L", "", "", \
"", "", "N", "", "", "", "029E"}
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.