version 0.7.2

DESCRIPTION

@@ -1,8 +1,9 @@
 Package: KLINK
 Title: Kinship Analysis with Linked Markers
-Version: 0.6.1
+Version: 0.7.2
 Authors@R: 
-    person("Magnus Dehli", "Vigeland", , "m.d.vigeland@medisin.uio.no", role = c("aut", "cre"))
+    person("Magnus Dehli", "Vigeland", , "m.d.vigeland@medisin.uio.no", role = c("aut", "cre"),
+    comment = c(ORCID = "0000-0002-9134-4962"))
 Description: A 'shiny' application for forensic kinship testing, based on
     the 'pedsuite' R packages. 'KLINK' is closely aligned with the (non-R)
     software 'Familias' and 'FamLink', but offers several unique features,
@@ -13,16 +14,17 @@ License: GPL (>= 3)
 URL: https://github.com/magnusdv/KLINK
 BugReports: https://github.com/magnusdv/KLINK/issues
 Depends: R (>= 4.1)
-Imports: forrel (>= 1.5.3), gt (>= 0.9.0), openxlsx, pedmut (>= 0.6.0),
-        pedprobr (>= 0.8.0), pedtools (>= 2.3.1), pkgload, shiny (>=
-        1.7.4), shinydashboard, utils, verbalisr
+Imports: forrel (>= 1.6.0), gt (>= 0.9.0), openxlsx, pedFamilias,
+        pedmut (>= 0.7.1), pedprobr (>= 0.8.0), pedtools (>= 2.5.0),
+        shiny (>= 1.7.4), shinydashboard, verbalisr, zip
 Encoding: UTF-8
 Language: en-GB
 LazyData: true
 RoxygenNote: 7.2.3
 NeedsCompilation: no
-Packaged: 2023-08-29 18:55:38 UTC; magnusdv
+Packaged: 2023-11-09 10:00:57 UTC; magnu
 Author: Magnus Dehli Vigeland [aut, cre]
