tests/testthat/helper-test_data.R

# load withr as needed by some tests that use random numbers
library(withr)

# Test data cross checked with Python solutions were possible

# test dataset
data = structure(c(0, 0, 1, 1, 0, 0, 1, 1, 0, 0, 1, 1, 0, 1, 0, 1, 0,
                1, 0, 1), .Dim = 4:5)
# test slice of dataset (first column)
x_i = c(0, 0, 1, 1)

# data parameters
n_samples <- nrow(data)
n_visible <- ncol(data)
n_hidden = 2
dim_hidden = 3
dim_visible = 2

# tc parameters
tcs = matrix(rep(0.0, n_hidden), nrow=n_hidden)
tc_min = 0.01  # Try to "boost" hidden units with less than tc_min
tc_history <- list()


#### initial values for debug  ####
alpha <- array ( c(0.818, 0.792, 0.575, 0.678, 0.914,
                   0.623, 0.884, 0.765, 0.715, 0.888), dim= c(n_hidden, n_visible))
p_rand <- p_rand <- array( dim = c(n_hidden, n_samples, dim_hidden))
p_rand[, , 1] <- c(0.250, 0.156, 0.258, 0.404, 0.229, 0.746, 0.289, 0.430)
p_rand[, , 2] <- c(0.871, 0.284, 0.260, 0.479, 0.467, 0.151, 0.886, 0.336)
p_rand[, , 3] <- c(0.059, 0.299, 0.222, 0.409, 0.110, 0.493, 0.010, 0.197)
p_rand <- log( p_rand)

# Expected p_y_given_x_3d and log_z from normalise_latent - also used as inputs for other function tests
p_y_given_x_3d <- structure(c(0.211864406779661, 0.211096075778079, 0.348648648648649,
                             0.312693498452012, 0.284119106699752, 0.536690647482014,
                             0.243881856540084, 0.446521287642783, 0.738135593220339,
                             0.384303112313938, 0.351351351351351, 0.370743034055728,
                             0.579404466501241, 0.10863309352518, 0.747679324894515,
                             0.348909657320872, 0.05, 0.404600811907984, 0.3,
                             0.31656346749226, 0.136476426799007, 0.354676258992806,
                             0.00843881856540085, 0.204569055036345),
                            .Dim = c(2L, 4L, 3L))

log_z <- structure(c(0.165514438477573, -0.302457358033935, -0.301105092783922,
            0.25619140536041, -0.215671536475509, 0.3293037471426, 0.169742774587095,
            -0.0377018671840115), .Dim = c(2L, 4L))

# calculate_p_y check result
log_p_y <- structure(c(-1.30131233762492, -0.976258809526706, -0.504280872127337,
                       -1.1934620796358, -2.0883943231501, -1.13908336313752),
                     .Dim = 2:3)


#
result_gaussian_no_smooth <- list(
    mean_ml = structure(c(0.485065836713681, 0.652429296866257, 0.549159919734141,
                          0.377327181451717, 0.292808206499491, 0.436770637223431
                          ), .Dim = 2:3),
    sig_ml = structure(c(3.07166862731226, 0.67403283287192, 0.422359821392027,
                         1.34014258508784, 10.2482872274822, 1.12329745214559
                         ), .Dim = 2:3))

result_gaussian_smooth <- list(
    mean_ml = structure(c(0.499004487901739, 0.518163858236057, 0.500459365867796,
                          0.452606870156963, 0.425982897439121, 0.491278733479767),
                        .Dim = 2:3),
    sig_ml = structure(c(1.57183232366738, 0.443890309613783, 0.367339936874075,
                         0.489091878155635, 6.16668958478516, 0.580952434470601),
                       .Dim = 2:3))


