

> data.table::setDTthreads(1)
> 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"&region=="n"), factors=c("ds", "region"), prior="nochange")
> act2 <- define_activity("test", c("vol"))
> transprobs(act2) <- estimatetransprobs("vol", NULL, subset(statespace, !(ds=="sp"&region=="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"&region=="n"), subset(statespace, ds=="sp"&region=="n"), factors=c("ds", "region"), prior="nochange")
> act2 <- define_activity("test", c("vol"))
> transprobs(act2) <- estimatetransprobs("vol", subset(pairdata, !(ds=="sp"&region=="n")), subset(statespace, !(ds=="sp"&region=="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"&region=="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))
>
