Binary Substrings

You are given a binary string $B and an integer $S. Write a script to split the binary string $B of size $S and then find the minimum number of flips required to make it all the same.

使用 string range 分組，再比對字串。使用好幾個 for 迴圈，所以效率會不太好。

#!/usr/bin/env tclsh
#
# You are given a binary string $B and an integer $S.
# Write a script to split the binary string $B of size $S and
# then find the minimum number of flips required to make it all
# the same.
#
# Input: $B = “101100101”, $S = 3
# Output: 1
#

if {$argc >= 2} {
    set orgstring [lindex $argv 0]
    set number [lindex $argv 1]

    if {![string is integer $number]} {
        puts "S should be a number."
        exit
    }
    
    if {$number <= 0} {
        puts "S should be > 0."
        exit
    }
} else {
    exit
}

set len [string length $orgstring]
if {[expr $len % $number] != 0} {
    puts "Invalid input."
    exit
}

set stringlist {}
set max [expr $len / $number]
for {set i 0} {$i < $max} {incr i} {
   set mystring [string range $orgstring [expr $number * $i] [expr $number * $i + ($number - 1)]]
   lappend stringlist $mystring
}

set results {}
for {set i 0} {$i < $max} {incr i} {
    set count 0
    for {set j 0} {$j < $max} {incr j} {
        if {$i != $j} {
            set first [lindex $stringlist $i]
            set second [lindex $stringlist $j]
            for {set k 0} {$k < $number} {incr k} {
                if {[string index $first $k] != [string index $second $k]} {
                    incr count
                }
            }
        }
    }

    lappend results $count
}

puts "Input: \$B = \“$orgstring\”, \$S = $number"
puts "Output: [::tcl::mathfunc::min {*}$results]"

Caesar Cipher

You are given string $S containing alphabets A..Z only and a number $N. Write a script to encrypt the given string $S using Caesar Cipher with left shift of size $N.

下面是 Caesar Cipher 的實作，使用 format 命令造出相對應的表格，並且使用 string toupper 轉換字串（用來確定輸入都是大寫字母）， 再使用 string map 來產出需要的結果。事實上我在轉換表格同時處理了大寫和小寫，只是題目只要求大寫，以及處理 left shift 的要求。

#!/usr/bin/env tclsh
#
# You are given string $S containing alphabets A..Z only and a number $N.
# Write a script to encrypt the given string $S using Caesar Cipher with 
# left shift of size $N.
#
# Input: $S = "THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG", $N = 3
# Output: "QEB NRFZH YOLTK CLU GRJMP LSBO QEB IXWV ALD"
#

set encryptMap {}
set decryptMap {}

proc createEncMap {shift} {
    set shift [expr 26 - $shift]
    for {set i 0} {$i < 26} {incr i} {
        append ::encryptMap [format "%c %c %c %c " \
            [expr {$i+65}] [expr {($i+$shift)%26+65}] \
            [expr {$i+97}] [expr {($i+$shift)%26+97}]]
    }
}

proc createDecMap {shift} {
    set shift [expr 26 - $shift]
    for {set i 0} {$i < 26} {incr i} {
        append ::decryptMap [format "%c %c %c %c " \
            [expr {$i+65}] [expr {($i-$shift)%26+65}] \
            [expr {$i+97}] [expr {($i-$shift)%26+97}]]
    }
}

if {$argc >= 2} {
    set orgstring [lindex $argv 0]
    set shift [lindex $argv 1]

    set orgstring [string toupper $orgstring]
    if {![string is integer $shift]} {
        puts "N should be a number."
        exit
    }
    set shift [expr abs($shift)%26]
} else {
    exit
}

createEncMap $shift
createDecMap $shift
set result [string map $encryptMap $orgstring]
puts "Plain: $orgstring"
puts "Output: $result"
puts "Check: [string map $decryptMap $result]"

Edit Distance

You are given two strings $S1 and $S2. Write a script to find out the minimum operations required to convert $S1 into $S2. The operations can be 'insert', 'remove' or 'replace' a character.

可以參考維基百科 Edit distance 的解釋。 這裡使用最簡單（但是執行效率不佳）的遞迴版本實作。

