version 2.1-12

cran · Dec 5, 2019 · f9adde3 · f9adde3
1 parent 33afb49
commit f9adde3
Show file tree

Hide file tree

Showing 31 changed files with 107 additions and 51 deletions.
diff --git a/ChangeLog b/ChangeLog
@@ -1165,3 +1165,10 @@ warning that can occur.
 
 Adjusted a comment (in f1()) in ffun.R.
 07/08/2019
+
+Adjusted code to accommodate the fact that R now assigns the class
+of a matrix as c("matrix","array").
+
+Incremented the version number (to 2.1-12).
+Uploaded to CRAN.
+05/12/2019
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: hmm.discnp
-Version: 2.1-11
-Date: 2019-08-07
+Version: 2.1-12
+Date: 2019-12-05
 Title: Hidden Markov Models with Discrete Non-Parametric Observation
         Distributions
 Author: Rolf Turner
@@ -19,6 +19,6 @@ LazyData: true
 ByteCompile: true
 License: GPL (>= 2)
 NeedsCompilation: yes
-Packaged: 2019-08-07 07:05:26 UTC; rolf
+Packaged: 2019-12-05 11:22:05 UTC; rolf
 Repository: CRAN
-Date/Publication: 2019-08-07 12:40:02 UTC
+Date/Publication: 2019-12-05 12:30:02 UTC
diff --git a/MD5 b/MD5
@@ -1,5 +1,5 @@
-fb72361e7ef5e3a01d57493cdfcd716a *ChangeLog
-06f156cf6356e8f2b1138e8d807c09c1 *DESCRIPTION
+fa01911253ebbff67d30dfdf9ec49f80 *ChangeLog
+df2ad06d696fa2882440e5db25bac6b7 *DESCRIPTION
 14c3a38d432b0beee410c1255a86c006 *NAMESPACE
 095b3e16a3334cdf6278ef86a8b40543 *R/First.R
 33b7623305e837aa24a6407e2484ab9f *R/RCS/First.R,v
@@ -49,13 +49,13 @@ fd686611b12e5c472be4bfab32914cbb *R/hmmUV.R
 e438305b8daf6000ed7f71c0ab21d8ff *R/logLikHmm.R
 bae08c5b872237758792e9c3ed80ef4b *R/makeDat.R
 9db16eecc57e143f7e32884996c8e98c *R/misstify.R
-43a7d52e1c26f6ad17383b91a08030f2 *R/mps.R
-710a7a3506ecd2f9baef5195b47e1fe8 *R/nafracCalc.R
+f4aced552a3ac0523897c98d329263d6 *R/mps.R
+58b3c939c624d5a54d81ff40da8c05bb *R/nafracCalc.R
 4e9fb9811cf9f98e1e54bc5c922fbffa *R/orgethgl.R
 7d9d148d9afe47521424064119da6299 *R/paramExtract.R
-fa29f249d1a20ff1b911eda703e75820 *R/pr.R
+a1350829a90b7225cb8d569500e099d5 *R/pr.R
 6bf464b6d7022e202c7d917f0d22281f *R/predict.hmm.discnp.R
-53a84e23aabe1bca23d5bd49eaf1ecf2 *R/predictEngineHmmDiscnp.R
+cd14eac6703ece0100fef23afdb1e60f *R/predictEngineHmmDiscnp.R
 bfbbfb6426423cfc02eb963099a6f2d6 *R/recurse.R
 bab91cc639aec80b6f97be26d6374698 *R/revise.ispd.R
 bdb13252869f8546bddc6df5da13adb6 *R/revise.rho.R
@@ -65,36 +65,36 @@ bdb13252869f8546bddc6df5da13adb6 *R/revise.rho.R
 d32ac2d10f8cef376161d1b949e17698 *R/rhmm.default.R
 7dfa4fdad09ad9424b4a08385728d8df *R/rhmm.hmm.discnp.R
 d9d51b4c16dcaf6b4114d8488b9aa300 *R/scovmat.R
-8a0757c85c527667690a47e3c2fd9db0 *R/sp.R
+a0e678ccebaee3a8c29632b91f063d48 *R/sp.R
 fcc04a6a461c3fa144ce37730a5cbb16 *R/squantCI.R
 88e70a62d93b1e1b1e1066196caea75c *R/steepest.R
 14a6661b5023429624ac39751618082f *R/tidyList.R
 d006a911546289641553b85704e41a57 *R/type4stuff.R
 d0d14eed1ac4b3ec4b4db4ca9a6c7a75 *R/update.hmm.discnp.R
 624c883a77f31a8d3a1a174c7aaba682 *R/viterbi.R
