Playfair cipher: Difference between revisions

→‎{{header|Tcl}}: fix method to build digrams
(→‎{{header|Tcl}}: fix method to build digrams)
Line 2,881:
 
=={{header|Tcl}}==
{{incorrect|Tcl|TREESTUMP -> TREXSTUMPZ, should be TREXESTUMP}}
(My guess is that lappend digraphs $c0 [expr {$c0 eq $c ? "X" : $c}] is simply discarding $c. [[User:Petelomax|Pete Lomax]] ([[User talk:Petelomax|talk]]) 05:54, 13 October 2018 (UTC))
 
{{works with|Tcl|8.6}}
Line 2,890 ⟶ 2,888:
variable grid lookup excluder
constructor {{keyword "PLAYFAIR EXAMPLE"} {exclude "J"}} {
# Tweaking according to exact operation mode
if {$exclude eq "J"} {
set excluder "J I"
} else {
set excluder [list $exclude ""]
}
}
# Clean up the keyword source
set keys [my Clean [append keyword "ABCDEFGHIJKLMNOPQRSTUVWXYZ"]]
# Generate the encoding grid
set grid [lrepeat 5 [lrepeat 5 ""]]
set idx -1
for {set i 0} {$i < 5} {incr i} {for {set j 0} {$j < 5} {} {
if {![info exist lookup([set c [lindex $keys [incr idx]]])]} {
lset grid $i $j $c
set lookup($c) [list $i $j]
incr j
}
}}
 
# Sanity check
# Clean up the keyword source
if {[array size lookup] != 25} {
set keys [my Clean [append keyword "ABCDEFGHIJKLMNOPQRSTUVWXYZ"]]
error "failed to build encoding table correctly"
 
}
# Generate the encoding grid
set grid [lrepeat 5 [lrepeat 5 ""]]
set idx -1
for {set i 0} {$i < 5} {incr i} {for {set j 0} {$j < 5} {} {
if {![info exist lookup([set c [lindex $keys [incr idx]]])]} {
lset grid $i $j $c
set lookup($c) [list $i $j]
incr j
}
}}
 
# Sanity check
if {[array size lookup] != 25} {
error "failed to build encoding table correctly"
}
}
 
# Worker to apply a consistent cleanup/split rule
method Clean {str} {
set str [string map $excluder [string toupper $str]]
split [regsub -all {[^A-Z]} $str ""] ""
}
 
# These public methods are implemented by a single non-public method
forward encode my Transform 1
forward decode my Transform -1
 
# The application of the Playfair cypher transform
method Transform {direction message} {
# Split message into true digraphs
foreach c [my Clean $message] {
if {![info exists lookup($c)]} continue
if {![info existexists c0]} {
set c0 $c
lappend digraphs $c0 [expr {$c0 eq $c ? "X" : $c}]
} else {
unset c0
} else if {$c0 ne $c} {
lappend digraphs $c0 $c
set c0 $c
unset c0
}
} else {
}
lappend digraphs $c0 "X"
if {[info exist c0]} {
set c0 $c
lappend digraphs $c0 "Z"
}
}
}
 
}
# Encode the digraphs
if {[info exists c0]} {
set result ""
foreach {a b} $ lappend digraphs {$c0 "Z"
lassign $lookup($a) ai aj }
lassign $lookup($b) bi bj
if {$ai == $bi} {
set aj [expr {($aj + $direction) % 5}]
set bj [expr {($bj + $direction) % 5}]
} elseif {$aj == $bj} {
set ai [expr {($ai + $direction) % 5}]
set bi [expr {($bi + $direction) % 5}]
} else {
set tmp $aj
set aj $bj
set bj $tmp
}
lappend result [lindex $grid $ai $aj][lindex $grid $bi $bj]
}
 
# Encode the digraphs
# Real use would be: return [join $result ""]
return $ set result ""
foreach {a b} $digraphs {
lassign $lookup($a) ai aj
lassign $lookup($b) bi bj
if {$ai == $bi} {
set aj [expr {($aj + $direction) % 5}]
set bj [expr {($bj + $direction) % 5}]
} elseif {$aj == $bj} {
set ai [expr {($ai + $direction) % 5}]
set bi [expr {($bi + $direction) % 5}]
} else {
set tmp $aj
set aj $bj
set bj $tmp
}
lappend result [lindex $grid $ai $aj][lindex $grid $bi $bj]
}
# Real use would be: return [join $result ""]
return $result
}
}</lang>
Line 2,977 ⟶ 2,980:
<pre>
Original: Hide the gold in...the TREESTUMP!!!
Encoded: BM OD ZB XD NA BE KU DM UI XM KZMO ZRUV FTIF
Decoded: HI DE TH EG OL DI NT HE TR EX STES UMTU PZMP
</pre>
 
Anonymous user