theta_result_gaussian_no_smooth <- list(
    list(mean_ml = structure(c(0.485065836713681, 0.652429296866257, 0.549159919734141,
                               0.377327181451717, 0.292808206499491, 0.436770637223431
                               ), .Dim = 2:3),
         sig_ml = structure(c(3.07166862731226, 0.67403283287192, 0.422359821392027,
                              1.34014258508784, 10.2482872274822, 1.12329745214559
                              ), .Dim = 2:3)),
    list(mean_ml = structure(c(0.485065836713681, 0.652429296866257, 0.549159919734141,
                               0.377327181451717, 0.292808206499491, 0.436770637223431),
                             .Dim = 2:3),
         sig_ml = structure(c(3.07166862731226, 0.67403283287192, 0.422359821392027,
                              1.34014258508784, 10.2482872274822,1.12329745214559),
                            .Dim = 2:3)),
    list(mean_ml = structure(c(0.485065836713681, 0.652429296866257, 0.549159919734141,
                               0.377327181451717, 0.292808206499491, 0.436770637223431),
                             .Dim = 2:3),
         sig_ml = structure(c(3.07166862731226, 0.67403283287192, 0.422359821392027,
                              1.34014258508784, 10.2482872274822, 1.12329745214559),
                            .Dim = 2:3)),
    list(mean_ml = structure(c(0.544348069962135, 0.503791656067947, 0.45478936738257,
                               0.593484480213392, 0.623215432246983, 0.407004543860708),
                             .Dim = 2:3),
         sig_ml = structure(c(3.0502249514598, 0.743052446088727, 0.422995615430913,
                              1.37613013535667, 11.6214986931416, 1.10206364242556),
                            .Dim = 2:3)),
    list(mean_ml = structure(c(0.544348069962135, 0.503791656067947, 0.45478936738257,
                               0.593484480213392, 0.623215432246983, 0.407004543860708),
                             .Dim = 2:3),
         sig_ml = structure(c(3.0502249514598, 0.743052446088727, 0.422995615430913,
                              1.37613013535667, 11.6214986931416, 1.10206364242556),
                            .Dim = 2:3)))


theta_i_bernoulli_ns <- structure(c(-1.43626304296777, -1.38760598609224, -1.39408499537967,
            -1.3888896801509, -1.43103321699891, -0.0682080796686932, -0.106941919424571,
            -0.515999177936465, -0.990771251614206, -0.114663818967529, -0.198430972290225,
            -1.09836725634523, -0.0966215282678604, -0.879617779632099, -0.111255345284007,
            -1.04131843254436, -0.610398534801789, -0.903270327486098, -0.0331088161328807,
            -0.961009346530773, -0.348499528714456, -0.216739329043776, -0.250896956305951,
            -1.08136242907494, -0.866431879810989, -0.250656692893244, -0.295983767369762,
            -0.154706651112065, -0.743658949504606, -0.948618240072392, -0.121713565313257,
            -0.514743427745998, -1.04543410101905, -0.0737492325715721, -0.804434834048152,
            -0.964943704311736, -0.804558236966841, -0.699230616912246, -0.114115756703541,
            -0.495703916531056), .Dim = c(2L, 2L, 10L))

marginal_p_bernoulli_result <- structure(
  c(-1.43626304296777, -1.39408499537967, -1.43103321699891, -0.106941919424571,
    -0.990771251614206, -0.198430972290225, -0.0966215282678604, -0.111255345284007,
    -0.610398534801789, -0.0331088161328807, -0.348499528714456, -0.250896956305951,
    -0.866431879810989, -0.295983767369762, -0.743658949504606, -0.121713565313257,
    -1.04543410101905, -0.804434834048152, -0.804558236966841, -0.114115756703541,
    -1.43626304296777, -1.39408499537967, -1.43103321699891, -0.106941919424571,
    -0.990771251614206, -0.198430972290225, -0.0966215282678604, -0.111255345284007,
    -0.610398534801789, -0.0331088161328807, -0.348499528714456, -0.250896956305951,
    -0.866431879810989, -0.295983767369762, -0.743658949504606, -0.121713565313257,
    -1.04543410101905, -0.804434834048152, -0.804558236966841, -0.114115756703541,
    -1.38760598609224, -1.3888896801509, -0.0682080796686932, -0.515999177936465,
    -0.114663818967529, -1.09836725634523, -0.879617779632099, -1.04131843254436,
    -0.903270327486098, -0.961009346530773, -0.216739329043776, -1.08136242907494,
    -0.250656692893244, -0.154706651112065, -0.948618240072392, -0.514743427745998,
    -0.0737492325715721, -0.964943704311736, -0.699230616912246, -0.495703916531056,
    -1.38760598609224, -1.3888896801509, -0.0682080796686932, -0.515999177936465,
    -0.114663818967529, -1.09836725634523, -0.879617779632099, -1.04131843254436,
    -0.903270327486098, -0.961009346530773, -0.216739329043776, -1.08136242907494,
    -0.250656692893244, -0.154706651112065, -0.948618240072392, -0.514743427745998,
    -0.0737492325715721, -0.964943704311736, -0.699230616912246, -0.495703916531056),
  .Dim = c(2L, 10L, 4L))


