pkg

.Rbuildignore

@@ -0,0 +1,2 @@
+^.*\.Rproj$
+^\.Rproj\.user$

DESCRIPTION

@@ -0,0 +1,31 @@
+Package: straf
+Title: STR Analysis For Forensics
+Version: 1.4.7
+Authors@R: 
+    person(given = "Alexandre",
+           family = "Gouy",
+           role = c("aut", "cre"),
+           email = "alexandre.gouy@protonmail.com")
+Description: straf is a Shiny application to perform STR / microsatellite data analysis.
+License: `use_gpl3_license()`
+Encoding: UTF-8
+LazyData: true
+Roxygen: list(markdown = TRUE)
+RoxygenNote: 7.1.1.9000
+Imports:
+  shiny (>= 1.5.0),
+  colourpicker,
+  DT,
+  plotly,
+  shinyWidgets,
+  ade4,
+  adegenet,
+  pegas,
+  hierfstat,
+  car,
+  openxlsx,
+  reshape2,
+  dplyr,
+  tidyr,
+  ggplot2,
+  ggrepel

NAMESPACE

@@ -0,0 +1,17 @@
+# Generated by roxygen2: do not edit by hand
+
+import(ade4)
+import(adegenet)
+import(car)
+import(colourpicker)
+import(dplyr)
+import(ggplot2)
+import(ggrepel)
+import(hierfstat)
+import(openxlsx)
+import(pegas)
+import(plotly)
+import(reshape2)
+import(shiny)
+import(shinyWidgets)
+import(tidyr)

R/helpers.R