+    (<https://orcid.org/0000-0002-9134-4962>)
 Maintainer: Magnus Dehli Vigeland <m.d.vigeland@medisin.uio.no>
 Repository: CRAN
-Date/Publication: 2023-08-30 15:50:08 UTC
+Date/Publication: 2023-11-09 11:40:10 UTC

MD5

@@ -1,22 +1,32 @@
-e8336e02ee096107e126242083d23fd7 *DESCRIPTION
-6aab6fb3adaab3a0e3e31e4ac3f7fc32 *NAMESPACE
-9ce4ccc49456063b961597c67c082b7e *NEWS.md
-95ddc64656607b5ce629ba41370fa956 *R/KLINK-package.R
-573c166330c824bc4bd8717b227d0bd2 *R/data.R
-ca7f32b9dea511afb1b222b71caf9d7f *R/karyo.R
-f2c422c64d244aaa3e808ebe2bbc01e0 *R/linkedLR.R
-00de0e301b353dd38711b945e60703e8 *R/loadFamFile.R
-c0a380c479bf947092cd80b2b0f90aca *R/lumping.R
-de37c8fa4ad045e82e0ea3c775089599 *R/markerSummary.R
-3e2bb3055512cf6b37728e46f3a33c52 *R/plotPed.R
+faa6f9cb3a01d5458fa47f2869d98fb6 *DESCRIPTION
+7a89d43a9c9430120214fe4df987f2fa *NAMESPACE
+f493972d51a8edabdb407022095f06e4 *NEWS.md
+9aacc060412c3ca3797e20344f296904 *R/KLINK-package.R
+141f30beb43a6a4fbe9d1604ec554c59 *R/data.R
+f9f061099af30d4190d7ad77e57659f8 *R/karyo.R
+5a6b9707a7618784f0586d6523e6424e *R/launchApp.R
+bcf6bd7ef3d572fe0dfe40046cfafc4f *R/linkedLR.R
+ce2a9a577ce3e9d73edcc0128d008597 *R/loadFamFile.R
+ac91fee2659ab1410680a683633d075c *R/lumping.R
+1eba8608f13a77eea15bcb4342e92555 *R/markerSummary.R
+fd96cdda7ba1c8b28d261cb2ab59f8b1 *R/plotPed.R
 c42aa511a6d6be1b96e840c3759b1457 *R/prettyTable.R
-008c5dbc9667d2df930b8291f1a93463 *R/runKLINK.R
-1461e007b0aea83e99f588b6ce6ac41b *R/utils.R
-d1557d1b1f8eb175425ed014abc4b541 *R/writeResult.R
-9e85584d05e70582264591e361708aae *README.md
+6b4d4fb696f91344bc1133d26815e286 *R/utils.R
+f0e62e010815a5b5b7120a3bb9f50683 *R/writeMasked.R
+ebcaea0db46aba88b9c44fb80c19be70 *R/writeResult.R
+3fcd4a5f25a56b35e2790a7bbbd28f13 *R/zzz.R
+5c828905e83eb4cc4ee131b96799ed7c *README.md
 df96c66f43a4fd12699a81b16f8db9a1 *data/LINKAGEMAP.rda
+6da26be792f1a70cfbfb71a975fb4a74 *data/paternity.rda
 4457ee18ae36d06765bc11a9d849cb85 *inst/extdata/halfsib-test.fam
-7292f31ac558c5cd9bbf13004dcc4c62 *man/KLINK-package.Rd
-8fba5f586d2bf351f01b15133c25dcb9 *man/LINKAGEMAP.Rd
+8ccabc0a5158c87fe2ec33d5e6b47d32 *inst/shiny/app.R
+7ea88a9eae171ad249eeb70a0c01be34 *inst/shiny/www/GA.html
+5502540fdf959e5bc95aca30381687cf *man/KLINK-package.Rd
+bc38b9457777b038d02cea5024ee8a4f *man/LINKAGEMAP.Rd
+c7ca2a6d48e297391fa8b3eb8977a58c *man/figures/screenshot-klink.png
+49c7df0c785cefe6eee1977ef414289f *man/launchApp.Rd
 881028ce6a09bf7e231540991c5620bb *man/linkedLR.Rd
-a480e01e738deec0ea9f9eb81cb5492d *man/runKLINK.Rd
+b13e21309edb7e3f85daaa39a7ab2a4c *man/loadFamFile.Rd
+b9ed854ce16edf7a35a687709c805d01 *man/markerSummary.Rd
+52b9f0df18639509a3c9f1c47e710615 *man/paternity.Rd
+cfca8da63aedfd2f32b01c525184139b *man/writeResult.Rd

NAMESPACE

@@ -1,16 +1,19 @@
-# Generated by roxygen2: do not edit by hand
-
-export(linkedLR)
-export(runKLINK)
-import(gt)
-import(openxlsx)
-import(pedtools)
-import(shiny, except = c(singleton, is.singleton))
-import(shinydashboard)
-importFrom(graphics,legend)
-importFrom(graphics,par)
-importFrom(graphics,plot.new)
-importFrom(graphics,points)
-importFrom(graphics,rect)
-importFrom(graphics,text.default)
-importFrom(utils,packageDescription)
+# Generated by roxygen2: do not edit by hand
+
+export(launchApp)
+export(linkedLR)
+export(loadFamFile)
+export(markerSummary)
+export(runKLINK)
+export(writeResult)
+import(gt)
+import(openxlsx)
+import(pedtools)
+import(shiny, except = c(singleton, is.singleton))
+import(shinydashboard)
+importFrom(graphics,legend)
+importFrom(graphics,par)
+importFrom(graphics,plot.new)
+importFrom(graphics,points)
+importFrom(graphics,rect)
+importFrom(graphics,text.default)

NEWS.md

@@ -1,3 +1,36 @@
+# KLINK 0.7.2
+
+* Internal reorganisation, moving the Shiny code to `inst/shiny/app.R`.
+
+* `launchApp()` is now the main launching function, with `runKLINK()` as an alias.
+
+* Fixes a minor regression error in the previous version.
+
+
+# KLINK 0.7.1
+
+* New button "Mask" for downloading a masked version of the dataset.
+
+* Reading/writing .fam files is now handled by the new package `pedFamilias()`, which has been split out from `forrel`.
+
+* Added R option `KLINK.debug` which can be set to TRUE for debugging (only when running KLINK from R). 
+
+* Use (experimental) `autoScale` option in pedigree plots.
+
+* Minor internal tweaks and bug fixes.
+
+
+# KLINK 0.7.0
+
+* Although KLINK is primarily a Shiny app, the package now documents and exports the main functions, enabling analysis in R as well.
+
+* Added new dataset `paternity`, with simulated data for a paternity case (including a mutation).
+
+* Improved formatting in output Excel document.
+
+* Simplified code in sync with recent pedsuite updates. The plots may appear slightly modified.
+
+
 # KLINK 0.6.1
 
 * First CRAN release.

R/KLINK-package.R

@@ -3,15 +3,15 @@
 
 ## usethis namespace: start
 #' @rawNamespace import(shiny, except = c(singleton, is.singleton))
-#' @import shinydashboard
 #' @import gt
 #' @import openxlsx
 #' @import pedtools
+#' @import shinydashboard
 ## usethis namespace: end
 NULL
 
 
 # Hack to avoid CRAN note. (load_all is only used in app.R which is in Rbuildignore.)
 ignore_unused_imports = function() {
-  pkgload::load_all
+  zip::zip
 }

R/data.R

@@ -1,7 +1,21 @@
 #' Built-in linkage map
 #'
-#' A genetic map including 9 pairs of linked STR markers
+#' A genetic map including 9 pairs of linked STR markers.
 #'
 #' @format A data frame with 18 rows and 5 columns.
 #'
 "LINKAGEMAP"
+
+
+#' Dataset for a paternity case
+#'
+#' A list of two pedigrees forming the hypotheses in a paternity case: H1 (`AF` is
+#' the father of `CH`) and H2 (unrelated). `AF` and `CH` are genotyped with 11
+#' markers, with allele frequencies from `forrel::NorwegianFrequencies`.
+#'
+#' @format A list of two pedigrees, named H1 and H2.
+#'
+#' @examples
+#' pedtools::plotPedList(paternity, marker = "SE33")
+#' forrel::kinshipLR(paternity)
+"paternity"

R/karyo.R

@@ -22,6 +22,11 @@ karyogram = function(markerdata, cols = KARYOPALETTE, bgcol = "gray92") {
          pch = 21, pt.cex = 2.2, pt.bg = cols[1:9], bty = "n")
 }
 