#!/usr/bin/env tclsh
#
# You are given two strings $S1 and $S2.
# Write a script to find out the minimum operations required to 
# convert $S1 into $S2. The operations can be 'insert', 'remove' 
# or 'replace' a character.
#
proc editdistance {str1 str2 m n} {
    if {$m == 0} {
        return $n
    }

    if {$n == 0} {
        return $m
    }

    set mvalue [tcl::mathop::- $m 1]
    set nvalue [tcl::mathop::- $n 1]

    # If last characters of two strings are same, nothing
    # much to do. Ignore and count for remaining strings.
    if {[string index $str1 $mvalue] == [string index $str2 $nvalue]} {
        return [editdistance $str1 $str2 $mvalue $nvalue]
    }

    # To insert, remove or replace operation
    return [tcl::mathop::+ 1 [tcl::mathfunc::min \
                   [editdistance $str1 $str2 $m $nvalue] \
                   [editdistance $str1 $str2 $mvalue $n] \
                   [editdistance $str1 $str2 $mvalue $nvalue]]]
}

if {$argc != 2} {
    exit
}

set s1 [lindex $argv 0]
set s2 [lindex $argv 1]

set r [editdistance $s1 $s2 [string length $s1] [string length $s2]]
puts "Output: $r"

如果觀察程式的運作，可以注意到，會一再重覆計算一些已經計算過的項目。 因此一個改進的方向是 dynamic programming，運用陣列記住已經算過的值，這樣就可以避免重複計算， 讓程式計算速度更快。所以建立一個 mxn 的陣列，並且記錄已經計算過的值，最後 dp(m,n) 就是答案。

#!/usr/bin/env tclsh
#
# You are given two strings $S1 and $S2.
# Write a script to find out the minimum operations required to 
# convert $S1 into $S2. The operations can be 'insert', 'remove' 
# or 'replace' a character.
#
proc editdistance {str1 str2 m n} {
    array set dp {}

    for {set i 0} {$i <= $m} {incr i} {
        for {set j 0} {$j <= $n} {incr j} {
            set ivalue [tcl::mathop::- $i 1]
            set jvalue [tcl::mathop::- $j 1]

            if {$i == 0} {
                set dp($i,$j) $j
            } elseif {$j == 0} {
                set dp($i,$j) $i
            } elseif {[string index $str1 $ivalue] == [string index $str2 $jvalue]} {
                set dp($i,$j) $dp($ivalue,$jvalue)
            } else {
                set dp($i,$j) [tcl::mathop::+ 1 [tcl::mathfunc::min \
                   $dp($i,$jvalue) $dp($ivalue,$j) $dp($ivalue,$jvalue)]]
            }
        }
    }

    return $dp($m,$n)
}

if {$argc != 2} {
    exit
}

set s1 [lindex $argv 0]
set s2 [lindex $argv 1]

set r [editdistance $s1 $s2 [string length $s1] [string length $s2]]
puts "Output: $r"

但是上面的解法如果是比較大的字串，就會需要很多空間儲存。觀察程式的計算， 可以發現當我們在計算第二列的時候，只需要第一列的結果（以此類推）。 所以我們可以使用一個 2xm 的陣列來計算。

#!/usr/bin/env tclsh
#
# You are given two strings $S1 and $S2.
# Write a script to find out the minimum operations required to 
# convert $S1 into $S2. The operations can be 'insert', 'remove' 
# or 'replace' a character.
#
proc editdistance {str1 str2 m n} {
    array set dp {}

    # Base condition when second string is empty
    for {set i 0} {$i <= $m} {incr i} {
        set dp(0,$i) $i
    }

    for {set i 1} {$i <= $n} {incr i} {
        for {set j 0} {$j <= $m} {incr j} {
            set ivalue [tcl::mathop::- $i 1]
            set jvalue [tcl::mathop::- $j 1]

            if {$j == 0} {
                set dp([tcl::mathop::% $i 2],$j) $i
            } elseif {[string index $str1 $jvalue] == [string index $str2 $ivalue]} {
                set dp([tcl::mathop::% $i 2],$j) $dp([tcl::mathop::% $ivalue 2],$jvalue)
            } else {
                set dp([tcl::mathop::% $i 2],$j) \
                    [tcl::mathop::+ 1 [tcl::mathfunc::min \
                        $dp([tcl::mathop::% $i 2],$jvalue) \
                        $dp([tcl::mathop::% $ivalue 2],$j) \
                        $dp([tcl::mathop::% $ivalue 2],$jvalue)]]
            }
        }
    }

    return $dp([tcl::mathop::% $n 2],$m)
}

if {$argc != 2} {
    exit
}