-57de54763966b6ad09dc2f75e1bb56f1 *data/Bovine.rda
-ecb1bf64d3f0bd9eb026bff368703d88 *data/Cryptosporidiosis.rda
-23d9246b3472cab41553d3ca12b47f48 *data/Downloads.rda
-db09cd9d0114d4e0b0ecfe5921db709f *data/EricssonB_Jul2.rda
-b8c42ff8595b87c6c483600d7e146582 *data/FattyLiver.rda
-5119efa152ef6c528a9bb0e0c536e057 *data/FattyLiver2.rda
-1c5a33422909288a3fac9e196618d0e6 *data/Hanta.rda
-4959fa22f178b03d413295282fa7f4f8 *data/IPs.rda
-40d797bb606cb0d4513a7085c30d94d1 *data/InfantEEGsleepstates.rda
-b8a938c13a0cd4a9f505b1c99dc3e645 *data/LegionnairesDisease.rda
-b91affc500894808359ed60483d749db *data/OffshoreRigcountsAlaska.rda
-49c582bcfd6f3f1171ef1bd02f4aa6bd *data/PriceStability.rda
-80f8583f81d932482af9cf23bc3e44f4 *data/Strikes.rda
-d85a7475d85b24644a8546fa71f62981 *data/SydColDisc.rda
-8750667e610ea178d6ea7aa10a9101fd *data/WoodPeweeSong.rda
-eb7d22f1ba36e2550a6c5f5259c5148c *data/ccprSim.rda
-74f712453ef4cca6b0347c708c66627a *data/ftLiardFlows.rda
-8db0ffb63c197b7a79c09043a11370a1 *data/goldparticle380.rda
-bcd8cda916e2d94705f5e701c9a1d012 *data/lesionCount.rda
-e9502fddfe815e2457da1252e990e208 *data/linLandFlows.rda
-6a11ec0eeb16ca9566ae3729db4f9a5b *data/portMannFlows.rda
-b938b79f540c68dccb70efe6b0202f31 *data/portMannSedCon.rda
-59042e6ecccb693e3584c6e88922003f *data/portMannSedLoads.rda
+32954c149feb0b93b4ab0b4eec6bb632 *data/Bovine.rda
+ccf88a728ddf4c3ede54eade3f14b319 *data/Cryptosporidiosis.rda
+c0ea675d4094cce9f7f49c6a6be6a152 *data/Downloads.rda
+1a4981defc1a33fbc8d5c912b35281a6 *data/EricssonB_Jul2.rda
+535e81d6a87c437c378e8d3b8242fac8 *data/FattyLiver.rda
+dba4b56d5a063be04513a16da22046fd *data/FattyLiver2.rda
+53b08dcaca25b1ddd7f8f893119f85b5 *data/Hanta.rda
+d1a29d7c67af055cd8a063d869227431 *data/IPs.rda
+c2430277e312bab49a6ddf9ad335d78e *data/InfantEEGsleepstates.rda
+752fa81147b050a2995bebd0dc9337f7 *data/LegionnairesDisease.rda
+f9f0c661ea2fccdd1a3665f1ce169d1c *data/OffshoreRigcountsAlaska.rda
+1ee09beb7761e5d8bb56ff25356e411b *data/PriceStability.rda
+9dbbd795faaead2e1ac35eb1842cd5a1 *data/Strikes.rda
+038ee97f3598e5e30e9338f28a2e537e *data/SydColDisc.rda
+45a15243acc0646e5c7e260625fbf7a0 *data/WoodPeweeSong.rda
+8691f062ddb778278d0f4336952145d4 *data/ccprSim.rda
+153dc742a60b6a5415e282302a5bb1b2 *data/ftLiardFlows.rda
+5ec6b2939f9688e4253e5610de3feb34 *data/goldparticle380.rda
+0c0c9dee9745d81b6e308486128bf9d7 *data/lesionCount.rda
+f5afb35ca89526bdd28f51f61b80ba99 *data/linLandFlows.rda
+cc7c92cc72cf6ebf1b6b830c2ea800dc *data/portMannFlows.rda
+5e2c4f492b5ffaf43574e00b60c5391d *data/portMannSedCon.rda
+b407047f4bb669b55a3a2a1dcef44c15 *data/portMannSedLoads.rda
 2656ac33803f83f5d131053efc7c4b6b *inst/READ_ME
 dd41961396b612dbb4afc7fdcf73e55e *inst/Ratfor/RCS/afun.r,v
 75869a842561e24d282d8ed2fc73eab8 *inst/Ratfor/RCS/bfun.r,v

