GCD Sum

You are given a positive integer $N. Write a script to sum GCD of all possible unique pairs between 1 and $N.

找出來最大公因數 (greatest common divisor) 的和。這裡使用輾轉相除法寫一個取得 gcd 值的函式。

#!/usr/bin/tclsh
#
# You are given a positive integer $N.
# Write a script to sum GCD of all possible unique pairs 
# between 1 and $N.
#

proc gcd {a b} {
    while {$b > 0} {
        set r [::tcl::mathop::% $a $b]
        set a $b
        set b $r
    }

    return $a
}

puts -nonewline "Input: "
flush stdout
gets stdin number
if {$number <= 1} {
    puts "Number requires > 1."
    exit
}

set sum 0
for {set i 1} {$i <= $number} {incr i} {
    for {set j [::tcl::mathop::+ $i 1]} {$j <= $number} {incr j} {
        set value [gcd $i $j]
        set sum [expr $sum + $value]
    }
} 
puts "Output: $sum"

也可以使用 tcllib math::numtheory 套件中的 gcd 函式取得最大公因數的值再加總起來。

#!/usr/bin/tclsh
#
# You are given a positive integer $N.
# Write a script to sum GCD of all possible unique pairs 
# between 1 and $N.
#

package require math::numtheory

puts -nonewline "Input: "
flush stdout
gets stdin number
if {$number <= 1} {
    puts "Number requires > 1."
    exit
}

set sum 0
for {set i 1} {$i <= $number} {incr i} {
    for {set j [::tcl::mathop::+ $i 1]} {$j <= $number} {incr j} {
        set value [math::numtheory::gcd $i $j]
        set sum [expr $sum + $value]
    }
} 
puts "Output: $sum"

Array of Product

You are given an array of positive integers @N. Write a script to return an array @M where $M[i] is the product of all elements of @N except the index $N[i].

#!/usr/bin/env tclsh
#
# You are given an array of positive integers @N.
# Write a script to return an array @M where $M[i] is the product 
# of all elements of @N except the index $N[i].
#

if {$argc <= 1} {
    puts "Please input a list."
    exit
}

set mylist $argv
set p [tcl::mathop::* {*}$mylist]
set result [list]
foreach element $mylist {lappend result [tcl::mathop::/ $p $element]}
puts $result

使用 lmap 來尋訪串列中的每一個元素來解題，可以改寫如下：

#!/usr/bin/env tclsh
#
# You are given an array of positive integers @N.
# Write a script to return an array @M where $M[i] is the product 
# of all elements of @N except the index $N[i].
#

if {$argc <= 1} {
    puts "Please input a list."
    exit
}

set mylist $argv
set p [tcl::mathop::* {*}$mylist]
set result [lmap element $mylist {tcl::mathop::/ $p $element}]
puts $result

Longest Consecutive Sequences

試著使用 Tcl 解 Longest Consecutive Sequences 問題。

#!/usr/bin/env tclsh
#
# You are given an unsorted array of integers.
# Write a script to find the longest consecutive sequence.
# Print 0 if none sequence found.
#

if {$argc <= 1} {
    puts "Please input a list."
    exit
}

# To compare two list's length
proc mysortproc {x y} {
    set len1 [llength $x]
    set len2 [llength $y]

    if {$len1 > $len2} {
        return -1
    } elseif {$len1 < $len2} {
        return 1
    } else {
        return 0
    }
}

set len [llength $argv]
set mylist [lsort -integer $argv]
set last [lindex $mylist 0]
set index 0
set results [list]
lset results $index [list $last]
for {set count 1} {$count < $len} {incr count} {
    set current [lindex $mylist $count]

    if {$current != [expr $last + 1]} {
       incr index
    }

    set indexlist [lindex $results $index]
    set indexlist [lappend indexlist $current]
    lset results $index $indexlist

    set last $current
}

# Sort our results by using sublists's length
set results [lsort -command mysortproc $results]
if {[llength [lindex $results 0]] > 1} {
    puts [lindex $results 0]
} else {
    puts 0
}

如果要使用 anonymous function，則可以改寫如下：

#!/usr/bin/env tclsh
#
# You are given an unsorted array of integers.
# Write a script to find the longest consecutive sequence.
# Print 0 if none sequence found.
#

if {$argc <= 1} {
    puts "Please input a list."
    exit
}

set len [llength $argv]
set mylist [lsort -integer $argv]
set last [lindex $mylist 0]
set index 0
set results [list]
lset results $index [list $last]
for {set count 1} {$count < $len} {incr count} {
    set current [lindex $mylist $count]

    if {$current != [expr $last + 1]} {
       incr index
    }

    set indexlist [lindex $results $index]
    set indexlist [lappend indexlist $current]
    lset results $index $indexlist

    set last $current
}

# Sort our results by using sublists's length
set results [lsort -command {apply {{x y} {
    set len1 [llength $x]
    set len2 [llength $y]

    if {$len1 > $len2} {
        return -1
    } elseif {$len1 < $len2} {
        return 1
    } else {
        return 0
    }
}}} $results]
if {[llength [lindex $results 0]] > 1} {
    puts [lindex $results 0]
} else {
    puts 0
}

也可以使用其它的方式，直接記錄 Longest Consecutive Sequences 的排序，如下所示：

#!/usr/bin/env tclsh
#
# You are given an unsorted array of integers.
# Write a script to find the longest consecutive sequence.
# Print 0 if none sequence found.
#

if {$argc <= 1} {
    puts "Please input a list."
    exit
}

set len [llength $argv]
set mylist [lsort -integer $argv]
set last [lindex $mylist 0]
set index 0
set curresult [list $last]
set maxresult [list $last]
set curval 1
set maxval 1
for {set count 1} {$count < $len} {incr count} {
    set current [lindex $mylist $count]

    if {$current == [expr $last + 1]} {
       lappend curresult $current
       incr curval

       if {$curval > $maxval} {
           set maxresult $curresult
           set maxval $curval
       }
    } else {
       set curval 1
       set curresult [list $current]
    }

    set last $current
}

if {$maxval > 1} {
    puts $maxresult
} else {
    puts "0"
}

Memfrob

使用者在命令列輸入一個字串，使用 Memfrob 編碼（字串的每個字元 XOR 42）以後輸出結果：

#!/usr/bin/env tclsh

proc memfrob {origString} {
    set length [string length $origString]
    set resultString ""
    for {set count 0} {$count < $length} {incr count} {
        set result [string index $origString $count]
        set result [binary format c [expr [scan $result %c] ^ 42]]
        append resultString $result
    }

    return $resultString
}

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

puts "String: $countString"
puts "Result: [memfrob $countString]"

Web Services for Tcl (tclws) 3.0.0

Web Services for Tcl (tclws) 最近釋出了 3.0.0 版，加入了 -hostProtocol 選項，同時將 Tcl 版本的要求從 8.4 升到 8.6。

在最近一個月 Web Services for Tcl 有比較多的小更新版本，從 2.7.0, 2.7.1 到 3.0.0 這幾個版本的更新。