R Shiny を使ってWebアプリを作って動くまでやってみる（sup 1）補助プログラムの作成

library(dragulaSelectR)
library(dplyr)
library(shinyjs)

###############################
# operator opposite of %in%
###############################

'%!in%' = function(x,y)!('%in%'(x,y))

###############################
# create elements
###############################

createItem = function(ind, nums) {
  tagList(
    HTML("<style>
         .draggray { color:#000; background: #f1f1f1; }
         .draggray i { margin-left: 5px; width:100px; }
         </style>"),
    div(class = "draggray",
        "Group # : ",
        ind),
    div("size :", nums)
  )
}

dtGroupTablefunc = function(inFile, grpVar) {inFile  %>% group_by_at(grpVar) %>% summarise_all(funs(n())) %>% 
    select(c(1:2)) %>% dplyr::arrange(.[[grpVar]]) %>% na.omit()
}

initCanList = function(inFile, grpVar) {
  dtGroupTable = dtGroupTablefunc(inFile, grpVar)
  unique_val = unique(dtGroupTable[[grpVar]])
  
  x_tmp = list()
  for (ii in 1:length(unique_val)) {
    x_tmp[[ii]] = createItem(unique_val[ii], dtGroupTable[dtGroupTable[grpVar] == unique_val[ii],2])
    names(x_tmp)[ii] = unique_val[ii]
  }
  
  return(x_tmp)
}

###############################
# ui
###############################

ui = fluidPage(
  
  #####
  # element size
  #####
  tags$head(
    tags$style(HTML('
   
      .ds-dragitem, .ds-dropoption {
        position: relative;
        border-style: solid;
        border-color: lightgray;
        border-width: thin;
        margin: 4px;
        padding: 2px 4px;
      }
     
      .ds-dropzone[data-direction="horizontal"] > .ds-dropoption, .ds-dropzone[data-direction="horizontal"] > .gu-transit {
        vertical-align: middle;
        display: inline-block;
        text-align: !important left;
        width: 100px !important;
        height: 45px !important;
        margin: 3px 0px 3px 4px;
        padding: 0px;
        border-color: lightgray;
        border-width: thin;
      }
 
  '))
  ),
  
  #####
  # show display elements
  #####
  
  fluidRow(
    uiOutput("initDrag"),
    uiOutput("initDraw")
    
  )
)

#####################

server = function(input, output, session) {

  inFile = mtcars

  #####
  # Initialization of reactiveValues
  #####
  
  rvsTtl = reactiveValues()
  rvsdropzone = reactiveValues()
  counter = reactiveValues(countervalue = 0)
  
  #####
  # initialization of placeholder
  #####
  
  output$initDraw = renderUI({
    column(10,
           selectInput(inputId = "selGrp", "Select Group", choices = colnames(inFile)),
           div(id="selectorPlaceholder")
    )
  })
  
  output$initDrag = renderUI({
    column(2,
           actionButton("AddBtn", label = "ADD"),
           actionButton("DelBtn", label = "DEL"),
           h3("Dragzone"),
           uiOutput("dragZoneUI")
           
    )
  })
  
  #####
  # select group
  #####
  
  observeEvent(input$selGrp, {
    
    ### initialization of parameters
    
    if (counter$countervalue > 0) {
      for (zz2 in 1:counter$countervalue) {
        removeUI(selector = paste0('#dropzoneUI__',zz2))
        rvsTtl$ttl[[zz2]] = 0
      }
    }
    
    counter$countervalue = 0
    delList = NULL
    rvsdropzone$dropzone = NULL
    x_tmp = as.list(NULL)
    
    runjs('Shiny.onInputChange("dragZoneUI", null)')
    
  })
    

  #####
  # add ui
  #####
  
  observeEvent(input$AddBtn, {
    
    x_tmp = initCanList(inFile, input$selGrp)
    counter$countervalue = counter$countervalue + 1
    rvsdropzone$dropzone[[counter$countervalue]] = dropZoneInput(paste0("dropzone__",counter$countervalue),
                                                                 choices = x_tmp, direction="horizontal", placeholder = "drop here")
    rvsTtl$ttl[[counter$countervalue]] = 0
    element =
      div(id = paste0('dropzoneUI__',counter$countervalue),
          tagList(h3(paste0("Dropzone", counter$countervalue)), textOutput(paste0("GroupTtl", counter$countervalue))),
          rvsdropzone$dropzone[[counter$countervalue]]
      )
    insertUI(selector = "#selectorPlaceholder",  ui = element, immediate = TRUE)
  })
  
  
  #####
  # remove ui
  #####
  
  observeEvent(input$DelBtn, {

    if(counter$countervalue > 0) {
      removeUI(selector = paste0('#dropzoneUI__',counter$countervalue))
      counter$countervalue <- counter$countervalue - 1
    } else {
      showModal(modalDialog(h4("You can not delete anymore."), size = "m", easyClose = TRUE))
    }
    
  })
  
  
  #####
  # update dragzone
  #####
  
  output$dragZoneUI = renderUI({
    
    rvsdropzone$dropzone
    
    x_tmp = as.list(NULL)
    if (length(input$selGrp) == 0) {
      x_tmp = initCanList(inFile, colnames(inFile[1]))
    } else {
      x_tmp = initCanList(inFile, input$selGrp)
    }
    
    delList = NULL
    if (counter$countervalue > 0) {
      for (zzz in 1:counter$countervalue) {
        delList = c(delList, input[[paste0("dropzone__", zzz)]])
      }
    }
    
    dragZone("dragzone_ind", choices = x_tmp[names(x_tmp) %!in% delList])
  })
    
  #####
  # calc of group num
  #####
  
  observe( {
    
    validate(need(counter$countervalue > 0, ""))
    
    grpVar = input$selGrp
    dtGroupTable = dtGroupTablefunc(inFile, grpVar)
    
    for (zz2 in 1:counter$countervalue) {
      rvsTtl$ttl[[zz2]] = colSums(dtGroupTable[dtGroupTable[[grpVar]] %in% c(input[[paste0("dropzone__",zz2)]]), 2])
      output[[paste0("GroupTtl", counter$countervalue)]] = renderText({rvsTtl$ttl[[zz2]]})
    }
    
  })
}

shinyApp(ui = ui, server = server)

dropZoneInput(inputId, choices, presets = NULL, hidden = FALSE,
  placeholder = NULL, highlight = FALSE, multivalued = FALSE,
  selectable = FALSE, selectOnDrop = FALSE, togglevis = FALSE,
  togglelock = FALSE, removeOnSpill = TRUE, direction = "vertical",
  maxInput = Inf, replaceOnDrop = FALSE, flex = FALSE,
  server = NULL, ...)

rvsTtl = reactiveValues()
rvsdropzone = reactiveValues()
counter = reactiveValues(countervalue = 0)