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]See also vignere, caesar, uuencode, base64