inst/shiny/R/saveData.R

In ibdsim2: Simulation of Chromosomal Regions Shared by Family Members

saveData = function(segData1, segData2, params1, params2, version, tmpdir) {
  files = NULL
  
  if(!is.null(segData1)) {
    sumfile = file.path(tmpdir, "ibdsim2-summary-1.txt")
    writeSummary(sumfile, segData1$summary, params1, version)
    
    detfile = file.path(tmpdir, "ibdsim2-details-1.txt")
    write.table(segData1$perSim, file = detfile, quote = FALSE, row.names = FALSE, sep = "\t")
    files = c(files, sumfile, detfile)
  }
  
  if(!is.null(segData2)) {
    sumfile = file.path(tmpdir, "ibdsim2-summary-2.txt")
    writeSummary(sumfile, segData2$summary, params2, version)
    
    detfile = file.path(tmpdir, "ibdsim2-details-2.txt")
    write.table(segData2$perSim, file = detfile, quote = FALSE, row.names = FALSE, sep = "\t")
    files = c(files, sumfile, detfile)
  }
  
  # Return filenames without path
  basename(files)
}

writeSummary = function(file, df, params, version) {
  unitCap = switch(params$unit, cm = "cM", mb = "Mb")
  
  txt = '
  #####################################################
  # Generated by ibdsim2-shiny, {format(lubridate::now(),"%Y-%m-%d %H:%M:%S %Z")}
  # https://magnusdv.shinyapps.io/ibdsim2-shiny/
  # ibdsim2 version: {version}
  ####################################################
  #
  # Parameters
  # ==========
  # Analysis: {params$analysis}
  # Number of sims: {params$nsims} 
  # Length unit: {unitCap}
  # Random number seed: {params$seed}
  # Chromosomes: {switch(params$chrom, aut = "1-22", X = "X")} 
  # Crossover model: {params$model}
  # Sex-specific map: {params$sexspec}
  # Length cutoff: {params$cutoff} {unitCap}
  #
  # Relationship
  # ============
  # Builtin: {params$builtin %!% "-"}
  # Ped file: {params$loadped %!% "-"}
  # Individuals: {toString(params$ids) %!% "-"}
  # Label: {params$label %!% "-"}
  #
  # R code
  # ======
  # library(ibdsim2)
  # ped = {ped2ascii(params$ped)}
  # map = {map2ascii(params$chrom, params$unit, params$sexspec)}
  # sims = ibdsim(ped, N = {params$nsims}, ids = {vec2ascii(params$ids)}, map = map, model = "{params$model}", seed = {params$seed})
  # segs = findPattern(sims, pattern = list({switch(params$analysis, Sharing = "carriers", Autozygosity = "autozygous")} = {vec2ascii(params$ids)}), cutoff = {params$cutoff}, unit = "{params$unit}")
  # stats = segmentStats(segs, quantiles = c(0.025, 0.5, 0.975), unit = "{params$unit}")
  # stats$summary
  #'
  
  write(glue(txt), file)
  
  # Rounded summary table
  tbl = cbind(Variable = rownames(df), round(df, 2))
  
  suppressWarnings(write.table(tbl, file = file, append = TRUE, quote = FALSE,
                               row.names = FALSE, sep = "\t"))
}


summ = function(v) {
  res = c(mean = mean(v), 
          sd = sd(v), 
          min = min(v), 
          quantile(v, c(0.025, 0.5, 0.975)), 
          max = max(v))
  round(res, 2)
}

vec2ascii = function(x) {
  if(is.character(x))
    x = paste0('"', x, '"')
  sprintf("c(%s)", toString(x))
}

ped2ascii = function(ped) {
  glue_data(as.data.frame(ped), 
            "ped(id = {vec2ascii(id)}, fid = {vec2ascii(fid)}, mid = {vec2ascii(mid)}, sex = {vec2ascii(sex)})")
}

map2ascii = function(chrom, unit, sexspec) {
  chr = switch(chrom, aut = "1:22", X = '"X"')
  unif = tolower(unit) == "cm"
  aver = sexspec == "Off"
  glue('loadMap("decode19", chrom = {chr}, uniform = {unif}, sexAverage = {aver})')
}


`%!%` = function(x, y)
  if(is.null(x) || !length(x) || !nchar(x)) y else x