rot13

Difference between version 28 and 29 - Previous - Next

This is an encryption algorithm commonly used for hiding information in [usenet] posts that is open to all but not immediately readable. An example is posting about film endings, or example answers.

The algorithm is actually a [caesar] cipher with a 13 place rotation. This number is special because in an alphabet with 26 letters, caesar 13 and caesar -13 use the same map, so the same call can be used for encoding and decoding. ([RS])

Using '''tr''' from [Example scripts everybody should have], a rot13 cipher can be written as easily as
======
 puts [tr A-Za-z N-ZA-Mn-za-m {Guvf vf n grfg}]
======
----
So, using rot13, "fnynq" is caesar salad. --[CLN]
----
[KBK] - Any monoalphabetic substitution cipher is, of course, trivial
to break.  [Solving cryptograms] written in such ciphers is well within
the compass of Tcl's capabilities.

----
[FW] gives a version that doesn't require any additional procedures, and rotates by any amount (specified by an optional second argument, defaults to 13 of course) -- And supports negative rotation amounts, now, too.
======
 proc rot {text {amount 13}} {
   if {abs($amount) > 25} {
     set amount [expr {$amount % 26}]
   }
 
   set alphabet "ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz"
   set res ""
   set length [string length $text]
   set find_command [expr {$amount > 0 ? "first" : "last"}]

   for {set index 0} {$index < $length} {incr index} {
     set char [string index $text $index]
     set pos [string $find_command $char $alphabet]
     append res [expr {$pos == -1 ? $char : [string index $alphabet [expr {$pos + $amount}]]}]
   }
   return $res
 }
======

----

2002-12-10 [JJM], The one-liner approach to this problem:

======
 regsub -all -- {([a-z])} [string tolower $text] {[format "%c" [expr {[scan "a" "%c"] + ((([scan \1 "%c"] - [scan "a" "%c"]) + 13) % 26)}]]} text; set text [subst $text]
======

Or for those of us with Tcl 8.4.x:

======
 set text [subst [regsub -all -- {([a-z])} [string tolower $text] {[format "%c" [expr {[scan "a" "%c"] + ((([scan \1 "%c"] - [scan "a" "%c"]) + 13) % 26)}]]}]]
======

This doesn't do upper/lower case, though.  Just making note.  -[FW]

2002-12-10 [JJM], Yes, but this one does:

======
 set text [subst [regsub -all -- {([a-zA-Z])} $text {[if {[string is lower "\1"] != "0"} then {set A "a"; set dummy ""} else {set A "A"; set dummy ""}][format "%c" [expr {[scan $A "%c"] + ((([scan "\1" "%c"] - [scan $A "%c"]) + 13) % 26)}]]}]]
======

Slightly more generic/entertaining:

======
 proc rotate { text {amount 13} } { 
  return [subst [regsub -all -- {([a-zA-Z])} $text {[if {[string is lower "\1"] != "0"} then {set A "a"; set dummy ""} else {set A "A"; set dummy ""}][format "%c" [expr {[scan $A "%c"] + ((([scan "\1" "%c"] - [scan $A "%c"]) + $amount) % 26)}]]}]] 
 }
======

Suggested by dkf and modified slightly by [JJM]:

======
 set text [subst [regsub -all {([a-zA-Z])} $text {[format "%c" [expr {[string is lower "\1"] ? (97 + (([scan "\1" "%c"] - 84) % 26)) : (65 + (([scan "\1" "%c"] - 52) % 26))}]]}]]
======

As short as possible so far:

======
 set text [subst [regsub -all {[a-zA-Z]} $text {[format %c [expr [set c [scan & %c]] \& 96 | (($c \& 31) + 12) % 26 + 1]]}]]
======

[DKF] - Though these [subst]-based solutions are vulnerable to attacks from malicious and unfortunate input strings, forcing a slightly longer solution:

======
 set text [subst [regsub -all {[a-zA-Z]} [regsub -all "\[\[$\\\\\]" $text {\\&}] {[format %c [expr [set c [scan & %c]]\&96|(($c\&31)+12)%26+1]]}]]
======

CJU - If high-performance rot13 is ever a mission requirement, you'd probably do best with
a simple string map. It's also not as long as some of the more clever methods shown already. With -nocase, the uppercase letters will be rotated, but their upper-caseness will not be preserved.

======
 set text [string map -nocase {a n b o c p d q e r f s g t h u i v j w k x l y m z n a o b p c q d r e s f t g u h v i w j x k y l z m} $line]
======
[CGM] - Here's a more long-winded version I just wrote which builds a map for `string map` once and then just applies it:

======
# create rot13 map on startup
binary scan A c A
binary scan a c a
set ins [lseq 0 25]
set outs [concat [lseq 13 25] [lseq 0 12]]
foreach i $ins o $outs {
    foreach b [list $A $a] {
        foreach c [list $i $o] {
            lappend rot13map [binary format c [expr {$b + $c}]]
        }
    }
}
proc rot13 text {
    string map $::rot13map $text
}
======

----

See also [vignere], [caesar], [uuencode], [base64] 

<<categories>> Package | Cryptography