Skip to content

Commit 73214a8

Browse files
kingaakingaa
committed
improve testing
1 parent 26ff0f9 commit 73214a8

File tree

6 files changed

+99
-13
lines changed

6 files changed

+99
-13
lines changed

‎DESCRIPTION‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,8 @@
11
Package: pomp
22
Type: Package
33
Title: Statistical Inference for Partially Observed Markov Processes
4-
Version: 5.2.3.3
5-
Date: 2023-06-21
4+
Version: 5.2.3.4
5+
Date: 2023-06-22
66
Authors@R: c(person(given=c("Aaron","A."),family="King",role=c("aut","cre"),email="kingaa@umich.edu",comment=c(ORCID="0000-0001-6159-3207")),
77
person(given=c("Edward","L."),family="Ionides",role="aut",comment=c(ORCID="0000-0002-4190-0174")) ,
88
person(given="Carles",family="Bretó",role="aut",comment=c(ORCID="0000-0003-4695-4902")),

‎R/filter_traj.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -53,7 +53,7 @@ setMethod(
5353
if (missing(vars)) {
5454
x <- object@filter.traj
5555
} else {
56-
x <- object@filter.traj[vars,,drop=FALSE]
56+
x <- object@filter.traj[vars,,,drop=FALSE]
5757
}
5858
format <- match.arg(format)
5959
if (format == "data.frame") {

‎tests/kalman2.R‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -61,8 +61,16 @@ kf |> forecast() |> melt() |> sapply(class)
6161
kf |> forecast(format="d") |> sapply(class)
6262
kf |> filter_mean() |> melt() |> sapply(class)
6363
kf |> filter_mean(format="d") |> sapply(class)
64+
kf |> filter_mean(vars="x") |> dim()
65+
kf |> filter_mean(vars="x") |> dimnames()
66+
kf |> filter_mean(vars="x",format="d") |> dim()
67+
kf |> filter_mean(vars="x",format="d") |> getElement("name") |> unique()
6468
kf |> pred_mean() |> melt() |> sapply(class)
6569
kf |> pred_mean(format="d") |> sapply(class)
70+
kf |> pred_mean(vars="x") |> dim()
71+
kf |> pred_mean(vars="x") |> dimnames()
72+
kf |> pred_mean(vars="x",format="d") |> dim()
73+
kf |> pred_mean(vars="x",format="d") |> getElement("name") |> unique()
6674
try(kf |> pred_var() |> melt() |> sapply(class))
6775
try(kf |> pred_var(format="d") |> sapply(class))
6876
try(kf |> filter_traj() |> melt() |> sapply(class))

‎tests/kalman2.Rout.save‎

Lines changed: 28 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -102,12 +102,40 @@ NOTE: The provided object 'R' is available for use by POMP basic components.
102102
> kf |> filter_mean(format="d") |> sapply(class)
103103
name time value
104104
"character" "numeric" "numeric"
105+
> kf |> filter_mean(vars="x") |> dim()
106+
[1] 1 30
107+
> kf |> filter_mean(vars="x") |> dimnames()
108+
$name
109+
[1] "x"
110+
111+
$time
112+
[1] "1" "2" "3" "4" "5" "6" "7" "8" "9" "10" "11" "12" "13" "14" "15"
113+
[16] "16" "17" "18" "19" "20" "21" "22" "23" "24" "25" "26" "27" "28" "29" "30"
114+
115+
> kf |> filter_mean(vars="x",format="d") |> dim()
116+
[1] 30 3
117+
> kf |> filter_mean(vars="x",format="d") |> getElement("name") |> unique()
118+
[1] "x"
105119
> kf |> pred_mean() |> melt() |> sapply(class)
106120
name time value
107121
"character" "character" "numeric"
108122
> kf |> pred_mean(format="d") |> sapply(class)
109123
name time value
110124
"character" "numeric" "numeric"
125+
> kf |> pred_mean(vars="x") |> dim()
126+
[1] 1 30
127+
> kf |> pred_mean(vars="x") |> dimnames()
128+
$name
129+
[1] "x"
130+
131+
$time
132+
[1] "1" "2" "3" "4" "5" "6" "7" "8" "9" "10" "11" "12" "13" "14" "15"
133+
[16] "16" "17" "18" "19" "20" "21" "22" "23" "24" "25" "26" "27" "28" "29" "30"
134+
135+
> kf |> pred_mean(vars="x",format="d") |> dim()
136+
[1] 30 3
137+
> kf |> pred_mean(vars="x",format="d") |> getElement("name") |> unique()
138+
[1] "x"
111139
> try(kf |> pred_var() |> melt() |> sapply(class))
112140
Error in h(simpleError(msg, call)) :
113141
error in evaluating the argument 'data' in selecting a method for function 'melt': 'pred_var' is undefined for 'object' of class 'kalmand_pomp'.

‎tests/pfilter.R‎

Lines changed: 30 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -61,7 +61,7 @@ theta["alpha_1"] <- 1e60
6161
try(pfilter(pf,params=theta,pred.var=TRUE))
6262

6363
try(pfilter(pf,rprocess=onestep(
64-
function(x, t, params, delta.t, ...)stop("yikes!"))))
64+
function(x, t, params, delta.t, ...)stop("yikes!"))))
6565
try(pfilter(pf,dmeasure=Csnippet("error(\"ouch!\");")))
6666
pfilter(pf,dmeasure=function(log,...) -Inf)
6767
pfilter(pf,dmeasure=function(log,...) -Inf,filter.mean=TRUE)
@@ -72,6 +72,27 @@ pf3 <- pfilter(pf,t0=1,filter.traj=TRUE)
7272
pf4 <- pfilter(pf,dmeasure=Csnippet("lik = (give_log) ? R_NegInf : 0;"),
7373
filter.traj=TRUE)
7474

