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