2021-05-24

Higher Integer Set Bits

You are given a positive integer $N. Write a script to find the next higher integer having the same number of 1 bits in binary representation as $N.

#!/usr/bin/tclsh

proc nexthigher {x} {
    set next 0

    if {$x} {
        set rightOne [expr $x & -$x]
        set nextHigherOneBit [expr $x + $rightOne]
        set rightOnesPattern [expr $x ^ $nextHigherOneBit]
        set rightOnesPattern [expr $rightOnesPattern / $rightOne]
        set rightOnesPattern [expr $rightOnesPattern >> 2]
        set next [expr $nextHigherOneBit | $rightOnesPattern]
    }

    return $next
}

if {$argc >= 1} {
    set number [lindex $argv 0]
} elseif {$argc == 0} {
    exit    
}

if {$number < 0} {
    exit
}

puts "Output: [nexthigher $number]"

2021-04-26

Transpose File

You are given a text file. Write a script to transpose the contents of the given file.

Input File

name,age,sex
Mohammad,45,m
Joe,20,m
Julie,35,f
Cristina,10,f

Output:

name,Mohammad,Joe,Julie,Cristina
age,45,20,35,10
sex,m,m,f,f

處理程式:

package require struct::matrix

set infile [open "input.dat" r]

# Read data
set filedata [list]
while { [gets $infile line] >= 0 } {
    set mylist [split $line ","]
    lappend filedata $mylist
}
close $infile

set maxrow [llength $filedata]
set maxcol [llength [lindex $filedata 0]]

::struct::matrix data
for {set i 0} {$i < $maxcol} {incr i} {
    data add column
}

for {set i 0} {$i < $maxrow} {incr i} {
    data add row [lindex $filedata $i]
}

data transpose

set rows [data rows]
for {set row 0} {$row < $rows} {incr row} {
    set mylist [data get row $row]
    set result [join $mylist ","]
    puts $result
}
data destroy

或者使用 tcllib csv 配合 struct::matrix 來處理:

package require csv
package require struct::matrix

::struct::matrix data
set infile [open "input.dat" r]
csv::read2matrix $infile data  , auto
close $infile

data transpose

set rows [data rows]
for {set row 0} {$row < $rows} {incr row} {
    set mylist [data get row $row]
    set result [join $mylist ","]
    puts $result
}
data destroy

或者使用 tclcsv 讀出資料,再配合 struct::matrix 來處理:

package require tclcsv
package require struct::matrix

set infile [open "input.dat" r]
set filedata [tclcsv::csv_read $infile]
close $infile

set maxrow [llength $filedata]
set maxcol [llength [lindex $filedata 0]]

::struct::matrix data
for {set i 0} {$i < $maxcol} {incr i} {
    data add column
}

for {set i 0} {$i < $maxrow} {incr i} {
    data add row [lindex $filedata $i]
}

data transpose

set rows [data rows]
for {set row 0} {$row < $rows} {incr row} {
    set mylist [data get row $row]
    set result [join $mylist ","]
    puts $result
}
data destroy

也可以使用 SQLite3 In-Memory Database 來處理,首先將資料儲存到表格中,然後依序選出以後再印出來:

package require tdbc::sqlite3
tdbc::sqlite3::connection create db ":memory:"

set statement [db prepare {create table mydata (name TEXT, age integer, sex char(1))}]
$statement execute
$statement close

set infile [open "input.dat" r]

# Read first line, field name
gets $infile line
set titles [split $line ","]

# Read data
while { [gets $infile line] >= 0 } {
    set mylist [split $line ","]
    set name [lindex $mylist 0]
    set age [lindex $mylist 1]
    set sex [lindex $mylist 2]
    
    set statement [db prepare {insert into mydata values (:name, :age, :sex)}]
    $statement execute
    $statement close
}
close $infile

# Output
for {set i 0} {$i < [llength $titles]} {incr i} {
    set field [lindex $titles $i]
    puts -nonewline "$field"
    set statement [db prepare "select $field from mydata"]
    
    $statement foreach row {
        puts -nonewline ",[dict get $row $field]"
    }

    $statement close
    puts ""
}
db close

Valid Phone Numbers

You are given a text file. Write a script to display all valid phone numbers in the given text file.

Acceptable Phone Number Formats
+nn  nnnnnnnnnn
(nn) nnnnnnnnnn
nnnn nnnnnnnnnn

Input File

0044 1148820341
 +44 1148820341
  44-11-4882-0341
(44) 1148820341
  00 1148820341

Output

0044 1148820341
 +44 1148820341
(44) 1148820341

處理的程式:

set infile [open "input.dat" r]

while { [gets $infile line] >= 0 } {
    set data [string trim $line]
    if {[regexp {(^\+\d{2}|^\(\d{2}\)|^\d{4})\s\d{10}$} $data]} {
        puts $line
    }
}
close $infile

2021-04-19

Chowla Numbers

Write a script to generate first 20 Chowla Numbers, named after, Sarvadaman D. S. Chowla, a London born Indian American mathematician. It is defined as:
C(n) = (sum of divisors of n) - 1 - n

proc chowla {n} {
    set sum 0
    for {set i 2} {[expr $i * $i] <= $n} {incr i} {
        if {[expr $n % $i]==0} {
            set sum [expr $sum + $i]
            set j [expr int($n / $i)]
            if {$j != $i} {
                set sum [expr $sum + $j]
            }
        }
    }

    return $sum
}

for {set i 1} {$i <= 20} {incr i} {
    puts "chowla($i) = [chowla $i]"
}