theta_i_gaussian_ns <- theta_result_gaussian_no_smooth[[1]]

marginal_p_gaussian_result <- structure(c(-1.51834884879508, -1.03745939496067, -0.845003554373404,
                                          -1.11844618765833, -2.08667680351517, -1.06198733736554,
                                          -1.51834884879508, -1.03745939496067, -0.845003554373404,
                                          -1.11844618765833, -2.08667680351517, -1.06198733736554,
                                          -1.5232107545207, -0.811314184471757, -0.728610097315585,
                                          -1.20998332699955, -2.10689401531861, -1.1182764019012,
                                          -1.5232107545207, -0.811314184471757, -0.728610097315585,
                                          -1.20998332699955, -2.10689401531861, -1.1182764019012),
                                        .Dim = 2:4)

theta_result_discrete_no_smooth <- list(
    structure(c(-0.663769415931969, -0.723414188099684, -1.0562060877474, -0.427362203917095,
                -0.796552426098203, -0.599439615726331, -0.474058527830046, -0.974107414300832,
                -0.347633255622469, -1.22539353714455, -0.574243435301211, -0.828121333532572),
              .Dim = c(2L, 2L, 3L)),
    structure(c(-0.663769415931969, -0.723414188099684, -1.0562060877474, -0.427362203917095,
                -0.796552426098203, -0.599439615726331, -0.474058527830046, -0.974107414300832,
                -0.347633255622469, -1.22539353714455, -0.574243435301211, -0.828121333532572),
              .Dim = c(2L, 2L, 3L)),
    structure(c(-0.663769415931969, -0.723414188099684, -1.0562060877474, -0.427362203917095,
                -0.796552426098203, -0.599439615726331, -0.474058527830046, -0.974107414300832,
                -0.347633255622469, -1.22539353714455, -0.574243435301211, -0.828121333532572),
              .Dim = c(2L, 2L, 3L)),
    structure(c(-0.785847587352773, -0.608315829295159, -0.700749264685316, -0.685602452367139,
                -0.606651651571159, -0.78783869380893, -0.899754571446817, -0.522003625144585,
                -0.974766365320388, -0.473659084807036, -0.522813148290794, -0.898574651869688),
              .Dim = c(2L, 2L, 3L)),
    structure(c(-0.785847587352773, -0.608315829295159, -0.700749264685316, -0.685602452367139,
                -0.606651651571159, -0.78783869380893, -0.899754571446817, -0.522003625144585,
                -0.974766365320388, -0.473659084807036, -0.522813148290794, -0.898574651869688),
              .Dim = c(2L, 2L, 3L)))
theta_i_discrete_ns <- theta_result_discrete_no_smooth[[1]]


marginal_p_discrete_result <- structure(c(-0.663769415931969, -1.0562060877474, -0.796552426098203,
                                          -0.474058527830046, -0.347633255622469, -0.574243435301211,
                                          -0.663769415931969, -1.0562060877474, -0.796552426098203,
                                          -0.474058527830046, -0.347633255622469, -0.574243435301211,
                                          -0.723414188099684, -0.427362203917095, -0.599439615726331,
                                          -0.974107414300832, -1.22539353714455, -0.828121333532572,
                                          -0.723414188099684, -0.427362203917095, -0.599439615726331,
                                          -0.974107414300832, -1.22539353714455, -0.828121333532572),
                                        .Dim = 2:4)








