Swap Nibbles

You are given a positive integer $N.

Write a script to swap the two nibbles of the binary representation of the given number and print the decimal number of the new binary representation.

To keep the task simple, we only allow integer less than or equal to 255.

#!/usr/bin/env tclsh
#
# You are given a positive integer $N.
# Write a script to swap the two nibbles of the binary representation of the 
# given number and print the decimal number of the new binary representation.
# To keep the task simple, we only allow integer less than or equal to 255.
#
if {$argc >= 1} {
    set number [lindex $argv 0]
} elseif {$argc == 0} {
    puts "Please input a number"
    exit    
}

if {$number <=0 || $number > 255} {
    puts "Number requires 0 < N <= 255"
    exit
}

set number1 [format %04b [expr $number & 0xf]]
set number2 [format %04b [expr ($number >> 4) & 0xf]]
puts [format "%d" 0b$number1$number2]

Tcl / Tk 8.7a5 RELEASED

Tcl / Tk 8.7a5 RELEASED

這是 Tcl/Tk 8.7 第三個公開的 alpha 測試版，下面是更新的內容。

This release is a development release, and should only be considered for deployment use after considerable testing.

New Commands and Features
* [TIP 542,575] Support for switchable Full Unicode support
* [TIP 597] [string is unicode] and better utf-8/utf-16/cesu-8 encodings
* [TIP 588] Unicode for (X11) keysyms
* [TIP 595] Unicode-aware/case-sensitive Loadable Library handling
* [TIP 325] System tray and system notification
* [TIP 529] Add metadata dictionary property to tk photo image
* [TIP 584] Better introspection for ttk
* [TIP 481] Tcl_GetStringFromObj() with size_t length parameter
* [TIP 587] Default utf-8 for [source]
* [TIP 565] Gracefully ignore non-existent tags in canvas raise/lower
* [TIP 563] Scrollwheel on Horizontal Scrollbar Scrolls Without Shift
* [TIP 591] Rotate ttk::notebook window with mousewheel on tab
* [TIP 474] Uniform mouse wheel events
* [TIP 551] Permit underscore in numerical literals in source code
* [TIP 574] Add a 'tag delete' command to the ttk::treeview widget
* [TIP 564] Specify ttk font sizes in points on X11
* [TIP 586] C String Parsing Support for [binary scan]
* [TIP 598] Tcl_WinConvertError
* [TIP 580] Tk_GetDoublePixelsFromObj and 5 more
* [TIP 585] INDEX_TEMP_TABLE flag for Tcl_GetIndexFromObj()
* [TIP 582] Comments in Expressions
* [TIP 557] C++ support for Tcl
* 'end' argument to [$canvas insert]
* Implement 64-bit seek on Zip channels
* bind substitution %S
* Drop TCL_WINDOW_EVENTS from Tcl's [update idletasks]
* [chan truncate] for reflected channels
* tzdata updated to Olson's tzdata2021a

Deprecations/Migration aids
* [TIP 592] End support: Windows XP, Server 2003, Vista, Server 2008
* [TIP 590] Recommend lowercase Package Names
* [TIP 538] Externalize libtommath
* [TIP 543] Eliminate `TCL_INTERP_DESTROYED` flag value
* [TIP 559] Eliminate public routine `Tcl_FreeResult`
* [TIP 562] Deprecate channel types 1-4
* [TIP 578] Death to TCL_DBGX
* [TIP 569] Eliminate Comments That Serve Lint
* Restore Tcl [update] when Tk is destroyed
* Solve XKeycodeToKeysym deprecation
*** POTENTIAL INCOMPATIBILITY -- Tk 8.7 now requires X11R6 ***

Fix crashes or hangs in ...
* [string index abcd 0-0x10000000000000000]
* [set l {}; lpop l]
* tests binary-79.[12]
* [fconfigure stdout] on Windows
* Tcl_Unload()
* SVG memory overflow
* [tkwait]
* Aqua: dead keys as menu accelerator

Bug/Regression Repair
* [chan postevent] revised to be event-driven, as name implies
*** POTENTIAL INCOMPATIBILITY ***
* [string trim*] on astral characters
* deletion trace on imported ensemble
* Aqua: double click bind with changing focus
* Follow Mac OSX Key-repeat setting
* update scrollbars on treeview 

Binary Palindrome

You are given a positive integer $N.

Write a script to find out if the binary representation of the given integer is Palindrome. Print 1 if it is otherwise 0.

#!/usr/bin/env tclsh

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 result [format %b $number]
    set res [string reverse $result]
    if {[string compare $result $res]==0} {
        puts "1"
    } else {
        puts "0"
    }
}

Missing Row

You are given text file with rows numbered 1-15 in random order but there is a catch one row in missing in the file.

11, Line Eleven
1, Line one
9, Line Nine
13, Line Thirteen
2, Line two
6, Line Six
8, Line Eight
10, Line Ten
7, Line Seven
4, Line Four
14, Line Fourteen
3, Line three
15, Line Fifteen
5, Line Five

Write a script to find the missing row number.

這裡使用 tclcsv 讀取檔案內容，跟著再排序以後印出結果。

package require tclcsv

proc mysortproc {x y} {
    set len1 [lindex $x 0]
    set len2 [lindex $y 0]

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

set infile [open "input.dat" r]
set filedata [tclcsv::csv_read $infile]
close $infile
set tmpList [lsort -command mysortproc $filedata]
set len [llength $tmpList]
for {set i 0} {$i < $len} {incr i} {
     set mylist [lindex $tmpList $i]
     if {[lindex $mylist 0] != [expr $i + 1]} {
         puts "Mising row number: [expr $i + 1]"
         break
     }
}

Sum of Squares

You are given a number $N >= 10. Write a script to find out if the given number $N is such that sum of squares of all digits is a perfect square. Print 1 if it is otherwise 0.

#!/usr/bin/tclsh
# You are given a number $N >= 10.
# Write a script to find out if the given number $N is such 
# that sum of squares of all digits is a perfect square.
# Print 1 if it is otherwise 0.

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

set total 0
set mylist [split $number ""]
foreach substring $mylist {
    set result [expr $substring * $substring]
    set total [expr $total + $result]
}

set root [expr int(sqrt($total))]
set check [expr $root * $root]
if {$total==$check} {
    puts "Output: 1"
} else {
    puts "Output: 0"
}