diff --git a/R/mps.R b/R/mps.R
@@ -13,7 +13,7 @@ if(!is.null(model)) {
 
 # If Rho is presented in the "logistic style" parameterisation,
 # convert it to a matrix of probabilities.
-if(class(Rho)=="data.frame") Rho <- cnvrtRho(Rho)
+if(inherits(Rho,"data.frame")) Rho <- cnvrtRho(Rho)
 
 stnms <- rownames(tpm)
 if(is.null(ispd)) ispd <- revise.ispd(tpm)
@@ -25,10 +25,19 @@ y <- tidyList(y)
 y <- makeDat(y,X=NULL)
 
 # Set the type:
-type <- switch(class(Rho),data.frame=1, matrix= 2, list=3, array=4, NULL)
-if(is.null(type)) stop("Argument \"Rho\" is not of an appropriate form.\n")
-# Note: type = 1 can't happen here.
-if(is.null(type)) stop("Argument \"Rho\" is not of an appropriate form.\n")
+if(inherits(Rho,"data.frame")) {
+    type <- 1
+} else if(inherits(Rho,"list")) {
+    type <- 3
+} else if(inherits(Rho,c("matrix","array"))) {
+    if(length(dim(Rho))==2) type <- 2
+    else if(length(dim(Rho))==3) type <- 4
+    else stop("Object \"Rho\" can be of dimension 2 or 3 only.\n")
+} else {
+    stop("Object \"Rho\" has an incorrect class.\n")
+}
+# Note: type = 1 can't happen here; Rho would have been converted
+# from data frame to matrix.
 
 Rho  <- check.yval(attr(y,"lvls"),Rho,type,warn=warn)
 lns  <- sapply(y,nrow)

diff --git a/R/nafracCalc.R b/R/nafracCalc.R
@@ -5,13 +5,25 @@ nafracCalc <- function(y,drop=TRUE){
         return(rslt)
     }
     if(!is.list(y)) y <- list(y)
-    cls <- unique(sapply(y,class))
-    if(length(cls) > 1) stop("The list \"y\" has entries of different classes.\n")
-    if(!cls %in% c("matrix","character","integer","numeric","factor")) {
+
+# Check that the entries of y all have the same class and that this
+# class is appropriate.
+    elsie <- unique(sapply(y,function(x){length(class(x))}))
+    if(length(elsie) > 1)
+        stop("The list \"y\" has entries with classes of different lengths.\n")
+    m   <- matrix(unlist(lapply(y,class)),nrow=length(y),byrow=TRUE)
+    ndm <- !duplicated(m)
+    if(sum(ndm) > 1)
+        stop("The list \"y\" has entries of different classes.\n")
+    if(!inherits(y[[1]],
+            c("matrix","character","integer","numeric","factor"))) {
+        cls <- paste(m[ndm,],collapse=" ")
         whinge <- paste0("The class of the entries of the list \"y\" is\n",
-                         "\"",cls,"\" which is inappropriate.\n")
+                         "  \"",cls,"\" which is inappropriate.\n")
         stop(whinge)
     }
+
+# Now count the missing values.
     aaa <- sapply(y,function(x){apply(as.matrix(x),2,function(z){sum(is.na(z))})})
     bbb <- sapply(y,function(x){apply(as.matrix(x),2,length)},simplify="array")
     num <- if(is.matrix(aaa)) apply(aaa,1,sum) else (sum(aaa))

diff --git a/R/pr.R b/R/pr.R
@@ -10,12 +10,22 @@ if(!is.null(model)) {
 
 # If Rho is presented in the "logistic style" parameterisation,
 # convert it to a matrix of probabilities.
-if(class(Rho)=="data.frame") Rho <- cnvrtRho(Rho)
+if(inherits(Rho,"data.frame")) Rho <- cnvrtRho(Rho)
 
 # Set the type:
-type <- switch(class(Rho),data.frame=1, matrix= 2, list=3, array=4, NULL)
-if(is.null(type)) stop("Argument \"Rho\" is not of an appropriate form.\n")
-# Note: type = 1 can't happen here.
+if(inherits(Rho,"data.frame")) {
+    type <- 1
+} else if(inherits(Rho,"list")) {
+    type <- 3
+} else if(inherits(Rho,c("matrix","array"))) {
+    if(length(dim(Rho))==2) type <- 2
+    else if(length(dim(Rho))==3) type <- 4
+    else stop("Object \"Rho\" can be of dimension 2 or 3 only.\n")
+} else {
+    stop("Object \"Rho\" has an incorrect class.\n")
+}
+# Note: type = 1 can't happen here; Rho would have been converted
+# from data frame to matrix.
 
 if(missing(y)) {
 	y <- if(!is.null(model)) model$y else NULL

diff --git a/R/predictEngineHmmDiscnp.R b/R/predictEngineHmmDiscnp.R
@@ -1,8 +1,17 @@
 predictEngineHmmDiscnp <- function(stateProbs,Rho,numb,drop) {
 
 # Set the type:
-type <- switch(class(Rho),data.frame=1, matrix=2, list=3, array=4, NULL)
-if(is.null(type)) stop("Argument \"Rho\" is not of an appropriate form.\n")
+if(inherits(Rho,"data.frame")) {
+    type <- 1
+} else if(inherits(Rho,"list")) {
+    type <- 3
+} else if(inherits(Rho,c("matrix","array"))) {
+    if(length(dim(Rho))==2) type <- 2
+    else if(length(dim(Rho))==3) type <- 4
+    else stop("Object \"Rho\" can be of dimension 2 or 3 only.\n")
+} else {
+    stop("Object \"Rho\" has an incorrect class.\n")
+}
 
 if(!is.list(stateProbs)) stateProbs <- list(stateProbs)
 fitVal <- switch(type,

diff --git a/R/sp.R b/R/sp.R
@@ -18,8 +18,17 @@ sp <- function (y, model = NULL, tpm=NULL, Rho=NULL, ispd=NULL, X=NULL,
     if(is.null(ispd)) ispd <- revise.ispd(tpm)
 
 # Set the type:
-    type <- switch(class(Rho),data.frame=1, matrix=2, list=3, array=4, NULL)
-    if(is.null(type)) stop("Argument \"Rho\" is not of an appropriate form.\n")
+if(inherits(Rho,"data.frame")) {
+    type <- 1
+} else if(inherits(Rho,"list")) {
+    type <- 3
+} else if(inherits(Rho,c("matrix","array"))) {
+    if(length(dim(Rho))==2) type <- 2
+    else if(length(dim(Rho))==3) type <- 4
+    else stop("Object \"Rho\" can be of dimension 2 or 3 only.\n")
+} else {
+    stop("Object \"Rho\" has an incorrect class.\n")
+}
 
 # Tidy up y and check on compatibility of y and Rho.
     y <- tidyList(y)

diff --git a/data/Bovine.rda b/data/Bovine.rda
diff --git a/data/Cryptosporidiosis.rda b/data/Cryptosporidiosis.rda
diff --git a/data/Downloads.rda b/data/Downloads.rda
diff --git a/data/EricssonB_Jul2.rda b/data/EricssonB_Jul2.rda
diff --git a/data/FattyLiver.rda b/data/FattyLiver.rda
diff --git a/data/FattyLiver2.rda b/data/FattyLiver2.rda
diff --git a/data/Hanta.rda b/data/Hanta.rda
diff --git a/data/IPs.rda b/data/IPs.rda
diff --git a/data/InfantEEGsleepstates.rda b/data/InfantEEGsleepstates.rda
diff --git a/data/LegionnairesDisease.rda b/data/LegionnairesDisease.rda
diff --git a/data/OffshoreRigcountsAlaska.rda b/data/OffshoreRigcountsAlaska.rda
diff --git a/data/PriceStability.rda b/data/PriceStability.rda
diff --git a/data/Strikes.rda b/data/Strikes.rda
diff --git a/data/SydColDisc.rda b/data/SydColDisc.rda
diff --git a/data/WoodPeweeSong.rda b/data/WoodPeweeSong.rda
diff --git a/data/ccprSim.rda b/data/ccprSim.rda
diff --git a/data/ftLiardFlows.rda b/data/ftLiardFlows.rda
diff --git a/data/goldparticle380.rda b/data/goldparticle380.rda
diff --git a/data/lesionCount.rda b/data/lesionCount.rda
diff --git a/data/linLandFlows.rda b/data/linLandFlows.rda
diff --git a/data/portMannFlows.rda b/data/portMannFlows.rda
diff --git a/data/portMannSedCon.rda b/data/portMannSedCon.rda
diff --git a/data/portMannSedLoads.rda b/data/portMannSedLoads.rda