# -*- tcl -*-

source [file join \
        [file dirname [file dirname [file join [pwd] [info script]]]] \
        devtools testutilities.tcl]

testsNeedTcl     8.6
testsNeedTcltest 1.0

support {
    useLocal math.tcl       math
    useLocal linalg.tcl     math::linearalgebra
    useLocal statistics.tcl math::statistics
}
testing {
    useLocal pca.tcl math::PCA
}

#package require math::statistics

#
# Matching procedure - flatten the lists
#
proc matchNumbers {expected actual} {
    if {$actual=="" && $expected!=""} then {
        return 0
    }
    if {$actual!="" && $expected==""} then {
        return 0
    }
    set match 1
    if { [llength [lindex $expected 0]] > 1 } {
        foreach a $actual e $expected {
            set match [matchNumbers $e $a]
            if { $match == 0 } {
                break
            }
        }
    } else {

        foreach a $actual e $expected {
            if {[string is double $a]==0  || [string is double $e]==0} then {
                return 0
            }
            if {abs($a-$e) > 0.1e-6} {
                set match 0
                break
            }
        }
    }
    return $match
}

customMatch numbers matchNumbers

# Test the normalise/denormalise procedures

test normalise-1.0 "Normalise a vector" -match numbers -body {
    ::math::PCA::Normalise {1.0 2.0 3.0} {0.0 1.0 2.0} {2.0 2.0 2.0}
} -result {0.5 0.5 0.5}

test normalise-1.1 "Denormalise a vector" -match numbers -body {
    ::math::PCA::Denormalise {0.5 0.5 0.5} {0.0 1.0 2.0} {2.0 2.0 2.0}
} -result {1.0 2.0 3.0}

set plusminus   {{ 3.0 -3.0 -3.0  3.0}
                 {-3.0  3.0  3.0 -3.0}
                 { 0.0  0.0  0.0  0.0}
                 {-3.0  3.0 -3.0  3.0}
                 { 3.0 -3.0  3.0 -3.0}}

set transformed {{ 1.0 -1.0 -1.0  1.0}
                 {-1.0  1.0  1.0 -1.0}
                 { 0.0  0.0  0.0  0.0}
                 {-1.0  1.0 -1.0  1.0}
                 { 1.0 -1.0  1.0 -1.0}}

set zeroes      {0.0 0.0 0.0 0.0}
set threes      {3.0 3.0 3.0 3.0}

set data        {{7 4 3}
                 {4 1 8}
                 {6 3 5}
                 {8 6 1}
                 {8 5 7}
                 {7 2 9}
                 {5 3 3}
                 {9 5 8}
                 {7 4 5}
                 {8 2 2}}
set ones        {1.0 1.0 1.0}

test normalise-1.2 "Check transformation - transformed matrix" -match numbers -body {
    lindex [::math::PCA::Transform $plusminus 1] 0
} -result $transformed

test normalise-1.3 "Check transformation - averages" -match numbers -body {
    lindex [::math::PCA::Transform $plusminus 1] 1
} -result $zeroes

test normalise-1.4 "Check transformation - scale values" -match numbers -body {
    lindex [::math::PCA::Transform $plusminus 1] 2
} -result $threes

test normalise-1.5 "Check transformation - unit standard deviations" -match numbers -body {
    set transformedData  [lindex [::math::PCA::Transform $data 1] 0]
    set transposedMatrix [::math::linearalgebra::transpose $transformedData]

    set stdevs {}
    foreach vector $transposedMatrix {
        lappend stdevs [::math::statistics::stdev $vector]
    }
    set stdevs
} -result $ones

test normalise-1.6 "Check transformation - retain lengths" -match numbers -body {
    lindex [::math::PCA::Transform $data 0] 2
} -result $ones

test create-1.1 "Create a PCA object correctly" -match glob -setup {
    set pca {}
} -body {
    set pca [::math::PCA::createPCA $data]
} -cleanup {
    if { $pca ne "" } {
        $pca destroy
    }
} -returnCodes 0 -result *

test create-1.2 "Create a PCA object correctly - 2" -match glob -setup {
    set pca {}
} -body {
    set pca [::math::PCA::createPCA $data -covariance 0]
} -cleanup {
    if { $pca ne "" } {
        $pca destroy
    }
} -returnCodes 0 -result *

test create-1.3 "Create a PCA object incorrectly" -match glob -setup {
    set pca {}
} -body {
    ::math::PCA::createPCA $zeroes
} -cleanup {
    if { $pca ne "" } {
        $pca destroy
    }
} -returnCodes 1 -result *

