context(desc="Testing robust FH:")
test_that(desc="fitfh is producing 'good'/'expected' results:", {
browser()
tmp <- genModelSpecs(type = "test")
expect_error(addModelFrame(tmp, y ~ x, "x", "x", data.frame(y = rnorm(100), x = rnorm(100))))
modelSpecs <- genModelSpecs(type = "RFH")
data(milk, envir=environment())
milk$SD <- milk$SD^2
modelSpecs <- addModelFrame(modelSpecs, formula = yi ~ MajorArea, vardir="SD", idName="SmallArea", data = milk)
modelSpecs <- addStartValues(modelSpecs)
modelSpecs <- optimizeParam(modelSpecs)
modelSpecs <- optimizeRE(modelSpecs)
fh <- sae::eblupFH(yi ~ MajorArea, SD, method = "REML", MAXITER = 100, PRECISION = 1e-06, data = milk)$eblup
rfh <- modelSpecs$X %*% modelSpecs$beta + modelSpecs$fitre$x
expect_that(fh, equals(rfh, tolerance = 0.015))
fit <- fitfh(formula = yi ~ MajorArea, vardir="SD", idName="SmallArea", data = milk, type = "RFH",
optsRobust = genOptsRobust(k = 10000))
expect_that(fh, equals(fit$prediction, tolerance = 0.015))
expect_that(1 > confint(lm(fh ~ fit$prediction))[2, 1] &
1 < confint(lm(fh ~ fit$prediction))[2, 2], is_true())
})
test_that("RFH is handling 0 variances", {
dat <- structure(list(idD = 1:20,
y = c(1.91334788421053, 1.31219963636364, 0.465175530756437,
3.02856546, 0.676592046, 0.3379209, 0.120637807017544,
0.470554980362538, 0.508989952, 0.452383672961443,
0.543936295833333, 0.758410128920415, 0.505185970149254,
0.41766147754491, 0.324333567447743, 0.0957985490196078,
0.243834842931937, 0.122924552023121, 0.151441988970877,
0.135980818181818),
x = c(9, 4.81818181818182, 3.32769830949285, 11.34,
4.15533980582524, 3.2, 1.57894736842105, 2.88821752265861,
3.496, 3.13930348258706, 2.54166666666667,
4.05536332179931, 3.29850746268657, 2.70209580838323,
2.67102137767221, 1.62352941176471, 1.37696335078534,
1.63583815028902, 1.63561643835616, 1.70087976539589),
dirVar = c(0.0691726074203466, 0.00377145639910195,
0.0216503883117238, 0.278008289005939,
0.0166537591225976, 1.37298169483161,
0.698959846705716, 2.92265293884939,
0.956783706938724, 0.422775156250175,
5.45007382273668, 0.244958830050519,
0.177044995542312, 0.229011362363644,
0.0626689312819137, 0.220433595440947,
0.251129347662288, 0.357922374351885,
0.582439697566219, 0.298090953862522)),
.Names = c("idD", "y", "x", "dirVar"), class = "data.frame",
row.names = c(NA, -20L))
expect_true(all(fitfh(y ~ x, vardir = "dirVar", data=dat, idName="idD")$fitre$x == 0))
})
test_that("RFH is handling NA starting values", {
dat <- structure(list(
idD = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12,
13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28,
29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44,
45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60,
61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76,
77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92,
93, 94, 95, 96, 97, 98, 99, 100),
y = c(103.641968023894, 100.861682843873,
102.874707300598, 98.8792257721062, 104.100450103799, 100.020291584306,
95.0460964644493, 105.334030892498, 103.347445994879, 101.493683724465,
99.344125926307, 97.7500268219175, 99.7156695679143, 99.4242922407169,
100.607060026502, 97.7687839222435, 97.7387925480391, 95.513132954054,
100.703979587653, 101.431416632708, 99.5926299635473, 99.2329916602849,
100.708960495003, 100.132829769572, 99.1694558205763, 99.8361552611349,
98.2939096455057, 98.5700024994403, 99.5791295603795, 94.3863826607706,
104.077941626555, 99.7394404387897, 100.286566496771, 101.320483748498,
102.910252930382, 95.0733335632203, 99.946348176415, 103.063689986658,
98.7534171853108, 100.607055664873, 94.6798919737098, 101.515996594799,
100.118107661963, 97.8814104523711, 100.133835347052, 96.053349700745,
101.843672237293, 101.897267225654, 104.748415922607, 97.9518434779897,
102.653869138286, 99.5371900245036, 101.579445761351, 103.829140298206,
99.3449940555794, 101.936651337295, 99.5913339207755, 105.073389303569,
101.450237785878, 99.6158171331068, 100.983933671359, 97.3743177024981,
100.390753523664, 97.1060369993354, 101.120448973453, 101.893611354984,
99.2494091023531, 96.6536793520929, 96.4754877958497, 102.995800414087,
96.1229978067898, 101.15123058966, 99.4937766685497, 98.8669658427311,
99.7659417498383, 100.030471329082, 98.544197975497, 100.891882816417,
101.628533810747, 98.6312972985763, 101.409939182577, 99.8487028834338,
98.4782707787289, 98.8053394002484, 102.761095574832, 100.88693684752,
97.1856459188761, 100.061611319284, 98.8440399116528, 104.663293618689,
100.065085392815, 100.117076577527, 100.693444349632, 99.4391309082438,
98.6534438888243, 97.8565055102041, 102.047951792107, 102.092175671818,
98.3499996078536, 98.8957245582752),
x =
c(0.532558584971213,
2.46373550230602, 0.238806629784488, 2.03361712085865, 2.36340926386979,
-1.7062932042923, -3.15521779648392, 4.96980863086164, 0.812109999259518,
0.253267731817562, -1.78284368089218, 1.36781811484552, 0.459154887047119,
-0.77566857181615, 0.702968973137439, -2.12094812035372, -2.17932186827373,
-1.58038438560073, -0.496129876407152, 2.82681746857398, 0.31411715768068,
-1.14894192356413, 1.2693917068652, 0.442292505697221, -2.68304498397501,
-0.118309313829195, -1.91961358885011, -0.595347970037377, -0.924814465753458,
-1.8893380080788, 0.750947165848593, 1.78643318730149, 0.139764800665079,
0.411792144984676, 0.768210856097585, -2.81717996490121, 1.31718960171318,
1.69830716477857, -0.231100595846109, -2.25673044177658, -2.22765436265878,
0.54747329624072, 2.08230973904838, -0.120630537603191, 1.25580179762768,
-2.00642826972068, 1.27088017881638, 2.1434480991878, 1.41628369108124,
0.149453617082991, 0.0756996564162075, -0.528572452834153, 0.725358641739131,
2.60456809428939, -0.609973862167897, 2.01671820469056, 1.2443579673053,
2.52258140004656, 0.588435282457869, -0.91450113932374, 2.52958707868942,
-0.217342732920202, -0.537363293578067, -3.53792245010324, 0.747648743489273,
-0.169150968536208, 0.634451620353682, 1.02229281589786, -3.43157383169597,
0.498121898350712, -1.88806844905829, -1.12646865901801, 1.45867870955305,
1.03922006271774, -0.291172692914827, -1.17648415697252, -1.75080188581083,
1.53140941774315, 3.67750959906679, -1.62109310797793, -0.497263885456498,
-0.717714527609405, -1.60457190489782, 1.73292752465049, 0.104282532459583,
2.08671490239293, -0.127988559881931, 0.875383799930095, -0.96572721368584,
1.25368665002089, -1.34011582918733, -1.72456105717549, -1.23549435569008,
-0.412481173156587, -1.68456440415766, -1.57462058851145, 1.34050812042039,
3.60742100093243, -2.31968022599742, 0.286910431184626),
dirVar1 =
c(4.03594320556032,
9.39967926033263, 17.040266590707, 4.77443626349142, 2.94790204471392,
0.57352600213126, 8.15639841791056, 4.92283081025418, 16.6265172913065,
1.1023465795918, 8.62669089466866, 7.64530393923861, 5.78420148303188,
7.74445281682331, 3.20133274411387, 6.40733108522638, 2.41132062594929,
9.71993670055318, 11.7470455105339, 3.4639688958947, 14.695268933622,
5.67994400767971, 7.11568337412993, 1.35836224963361, 10.6206448634138,
3.07464604271165, 2.60516681879097, 7.10731101247731, 2.07316530907746,
3.28040999106147, 11.1348988736552, 8.21116269646562, 13.3144902062013,
4.12767116024658, 1.64230419985335, 2.70424553807854, 4.74640192251688,
2.92485966114467, 5.90728850013109, 1.41584758666076, 3.71109592140345,
3.00281365146614, 1.64713622259774, 5.53082574922285, 12.0589727608735,
0.519112795453996, 5.55543924683563, 0.801229660288171, 4.6543900347215,
7.84852593840381, 9.24211400741953, 6.85351912070506, 3.71165997160308,
0.286259735456097, 10.6791623360737, 3.75061736752101, 3.79666317565693,
7.84304830910677, 1.41301902302863, 7.04091375509899, 1.84863482713951,
7.90478006830056, 6.89500974046904, 7.95758264595003, 2.00847363538267,
11.6139881284694, 1.97294050511757, 12.2071697240143, 11.5437560302369,
9.78898973769786, 3.96453965058017, 7.86955212975499, 11.6176921312165,
5.41658308623833, 5.16213615093084, 1.53726710316234, 4.56928565804804,
0.848393110935803, 8.35682527252196, 3.51833615121558, 16.8731921977033,
1.97266342683447, 3.08602967592079, 3.68096730052866, 1.56172911176827,
10.1694885602141, 8.60586244001788, 5.80645931467113, 10.6112692830552,
14.8966366380718, 10.2589210199497, 3.66772297474225, 12.3145606453098,
3.60585551287183, 9.56685813801394, 3.38199989146242, 18.4945398097131,
5.31956929462766, 5.22995361809468, 5.52324846801952)),
.Names = c("idD", "y", "x", "dirVar1"),
row.names = c(NA, -100L),
class = "data.frame")
expect_error(fitfh(y ~ x, vardir="dirVar1", idName="idD", data=dat))
})
test_that("RFH is handling non-ververgent parameters", {
dat <- structure(
list(idD = 1:20,
y = c(21.0919637167574, 5.61070584545455,
3.54828589060982, 33.0961835921291, 3.74100787361327, 3.79126509031645,
2.72227601908768, 3.3196042892472, 5.0676577225605, 5.45141858958829,
4.29418526361047, 10.5702891687751, 4.04761669364426, 3.79953776498206,
2.85715211130454, 1.59487868092537, 3.16465886375883, 1.37073313693622,
2.30610819166901, 1.32167531531223),
turn_1Mean = c(20.1626049921011,
9.97024218181818, 4.20630126056979, 27.8645965060241, 6.16875923226433,
3.5994935678392, 1.55435983985765, 3.92907781037351, 5.094303159583,
4.7993637605774, 5.33085549560853, 6.6992411599723, 5.64321055597295,
3.60830092462161, 3.05252203826955, 1.04171125736739, 1.66851967995803,
1.28900210526316, 1.57132211796982, 1.19458282111437),
wpMean = c(9.34123222748815,
6.36363636363636, 3.31819955769481, 11.4738955823293, 3.95918367346939,
3.07537688442211, 1.8576512455516, 2.86405564796613, 3.55733761026464,
3.1231956197113, 2.67795901296529, 3.77943213296399, 3.47332832456799,
2.63719466506819, 2.69111005467079, 1.66208251473477, 1.43913955928646,
1.6711972238288, 1.58134430727023, 1.65483870967742),
sc2Mean = c(0.358609794628752,
0.336363636363636, 0.542604397033953, 0.0963855421686747, 0.498542274052478,
0.346733668341709, 0.357651245551601, 0.514894903977015, 0.583801122694467,
0.485316077650572, 0.429945629443747, 0.44909972299169, 0.519909842223892,
0.488386033268395, 0.445329213216068, 0.28565815324165, 0.227177334732424,
0.315355696934644, 0.266666666666667, 0.258357771260997),
sc3Mean = c(0.144813059505003,
0.0636363636363636, 0.170807857421621, 0.279116465863454, 0.210884353741497,
0.100502512562814, 0.0480427046263345, 0.0993497656131861, 0.150761828388132,
0.150572424091588, 0.113759933082392, 0.170013850415512, 0.174305033809166,
0.112093511164394, 0.100427858331353, 0.02475442043222, 0.0110178384050367,
0.0338345864661654, 0.0260631001371742, 0.0381231671554252),
sc4Mean = c(0.105845181674566, 0.163636363636364, 0.0323923507219982,
0.419678714859438, 0.0621963070942663, 0.0452261306532663,
0.00177935943060498, 0.0285800695599577, 0.0400962309542903,
0.0303633648581384, 0.0242576327896278, 0.0585180055401662,
0.0353117956423742, 0.0181327738648284, 0.0232945091514143,
0.00707269155206287, 0.00367261280167891, 0.00419317524580682,
0.00493827160493827, 0.00498533724340176),
sc5Mean = c(0.187993680884676,
0.0909090909090909, 0.00533368023936516, 0.1285140562249,
0.0087463556851312, 0.0100502512562814, 0.00355871886120996,
0.00725843036443369, 0.00882117080994387, 0.00721752115480338,
0.00501882057716437, 0.0155817174515235, 0.00826446280991736,
0.00404615615165593, 0.00713097218920846, 0.00275049115913556,
0.00209863588667366, 0.000144592249855408, 0.000823045267489712,
0.00117302052785924),
dirVar2 = c(0.0202742803987084, 0.265287826983338,
0.00107652227577416, 0.360258550925784, 0.00784593180034094,
0.020139164866869, 0.0160494794228832, 0.00243727866974958,
0.00718220457768342, 0.00695511694196554, 0.0134577935248127,
0.115480614608947, 0.0080895879968789, 0.00210015358385413,
0.000883221121253344, 0.00260600610576751, 0.0469492679065737,
0.000137332178603579, 0.00510665163564767, 0.000440925917509196)),
.Names = c("idD", "y", "turn_1Mean", "wpMean", "sc2Mean", "sc3Mean", "sc4Mean",
"sc5Mean", "dirVar2"), class = "data.frame", row.names = c(NA, -20L))
rfh <- fitfh(y ~ turn_1Mean + wpMean + sc2Mean + sc3Mean + sc4Mean + sc5Mean,
data = dat, vardir = "dirVar2", idName = "idD")
expect_equal(unique(rfh$fitparam$returnStatus[1]), 1)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.