tests/testthat/test-fmrs.R

test_that("test fmrs", {
        set.seed(1980)
        nComp = 2
        nCov = 10
        nObs = 500
        dispersion = c(1, 1)
        mixProp = c(0.4, 0.6)
        rho = 0.5
        coeff1 = c( 2,  2, -1, -2, 1, 2, 0, 0,  0, 0,  0)
        coeff2 = c(-1, -1,  1,  2, 0, 0, 0, 0, -1, 2, -2)
        umax = 40

        dat <- fmrs.gendata(nObs = nObs, nComp = nComp, nCov = nCov,
        coeff = c(coeff1, coeff2), dispersion = dispersion,
        mixProp = mixProp, rho = rho, umax = umax,
        disFamily = "lnorm")

        res.mle <- fmrs.mle(y = dat$y, x = dat$x, delta = dat$delta,
        nComp = nComp, disFamily = "lnorm",
        initCoeff = c(coeff1, coeff2),
        initDispersion = rep(1, nComp),
        initmixProp = rep(1/nComp, nComp))

        res.mple <- fmrs.varsel(y = dat$y, x = dat$x, delta = dat$delta,
                                nComp = ncomp(res.mle), disFamily = 'lnorm',
                                initCoeff=c(coefficients(res.mle)),
                                initDispersion = dispersion(res.mle),
                                initmixProp = mixProp(res.mle),
                                penFamily = 'adplasso',
                                lambPen = c(0,1,0.1))

        expect_equal(sum(round(coefficients(res.mple),1)==0), 7, tolerance = 2)
        })

Try the fmrs package in your browser

Any scripts or data that you put into this service are public.

fmrs documentation built on Nov. 8, 2020, 5:50 p.m.