R/shiny_parts_ui.R

In tidycells: Read Tabular Data from Diverse Sources and Easily Make Them Tidy

#####  helper functions #####

# this configures the style for dropdown menu
selectize_drop_down_style <- function() {
  tags$style(
    type = "text/css",
    ".selectize-dropdown-content{height: 100px;}"
  )
}

# checks plotly present or not
plotly_present <- function() {
  is_available("plotly")
}

# checks plotly present or not
DT_present <- function() {
  is_available("DT")
}


##### ui modules #####

# attach in ui like this
# ui <- miniPage(
#   gadgetTitleBar("<title>"),
#   miniTabstripPanel(
#     ui_part_plot_tune()))

ui_part_plot_tune <- function(id = "ui_plot_tune",
                              selected_fill = "data_type", fill_option = TRUE,
                              txt_alpha_max = 1, txt_alpha = txt_alpha_max) {
  ns <- NS(id)

  miniTabPanel("Parameters",
    icon = icon("sliders"),
    miniContentPanel(
      plotOutput(ns("plot_tune"), height = "100%")
    ),
    miniButtonBlock(
      conditionalPanel(
        ifelse(fill_option, "true", "false"),
        radioButtons(ns("fill"),
          label = "Fill type:",
          choices = c("data_type", "type"),
          selected = selected_fill
        )
      ),
      checkboxInput(ns("no_txt"), label = "Disable Text in Cells", value = FALSE),
      conditionalPanel(
        "!input.no_txt",
        div(
          checkboxInput(ns("adaptive_txt_size"), label = "Adaptive text size", value = TRUE),
          sliderInput(ns("txt_size"), label = "Text size", min = 1, max = 10, value = 4, step = 0.5),
          sliderInput(ns("txt_alpha"), label = "Text transparency", min = 0, max = txt_alpha_max, value = txt_alpha, step = 0.05)
        ),
        ns = ns
      )
    )
  )
}


ui_part_visualize <- function(id = "ui_visualize") {
  ns <- NS(id)

  if (plotly_present()) {
    miniTabPanel("Visualize",
      icon = icon("bar-chart"),
      miniContentPanel(
        h5("Interactive Data View generated by plotly",
          # tooltip
          title = "Please don't change the tabs while loading. Otherwise you may see wrongly rendered plotly."
        ),
        plotly::plotlyOutput(ns("plot_plotly"), height = "100%")
      )
    )
  } else {
    ""
  }
}

ui_part_va_classify <- function(id = "ui_va_classify") {
  ns <- NS(id)

  miniTabPanel("Classify",
    icon = icon("table"),
    miniContentPanel(
      padding = 0,
      plotOutput(ns("plot_va_classify"), height = "100%", brush = brushOpts(ns("brush_va_classify")))
    ),
    miniButtonBlock(
      h3("Make selection as:"),
      actionButton(ns("make_value_va_classify"), "Values"),
      actionButton(ns("make_attr_va_classify"), "Attribute"),
      actionButton(ns("reset_va_classify"), "Reset All",
        # tooltip
        title = "Load original data with basic classification", icon = icon("undo")
      )
    )
  )
}

ui_part_crop <- function(id = "ui_crop", reset_msg = "Load original data") {
  ns <- NS(id)

  miniTabPanel("Crop",
    icon = icon("crop-alt"),
    miniContentPanel(
      padding = 0,
      plotOutput(ns("plot_crop"), height = "100%", brush = brushOpts(ns("brush_crop")))
    ),
    miniButtonBlock(
      actionButton(ns("data_crop"), "Crop"),
      actionButton(ns("data_del"), "Delete"),
      actionButton(ns("data_reset"), "Reset",
        # tooltip
        title = reset_msg, icon = icon("undo")
      )
    )
  )
}


ui_part_data_block <- function(id = "ui_data_block", zoom_this = FALSE, direction_text_this = TRUE, plot_issues_option = TRUE) {
  ns <- NS(id)

  miniTabPanel("Data Block",
    icon = icon("cubes"),
    miniContentPanel(
      plotOutput(ns("plot_data_block"), height = "100%")
    ),
    miniButtonBlock(
      selectize_drop_down_style(),
      div(
        selectizeInput(ns("gids"),
          label = "Select Data Block ids",
          choices = c("All"),
          multiple = TRUE,
          options = list(
            placeholder = "Please wait while it gets updated...",
            onInitialize = I('function() { this.setValue(""); }')
          )
        ),
        div(
          style = "display: inline-block;vertical-align:top; width: 170px;",
          checkboxInput(ns("zoom_selected_gids"), label = "Zoom selected blocks", value = zoom_this)
        ),
        div(
          style = "display: inline-block;vertical-align:top; width: 90px;",
          conditionalPanel(
            ifelse(plot_issues_option, "true", "false"),
            checkboxInput(ns("plot_issues"), label = "Plot Issues", value = FALSE)
          )
        )
      ),
      div(span(style = "display:inline-block; width: 50px;")),
      div(
        checkboxInput(ns("block_boundary"), label = "Draw Data Block boundary", value = FALSE),
        conditionalPanel(
          "!input.block_boundary",
          checkboxInput(ns("dat_att_boundary"), label = "Draw Data / Attribute Block boundary", value = FALSE),
          ns = ns
        )
      ),
      div(
        checkboxInput(ns("direction_text"), label = "Draw Direction Text", value = direction_text_this),
        conditionalPanel(
          "input.direction_text",
          checkboxInput(ns("direction_text_on_all"), label = "Direction Text on all attributes", value = FALSE),
          ns = ns
        )
      )
    )
  )
}

ui_part_orientation_modification <- function(id = "ui_orientation_modification") {
  ns <- NS(id)

  miniTabPanel("Orientation",
    icon = icon("arrows"),
    miniContentPanel(
      plotOutput(ns("plot_omod"),
        height = "100%",
        brush = brushOpts(ns("brush_omod")),
        click = clickOpts(ns("click_omod")),
        dblclick = clickOpts(ns("dbclick_omod"))
      )
    ),
    miniButtonBlock(
      selectize_drop_down_style(),
      div(
        div(
          title = "Please Select Attribute Cells to modify direction",
          selectizeInput(ns("new_direction"),
            label = "Select Direction",
            choices = NULL,
            multiple = FALSE,
            options = list(
              placeholder = "Please Select Cells ...",
              onInitialize = I('function() { this.setValue(""); }')
            )
          )
        ),
        checkboxInput(ns("allow_all_dirs"), label = "Allow All Directions", value = FALSE)
      ),
      div(span(style = "display:inline-block; width: 50px;")),
      div(
        br(),
        actionButton(ns("reset_direction"), "Reset"),
        actionButton(ns("apply_direction"), "Apply")
      )
    )
  )
}


ui_part_traceback <- function(id = "ui_traceback") {
  ns <- NS(id)

  if (DT_present()) {
    miniTabPanel("Traceback",
      icon = icon("map-signs"),
      miniContentPanel(
        absolutePanel(
          top = 20, left = 20, width = 500,
          draggable = TRUE,
          wellPanel(DT::DTOutput(ns("dt_trace"), height = "100%"),
            style = "font-size:70%"
          ),
          style = "opacity: 0.90"
        ),
        plotOutput(ns("plot_traceback"),
          height = "100%",
          dblclick = clickOpts(ns("click_traceback"))
        )
      )
    )
  } else {
    ""
  }
}