下面是用來測試 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
