How can we transform text in order to achieve ROT13 and flip text using Wolfram Mathematica?
3 Answers
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 ɐɔıʇɐɯǝɥʇɐɯ"
-
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$– b3m2a1Commented Jun 7, 2017 at 18:27 -
1$\begingroup$ they are built-in eg
FromCharacterCode[607]
is upside down "f" .. $\endgroup$ Commented Jun 7, 2017 at 19:31 -
$\begingroup$ @george2079 I know. I was wondering if there was a built-in translation table, though. $\endgroup$– b3m2a1Commented Jun 7, 2017 at 19:32
-
$\begingroup$ @b3m2a1 I used text from text-filter.com. The rules are not simple, see at the Wikipedia Page $\endgroup$– rhermansCommented Jun 8, 2017 at 9:47
-
1$\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$ Commented Oct 4, 2017 at 17:26
keeping it simple the rotation can be done just like this:
Rotate[#, Pi] &@"Hello World"
Rotate[Text[Style[#, FontSize -> 30]], Pi] &@"Hello World"
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"}