75+
stopifnot(
76+
pf2 |> filter_mean() |> dim()==c(2,100),
77+
pf2 |> filter_mean(vars="x1") |> dim()==c(1,100),
78+
pf2 |> filter_mean(vars=c("x2","x1")) |> dimnames() |> getElement("name")==c("x2","x1"),
79+
pf2 |> filter_mean(format="d") |> dim()==c(200,3),
80+
pf2 |> filter_mean(vars="x2",format="d") |> dim()==c(100,3),
81+
pf2 |> filter_mean(vars="x2",format="d") |> names()==c("name","time","value"),
82+
pf2 |> pred_mean() |> dim()==c(2,100),
83+
pf2 |> pred_mean(vars="x1") |> dim()==c(1,100),
84+
pf2 |> pred_mean(vars=c("x2","x1")) |> dimnames() |> getElement("name")==c("x2","x1"),
85+
pf2 |> pred_mean(format="d") |> dim()==c(200,3),
86+
pf2 |> pred_mean(vars="x2",format="d") |> dim()==c(100,3),
87+
pf2 |> pred_mean(vars="x2",format="d") |> names()==c("name","time","value"),
88+
pf2 |> pred_var() |> dim()==c(2,100),
89+
pf2 |> pred_var(vars="x1") |> dim()==c(1,100),
90+
pf2 |> pred_var(vars=c("x2","x1")) |> dimnames() |> getElement("name")==c("x2","x1"),
91+
pf2 |> pred_var(format="d") |> dim()==c(200,3),
92+
pf2 |> pred_var(vars="x2",format="d") |> dim()==c(100,3),
93+
pf2 |> pred_var(vars="x2",format="d") |> names()==c("name","time","value")
94+
)
95+
7596
pf1 |> saved_states(format="data") |> names()
7697
pf1 |> saved_states(format="data") |> dim()
7798
pf1 |> saved_states() |> melt() |> sapply(class)
@@ -98,6 +119,10 @@ pf2 |> as.data.frame() |> names()
98119
try(saved_states())
99120
try(saved_states(NULL))
100121
try(saved_states("bob"))
122+
stopifnot(
123+
filter_traj(pf1,vars="x2") |> dim()==c(1,1,101),
124+
filter_traj(pf1,vars="x2",format="d") |> dim()==c(101,4)
125+
)
101126

102127
try(ou2 |> as.data.frame() |> pfilter(Np=1000))
103128

