Test new data against dataset, curr: prints in rStudio console

Author: LogFlames

NAMESPACE

@@ -7,3 +7,4 @@ export(generate_allelemtach_profile_plot)
 export(get_id)
 export(handle_multimatch)
 export(import_data)
+export(match_new_data)

R/app.R

@@ -40,17 +40,14 @@ ui <- shiny::fluidPage(
 
       shiny::tags$hr(),
       # Select allele mismatch value
-      shiny::textInput(inputId = "alleleMismatchValue", label = "Allowed Allele-mismatch", value = "3"),
+      shiny::numericInput(inputId = "alleleMismatchValue", label = "Allowed Allele-mismatch", value = 3, min = 0, step = 1),
       # If the user asks for the plot, generate it and show it
       shiny::conditionalPanel(condition = "input.generateAllelematchProfile >= 1",
         plotOutput(outputId = "allelematchProfilePlot"),
       ),
-      shiny::conditionalPanel(condition = "input.generateAllelematchProfile == 0",
-        actionButton(inputId = "generateAllelematchProfile", "Generate Mismatch Plot"),
-      ),
-
-      h4("Type the column name of the specified columns."),
-      h5("If header is deseleted, type the indexes of the columns."),
+      shiny::actionButton(inputId = "generateAllelematchProfile", "Generate Mismatch Plot"),
+      shiny::h4("Type the column name of the specified columns."),
+      shiny::h5("If header is deseleted, type the indexes of the columns."),
 
 
       # Select Index Column
@@ -87,7 +84,7 @@ ui <- shiny::fluidPage(
               # Allow the user to select and handle all of the multiple matches that occured
               div(h4("Handle Multiple Matches")),
 
-              textInput(inputId = "multipleMatchIndex", label = "View Details (Index of Multiple Matched Sample): ", placeholder = "tex 2"),
+              shiny::numericInput(inputId = "multipleMatchIndex", label = "View Details (Index of Multiple Matched Sample): ", value = 0, min = 0, step = 1),
               DT::dataTableOutput("multipleMatchesTable"),
 
               # TODO:: Allow the user to handle these (similar to matching new data)
@@ -128,9 +125,11 @@ ui <- shiny::fluidPage(
                           shiny::conditionalPanel(condition = "input.new_data_mode == 'single'",
                                                   shiny::textInput(inputId = "new_data_index", label = "Index: "),
                                                   shiny::dateInput(inputId = "new_data_date", label = "Date: "),
-                                                  shiny::textInput(inputId = "new_data_nornt", label = "North: "),
+                                                  shiny::textInput(inputId = "new_data_north", label = "North: "),
                                                   shiny::textInput(inputId = "new_data_east", label = "East: "),
+                                                  shiny::h5(shiny::textOutput(outputId = "currentGenderStyle")),
                                                   shiny::textInput(inputId = "new_data_gender", label = "Gender: "),
+                                                  shiny::h5("Make sure the order is the same as the rest of the data, in alignment with the order given to the right."),
                                                   shiny::textInput(inputId = "new_data_locus", label = "Locus (separated by ' '):")
                                            ),
                           # If multiple is choosen, open those options
@@ -146,7 +145,7 @@ ui <- shiny::fluidPage(
                                            ),
                           shiny::tags$hr(),
                           # How many mismatchs to allow when mathcing new data to the rest of the dataset
-                          shiny::textInput(inputId = "new_data_mismatch", label = "Mismatch For New Data"),
+                          shiny::numericInput(inputId = "new_data_mismatch", label = "Mismatch For New Data", value = 3, min = 0, step = 1),
                           # Load the file or strings into data and compare with the dataset
                           shiny::actionButton(inputId = "search_new_data", label = "Match New Data To Dataset"),
                           shiny::tags$hr(),
@@ -176,10 +175,13 @@ server <- function(input, output, session) {
   })
 
   groupIndividuals <- function() {
+    req(input$file1)
     req(as.numeric(input$alleleMismatchValue))
 
     # Reload the data incase the colmn-names have changed
-    load_main_data()
+    c(data_temp, am_data_temp) %<-% load_main_data(input$file1$datapath)
+    data <<- data_temp
+    am_data <<- am_data_temp
 
     # Unpack the different data returned by our wrapper of allelematch into temp variables
     c(search_data_temp, multiple_matches_temp, unclassified_temp) %<-% GenotypeCheck::create_search_data(data, am_data, as.numeric(input$alleleMismatchValue))
@@ -190,9 +192,8 @@ server <- function(input, output, session) {
     unclassified <<- unclassified_temp
   }
 
-  load_main_data <- function() {
-    req(input$file1)
-
+  # load the main data file
+  load_main_data <- function(file) {
     # Read the locus data from the ui
     locus_columns <- strsplit(input$locusColumnNames, ",")[[1]]
 
@@ -211,10 +212,12 @@ server <- function(input, output, session) {
     }
 
     # Load the data, this will be the meta data
-    data <<- GenotypeCheck::import_data(input$file1$datapath, index_column = index_column, additional_data = additional_data, locus_names = locus_columns)
+    data <- GenotypeCheck::import_data(file, index_column = index_column, additional_data = additional_data, locus_names = locus_columns)
 
     # Create allaematch dataset, ignore some meta-data as it can be read from the "data" above, the index (SEP) is the same
-    am_data <<- GenotypeCheck::create_allelematch_dataset(data, ignore_columns = names(additional_data))
+    am_data <- GenotypeCheck::create_allelematch_dataset(data, ignore_columns = names(additional_data))
+
+    list(data, am_data)
   }
 
   update_output_preprocess_data <- function() {
@@ -247,6 +250,10 @@ server <- function(input, output, session) {
     output$amtUnclassified <- renderText(
       paste0("There were: ", length(unclassified$index), " samples that were unclassified.")
     )
+
+    output$currentGenderStyle <- renderText(
+      paste("The datasets gender-style is: ", paste0(data$gender[!duplicated(data$gender)], sep = ", ", collapse = ""))
+    )
   }
 
   # Observe when user types an index to view details
@@ -339,13 +346,48 @@ server <- function(input, output, session) {
     req(input$file1)
 
     # Reload the data incase teh colmnnames have changed
-    load_main_data()
+    c(data_temp, am_data_temp) %<-% load_main_data(input$file1$datapath)
+    data <<- data_temp
+    am_data <<- am_data_temp
 
     # Render the plot to the ui
     output$allelematchProfilePlot <- shiny::renderPlot({
       GenotypeCheck::generate_allelemtach_profile_plot(am_data)
     })
   })
+
+  shiny::observeEvent(input$search_new_data, {
+    if (input$new_data_mode == "single") {
+      # Make sure the essential data is given, the rest is meta-data and it would be annoying if it were required
+      req(input$new_data_index)
+      req(input$new_data_locus)
+      req(input$new_data_mismatch)
+
+      # Read the locus data from the ui
+      locus_columns <- strsplit(input$locusColumnNames, ",")[[1]]
+
+      # Split the locus string and name the columns accordingly in the same order that have been given in the panel to the right
+      # Order is important here
+      multilocus <- strsplit(input$new_data_locus, " ")[[1]]
+
+      names(multilocus) <- locus_columns
+
+      # Create the new data, a dataframe with one row
+      new_data <- data.frame(list(index = input$new_data_index), date = input$new_data_date, north = input$new_data_north,
+                             east = input$new_data_east, gender = input$new_data_gender) %>%
+        cbind(data.frame(as.list(multilocus)))
+    } else if (input$new_data_mode == "multiple") {
+      # If a file is given, use the already exsiting function to load and parse it according to the specifications on the right
+      c(new_data, new_am_data) %<-% load_main_data(input$new_data_file$datapath)
+    }
+    # Get the search_data-type of data for the new data
+    c(new_search_data, new_multiple_match, new_unclassified) %<-% GenotypeCheck::match_new_data(data = data, new_data = new_data, additional_data_columns = names(additional_data), allele_mismatch = input$new_data_mismatch)
+
+    # DEBUG: Temp
+    print(new_search_data)
+    print(new_multiple_match)
+    print(new_unclassified)
+  })
 }
 
 # Create a shiny app

R/import_data.R

@@ -81,8 +81,22 @@ create_search_data <- function(data, am_data, allele_mismatch) {
   # Group the samples together to form individuals
   am_unique <- allelematch::amUnique(am_data, alleleMismatch = allele_mismatch)
 
-  # Go through the data and create a large data.frame with all the prevoius samples, adding a column for the individ_id
   ind <- 0
+  # If a override id is specified, get the largest override id and add ind from that
+  if (!is.null(data$preset_ind)) {
+    # Convert everything to a number
+    preset_num <- as.numeric(data[,"preset_ind"])
+    # Remove everything that is not a number, out generated ind cannot accidentaly assume the same value
+    preset_num <- preset_num[!is.na(preset_num)]
+    # Start right after the biggest one found
+    ind_biggest <- max(preset_num) + 1
+    # If all override_ids were NA or not numbers, we can count from zero like usual
+    if (is.na(ind_biggest)) {
+      ind_biggest <- 0
+    }
+  }
+
+  # Go through the data and create a large data.frame with all the prevoius samples, adding a column for the individ_id
   search_data <- data.frame(index = character(), multilocus = character(), individ_id = character())
 
   for (pair in am_unique$pairwise) {
@@ -97,10 +111,7 @@ create_search_data <- function(data, am_data, allele_mismatch) {
 
   # If a override_id column is specified, write it to the new column
   if (!is.null(data$preset_ind)) {
-    for (ind in 1:length(search_data$index)) {
-      new_id <- data[search_data$index[[ind]],"preset_ind"]
-      search_data$override_id[[ind]] <- new_id
-    }
+    search_data$override_id <- data[search_data$index,"preset_ind"]
   }
 
   # The multiple matches that have been handled by the user previously and is now in the file
@@ -211,3 +222,30 @@ handle_multimatch <- function(search_data, multiple_matches, multimatch_index, n
   # Return the updated data
   list(search_data, multiple_matches)
 }
+
+#' Title
+#'
+#' @param data The old data, containing all samples that have already been handeled, or been choosen not to be handleh
+#' @param new_data The new data, the meta-data for the new sample, containing the same columns as the old data, index, locus, date, gender, etc
+#' @param additional_data_columns The names of the columns containing the meta-data for the \code{\link{create_allelematch_dataset}} to be able to create a new am_dataset
+#' @param allele_mismatch The mismatch (numbers of alleles that are allowed to differ between individuals) to use for this grouping, user could be intrested in being more strict or more loose, up to them
+#'
+#' @return Returns only the new data grouped into search_data format, which of them that matched multiple and if some of them were unclassified
+#' @export
+#'
+#' @examples
+match_new_data <- function(data, new_data, additional_data_columns, allele_mismatch) {
+  # Combine the data under each other, create a big data.frame
+  print(head(data))
+  print(head(new_data))
+  combined_data <- rbind(data, new_data)
+  # Create an amDataset to be able to run the grouping on all of the data
+  am_data <- create_allelematch_dataset(data = combined_data, ignore_columns = additional_data_columns)
+  # Get the combined data for all samples, every index and group, including which fitted into multiple and which were unclassified
+  c(combined_search_data, combined_multiple_matches, combined_unclassified) %<-% create_search_data(data = combined_data,
+              am_data = am_data, allele_mismatch = allele_mismatch)
+  # Return the data gathered but filter to only keep the entries whos indexes are not in the "old" data. Thereby only passing on the new data but sorted with individ_id, if they matched multiple and if they were unclassified
+  list(combined_search_data[!combined_search_data$index %in% data$index,],
+              combined_multiple_matches[!combined_multiple_matches %in% data$index],
+              combined_unclassified[!combined_unclassified$index %in% data$index])
+}