# 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
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.