2021-04-14

Bell Numbers

Write a script to display top 10 Bell Numbers. Please refer to wikipedia page for more informations.

proc bellNumber {n} {
    array set bell {}

    set bell(0,0) 1
    for {set i 1} {$i <= $n} {incr i} {
        set decri [expr $i -1]
        set bell($i,0) $bell($decri,$decri)

        for {set j 1} {$j <= $i} {incr j} {
            set decrj [expr $j -1]
            set bell($i,$j) [expr $bell($decri,$decrj) + $bell($i,$decrj)]
        }
    }

    return $bell($n,0)
}

for {set i 1} {$i <= 10} {incr i} {
    puts "n=$i, Bell Number=[bellNumber $i]"
}

2021-04-11

ooxml 1.6

 ooxml 是一個讀寫 Office Open XML "XLSX" (since Excel 2007) 的套件,使用 TEA 架構。需要 Tcl >= 8.6.7,  tclvfs::zip >= 1.4.2 與 tdom >= 0.9.0,所以在使用前要先安裝 tclvfs::zip 與 tdom,Tcl 的版本需要 8.6.7 或者是更新的版本。

今天我嘗試製作 ooxml RPM  檔案,RPM spec 可以看這裡。 

2021-04-01

Decimal String

You are given numerator and denominator i.e. $N and $D.

Write a script to convert the fraction into decimal string. If the fractional part is recurring then put it in parenthesis.

#!/usr/bin/env tclsh

proc fractionToDecimal {numerator denominator} {
    set n $numerator
    set d $denominator

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

    if {($n > 0) ^ ($d > 0)} {
        set solution "-"
    } else {
        set solution ""        
    }

    set n [expr abs($n)]
    set d [expr abs($d)]

    # integral part
    append solution [expr $n / $d]
    set n [expr $n % $d]
    if {$n==0} {
        return $solution
    }

    append solution "."

    # fractional part
    set mymap [dict create $n [string length $solution]]
    while {$n != 0} {
        set n [expr $n * 10]
        set r [expr $n / $d]
        append solution $r
        set n [expr $n % $d]
        if {[dict exists $mymap $n]==1} {
            set index [dict get $mymap $n]
            set result [string range $solution 0 [expr $index-1]]
            append result "("
            append result [string range $solution $index end]
            append result ")"
            set solution $result
            break
        } else {
            dict set mymap $n [string length $solution]
        }
    }

    return $solution
}

if {$argc != 2} {
    exit
}

set n [lindex $argv 0]
set d [lindex $argv 1]
puts [fractionToDecimal $n $d]

2021-03-30

Maximum Gap

You are given an array of integers @N.

Write a script to display the maximum difference between two successive elements once the array is sorted.

If the array contains only 1 element then display 0.

#!/usr/bin/env tclsh
#
# You are given an array of integers @N.
# Write a script to display the maximum difference between 
# two successive elements once the array is sorted.
# If the array contains only 1 element then display 0.
#

if {$argc == 0} {
    exit
} elseif {$argc == 1} {
    puts "0"
    exit
}

set len [llength $argv]
set mylist [lsort -integer $argv]
set max 0
for {set count 1} {$count < $len} {incr count} {
    set prev [lindex $mylist [expr $count - 1]]
    set curr [lindex $mylist $count]

    set result [expr $curr - $prev]
    if {$result > $max} {
        set max $result
    }
}

puts $max

2021-03-23

The Name Game

You are given a $name.

Write a script to display the lyrics to the Shirley Ellis song The Name Game. Please checkout the wiki page for more information.

#!/usr/bin/env tclsh
#
# You are given a $name.
# Write a script to display the lyrics to
# the Shirley Ellis song The Name Game.
#
if {$argc >= 1} {
    set xname [lindex $argv 0]
} elseif {$argc == 0} {
    puts "Please input a string"
    exit    
}

if {[string length $xname] <= 1} {
    puts "Please give a longer string"
    exit
}

set yname [string range $xname 1 end]
puts "$xname, $xname, bo-b$yname"
puts "Bonana-fanna fo-f$yname"
puts "Fee fi mo-m$yname"
puts "$xname!"

2021-03-18

FUSC Sequence

Write a script to generate first 50 members of FUSC Sequence.

The sequence defined as below:
fusc(0) = 0
fusc(1) = 1
for n > 1:
when n is even: fusc(n) = fusc(n / 2),
when n is odd: fusc(n) = fusc((n-1)/2) + fusc((n+1)/2)

#!/usr/bin/env tclsh
#
# Write a script to generate first 50 members of FUSC Sequence.
# fusc(0) = 0
# fusc(1) = 1
# for n > 1:
# when n is even: fusc(n) = fusc(n / 2),
# when n is odd: fusc(n) = fusc((n-1)/2) + fusc((n+1)/2)
#
proc fusc {n} {
    if {$n == 0}  {
        return 0
    } elseif {$n == 1} {
        return 1
    } elseif {$n > 1} {
        set checkn [tcl::mathop::% $n 2]
        if {$checkn==0} {
            return [fusc [tcl::mathop::/ $n 2]]
        } else {
            set subn [tcl::mathop::- $n 1]
            set addn [tcl::mathop::+ $n 1]
            return [tcl::mathop::+ [fusc [tcl::mathop::/ $subn 2]] [fusc [tcl::mathop::/ $addn 2]]]
        }
    } else {
        return -code error "Invalid input"
    }
}

set results [list]
for {set i 0} {$i < 50} {incr i} {
    lappend results [fusc $i]
}
set r [join $results ", "]
puts $r