@@ -174,7 +174,7 @@ getIndicesFromGenind <- function(data,
   DAT <- data.frame(freq, loc, alle)
   N <- tapply(DAT$freq, DAT$loc, sum)
   DAT$frequency <- DAT$freq / N[DAT$loc]
-  
+
   PIC <- NULL
   for(i in unique(loc)) {
 
@@ -217,25 +217,21 @@ getIndicesFromGenind <- function(data,
     PM = PM,
     PD = 1 - PM
   )
-  
+
   if(ploidy == "Diploid") {
-
-    DF$Hobs <- summary(data)$Hobs[names(GD)]
+    DF$Hobs <- adegenet::summary(data)$Hobs[names(GD)]
     DF$PE <- (DF$Hobs ^ 2) * (1 - 2 * (DF$Hobs) * ((1 - DF$Hobs) ^ 2))
     DF$TPI <- 1 / (2 * (1 - DF$Hobs))
-
   }
 
 
   if(length(unique(data@pop)) > 1 & length(locNames(data)) > 1) {
-
     basicstat <- basic.stats(
       data,
       diploid = switch(ploidy, Diploid = TRUE, Haploid = FALSE),
       digits = 4
     )$perloc
     rownames(basicstat) <- as.character(unique(data@loc.fac))
-
     Fst <- wc(
       data,
       diploid = switch(ploidy, Diploid = TRUE, Haploid = FALSE)

R/module_data.R

@@ -0,0 +1,138 @@
+### Input data module
+data_UI <- function(id) {
+  ns <- NS(id)
+  tabPanel(
+    "Data",
+    h3("Dataset"),
+    div(DT::dataTableOutput(ns('contents')), style = "font-size:70%"),
+
+    tags$hr(),
+    h3("Allele frequencies per locus"),
+    awesomeCheckbox(
+      ns('displayAlleleFreq'), 'Plot the distribution of allele frequencies',
+      FALSE
+    ),
+    conditionalPanel(
+      condition = 'input.displayAlleleFreq == true',
+      ns = ns,
+      uiOutput(ns('plotAF'))
+    ),
+
+    tags$hr(),
+    awesomeCheckbox(
+      ns('displayAlleleTable'),
+      'Display a table of allele frequencies',
+      FALSE
+    ),
+    conditionalPanel(
+      condition = "input.displayAlleleTable == true",
+      ns = ns,
+      uiOutput(ns("selectPop")),
+      div(DT::dataTableOutput(ns('tableFreq')), style = "font-size:70%"),
+      downloadButton(ns('dlTabfreq'), 'Download as text (.tsv)'),
+      downloadButton(ns('dlTabfreqXL'), 'Download as Excel (.xlsx)')
+    ),
+
+    tags$hr()
+  )
+}
+
+data_Server <- function(id, getgenind, getData, barplotcolor, transparency, width, height, popnames) {
+  moduleServer(
+    id,
+    function(input, output, session) {
+
+      ns <- session$ns
+
+      output$contents <- DT::renderDataTable({
+        if (is.null(getData())) return(NULL)
+        X <- read.table(
+          getData()$datapath,
+          header = TRUE, sep = "\t",
+          colClasses = "character"
+        )
+        DT::datatable(X)
+      })
+
+      output$alleleFreq <- renderPlot({ # barplots of allele freq distributions
+
+        if (!input$displayAlleleFreq)  return(NULL)
+        dat2 <- getgenind()
+        freq <- apply(dat2@tab, 2, sum, na.rm = TRUE) #counts number of alleles
+        nam <- strsplit(names(freq), split = "[.]") #split locus and allele name
+        loc <- as.factor(unlist(
+          lapply(nam, function(x) x[1])
+        ))
+        alle <- as.numeric(unlist(
+          lapply(nam, function(x) sub("-", ".", x[2]))
+        ))
+        DAT <- data.frame(freq, loc, alle)
+        DAT <- DAT[order(DAT$alle), ]
+
+        ###depending on the number of loci, different number of columns:
+        nL <- length(unique(DAT$loc))
+        if(nL <= 5) n_col <- 2
+        if(nL >= 6) n_col <- 3
+        if(nL >= 10) n_col <- 4
+
+        par(mfrow = c(ceiling(nL / n_col), n_col), mar = rep(2, 4))
+        for(i in unique(DAT$loc)) {
+          barplot(
+            DAT$freq[DAT$loc == i],
+            names.arg = DAT$alle[DAT$loc == i],
+            main = i,
+            col = transp(barplotcolor(), transparency()),
+            border = 0
+          )
+        }
+      })
+
+      output$plotAF <- renderUI({ #display UI only if allele freq is checked
+        plotOutput(
+          ns('alleleFreq'),
+          width = paste(width(), "%", sep = ""),
+          height = height()
+        )
+      })
+
+      alleleFreqTabs <- reactive({
+        if (!input$displayAlleleTable)  return(NULL)
+        dat2 <- getgenind()
+        matr <- getFreqAllPop(dat2)
+        return(matr)
+      })
+
+      output$selectPop <- renderUI({
+        selectInput(ns("selectPop"), "Select a population:", popnames())
+      })
+
+      output$tableFreq <- DT::renderDataTable({
+        if (!input$displayAlleleTable | is.null(input$selectPop)) return(NULL)
+        if(input$selectPop == "") matr <- alleleFreqTabs()[[1]]
+        else matr <- alleleFreqTabs()[[input$selectPop]]
+        DT::datatable(matr) %>% DT::formatRound(columns = colnames(matr), digits = 3)
+      })
+
+      output$dlTabfreq <- downloadHandler(
+        filename = function() { paste('allele_frequencies.tsv', sep='') },
+        content = function(file) {
+          if (!input$displayAlleleTable) return(NULL)
+          if(input$selectPop == "") matr <- alleleFreqTabs()[[1]]
+          else matr <- alleleFreqTabs()[[input$selectPop]]
+          write.table(matr, file, sep = "\t", na = "", row.names = TRUE)
+        }
+      )
+
+      output$dlTabfreqXL <- downloadHandler(
+        filename = function() { paste('allele_frequencies.xlsx', sep='') },
+        content = function(file) {
+          if (!input$displayAlleleTable) return(NULL)
+          if(input$selectPop == "") matr <- alleleFreqTabs()[[1]]
+          else matr <- alleleFreqTabs()[[input$selectPop]]
+          openxlsx::write.xlsx(list(allele_frequencies = matr), file = file, rowNames = TRUE)
+        }
+      )
+
+    }
+  )
+}

R/module_file_conversion.R

@@ -0,0 +1,54 @@
+## File conversion module
+file_conv_UI <- function(id) {
+  ns <- NS(id)
+  tabPanel(
+    "File conversion",
+    h3("Genepop"),
+    downloadButton(ns('dlGenepop'), 'Download file in the Genepop format'),
+    tags$br(),
+    h3("Familias"),
+    downloadButton(ns('dlFamilias'), 'Download file in the Familias format'),
+    tags$br(),
+    h3("Arlequin (diploid data only)"),
+    downloadButton(ns('dlArlequin'), 'Download file in the Arlequin format'),
+    tags$br()
+  )
+}
+
+file_conv_Server <- function(id, fpath, ploidy) {
+  moduleServer(
+    id,
+    function(input, output, session) {
+
+      #### FILE CONVERSION
+      output$dlGenepop <- downloadHandler(
+        filename = function() { 
+          paste('straf2genepop.txt', sep='') 
+        },
+        content = function(file) {
+          gp <- straf2genepop(f.name = fpath(), ploidy = switch(ploidy(), Diploid = 2, Haploid = 1))
+          cat(gp, file = file)
+        }
+      )
+
+      output$dlArlequin <- downloadHandler(
+        filename = function() { 
+          paste('straf2arlequin.arp', sep='') 
+        },
+        content = function(file) {
+          gp <- straf2arlequin(fpath())
+          cat(gp, file = file)
+        }
+      )
+
+      output$dlFamilias <- downloadHandler(
+        filename = function() { 
+          paste('straf2familias.txt', sep='')
+        },
+        content = function(file) {
+          fmi <- straf2familias(fpath())
+          cat(fmi, file = file)
+        }
+      )
+    }
+  )}