@@ -108,10 +133,10 @@ ou2 |>
108133
times="time",t0=0,Np=500,
109134
params=list(x1_0=-3,x2_0=4),
110135
rprocess=onestep(
111-
step.fun=function(x1,x2,delta.t,...) {
112-
setNames(rnorm(n=2,mean=c(x1,x2),sd=5*delta.t),c("x1","x2"))
113-
}
114-
),
136+
step.fun=function(x1,x2,delta.t,...) {
137+
setNames(rnorm(n=2,mean=c(x1,x2),sd=5*delta.t),c("x1","x2"))
138+
}
139+
),
115140
dmeasure=function(x1,x2,y1,y2,...,log) {
116141
ll <- sum(dnorm(x=c(y1,y2),mean=c(x1,x2),sd=5,log=TRUE))
117142
if (log) ll else exp(ll)

‎tests/pfilter.Rout.save‎

Lines changed: 30 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -146,7 +146,7 @@ sigma_3: 2
146146
Error : in 'pfilter': non-finite state variable: x1
147147
>
148148
> try(pfilter(pf,rprocess=onestep(
149-
+ function(x, t, params, delta.t, ...)stop("yikes!"))))
149+
+ function(x, t, params, delta.t, ...)stop("yikes!"))))
150150
Error : in 'pfilter': in 'rprocess': yikes!
151151
> try(pfilter(pf,dmeasure=Csnippet("error(\"ouch!\");")))
152152
Error : in 'pfilter': in 'dmeasure': ouch!
@@ -161,6 +161,27 @@ Error : in 'pfilter': in 'dmeasure': ouch!
161161
> pf4 <- pfilter(pf,dmeasure=Csnippet("lik = (give_log) ? R_NegInf : 0;"),
162162
+ filter.traj=TRUE)
163163
>
164+
> stopifnot(
165+
+ pf2 |> filter_mean() |> dim()==c(2,100),
166+
+ pf2 |> filter_mean(vars="x1") |> dim()==c(1,100),
167+
+ pf2 |> filter_mean(vars=c("x2","x1")) |> dimnames() |> getElement("name")==c("x2","x1"),
168+
+ pf2 |> filter_mean(format="d") |> dim()==c(200,3),
169+
+ pf2 |> filter_mean(vars="x2",format="d") |> dim()==c(100,3),
170+
+ pf2 |> filter_mean(vars="x2",format="d") |> names()==c("name","time","value"),
171+
+ pf2 |> pred_mean() |> dim()==c(2,100),
172+
+ pf2 |> pred_mean(vars="x1") |> dim()==c(1,100),
173+
+ pf2 |> pred_mean(vars=c("x2","x1")) |> dimnames() |> getElement("name")==c("x2","x1"),
174+
+ pf2 |> pred_mean(format="d") |> dim()==c(200,3),
175+
+ pf2 |> pred_mean(vars="x2",format="d") |> dim()==c(100,3),
176+
+ pf2 |> pred_mean(vars="x2",format="d") |> names()==c("name","time","value"),
177+
+ pf2 |> pred_var() |> dim()==c(2,100),
178+
+ pf2 |> pred_var(vars="x1") |> dim()==c(1,100),
179+
+ pf2 |> pred_var(vars=c("x2","x1")) |> dimnames() |> getElement("name")==c("x2","x1"),
180+
+ pf2 |> pred_var(format="d") |> dim()==c(200,3),
181+
+ pf2 |> pred_var(vars="x2",format="d") |> dim()==c(100,3),
182+
+ pf2 |> pred_var(vars="x2",format="d") |> names()==c("name","time","value")
183+
+ )
184+
>
164185
> pf1 |> saved_states(format="data") |> names()
165186
[1] "time" ".id" "name" "value"
166187
> pf1 |> saved_states(format="data") |> dim()
@@ -234,6 +255,10 @@ Error : in 'saved_states': 'object' is a required argument.
234255
Error : 'saved_states' is undefined for 'object' of class 'NULL'.
235256
> try(saved_states("bob"))
236257
Error : 'saved_states' is undefined for 'object' of class 'character'.
258+
> stopifnot(
259+
+ filter_traj(pf1,vars="x2") |> dim()==c(1,1,101),
260+
+ filter_traj(pf1,vars="x2",format="d") |> dim()==c(101,4)
261+
+ )
237262
>
238263
> try(ou2 |> as.data.frame() |> pfilter(Np=1000))
239264
Error : in 'pfilter': 'times' should either be a numeric vector of observation times or a single name identifying the column of data that represents the observation times.
@@ -245,10 +270,10 @@ Error : in 'pfilter': 'times' should either be a numeric vector of observation t
245270
+ times="time",t0=0,Np=500,
246271
+ params=list(x1_0=-3,x2_0=4),
247272
+ rprocess=onestep(
248-
+ step.fun=function(x1,x2,delta.t,...) {
249-
+ setNames(rnorm(n=2,mean=c(x1,x2),sd=5*delta.t),c("x1","x2"))
250-
+ }
251-
+ ),
273+
+ step.fun=function(x1,x2,delta.t,...) {
274+
+ setNames(rnorm(n=2,mean=c(x1,x2),sd=5*delta.t),c("x1","x2"))
275+
+ }
276+
+ ),
252277
+ dmeasure=function(x1,x2,y1,y2,...,log) {
253278
+ ll <- sum(dnorm(x=c(y1,y2),mean=c(x1,x2),sd=5,log=TRUE))
254279
+ if (log) ll else exp(ll)

0 commit comments

Comments
 (0)