+
+
+# Hardcoded parameters ----------------------------------------------------
+
+
 CHROM.MB = c(247.2, 242.9, 199.5, 191.3, 180.9, 170.9, 158.8, 146.3, 140.3,
              135.4, 134.4, 132.3, 114.1, 106.4, 100.3,  88.8,  78.8, 76.1,
              63.8,  62.4,  46.9,  49.7)

R/launchApp.R

@@ -0,0 +1,20 @@
+#' Launch KLINK
+#'
+#' This launches the KLINK app. `runKLINK()` is a synonym for `launchApp()`.
+#'
+#' @return No return value, called for side effects.
+#'
+#' @examples
+#'
+#' \dontrun{
+#' launchApp()
+#' }
+#'
+#' @export
+launchApp = function() {
+  shiny::runApp(system.file("shiny", package = "KLINK"))
+}
+
+#' @export
+#' @rdname launchApp
+runKLINK = launchApp

R/linkedLR.R

@@ -27,6 +27,7 @@
 #'
 #' @export
 linkedLR = function(pedigrees, linkageMap, markerData = NULL, mapfun = "Kosambi") {
+  if (getOption("KLINK.debug")) print("linkedLR")
 
   if(is.null(markerData))
     markerData = markerSummary(pedigrees, linkageMap)
@@ -63,7 +64,11 @@ linkedLR = function(pedigrees, linkageMap, markerData = NULL, mapfun = "Kosambi"
 
   # No-mutation versions
   pedsNomut = lapply(pedigrees, function(x) setMutmod(x, model = NULL))
-  LRnomut = forrel::kinshipLR(pedsNomut, markers = res$Marker)$LRperMarker[,1]
+  LRnomut = forrel::kinshipLR(pedsNomut, markers = res$Marker)$LRperMarker[, 1]
+
+  # Fix lost names when only 1 marker
+  if(is.null(names(LRnomut)))
+    names(LRnomut) = res$Marker
 
   # Split linkage groups
   pairs = split(res, res$Pair)
@@ -95,6 +100,7 @@ linkedLR = function(pedigrees, linkageMap, markerData = NULL, mapfun = "Kosambi"
 
 
 .linkedLR = function(peds, markerpair, cmpos, mapfun, disableMut = FALSE) {
+  if (getOption("KLINK.debug")) print(paste(".linkedLR:", paste(markerpair, collapse = ", ")))
   if(length(markerpair) < 2)
     return(NA_real_)
 

R/loadFamFile.R

@@ -1,13 +1,40 @@
+#' Load .fam file
+#'
+#' @param path The path to a .fam file.
+#' @param fallbackModel The name of a mutation model; passed on to
+#'   [pedFamilias::readFam()].
+#' @param withParams A logical indicating if the Familias parameters should be
+#'   included in the output. (See [pedFamilias::readFam()].)
+#'
+#' @return A list of two `ped` objects.
+#'
+#' @examples
+#' fam = system.file("extdata/halfsib-test.fam", package = "KLINK")
+#' peds = loadFamFile(fam)
+#' pedtools::plotPedList(peds)
+#'
+#' @export
+loadFamFile = function(path, fallbackModel = "equal", withParams = FALSE) {
+  if (getOption("KLINK.debug")) print("loadFamFile")
+  x0 = pedFamilias::readFam(path, useDVI = NA, verbose = FALSE,
+                            prefixAdded = ":missing:", includeParams = TRUE,
+                            fallbackModel = fallbackModel, simplify1 = FALSE)
 
-loadFamFile = function(path, fallbackModel = "equal") {
-  x = forrel::readFam(path, useDVI = FALSE, verbose = FALSE, prefixAdded = ":missing:",
-                      fallbackModel = fallbackModel)
+  x = x0$main
+  params = x0$params
+
+  if(isTRUE(params$dvi))
+    stop2("This file was exported from the DVI module of Familias. Such files cannot be used in KLINK.")
+
+  theta = params$theta
+  if(length(theta) && !is.na(theta) && theta > 0)
+    warning("Nonzero theta correction detected: theta = ", theta, call. = FALSE)
 
   if(!length(x) || (!is.ped(x[[1]]) && !is.pedList(x[[1]])))
-    stop("No pedigrees found in the Familias file.", call. = FALSE)
+    stop2("No pedigrees found in the Familias file.")
 
   if(all(sapply(x, pedtools::is.singleton)))
-    stop("This Familias file contains only singletons", call. = FALSE)
+    stop2("This Familias file contains only singletons")
 
   # Ensure each pedigree is an unnamed list
   x = lapply(x, function(xx) {
@@ -16,11 +43,15 @@ loadFamFile = function(path, fallbackModel = "equal") {
     else if(pedtools::is.pedList(xx))
       unname(xx)
     else
-      stop("Unexpected content detected in the Familias file.")
+      stop2("Unexpected content detected in the Familias file.")
   })
 
-  if(length(x) == 1)
-    stop("Only one pedigree found in the Familias file.", call. = FALSE)
+  if(length(x) == 1) {
+    warning("Only one pedigree found. Adding unrelated hypothesis", call. = FALSE)
+    un = singletons(typedMembers(x[[1]]))
+    un = transferMarkers(from = x[[1]], to = un)
+    x = c(x, list(un))
+  }
 
   if(length(x) > 2) {
     warning("This familias file contains more than two pedigrees; only the first two are used", call. = FALSE)
@@ -41,19 +72,25 @@ loadFamFile = function(path, fallbackModel = "equal") {
 
   if(is.null(names(x)))
     names(x) = c("Ped 1", "Ped 2")
+  else if(any(msnm <- names(x) == ""))
+    names(x)[msnm] = paste("Ped", which(msnm))
 
-  x
+  if(withParams)
+    list(peds = x, params = params)
+  else
+    x
 }
 
 
 removeEmpty = function(x) {
+  if (getOption("KLINK.debug")) print("removeEmpty")
   if(is.null(x))
     return(NULL)
   for(pedname in names(x)) {
     ped = x[[pedname]]
     empty = vapply(ped, function(comp) !any(unlist(comp$MARKERS)), FALSE)
     if(all(empty))
-      stop(sprintf("Pedigree '%s' has no typed members", pedname))
+      stop2(sprintf("Pedigree '%s' has no typed members", pedname))
     x[[pedname]] = ped[!empty]
   }
   x

R/lumping.R

@@ -71,7 +71,7 @@ lumpMutSpecial = function(mut, lump, method = "foundersUntyped") {
   als = colnames(mut)
   afr = attr(mut, "afreq")
   keep = setdiff(als, lump)
-  wei = if(method == "foundersUntyped") afr[lump] else stop("Method not implemented: ", method)
+  wei = if(method == "foundersUntyped") afr[lump] else stop2("Lumping method not implemented: ", method)
   weiScaled = wei/sum(wei)
 
   m2 = mut[keep, keep, drop = FALSE]

R/markerSummary.R

@@ -1,10 +1,20 @@
-
-markerSummary = function(x, linkageMap = NULL) {
-  ped1 = x[[1]]
-  ped2 = x[[2]]
+#' Generate table of marker data
+#'
+#' @param pedigrees A list of 2 pedigrees.
+#' @param linkageMap A data frame.
+#'
+#' @return A data frame.
+#'
+#' @examples
+#' markerSummary(paternity)
+#'
+#' @export
+markerSummary = function(pedigrees, linkageMap = NULL) {
+  ped1 = pedigrees[[1]]
+  ped2 = pedigrees[[2]]
 
   # Check if special (founder-type) lumping applies to all markers
-  specLump = specialLumpability(x)
+  specLump = specialLumpability(pedigrees)
 
   # Genotypes
   geno = t.default(pedtools::getGenotypes(ped1, ids = typedMembers(ped1)))