log_marg_x_4d_discrete <- structure(c(
  0.0294637765146899, -0.363042232403415, 0.0294637765146899, -0.363042232403415, -0.0303530120290427,
  0.265768302136856, -0.0303530120290427, 0.265768302136856, 0.0294637765146899, -0.363042232403415,
  0.0294637765146899, -0.363042232403415, -0.0303530120290427, 0.265768302136856, -0.0303530120290427,
  0.265768302136856, 0.0294637765146899, -0.363042232403415, 0.0294637765146899, -0.363042232403415,
  -0.0303530120290427, 0.265768302136856, -0.0303530120290427, 0.265768302136856, -0.0927612657953703,
  -0.00760421589983051, 0.0848922139713737, 0.00754685997181348, -0.0927612657953703, -0.00760421589983051,
  0.0848922139713737, 0.00754685997181348, -0.0927612657953703, -0.00760421589983051, 0.0848922139713737,
  0.00754685997181348, -0.0927612657953703, -0.00760421589983051, 0.0848922139713737, 0.00754685997181348,
  -0.103319233651544, 0.219105327513939, -0.103319233651544, 0.219105327513939, 0.0936215603443104,
  -0.28097690824688, 0.0936215603443104, -0.28097690824688, -0.103319233651544, 0.219105327513939,
  -0.103319233651544, 0.219105327513939, 0.0936215603443104,-0.28097690824688, 0.0936215603443104,
  -0.28097690824688, -0.103319233651544, 0.219105327513939, -0.103319233651544, 0.219105327513939,
  0.0936215603443104, -0.28097690824688, 0.0936215603443104, -0.28097690824688, 0.0864346699862441,
  -0.206609522661332, -0.0946306505423971, 0.171145687194367, 0.0864346699862441, -0.206609522661332,
  -0.0946306505423971, 0.171145687194367, 0.0864346699862441, -0.206609522661332, -0.0946306505423971,
  0.171145687194367, 0.0864346699862441, -0.206609522661332, -0.0946306505423971, 0.171145687194367,
  0.34559993682419, 0.118920420042774, 0.34559993682419, 0.118920420042774, -0.532332361073909,
  -0.134990827478621, -0.532332361073909, -0.134990827478621, 0.34559993682419, 0.118920420042774,
  0.34559993682419, 0.118920420042774, -0.532332361073909, -0.134990827478621, -0.532332361073909,
  -0.134990827478621, 0.34559993682419, 0.118920420042774, 0.34559993682419, 0.118920420042774,
  -0.532332361073909, -0.134990827478621, -0.532332361073909, -0.134990827478621, -0.281680043762985,
  0.170331900494691, 0.219548958459497, -0.205425339530735, -0.281680043762985, 0.170331900494691,
  0.219548958459497, -0.205425339530735, -0.281680043762985, 0.170331900494691, 0.219548958459497,
  -0.205425339530735, -0.281680043762985, 0.170331900494691, 0.219548958459497, -0.205425339530735),
  .Dim = c(2L, 4L, 5L, 3L))


alpha_4latent_test <- structure(c(1.00020021445258, 0.000701057459227741, 1.00068521859567,
                             0.000527959984261543, 1.00091687577451, 0.000807935200864449,
                             1.00028439945728, 0.0009565001251176, 1.00010465012793, 0.000110453018685803),
                           .Dim = c(2L, 5L))


update_alpha_test_result_seed5 <- structure(c(1.00010465012793, 0.000110453018685803, 1.00070105745923,
                                              0.000273284949595109, 1.00052795998426, 0.000490513201802969,
                                              1.00080793520086, 0.000318404018646106, 1.00095650012512,
                                              0.000559172826586291),
                                            .Dim = c(2L, 5L))

updated_p_y_given_x_3d <- structure(c(0.0120966860928375, 0.37678808994633, 0.0153701508717977,
                                      0.376791949782257, 0.00843794530480509, 0.376931392538745,
                                      0.0107323476636507, 0.376935253639364, 0.987623693745951,
                                      0.303090551639091, 0.984277348430314, 0.303113975604685,
                                      0.991375794272762, 0.303009682882093, 0.989032603345896,
                                      0.303033100434402, 0.000279620161211356, 0.320121358414579,
                                      0.000352500697888493, 0.320094074613059, 0.000186260422432821,
                                      0.320058924579162, 0.000235048990453142, 0.320031645926234),
                                    .Dim = c(2L, 4L, 3L))

updated_log_z <- structure(c(0.816755123445272, -7.36603179469996e-06, 0.768964780157148,
                             -6.05274571589323e-06, 0.89275126619304, -3.75601370286249e-05,
                             0.843933262518173, -3.62463115813506e-05),
                           .Dim = c(2L, 4L))

updated_tc <- list(tcs = structure(c(0.830601108078408, -2.18063065301422e-05),
                                   .Dim = 2:1),
                   tc_history = list(
                       structure(c(0.830601108078408, -2.18063065301422e-05),
                                 .Dim = 2:1)))



