R Under development (unstable) (2025-09-02 r88773 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2025 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.

> 
> ##
> ## example data and test steps from pedigree.shrink
> ## Jason Sinnwell
> ##
> 
> require(kinship2)
Loading required package: kinship2
Loading required package: Matrix
Loading required package: quadprog
Warning: kinship2 package is deprecated for R <= 4.5; switch functionality to Pedixplorer from BioConductor> 
> 
> data(minnbreast)
> pedMN <- with(minnbreast, pedigree(id, fatherid, motherid, sex,famid=famid,
+                          affected=cbind(cancer, bcpc, proband)))
> 
> 
> 
> ## this pedigree as one person with cancer. The pedigree is not informative
> ## if they are the only available, so pedigree.shrink trims all.
> ## This caused an error in pedigree.shrink before kinship2. v1.2.8. Now fixed
> mn2 <- pedMN[2]
> #plot(mn2)
> 
> ## breaks in pedigree.trim
> shrink.mn2 <- pedigree.shrink(mn2,
+                avail=ifelse(is.na(mn2$affected[,1]), 0, mn2$affected[,1]))
> shrink.mn2
Pedigree Size:
                 N.subj Bits
Original             38   19
Only Informative      0    0
Trimmed               0    0

 Unavailable subjects trimmed:
 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 26050 26051 
> 
> mnf8 <- pedMN['8']
> #plot(mnf8)
> shrink.mnf8 <- pedigree.shrink(mnf8,
+               avail=ifelse(is.na(mnf8$affected[,1]), 0, mnf8$affected[,1]))
> 
> shrink.mnf8
Pedigree Size:
                 N.subj Bits
Original             40   26
Only Informative      8    4
Trimmed               8    4

 Unavailable subjects trimmed:
 137 138 139 140 144 145 146 147 148 150 151 152 153 154 155 156 157 158 159 160 163 164 165 166 167 168 169 170 171 172 173 174 
> 
> 
> ## use sample.ped from the package
> data(sample.ped)
> 
> pedAll <- pedigree(sample.ped$id, sample.ped$father, sample.ped$mother, 
+        sample.ped$sex,
+        affected=cbind(sample.ped$affected, sample.ped$avail), 
+        famid=sample.ped$ped)
> 
> 
> ped1 <- pedAll['1']
> 
> ped2 <- pedAll['2']
> 
> ped2$sex[c(13,12)] <- c("unknown", "terminated")
> 
> 
> ## set 2nd col of affected to NA
> ped2$affected[c(7,9),2] <- NA
> 
> 
> set.seed(10)
> shrink1.avail.B32 <- pedigree.shrink(ped=ped1, avail=ped1$affected[,2], maxBits=32)
> 
> set.seed(10)
> shrink1.avail.B25 <- pedigree.shrink(ped=ped1, avail=ped1$affected[,2], maxBits=25)
> 
> shrink1.avail.B32$idTrimmed
 [1] 101 102 107 108 111 113 121 122 123 131 132 134 139
> ## 101 102 107 108 111 121 122 123 131 132 134 139
> shrink1.avail.B25$idTrimmed  
                                                         id 
101 102 107 108 111 113 121 122 123 131 132 134 139 140 141 
> ## 101 102 107 108 111 121 122 123 131 132 134 139 125 126
> 
> print(shrink1.avail.B32)
Pedigree Size:
                 N.subj Bits
Original             41   46
Only Informative     28   29
Trimmed              28   29

 Unavailable subjects trimmed:
 101 102 107 108 111 113 121 122 123 131 132 134 139 
> print(shrink1.avail.B25)
Pedigree Size:
                 N.subj Bits
Original             41   46
Only Informative     28   29
Trimmed              22   23

 Unavailable subjects trimmed:
 101 102 107 108 111 113 121 122 123 131 132 134 139 

 Informative subjects trimmed:
 140 141 
> 
> 
> #Pedigree Size:
> #                 N.subj Bits
> #Original             41   49
> #Only Informative     29   31
> #Trimmed              26   25
> 
> # Unavailable subjects trimmed:
> # 101 102 107 108 111 121 122 123 131 132 134 139 
> #
> # Informative subjects trimmed:
> # 125 126
> 
> ped1df <- as.data.frame(ped1)
> 
> ped1df$idchar <- gsub("^1","A-", as.character(ped1df$id))
> ped1df$dadidchar <- gsub("^1","A-", as.character(ped1df$dadid))
> ped1df$momidchar <- gsub("^1","A-", as.character(ped1df$momid))
> #ped1df$dadidchar <- ifelse(ped1df$dadidchar=="0", NA, ped1df$dadidchar)
> #ped1df$momidchar <- ifelse(ped1df$momidchar=="0", NA, ped1df$momidchar)
> ped1char <- with(ped1df, pedigree(idchar, dadidchar, momidchar, sex, affected,missid=c("0")))
> 
> set.seed(100)
> shrink1.p1char.B32 <- pedigree.shrink(ped=ped1char, avail=ped1char$affected[,2], maxBits=32)
> shrink1.p1char.B32$idTrimmed
 [1] "A-01" "A-02" "A-07" "A-08" "A-11" "A-13" "A-21" "A-22" "A-23" "A-31"
[11] "A-32" "A-34" "A-39"
> shrink1.avail.B32$idTrimmed
 [1] 101 102 107 108 111 113 121 122 123 131 132 134 139
> 
> set.seed(100)
> shrink1.p1char.B25 <- pedigree.shrink(ped=ped1char, avail=ped1char$affected[,2], maxBits=25)
> shrink1.p1char.B25$idTrimmed
 [1] "A-01" "A-02" "A-07" "A-08" "A-11" "A-13" "A-21" "A-22" "A-23" "A-31"
[11] "A-32" "A-34" "A-39" "A-33" "A-41"
> shrink1.avail.B25$idTrimmed
                                                         id 
101 102 107 108 111 113 121 122 123 131 132 134 139 140 141 
> 
> proc.time()
   user  system elapsed 
   1.01    0.17    1.17