2022-05-11
2022-05-04
2022-04-17
openSUSE, Tcl and SQLite
最近的 openSUSE build service 在 devel:languages:tcl/tcl 對 Tcl 套件做了修改,移掉了 Tcl source code 中關於 SQLite3 套件的部份,同時建立與 sqlite3-tcl 套件的依賴性(而這個套件來自於 sqlite3)。
我覺得這似乎有彼此依賴的問題(不確定),不過這樣我就必須把 SQLite3 套件也做一個連結到我 openSUSE build service 的計畫中,才能夠解決其它套件的相依性問題(因為現在 Tcl 會對 sqlite3-tcl 套件產生依賴)。
2022-03-24
Missing Permutation
只是做一點程式練習。
You are given possible permutations of the string 'PERL'.
PELR, PREL, PERL, PRLE, PLER, PLRE, EPRL, EPLR, ERPL,
ERLP, ELPR, ELRP, RPEL, RPLE, REPL, RELP, RLPE, RLEP,
LPER, LPRE, LEPR, LRPE, LREP
Write a script to find any permutations missing from the list.
#!/usr/bin/env tclsh
proc permutations { list size } {
if { $size == 0 } {
return [list [list]]
}
set retval {}
for { set i 0 } { $i < [llength $list] } { incr i } {
set firstElement [lindex $list $i]
set remainingElements [lreplace $list $i $i]
foreach subset [permutations $remainingElements [expr { $size - 1 }]] {
lappend retval [linsert $subset 0 $firstElement]
}
}
return $retval
}
set compare [list PELR PREL PERL PRLE PLER PLRE EPRL EPLR ERPL \
ERLP ELPR ELRP RPEL RPLE REPL RELP RLPE RLEP \
LPER LPRE LEPR LRPE LREP]
set result [list]
foreach r [permutations [list P E R L] 4] {
set nr [join $r ""]
lappend result $nr
}
set result [lsort $result]
set compare [lsort $compare]
set len [llength $result]
for {set i 0} {$i < $len} {incr i} {
set ri [lindex $result $i]
set ci [lindex $compare $i]
if {[string compare $ri $ci] != 0} {
puts $ri
break
}
}
2022-03-05
PgTcl 2.8.0
這是一個 bug fix 的版本,不過釋出的原始碼包裡 configure.in 裡的版本還是 2.7.7,如果使用者會在意這件事的話,可以自己修正這件事(在 configure.in 檔案將 2.7.7 改為 2.8.0,然後執行 autoconf, ./configure 與 make)。
2022-02-24
ticklecharts: Tcl wrapper for Apache ECharts
我有點驚訝,Apache ECharts (JavaScript Visualization library) 有人嘗試撰寫 Tcl wrapper。目前看起來才剛起步,不過有一些命令可以使用了,我想有人嘗試是一件好事。
2021-10-14
tcl-lmdb v0.4.2
檔案放置網頁
tcl-lmdb - Tcl interface to the Lightning Memory-Mapped DatabaseAbout
This is the Lightning Memory-Mapped Database (LMDB) extension for Tcl using the Tcl Extension Architecture (TEA).LMDB is a Btree-based database management library with an API similar to BerkeleyDB. The library is thread-aware and supports concurrent read/write access from multiple processes and threads. The DB structure is multi-versioned, and data pages use a copy-on-write strategy, which also provides resistance to corruption and eliminates the need for any recovery procedures. The database is exposed in a memory map, requiring no page cache layer of its own. This extension provides an easy to use interface for accessing LMDB database files from Tcl.
Main Change
- Update LMDB source code.
- generic/tclmdb.c: Improve code to create list
這一樣也是一個 checkpoint 版本,只是建立 tag 追蹤從上一個版本以來的變化。tcl-lmdb 有一個小變動,更改了幾個 Tcl_NewListObj 的部份,設定 List 的數目,其它的沒有變動。
tcl-opencv v0.11
第一次 tag 的時候發現 ::cv::readOpticalFlow and ::cv::writeOpticalFlow 可以在 OpenCV 3.x 使用,但是需要 contrib module optflow(OpenCV 4.0 才移進 video module),所以沒有編譯 optflow module 的 3.x 版會編譯失敗。可是這是別人提供的 patch,我似乎最好不要直接 mark 掉,所以我移掉 0.11 的 tag,更新文件提醒有這件事以後,才又再 re-tag 一次。
因為這個問題,我在 OpenSUSE build service 上的 OpenSUSE LEAP 15.2 需要將 science/openSUSE_Leap_15.2 repository 放在第一位(這樣就會使用 OpenCV 4.5.x,而不是 3.3.x)才行,所以我也更新了 RPM spec,直接設定 OpenCV 版本 >= 4.5。
如果不是自己編譯,那麼 Linux distribution 的套件怎麼選擇 contrib module 是個問題,很明顯的 Linux distribution 間會有不同的選法,這對於我來說是個大問題(簡單的說就是 Debian/Ubuntu 可以編譯過的,OpenSUSE 不一定可以,反之亦然)。最簡單的做法就是進入 main module 才考慮加入套件的 command。
2021-10-04
PLplot, Tcl and openSUSE
我不知道在其它平台的情況怎麼樣,但是有趣的地方在於,如果我自己從 source code build 以後安裝,問題反而小一點。
首先是使用 zypper 安裝:
sudo zypper in plplot-common plplot-tcltk-devel plplot-driver-cairo plplot-driver-svg
從安裝檔案可以發現,pkgIndex.tcl 在 /usr/share/plplot5.15.0 (ps. 版本號要看安裝的版本而定),所以要讓 Tcl shell 可以正確找到的話,需要在 .tclshrc 或者是執行 tclsh 後加入下面的命令:
lappend auto_path /usr/share/plplot5.15.0
可能是因為設定的關係,pkgIndex.tcl 的目錄搜尋設定是錯的,下面是修正的設定:
if {![string compare -length $bLen $buildDir $pkgIndexDir]} then {
set searchdirs [list "/home/abuild/rpmbuild/BUILD/plplot-5.15.0/build/bindings/tcl"]
} else {
set searchdirs [list "/usr/lib64"]
}
if {![string compare -length $bLen $buildDir $pkgIndexDir]} then {
set searchdirs [list "/home/abuild/rpmbuild/BUILD/plplot-5.15.0/build/drivers"]
} else {
set searchdirs [list "/usr/lib64/plplot5.15.0/drivers"]
}
if {![string compare -length $bLen $buildDir $pkgIndexDir]} then {
set searchdirs [list "/home/abuild/rpmbuild/BUILD/plplot-5.15.0/build/drivers"]
} else {
set searchdirs [list "/usr/lib64/plplot5.15.0/drivers"]
}
如果使用 tclsh ,還需要:
package require Pltcl
但是設定完上列的項目,在 pltcl 執行 plinit 初始化仍然會有下面的錯誤訊息:
plInitDispatchTable: Could not open drivers directory, aborting operation
或者是 tclsh 沒有選擇列表的情況下有下列的訊息:
Enter device number or keyword:
這表示 PLplot 找不到 driver 的位置(但是其實你已經安裝了)。 一個解法是設定 PLPLOT_DRV_DIR,例如下面的設定:
export PLPLOT_DRV_DIR=/usr/lib64/plplot5.15.0/drivers
2021-09-24
OpenCV ANN_MLP
下面是用來測試 tcl-opencv 新加入的 ANN_MLP command,寫了一個簡單的測試程式來測試:
package require opencv
proc showImage {image columns name} {
set bigImage [cv::Mat::Mat 0 0 $::cv::CV_32F]
for {set i 0} {$i < [$image rows]} {incr i} {
set row [$image rowRange $i [expr $i + 1]]
set rs [$row reshape 0 $columns]
$bigImage push_back $rs
$row close
$rs close
}
set bigImageT [$bigImage transpose]
::cv::imshow $name $bigImageT
$bigImageT close
$bigImage close
}
#
# Download file from:
# https://github.com/opencv/opencv/tree/master/samples/data/data01.xml
#
set filename "data01.xml"
set f [::cv::FileStorage]
$f open $filename $::cv::FileStorage::READ
set dataMat [$f readMat datamat]
set labelsMat [$f readMat labelsmat]
$f close
set data [$dataMat convert $::cv::CV_32F]
set labels [$labelsMat convert $::cv::CV_32F]
puts "Loading training data... read [$data rows] rows of data"
$dataMat close
$labelsMat close
set data_train [cv::Mat::Mat 0 0 $::cv::CV_32F]
set data_test [cv::Mat::Mat 0 0 $::cv::CV_32F]
set labels_train [cv::Mat::Mat 0 0 $::cv::CV_32F]
set labels_test [cv::Mat::Mat 0 0 $::cv::CV_32F]
for {set i 0} {$i < [$data rows]} {incr i} {
if {[expr $i%2]==0} {
$data_train push_back [$data rowRange $i [expr $i + 1]]
$labels_train push_back [$labels rowRange $i [expr $i + 1]]
} else {
$data_test push_back [$data rowRange $i [expr $i + 1]]
$labels_test push_back [$labels rowRange $i [expr $i + 1]]
}
}
$data close
$labels close
# MLP does not support categorical variables by explicitly.
# Update our labels
set res_train [::cv::Mat::zeros [$labels_train rows] 2 $::cv::CV_32F]
for {set i 0} {$i < [$labels_train rows]} {incr i} {
set value [expr int([$labels_train at [list $i 0] 0])]
$res_train at [list $i $value] 0 1
}
set res_test [::cv::Mat::zeros [$labels_test rows] 2 $::cv::CV_32F]
for {set i 0} {$i < [$labels_test rows]} {incr i} {
set value [expr int([$labels_test at [list $i 0] 0])]
$res_test at [list $i $value] 0 1
}
showImage $data_train 28 "train data"
showImage $data_test 28 "test data"
cv::waitKey 0
set term [::cv::TermCriteria [expr $::cv::EPS | $::cv::COUNT] 500 0.0001]
set layers [::cv::Mat::Mat 1 3 $::cv::CV_32S]
$layers at [list 0 0] 0 [$data_train cols]
$layers at [list 0 1] 0 10
$layers at [list 0 2] 0 [$res_train cols]
set mlp [::cv::ml::ANN_MLP]
$mlp setLayerSizes $layers
$mlp setActivationFunction $::cv::ml::MLP_SIGMOID_SYM 0 0
$mlp setTrainMethod $::cv::ml::MLP_BACKPROP 0.0001 0
$mlp setTermCriteria $term
puts "Training..."
set trainData [::cv::ml::TrainData $data_train $::cv::ml::ROW_SAMPLE $res_train]
$mlp train $trainData
$trainData close
$data_train close
$labels_train close
$res_train close
$term close
$layers close
$mlp save "mlp.xml"
$mlp close
set mlp [::cv::ml::ANN_MLP::load "mlp.xml"]
#
# MLP will give us a vector of "probabilities" at the prediction stage
#
puts "Predicting..."
set response [$mlp predict $data_test]
set res [lindex $response 1]
puts ""
puts "Labels test: "
set labels_test2 [$labels_test convert $::cv::CV_32S]
for {set i 0} {$i < [$labels_test2 rows]} {incr i} {
puts -nonewline "[$labels_test2 at [list $i 0] 0] "
}
puts ""
set correct 0
for {set i 0} {$i < [$labels_test2 rows]} {incr i} {
set row [$res rowRange $i [expr $i + 1]]
set rowt [$row transpose]
set rvalue [cv::minMaxIdx $rowt]
set max [lindex $rvalue 1]
set maxidx [lindex $max 1]
$row close
$rowt close
puts -nonewline "$maxidx "
if {$maxidx==[$labels_test2 at [list $i 0] 0]} {
incr correct
}
}
puts ""
puts "accuracy: [expr 100 * $correct/[$labels_test rows]]"
$res close
$data_test close
$labels_test close
$labels_test2 close
$res_test close