test eigenvectors-1.1 "Get the eigenvectors - all" -match numbers -setup {
    set pca [::math::PCA::createPCA $data]
} -body {
    set eigenvectors [$pca eigenvectors]
} -cleanup {
    if { $pca ne "" } {
        $pca destroy
    }
} -result {
    {0.6420045763498947 -0.38467229168844363 -0.6632174243435957}
    {0.6863616413605773 -0.0971303301343052 0.7207450285897333}
    {-0.3416691692479824 -0.9179286066874492 0.20166618906061484}}

test eigenvectors-1.2 "Get the eigenvalues - all" -match numbers -setup {
    set pca [::math::PCA::createPCA $data]
} -body {
    set eigenvalues [$pca eigenvalues]
} -cleanup {
    if { $pca ne "" } {
        $pca destroy
    }
} -result {1.768774136103425 0.9270759168988945 0.30414994699768233}

test eigenvectors-1.3 "Restrict to two components - eigenvectors" -match numbers -setup {
    set pca [::math::PCA::createPCA $data]
} -body {
    $pca using 2
    set eigenvectors [$pca eigenvectors]
} -cleanup {
    if { $pca ne "" } {
        $pca destroy
    }
} -result {
    {0.6420045763498947 -0.38467229168844363}
    {0.6863616413605773 -0.0971303301343052}
    {-0.3416691692479824 -0.9179286066874492}}

test eigenvectors-1.4 "Restrict to two components - eigenvalues" -match numbers -setup {
    set pca [::math::PCA::createPCA $data]
} -body {
    $pca using 2
    set eigenvalues [$pca eigenvalues]
} -cleanup {
    if { $pca ne "" } {
        $pca destroy
    }
} -result {1.768774136103425 0.9270759168988945}

test eigenvectors-1.5 "Restrict to two components - get all eigenvectors" -match numbers -setup {
    set pca [::math::PCA::createPCA $data]
} -body {
    global pca
    $pca using 2
    set eigenvectors [$pca eigenvectors -all]
} -cleanup {
    if { $pca ne "" } {
        $pca destroy
    }
} -result {
    {0.6420045763498947 -0.38467229168844363 -0.6632174243435957}
    {0.6863616413605773 -0.0971303301343052 0.7207450285897333}
    {-0.3416691692479824 -0.9179286066874492 0.20166618906061484}}

test eigenvectors-1.6 "Restrict to two components - get all eigenvalues" -match numbers -setup {
    set pca [::math::PCA::createPCA $data]
} -body {
    $pca using 2
    set eigenvalues [$pca eigenvalues -all]
} -cleanup {
    if { $pca ne "" } {
        $pca destroy
    }
} -result {1.768774136103425 0.9270759168988945 0.30414994699768233}

test eigenvectors-1.7 "Use all components again" -match numbers -setup {
    set pca [::math::PCA::createPCA $data]
} -body {
    $pca using 3
    set eigenvectors [$pca eigenvectors]
} -cleanup {
    if { $pca ne "" } {
        $pca destroy
    }
} -result {
    {0.6420045763498947 -0.38467229168844363 -0.6632174243435957}
    {0.6863616413605773 -0.0971303301343052 0.7207450285897333}
    {-0.3416691692479824 -0.9179286066874492 0.20166618906061484}}

test approximation-1.1 "Approximate an observation" -match numbers -setup {
    set pca [::math::PCA::createPCA $data]
} -body {
    $pca using 2
    set approximation [$pca approximate [lindex $::data 0]]
} -cleanup {
    if { $pca ne "" } {
        $pca destroy
    }
} -result {7.03386897006181 3.961810336299144 2.981031668611465}

test approximation-1.2 "Approximate an observation, get the scores" -match numbers -setup {
    set pca [::math::PCA::createPCA $data]
} -body {
    $pca using 2
    set scores [$pca scores [lindex $::data 0]]
} -result {0.5148128141212557 0.630835559461938}

test approximation-1.3 "Approximate an observation, get the Q statistic" -match numbers -setup {
    set pca [::math::PCA::createPCA $data]
} -body {
    $pca using 2
    set qstatistic [$pca qstatistic [lindex $::data 0]]
} -cleanup {
    if { $pca ne "" } {
        $pca destroy
    }
} -result 0.001123022217614874

test approximation-1.4 "Approximate an observation, get the corrected Q statistic" -match numbers -setup {
    set pca [::math::PCA::createPCA $data]
} -body {
    $pca using 2
    set qstatistic [$pca qstatistic [lindex $::data 0] -original]
} -cleanup {
    if { $pca ne "" } {
        $pca destroy
    }
} -result 0.0016043174537355342

test approximation-2.1 "Approximate all original data (actually reconstruct)" -match numbers -setup {
    set pca [::math::PCA::createPCA $data]
} -body {
    # Note: as we use all components, we reconstruct the original data "exactly"
    $pca using 3
    set approximation [$pca approximateOriginal]
} -cleanup {
    if { $pca ne "" } {
        $pca destroy
    }
} -result $data