### arguments for estimate parameters functions
data_est_tests = matrix(c(0,0,0,0,0,
                0,0,0,1,3,
                1,1,1,0,0,
                1,1,2,1,1), ncol=5, byrow = TRUE)


tc_hist_converged <- list(structure(c(0.0919859795589572, 0.00544256960649925), .Dim = 2:1),
     structure(c(0.536840469673255, 0.0212412648471452), .Dim = 2:1),
     structure(c(1.19480727651736, 0.0781317872088292), .Dim = 2:1),
     structure(c(1.36132996135349, 0.237936327502543), .Dim = 2:1),
     structure(c(1.38376905327964, 0.483661910947172), .Dim = 2:1),
     structure(c(1.38405118147144, 0.633487779837526), .Dim = 2:1),
     structure(c(1.38405123782951, 0.680365673117113), .Dim = 2:1),
     structure(c(1.38405127508472, 0.691033475969152), .Dim = 2:1),
     structure(c(1.38405131288432, 0.691644466118563), .Dim = 2:1),
     structure(c(1.38405135124099, 0.691648885312992), .Dim = 2:1),
     structure(c(1.38405139016679, 0.691648906408284), .Dim = 2:1),
     structure(c(1.38405142967412, 0.691648907783547), .Dim = 2:1),
     structure(c(1.38405146977576, 0.691648909075495), .Dim = 2:1),
     structure(c(1.38405151048485, 0.69164891037193), .Dim = 2:1),
     structure(c(1.38405155181492, 0.691648911673268), .Dim = 2:1),
     structure(c(1.38405159377991, 0.691648912979536), .Dim = 2:1),
     structure(c(1.38405163639416, 0.691648914290762), .Dim = 2:1),
     structure(c(1.38405167967248, 0.691648915606969), .Dim = 2:1),
     structure(c(1.38405172363009, 0.691648916928184), .Dim = 2:1))




#### data to test estimate_sig() function ####
sig_x_select <- structure(c(TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, TRUE,
                            FALSE, FALSE, FALSE, TRUE, TRUE, FALSE, FALSE, TRUE, FALSE, FALSE,
                            FALSE, FALSE, TRUE), .Dim = c(3L, 7L))
sig_term <- structure(c(-0.154151155164854, -0.559616263273018, -0.559616263273018,
                        -3.34062951353204, -3.7460946216402, -3.7460946216402, -0.409670404207369,
                        -0.815135512315533, -0.815135512315533, -0.188346351661581, -0.593811459769746,
                        -0.593811459769746, -1.65345146201078, -2.05891657011895, -2.05891657011895,
                        0.226487007993929, -0.178978100114236, -0.178978100114236, -0.293946107786993,
                        -0.699411215895157, -0.699411215895157, -0.768330423131835, -1.17379553124,
                        -1.17379553124, -0.162711162368496, -0.568176270476661, -0.568176270476661,
                        -0.159921891853003, -0.565386999961167, -0.565386999961167, -1.64290672278073,
                        -2.0483718308889, -2.0483718308889, -0.963708810820184, -1.36917391892835,
                        -1.36917391892835, -1.40693689409172, -1.81240200219989, -1.81240200219989,
                        -0.158746510994044, -0.564211619102209, -0.564211619102209, -1.06184565155979,
                        -1.46731075966795, -1.46731075966795, -0.0052898357698648, -0.410754943878029,
                        -0.410754943878029, -0.154620244208472, -0.560085352316636, -0.560085352316636,
                        -5.30311576910838, -5.70858087721655, -5.70858087721655, 0.0502941205134475,
                        -0.355170987594717, -0.355170987594717, -1.10356679508076, -1.50903190318892,
                        -1.50903190318892), .Dim = 3:5)
# uses also py_givenxdisc3_7
estsig_result <- structure(c(2.06313458560436, 0.0387414471485073, 0.786194744270184,
                             1.85329595162512, 0.749108448903946, 1.92728262635708, 1.44965345852587,
                             0.395754608120157, 1.66613762759161, 2.05126171002348, 0.39015056638395,
                             0.29127761135769, 0.991208113406456, 2.12694424596655, 0.668203760443655,
                             0.951970790385207, 2.00396613868832, 0.0112630408652883, 1.2532081568531,
                             0.22583688547725), .Dim = 4:5) # with seed 555
jpkrooney/rcorex documentation built on July 25, 2022, 1:37 a.m.