inst/shiny/R/rcode.R

In ibdsim2: Simulation of Chromosomal Regions Shared by Family Members

# Function to create the modal dialog
createCodeModal = function() {
  modalDialog(
    verbatimTextOutput("showCode", placeholder = FALSE),
    footer = tagList(
      modalButton("Close"),
      downloadButton("saveCode", "Save", class="btn btn-info")
    )
  )
}

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

validName = function(nms) {
  invalid = make.names(nms) != nms
  if(any(invalid))
    nms[invalid] = sprintf("`%s`", nms[invalid])
  nms
}
### TODO ###

# Not currently used

namedvec2ascii = function(x) {
  if(is.character(x))
    x[] = paste0('"', x, '"')
  args = glue("{validName(names(x))} = {x}")
  sprintf("c(%s)", toString(args))
}

generateCode = function(ped, ...) {
  pedDf = as.data.frame(ped)

  # Complete text template
  txt = '
  #############################################
  # Generated by ibdsim2-shiny, {format(lubridate::now(),"%Y-%m-%d %H:%M", tz = "UTC")} UTC
  # https://magnusdv.shinyapps.io/ibdsim2-shiny/
  #############################################

  # Load packages
  library(pedsuite)
  library(ibdsim2)

  # Pedigree
  x = ped(id  = {vec2ascii(pedDf$id)},
          fid = {vec2ascii(pedDf$fid)},
          mid = {vec2ascii(pedDf$mid)},
          sex = {vec2ascii(pedDf$sex)})

  # Plot
  plot(x)
  '

  # Glue and return
  glue(txt, .null = NULL)
}