R Under development (unstable) (2023-08-05 r84874 ucrt) -- "Unsuffered Consequences" Copyright (C) 2023 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > library(testthat) > library(efdm) > statespace <- expand.grid(ds=c("sp", "pi"), region=c("n", "s"), vol=1:3, stringsAsFactors=FALSE) > pairdata <- data.frame(ds=c("sp", "pi"), vol0=c(1,1), vol1=c(2,3), region=c("n", "s")) > actprob <- state0 <- statespace > actprob$test <- 1 > state0$area <- c(1,1,1,1, 0,0,0,0, 0,0,0,0) > orderresult <- function(res) { + res <- res[do.call(order, res[c("time", "region", "ds", "vol")]),c("time", "region", "ds", "vol", "activity", "area")] + row.names(res) <- NULL + res + } > > act1 <- define_activity("test", c("vol")) > transprobs(act1) <- estimatetransprobs("vol", NULL, subset(statespace, ds=="sp"®ion=="n"), factors=c("ds", "region"), prior="nochange") > act2 <- define_activity("test", c("vol")) > transprobs(act2) <- estimatetransprobs("vol", NULL, subset(statespace, !(ds=="sp"®ion=="n")), factors=c("ds", "region"), prior="nochange") > orderresult(runEFDM(state0, actprob, list(act1, act2), 1)) time region ds vol activity area 1 0 n pi 1 test 1 2 0 n sp 1 test 1 3 0 s pi 1 test 1 4 0 s sp 1 test 1 5 1 n pi 1 test 1 6 1 n sp 1 test 1 7 1 s pi 1 test 1 8 1 s sp 1 test 1 > > act1 <- define_activity("test", c("vol")) > transprobs(act1) <- estimatetransprobs("vol", subset(pairdata, ds=="sp"®ion=="n"), subset(statespace, ds=="sp"®ion=="n"), factors=c("ds", "region"), prior="nochange") > act2 <- define_activity("test", c("vol")) > transprobs(act2) <- estimatetransprobs("vol", subset(pairdata, !(ds=="sp"®ion=="n")), subset(statespace, !(ds=="sp"®ion=="n")), factors=c("ds", "region"), prior="nochange") > orderresult(runEFDM(state0, actprob, list(act1, act2), 10)) time region ds vol activity area 1 0 n pi 1 test 1.000000e+00 2 0 n sp 1 test 1.000000e+00 3 0 s pi 1 test 1.000000e+00 4 0 s sp 1 test 1.000000e+00 5 1 n pi 1 test 3.333333e-01 6 1 n pi 3 test 6.666667e-01 7 1 n sp 1 test 2.500000e-01 8 1 n sp 2 test 7.500000e-01 9 1 s pi 1 test 2.500000e-01 10 1 s pi 3 test 7.500000e-01 11 1 s sp 1 test 5.000000e-01 12 1 s sp 3 test 5.000000e-01 13 2 n pi 1 test 1.111111e-01 14 2 n pi 3 test 8.888889e-01 15 2 n sp 1 test 6.250000e-02 16 2 n sp 2 test 9.375000e-01 17 2 s pi 1 test 6.250000e-02 18 2 s pi 3 test 9.375000e-01 19 2 s sp 1 test 2.500000e-01 20 2 s sp 3 test 7.500000e-01 21 3 n pi 1 test 3.703704e-02 22 3 n pi 3 test 9.629630e-01 23 3 n sp 1 test 1.562500e-02 24 3 n sp 2 test 9.843750e-01 25 3 s pi 1 test 1.562500e-02 26 3 s pi 3 test 9.843750e-01 27 3 s sp 1 test 1.250000e-01 28 3 s sp 3 test 8.750000e-01 29 4 n pi 1 test 1.234568e-02 30 4 n pi 3 test 9.876543e-01 31 4 n sp 1 test 3.906250e-03 32 4 n sp 2 test 9.960938e-01 33 4 s pi 1 test 3.906250e-03 34 4 s pi 3 test 9.960938e-01 35 4 s sp 1 test 6.250000e-02 36 4 s sp 3 test 9.375000e-01 37 5 n pi 1 test 4.115226e-03 38 5 n pi 3 test 9.958848e-01 39 5 n sp 1 test 9.765625e-04 40 5 n sp 2 test 9.990234e-01 41 5 s pi 1 test 9.765625e-04 42 5 s pi 3 test 9.990234e-01 43 5 s sp 1 test 3.125000e-02 44 5 s sp 3 test 9.687500e-01 45 6 n pi 1 test 1.371742e-03 46 6 n pi 3 test 9.986283e-01 47 6 n sp 1 test 2.441406e-04 48 6 n sp 2 test 9.997559e-01 49 6 s pi 1 test 2.441406e-04 50 6 s pi 3 test 9.997559e-01 51 6 s sp 1 test 1.562500e-02 52 6 s sp 3 test 9.843750e-01 53 7 n pi 1 test 4.572474e-04 54 7 n pi 3 test 9.995428e-01 55 7 n sp 1 test 6.103516e-05 56 7 n sp 2 test 9.999390e-01 57 7 s pi 1 test 6.103516e-05 58 7 s pi 3 test 9.999390e-01 59 7 s sp 1 test 7.812500e-03 60 7 s sp 3 test 9.921875e-01 61 8 n pi 1 test 1.524158e-04 62 8 n pi 3 test 9.998476e-01 63 8 n sp 1 test 1.525879e-05 64 8 n sp 2 test 9.999847e-01 65 8 s pi 1 test 1.525879e-05 66 8 s pi 3 test 9.999847e-01 67 8 s sp 1 test 3.906250e-03 68 8 s sp 3 test 9.960938e-01 69 9 n pi 1 test 5.080526e-05 70 9 n pi 3 test 9.999492e-01 71 9 n sp 1 test 3.814697e-06 72 9 n sp 2 test 9.999962e-01 73 9 s pi 1 test 3.814697e-06 74 9 s pi 3 test 9.999962e-01 75 9 s sp 1 test 1.953125e-03 76 9 s sp 3 test 9.980469e-01 77 10 n pi 1 test 1.693509e-05 78 10 n pi 3 test 9.999831e-01 79 10 n sp 1 test 9.536743e-07 80 10 n sp 2 test 9.999990e-01 81 10 s pi 1 test 9.536743e-07 82 10 s pi 3 test 9.999990e-01 83 10 s sp 1 test 9.765625e-04 84 10 s sp 3 test 9.990234e-01 > > > statespace <- expand.grid(ds=c("sp", "pi"), region=c("n", "s"), vol=1:3, stringsAsFactors=FALSE) > act <- define_activity("test", c("vol")) > statespace1 <- subset(statespace, !(ds=="sp"®ion=="n")) > act <- efdm:::build_complex_statespace(act, statespace1, statespace1, factors=c("ds", "region")) > stopifnot(nrow(act$statespace[[1]])==3) > > statespace <- expand.grid(a=1:2, b=c("f", "g"), c=c(4,9), vol=1:3, stringsAsFactors=FALSE) > ii <- sample(nrow(statespace), sample(nrow(statespace), 1)) > act <- define_activity("test", c("vol")) > act <- efdm:::build_complex_statespace(act, statespace[ii,], statespace[ii,], factors=c("a", "b"), by="c") > expect_identical(sum(sapply(act$statespace, function(x) nrow(x$statespace0))), length(ii)) > > proc.time() user system elapsed 0.89 0.10 0.98