fix class()== issues, and Matrix updates

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: kinship2
-Version: 1.9.2
-Date: 2022-09-09
+Version: 1.9.3
+Date: 2022-09-27
 Title: Pedigree Functions
 Authors@R: c(
 	person("Jason", "Sinnwell", email="[email protected]", role=c("aut","cre")),
@@ -9,7 +9,7 @@ Authors@R: c(
 	person("Elizabeth", "Atkinson", role="ctb"),
 	person("Carly", "Mester", role='ctb'))
 Depends: 
-	 R (>= 3.5.0),
+	 R (>= 3.6.0),
 	 Matrix,
 	 quadprog
 Imports: 
@@ -26,5 +26,5 @@ Description: Routines to handle family data with a pedigree object. The initial
 	     with various criteria, and kinship for the X chromosome.
 License: GPL (>= 2)
 URL: https://cran.r-project.org/package=kinship2
-RoxygenNote: 7.0.2
+RoxygenNote: 7.2.1
 VignetteBuilder: knitr

NAMESPACE

@@ -1,5 +1,6 @@
 import(Matrix)
 import(quadprog)
+import(knitr)
 importFrom("graphics", "frame", "legend", "lines", "par", "plot",
            "plot.new", "plot.window", "points", "polygon", "segments",
            "strheight", "strwidth", "text")
@@ -13,7 +14,7 @@ export(plot.pedigree, print.pedigree, as.data.frame.pedigree)
 export(pedigree.shrink, pedigree.trim, pedigree.unrelated, bitSize)
 export(print.pedigree.shrink, plot.pedigree.shrink) #, dim.pedigree)
 export(findUnavailable, findAvailNonInform, findAvailAffected)
-export(printBanner, fixParents, legendPlot)
+export(fixParents, legendPlot)
 S3method(plot, pedigree)
 S3method(kinship, pedigree)
 S3method(kinship, default)

R/align.pedigree.R

@@ -2,7 +2,7 @@
 
 align.pedigree <- function(ped, packed=TRUE, width=10, align=TRUE, hints=ped$hints) {
 
-    if (class(ped)== 'pedigreeList') {
+    if ('pedigreeList' %in% class(ped)) {
         nped <- length(unique(ped$famid))
         alignment <- vector('list', nped)
         for (i in 1:nped) {
@@ -17,7 +17,7 @@ align.pedigree <- function(ped, packed=TRUE, width=10, align=TRUE, hints=ped$hin
     if (is.null(hints)) {
       hints <- try({autohint(ped)}, silent=TRUE)
       ## sometimes appears dim(ped) is empty (ped is NULL), so try fix here: (JPS 6/6/17
-      if(class(hints)=="try-error") hints <- list(order=seq_len(max(1, dim(ped)))) ## 1:dim(ped))
+      if("try-error" %in% class(hints)) hints <- list(order=seq_len(max(1, dim(ped)))) ## 1:dim(ped))
     } else {
       hints <- check.hint(hints, ped$sex)
     }

R/as.data.frame.pedigree.R

@@ -1,4 +1,19 @@
-# Automatically generated from all.nw using noweb
+#' data.frame from a pedigree object
+#'
+#' Extract the internal data from a pedigree object into a data.frame
+#'
+#' @param x pedigree object
+#' @param ... additional arguments passed to internal methods
+#' @return a data.frame with the data necessary to re-create the pedigree,
+#' minus special relationships.
+#' #' @author Jason Sinnwell
+#' @seealso \code{\link{pedigree}}
+#' @name as.data.frame.pedigree
+NULL
+#> NULL
+
+#' @rdname as.data.frame.pedigree
+#' @export
 
 as.data.frame.pedigree <- function(x, ...) {
 

R/bitSize.R

@@ -3,8 +3,8 @@
 bitSize <- function(ped) {
   ## calculate bit size of a pedigree
 
-if(class(ped)[1] != "pedigree")
-  stop("Must be a pegigree object.\n")
+  if(!("pedigree" %in% class(ped)))
+    stop("Must be a pegigree object.\n")
 
   father = ped$findex
   mother = ped$mindex

R/kindepth.R

@@ -8,7 +8,7 @@
 # full argument list.  In the former case we can simply skip a step
 
 kindepth <- function(id, dad.id, mom.id, align=FALSE) {
-    if (class(id)=='pedigree' || class(id)=='pedigreeList') {
+    if ("pedigree" %in% class(id) || "pedigreeList" %in% class(id)) {
         didx <- id$findex
         midx <- id$mindex
         n <- length(didx)

R/pedigree.legend.R

@@ -5,7 +5,6 @@
 #' @param ped Pedigree data frame with ped (pedigree id), id (id of individual),
 #'   father (id of father), mother (id of mother), sex, affected (affection status), 
 #'   and avail (DNA availability).
-#' 
 #' @param labels names for the affected indicators
 #' @param edges Number of edges for each polygon. Higher numbers give better
 #' resolution for the circle

R/pedigree.shrink.R

@@ -36,7 +36,7 @@ NULL
 #' @rdname pedigree.shrink
 #' @export
 pedigree.shrink <- function(ped, avail, affected=NULL, maxBits = 16) {
-  if(inherits(ped, "pedigree"))
+  if(!inherits(ped, "pedigree"))
     stop("Must be a pegigree object.\n")  
 
   if(any(is.na(avail)))

R/pedigree.trim.R

@@ -4,8 +4,8 @@ pedigree.trim <- function(removeID, ped){
 ## trim subjects from a pedigree who match the removeID 
 ## trim relation matrix as well
 
-if(class(ped)[1] != "pedigree")
-  stop("Must be a pegigree object.\n")
+  if(!("pedigree" %in% class(ped)))
+    stop("Must be a pegigree object.\n")
 
   rmidx <- match(removeID, ped$id)
   if(length(rmidx)>0) {

tests/failure.R

@@ -7,21 +7,19 @@ require(kinship2)
 #data(testped2)
 data(sample.ped)
 
-
-
 # rearrange the founders to get a nicer plot
 df1<- sample.ped[sample.ped$ped==1,]
 
 ped1 <- with(df1, pedigree(id, father, mother, sex, affected))
 
-plot(ped1)
+#plot(ped1)
 
 df1reord <- df1[c(35:41,1:34),]
 ped1reord <- with(df1reord, pedigree(id, father, mother, 
        sex, affected=affected))
 
 
-plot(ped1reord, col=df1reord$avail+1)
+#plot(ped1reord, col=df1reord$avail+1)
 
 
 # Two brothers married two sisters, which is currently "too much" for

tests/failure.Rout.save

@@ -1,13 +1,14 @@
 
-R version 2.15.0 (2012-03-30)
-Copyright (C) 2012 The R Foundation for Statistical Computing
-ISBN 3-900051-07-0
-Platform: x86_64-unknown-linux-gnu (64-bit)
+R Under development (unstable) (2022-09-11 r82834) -- "Unsuffered Consequences"
+Copyright (C) 2022 The R Foundation for Statistical Computing
+Platform: x86_64-pc-linux-gnu (64-bit)
 
 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.
 
+  Natural language support but running in an English locale
+
 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.
@@ -16,41 +17,36 @@ 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.
 
-> 
-> require(kinship2)
+R> 
+R> require(kinship2)
 Loading required package: kinship2
 Loading required package: Matrix
-Loading required package: lattice
 Loading required package: quadprog
-> #
-> # Here is a case where the levels fail to line up properly
-> #
-> 
-> #data(testped2)
-> data(sample.ped)
-> 
-> 
-> 
-> # rearrange the founders to get a nicer plot
-> df1<- sample.ped[sample.ped$ped==1,]
-> 
-> ped1 <- with(df1, pedigree(id, father, mother, sex, affected))
-> 
-> plot(ped1)
-Did not plot the following people: 113 
-> 
-> df1reord <- df1[c(35:41,1:34),]
-> ped1reord <- with(df1reord, pedigree(id, father, mother, 
+R> #
+R> # Here is a case where the levels fail to line up properly
+R> #
+R> 
+R> #data(testped2)
+R> data(sample.ped)
+R> 
+R> # rearrange the founders to get a nicer plot
+R> df1<- sample.ped[sample.ped$ped==1,]
+R> 
+R> ped1 <- with(df1, pedigree(id, father, mother, sex, affected))
+R> 
+R> #plot(ped1)
+R> 
+R> df1reord <- df1[c(35:41,1:34),]
+R> ped1reord <- with(df1reord, pedigree(id, father, mother, 
 +        sex, affected=affected))
-> 
-> 
-> plot(ped1reord, col=df1reord$avail+1)
-Did not plot the following people: 113 
-> 
-> 
-> # Two brothers married two sisters, which is currently "too much" for
-> #  the kindepth routine.
-> 
+R> 
+R> 
+R> #plot(ped1reord, col=df1reord$avail+1)
+R> 
+R> 
+R> # Two brothers married two sisters, which is currently "too much" for
+R> #  the kindepth routine.
+R> 
 > proc.time()
    user  system elapsed 
-  2.925   0.144   3.173 
+  2.159   0.145   2.472 

tests/makefam.Rout.save

@@ -1,13 +1,14 @@
 
-R version 2.15.0 (2012-03-30)
-Copyright (C) 2012 The R Foundation for Statistical Computing
-ISBN 3-900051-07-0
-Platform: x86_64-unknown-linux-gnu (64-bit)
+R Under development (unstable) (2022-09-11 r82834) -- "Unsuffered Consequences"
+Copyright (C) 2022 The R Foundation for Statistical Computing
+Platform: x86_64-pc-linux-gnu (64-bit)
 
 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.
 
+  Natural language support but running in an English locale
+
 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.
@@ -16,22 +17,23 @@ 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(kinship2)
+[Previously saved workspace restored]
+
+R> library(kinship2)
 Loading required package: Matrix
-Loading required package: lattice
 Loading required package: quadprog
-> aeq <- function(x,y) all.equal(as.vector(x), as.vector(y))
-> #
-> # A pedigree that can cause problems, due to a double marriage
-> #
-> id <- 1:20
-> mom<- c(0,0,0,2,2,2,0,2,0, 0,2,2,0,2,0,2, 7,7, 11,14)
-> dad<- c(0,0,0,1,1,1,0,1,0, 0,3,3,0,3,0,3, 8,8, 10,13)
-> 
-> temp<- makefamid(id, mom, dad)
-> aeq(temp, pmin(temp,1))
+R> aeq <- function(x,y) all.equal(as.vector(x), as.vector(y))
+R> #
+R> # A pedigree that can cause problems, due to a double marriage
+R> #
+R> id <- 1:20
+R> mom<- c(0,0,0,2,2,2,0,2,0, 0,2,2,0,2,0,2, 7,7, 11,14)
+R> dad<- c(0,0,0,1,1,1,0,1,0, 0,3,3,0,3,0,3, 8,8, 10,13)
+R> 
+R> temp<- makefamid(id, mom, dad)
+R> aeq(temp, pmin(temp,1))
 [1] TRUE
-> 
+R> 
 > proc.time()
    user  system elapsed 
-  2.594   0.109   2.781 
+  2.181   0.136   2.392 

tests/monozygote.Rout.save

@@ -1,12 +1,14 @@
 
-R version 4.0.2 (2020-06-22) -- "Taking Off Again"
-Copyright (C) 2020 The R Foundation for Statistical Computing
+R Under development (unstable) (2022-09-11 r82834) -- "Unsuffered Consequences"
+Copyright (C) 2022 The R Foundation for Statistical Computing
 Platform: x86_64-pc-linux-gnu (64-bit)
 
 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.
 
+  Natural language support but running in an English locale
+
 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.
@@ -15,12 +17,14 @@ 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.
 
-> require(kinship2)
+[Previously saved workspace restored]
+
+R> require(kinship2)
 Loading required package: kinship2
 Loading required package: Matrix
 Loading required package: quadprog
-> 
-> twindat <- c(1,3,4,2,
+R> 
+R> twindat <- c(1,3,4,2,
 +              2,0,0,1,
 +              3,8,7,1,
 +              4,6,5,2,
@@ -43,27 +47,27 @@ Loading required package: quadprog
 +              204,2,1,1,
 +              205,107,102,1,
 +              206,108,103,2)
-> twindat <- matrix(twindat, ncol=4, byrow=T)
-> dimnames(twindat) <- list(NULL, c('id', 'dadid', 'momid', 'sex'))
-> twindat <- data.frame(twindat)
->  
-> relate=data.frame(id1=c(101,102,101,104,203), id2=c(102,103,103,105,204), 
+R> twindat <- matrix(twindat, ncol=4, byrow=T)
+R> dimnames(twindat) <- list(NULL, c('id', 'dadid', 'momid', 'sex'))
+R> twindat <- data.frame(twindat)
+R>  
+R> relate=data.frame(id1=c(101,102,101,104,203), id2=c(102,103,103,105,204), 
 +                   code=c(1,1,1,2,1))
-> #
-> # Renumber everyone as 1,2,....; makes the all.equal checks easier
-> indx <- sort(unique(unlist(twindat[,1:3])))
-> twindat$id <- match(twindat$id, indx) -1
-> twindat$dadid <- match(twindat$dadid, indx) -1
-> twindat$momid <- match(twindat$momid, indx) -1
-> relate$id1 <- match(relate$id1, indx) -1
-> relate$id2 <- match(relate$id2, indx) -1
->  
-> # Build the pedigree and kinship
-> tped <- with(twindat, pedigree(id, dadid, momid, sex,
+R> #
+R> # Renumber everyone as 1,2,....; makes the all.equal checks easier
+R> indx <- sort(unique(unlist(twindat[,1:3])))
+R> twindat$id <- match(twindat$id, indx) -1
+R> twindat$dadid <- match(twindat$dadid, indx) -1
+R> twindat$momid <- match(twindat$momid, indx) -1
+R> relate$id1 <- match(relate$id1, indx) -1
+R> relate$id2 <- match(relate$id2, indx) -1
+R>  
+R> # Build the pedigree and kinship
+R> tped <- with(twindat, pedigree(id, dadid, momid, sex,
 +                                relation=relate))
-> kmat <- kinship(tped)
-> 
-> truth <- matrix(c(5,6, 0,
+R> kmat <- kinship(tped)
+R> 
+R> truth <- matrix(c(5,6, 0,
 +                   5,4, .25,    #parent child
 +                   10,11,.5,    # mz twins
 +                   22,12, .25,  # aunt, mz with mother
@@ -74,10 +78,10 @@ Loading required package: quadprog
 +                   19, 11, .125, # aunt who is a twin
 +                   19, 3,  .125), #grandmother
 +                 byrow=T, ncol=3)
-> 
-> all.equal(kmat[truth[,1:2]], truth[,3])
+R> 
+R> all.equal(kmat[truth[,1:2]], truth[,3])
 [1] TRUE
-> 
+R> 
 > proc.time()
    user  system elapsed 
-  1.116   0.118   1.288 
+  2.177   0.133   2.389