set s1 [lindex $argv 0]
set s2 [lindex $argv 1]

set r [editdistance $s1 $s2 [string length $s1] [string length $s2]]
puts "Output: $r"

Reverse Words

Write a script to reverse the order of words in the given string. The string may contain leading/trailing spaces. The string may have more than one space between words in the string. Print the result without leading/trailing spaces and there should be only one space between words.

#!/usr/bin/env tclsh
#
# Write a script to reverse the order of words in the given string. 
# The string may contain leading/trailing spaces. The string may
# have more than one space between words in the string. Print the
# result without leading/trailing spaces and there should be only
# one space between words.
#
if {$argc >= 1} {
    set orgstring [lindex $argv 0]
} elseif {$argc == 0} {
    puts "Please input a string"
    exit    
}

set theWords [regexp -all -inline {\S+} [string trim $orgstring]]
set result [lreverse $theWords]
puts "Output: [join $result " "]"

Palindrome Number

You are given a number $N. Write a script to figure out if the given number is Palindrome. Print 1 if true otherwise 0.

#!/usr/bin/tclsh
#
# Palindome Number:
# You are given a number $N. Write a script to figure out if 
# the given number is Palindrome. Print 1 if true otherwise 0.
#

if {$argc >= 1} {
    set number [lindex $argv 0]
} elseif {$argc == 0} {
    puts "Please input a number"
    exit
}

if {$number < 0} {
    puts "0"
} elseif {$number > 0} {
    set p $number
    set res 0
    while {$p > 0} {
        set res [expr $res * 10 + $p % 10]
        set p [expr $p / 10]
    }
    if {$number == $res} {
        puts "1"
    } else {
        puts "0"
    }
} else {
    puts "1"
}

也可以使用 string reverse 來解。

#!/usr/bin/tclsh
#
# Palindome Number:
# You are given a number $N. Write a script to figure out if
# the given number is Palindrome. Print 1 if true otherwise 0.
#

if {$argc >= 1} {
    set number [lindex $argv 0]
} elseif {$argc == 0} {
    puts "Please input a number"
    exit
}

if {$number < 0} {
    puts "0"
} elseif {$number > 0} {
    set res [string reverse $number]
    if {[string compare $number $res]==0} {
        puts "1"
    } else {
        puts "0"
    }
} else {
    puts "1"
}

Group Anagrams

You are given an array of strings. Write a script to group Anagrams together in any random order.

下面是我試著解的結果：

#!/usr/bin/tclsh
#
# You are given an array of strings @S. Write a script to 
# group Anagrams together in any random order.
#
if {$argc == 0} {
    puts "Please input a string"
    exit
}

set len [llength $argv]
set inlist $argv
set result [dict create]
for {set index 0} {$index < $len} {incr index} {
    set tmpstring [lindex $inlist $index]
    set tmplist [lsort [split $tmpstring ""]]
    set key [join $tmplist ""]
    if {[dict exists $result $key]} {
        set value [dict get $result $key]
        lappend value $tmpstring
        dict set result $key $value
    } else {
        set value [list]
        lappend value $tmpstring
        dict set result $key $value
    }
}

puts "Output:"
foreach {key value} $result {
    puts $value
}

也可以使用 array：

#!/usr/bin/tclsh
#
# You are given an array of strings @S. Write a script to 
# group Anagrams together in any random order.
#
if {$argc == 0} {
    puts "Please input a string"
    exit
}

set len [llength $argv]
set inlist $argv
array set result {}
for {set index 0} {$index < $len} {incr index} {
    set tmpstring [lindex $inlist $index]
    set tmplist [lsort [split $tmpstring ""]]
    set key [join $tmplist ""]

    # If arrayName is not the name of an array variable, 
    # or if the array contains no elements, 
    # then an empty list is returned. 
    set value [lindex [array get result $key] 1]
    lappend value $tmpstring
    array set result [list $key $value]
}

puts "Output:"
foreach {key value} [array get result] {
    puts $value
}

tkimg 1.4.12

在最近 tkimg 釋出了 1.4.12，可以在 tkImg 下載。

1.4.x 版本的可以在 8.3 或者是之後的使用，看下列的說明。

This file contains a collection of format handlers for the Tk photo image type, and a new image type, pixmaps. It can be used in combination with Tcl/Tk 8.3 or later but 8.6 or newer are highly recommended.

更新：
版本號有打錯， 重新更正過來。