inst/shinyapp/server.R

function(input, output, session) {
  values <- reactiveValues(
    plots = list(),      # list of plots the user saved
    maindata = NULL,     # the data frame used throughout the app
    updatePlot = FALSE,  # whether to manually update the plot
    prevPlot = NULL,     # the last plot that was successfully plotted
    updateTable = FALSE  # whether to manually update the dstats table
  )
  
   gradient <- callModule(gradientInput, "gradientcol",
                          init_col =c("#832424","white","#3A3A98"),
              allow_modify = FALSE, col_expand = TRUE) 
  
   gradientTableData <- reactive({
     df <- gradient$result()
   }
   )
   observeEvent(input$gradientreset, {
     gradient$reset()
   })  
  # observeEvent(input$userdefinedcontcolorreset, {
  #   cols <- c(scales::muted("red"),"white",
  #             scales::muted("blue"))
  #   colourpicker::updateColourInput(session = session,
  #                     inputId = paste0("colcont1"),
  #                     value = cols[1]
  #   )
  #   colourpicker::updateColourInput(session = session,
  #                     inputId = paste0("colcont2"),
  #                     value = cols[2]
  #   )
  #   colourpicker::updateColourInput(session = session,
  #                     inputId = paste0("colcont3"),
  #                     value = cols[3]
  #   )
  # })
  
  observeEvent(input$outsidelogticks, {
    updateCheckboxInput(session = session,inputId = "clip",value = FALSE
    )
  },ignoreNULL = TRUE, ignoreInit = TRUE)
  observeEvent(input$rugoutside, {
    updateCheckboxInput(session = session,inputId = "clip",value = FALSE
    )
  },ignoreNULL = TRUE, ignoreInit = TRUE)
  
  observeEvent(input$pairslowercont == 'cor', {
    updateSliderInput(session = session,inputId = "sizelowerpairs",value = 6)
  },ignoreNULL = TRUE, ignoreInit = TRUE)
  
  observeEvent(input$pairsuppercont == 'cor', {
    updateSliderInput(session = session,inputId = "sizeupperpairs",value = 6)
  },ignoreNULL = TRUE, ignoreInit = TRUE)

  observeEvent(input$show_pairs, {
    updateSelectInput(session = session, inputId = "facetlabeller",
                      selected = "label_value"
    )
    updateCheckboxInput(session = session,inputId = "facetwrap",
                        value = FALSE
    )
  })
  
  observeEvent(input$facetswitch %in% c("y","both"), {
    updateSliderInput(session = session,
                      inputId = "facettextyangle",
                      value = 0
    )
  },ignoreNULL = TRUE, ignoreInit = TRUE)
  
  mockFileUpload <- function(name) {
    shinyjs::runjs(paste0('$("#datafile").closest(".input-group").find("input[type=\'text\']").val(\'', name, '\')')) 
    shinyjs::runjs('$("#datafile_progress").removeClass("active").css("visibility", "visible"); $("#datafile_progress .progress-bar").width("100%").text("Upload complete")')
  }
  
  # If this app was launched from a function that explicitly set an initial dataset
  if (exists("ggquickeda_initdata")) {
    values$maindata <- get("ggquickeda_initdata")
    mockFileUpload("Initial Data")
  }
  
  # Kill the application/R session when a single shiny session is closed
  session$onSessionEnded(stopApp)
  
  # Variables to help with maintaining the dynamic number of "change the labels
  # of a variable" boxes
  changeLblsVals <- reactiveValues(
    numCurrent = 0,  # How many boxes are there currently
    numTotal = 0  # Max # of boxes at the same time, to prevent memory leaks
  )
  
  # Variables to reorder levels for in the table
  # changeorderVals <- reactiveValues(
  #   numCurrent = 0,  # How many boxes are there currently
  #   numTotal = 0  # Max # of boxes at the same time, to prevent memory leaks
  # )
  
  # Variables to help with maintaining the dynamic number of "quick relabel" boxes
  quickRelabel <- reactiveValues(
    numCurrent = 0,  # How many boxes are there currently
    numTotal = 0     # Max # of boxes at the same time, to prevent memory leaks
  )
  relabels <- character(0)
  
  # This object will track the order of values even through being renamed by
  # factor_lvl_change_select_* widgets
  factor_lvl_diff_tracker <- reactiveValues()
  
  # Add UI and corresponding outputs+observers for a "change factor levels"
  # section
  add_factor_lvl_change_box <- function() {
    changeLblsVals$numCurrent <- changeLblsVals$numCurrent + 1
    
    df <- factor_merge_data()
    items <- names(df)
    names(items) <- items
    MODEDF <- sapply(df, is.numeric)
    ALLNAMES <- names(df)[!MODEDF]
    ALLNAMES <- ALLNAMES[!ALLNAMES=="custombins"]
    names_used <- lapply(seq_len(changeLblsVals$numCurrent - 1),
                         function(i) {
                           input[[paste0("factor_lvl_change_select_", i)]]
                         }) %>% unlist()
    NAMESTOKEEP2 <- setdiff(ALLNAMES, names_used)
    NAMESTOKEEP2["Please select a variable"] = ""
    shinyjs::disable("factor_lvl_change_add")
    
    insertUI(
      selector = "#factor_lvl_change_placeholder", where = "beforeEnd",
      immediate = TRUE,
      div(class = "factor_lvl_change_box",
          selectizeInput(
            paste0("factor_lvl_change_select_", changeLblsVals$numCurrent),
            sprintf('Select a variable (%s):', changeLblsVals$numCurrent),
            choices = NAMESTOKEEP2, selected = ""
          ),
          textOutput(paste0("factor_lvl_change_labeltext_",
                            changeLblsVals$numCurrent)),
          div(
            class = "blind-dropdown",
            shinyjs::hidden(
              selectizeInput(
                inputId = paste0("factor_lvl_change_labels_", changeLblsVals$numCurrent),
                label = "",
                choices = c(),
                multiple = TRUE
              )
            )
          )
      )
    )
    
    # if we already had this many sections before, no need to wire up any
    # new observers
    if (changeLblsVals$numCurrent <= changeLblsVals$numTotal) {
      return()
    }
    num1 <- changeLblsVals$numCurrent
    changeLblsVals$numTotal <- num1
    
    output[[paste0("factor_lvl_change_labeltext_", num1)]] <- renderText({
      df <- factor_merge_data()
      selected_var <- input[[paste0("factor_lvl_change_select_", num1)]]
      if (is.null(selected_var) || selected_var == "") return(NULL)
      if (!selected_var %in% names(df)) return(NULL)
      labeltextout <- c("Old labels", levels(df[, selected_var]))
      labeltextout   
    })
    
    observeEvent(input[[paste0("factor_lvl_change_select_", num1)]], {
      selected_var <- input[[paste0("factor_lvl_change_select_", num1)]]
      if (selected_var == "") return()
      shinyjs::disable(paste0("factor_lvl_change_select_", num1))
      
      df <- factor_merge_data()
      MODEDF <- sapply(df, is.numeric)
      
      ALLNAMES <- names(df)[!MODEDF]
      ALLNAMES <- ALLNAMES[!ALLNAMES=="custombins"]
      if (changeLblsVals$numCurrent < length(ALLNAMES)) {
        shinyjs::enable("factor_lvl_change_add")
      }
      df <- factor_merge_data()
      shinyjs::show(paste0("factor_lvl_change_labels_", num1))
      
      selected_var_factor <- as.factor( df[, selected_var] )
      nlevels <- nlevels(selected_var_factor)
      levelsvalues <- levels(selected_var_factor)
      
      # Start tracking Recoding/Reordering in this variable
      # This object contains snapshots of the factor levels
      # including their recoded values. The elements represent the
      # newly named recoded level, while its name refers to the value
      # found in the data. Order is also retained for values present.
      # The dictionary keeps track of known recodings so that you can add
      # a level back using its new name (not resticted to only its true level)
      factor_lvl_diff_tracker[[ as.character(num1) ]] <- list(
        var = selected_var,
        last_value = setNames(levelsvalues, levelsvalues),
        second_last_value = setNames(levelsvalues, levelsvalues),
        dictionary_of_edits = setNames(levelsvalues, levelsvalues)
      )
      
      updateSelectizeInput(
        session, paste0("factor_lvl_change_labels_", num1),
        label = paste(selected_var, "requires", nlevels, "new labels,
                      edit the labels via Backspace/Enter keys. Drag and Drop the items to the desired order. Do not use semicolons."),
        choices = levelsvalues,
        selected = levelsvalues,
        options = list(
          create = TRUE, createOnBlur = TRUE,
          delimiter = ";",
          plugins = list('drag_drop', 'restore_on_backspace'),
          maxItems = nlevels
        )
        )
    })
    
    observeEvent(input[[ paste0("factor_lvl_change_labels_", num1) ]], {
      
      value_on_arrival <- input[[ paste0("factor_lvl_change_labels_", num1) ]]
      names(value_on_arrival) <- value_on_arrival
      
      diff_tracker <- factor_lvl_diff_tracker[[ as.character(num1) ]]
      previous_value <- diff_tracker[[ "last_value" ]]
      second_last_value <- diff_tracker[[ "second_last_value" ]]
      
      if ( identical(value_on_arrival, previous_value)) return()
      
      # The condition below handles label-adding events,
      # including addition of previously deleted levels.
      # These show up as a delete followed by an addition with a different name/value.
      # Hence, need to track the last 2 values and compare the newest with
      # the value twice preceding it
      #       EG.       Renaming Susan to Sue looks like this:
      #             1. c('Alfred', 'Betty', 'Susan')  <-- compare this
      #             2. c('Alfred', 'Betty')
      #             3. c('Alfred', 'Betty', 'Sue')   <-- against this
      #
      if (length(previous_value[ !is.na(previous_value)]) < length(value_on_arrival) ) {
        
        lvl_dict <-  diff_tracker[[ "dictionary_of_edits" ]]
        new_value <- setdiff(value_on_arrival, previous_value)
        
        already_in_dict <- new_value %in% lvl_dict
        
        if ( !isTRUE(already_in_dict)) { # If label has never been seen, add it to the dictionary
          
          value_before_edit <- setdiff(second_last_value[ !is.na(second_last_value)], value_on_arrival)
          lvl_in_data <- names(lvl_dict[ match(value_before_edit, lvl_dict)])
          
          new_value_tmp <- new_value
          names(new_value_tmp) <- lvl_in_data
          
          updated_lvl_dict <- c(lvl_dict, new_value_tmp)
          updated_lvl_dict <- updated_lvl_dict[ !duplicated(updated_lvl_dict)]
          updated_lvl_dict <- updated_lvl_dict[ !is.na(names(updated_lvl_dict))]
          
          factor_lvl_diff_tracker[[ as.character(num1) ]][[ "dictionary_of_edits" ]] <-
            updated_lvl_dict
        }
        
      }
      
      # This line should read directly from the most up-to-date value
      # (not the object `difftracker`)
      refreshed_lvl_dict <-  factor_lvl_diff_tracker[[ as.character(num1) ]][[ "dictionary_of_edits" ]]
      
      # If a level was removed, determine which level was removed by looking
      # at the levels before the change, and impute it with NA, while keeping
      # a place for it.
      #       EG.       Removing bat looks like this:
      #             1. c(ant = 'ant',  bat = 'bat', cat = 'cat')
      #             ... becomes...
      #             2. c(ant = 'ant',  bat = NA,    cat = 'cat')
      if( length(value_on_arrival) < length(previous_value) ){
        
        imputed_missing_current_value <- previous_value
        true_values <- names(refreshed_lvl_dict)[ match(value_on_arrival, refreshed_lvl_dict)]
        imputed_missing_current_value[ !names(imputed_missing_current_value) %in% true_values] <- NA_character_
        imputed_missing_current_value[ names(imputed_missing_current_value) %in% true_values] <- value_on_arrival
        value_on_arrival <- imputed_missing_current_value
        
      }
      
      # Next we change the *names* of the levels (after recoding) to match the
      # values taken in the data.
      # This is accomplished using the dictionary_of_edits that has been tracking
      # all recoding/relabelling events.
      #       EG.  Given a vector like this..
      #               c(ant = 'ant',  bat = 'bat', cat = 'MrChestington')
      #             .. and a dictionary like this...
      #               c(ant = 'ant', bat = 'bat', cat = 'cat', ant = 'MrAnt',
      #                 bat = 'batface', cat = 'MrChestington')
      #
      #             ... becomes...
      #             2. c(ant = 'ant',  bat = NA,    cat = 'cat')
      
      
      # names(value_on_arrival)[ !is.na(value_on_arrival)] <- names(refreshed_lvl_dict)[match(value_on_arrival[ !is.na(value_on_arrival)], refreshed_lvl_dict)]
      
      
      names(value_on_arrival)[ !is.na(value_on_arrival)] <-
        names(refreshed_lvl_dict)[ match(value_on_arrival[ !is.na(value_on_arrival)], refreshed_lvl_dict) ]
      
      factor_lvl_diff_tracker[[ as.character(num1) ]][[ "last_value" ]] <- value_on_arrival
      factor_lvl_diff_tracker[[ as.character(num1) ]][[ "second_last_value" ]] <- previous_value
      
    })
  }
  
  remove_last_factor_lvl_change_box <- function() {
    factor_lvl_diff_tracker[[ as.character(changeLblsVals$numCurrent) ]] <- NULL
    selector <- paste0("#factor_lvl_change_placeholder .factor_lvl_change_box:nth-child(", changeLblsVals$numCurrent, ")")
    removeUI(selector, multiple = FALSE, immediate = TRUE)
    changeLblsVals$numCurrent <- changeLblsVals$numCurrent - 1
    shinyjs::enable("factor_lvl_change_add")
  }
  
  # Decide if to enable/disable the remove variable labels button
  observeEvent(changeLblsVals$numCurrent, {
    shinyjs::toggleState("factor_lvl_change_remove", condition = changeLblsVals$numCurrent > 0)
  })
  
  # Load user data
  observeEvent(input$datafile, {
    file <- input$datafile$datapath
    values$maindata <- read.csv(file, na.strings = c("NA","."), stringsAsFactors = input$stringasfactor,
                                sep = input$fileseparator)
  })
  
  # Load sample dataset
  observeEvent(input$sample_data_btn, {
    file <- "data/sample_data.csv"
    values$maindata <- read.csv(file, na.strings = c("NA","."),
                                stringsAsFactors = input$stringasfactor,
                                sep = input$fileseparator)
    values$maindata[,"time_DT"] <- as.POSIXct(values$maindata[,"Time"],origin ="01-01-1970",format="%H")
    mockFileUpload("Sample Data")
  })
  
  # reset the dynamic "change factor levels" boxes
  observeEvent(factor_merge_data(), {
    shinyjs::show("factor_lvl_change_section")
    
    changeLblsVals$numCurrent <- 0
    
    removeUI(selector = ".factor_lvl_change_box",
             multiple = TRUE, immediate = TRUE)
    
    add_factor_lvl_change_box()
  })
  
  # add another "change factor levels" box
  observeEvent(input$factor_lvl_change_add, {
    add_factor_lvl_change_box()
  })
  # remove the last "change factor levels" box
  observeEvent(input$factor_lvl_change_remove, {
    remove_last_factor_lvl_change_box()
  })
  
  observeEvent(input$majorgridlinescolreset, {
    shinyjs::reset("majorgridlinescolx")
    shinyjs::reset("majorgridlinescoly")
    
  })
  observeEvent(input$minorgridlinescolreset, {
    shinyjs::reset("minorgridlinescolx")
    shinyjs::reset("minorgridlinescoly")
    
  })
  
  observeEvent(input$colpointreset, {
    shinyjs::reset("colpoint")
  })
  observeEvent(input$collinereset, {
    shinyjs::reset("colline")
  })
  observeEvent(input$colsmoothreset, {
    shinyjs::reset("colsmooth")
  })
  
  observeEvent(input$stripbackfillresetx, {
    shinyjs::reset("stripbackgroundfillx")
  })
  observeEvent(input$stripbackfillresety, {
    shinyjs::reset("stripbackgroundfilly")
  })
  observeEvent(input$vlinecol1reset, {
    shinyjs::reset("vlinecol1")
  })
  observeEvent(input$vlinecol2reset, {
    shinyjs::reset("vlinecol2")
  })
  observeEvent(input$hlinecol1reset, {
    shinyjs::reset("hlinecol1")
  })
  observeEvent(input$hlinecol2reset, {
    shinyjs::reset("hlinecol2")
  })

  output$ycol <- renderUI({
    df <- values$maindata
    validate(need(!is.null(df), "Please select a data set"))
    items=names(df)
    names(items)=items
    selectizeInput("y", "y variable(s):",choices=items,selected = items[1],multiple=TRUE,
                   options = list(
                     plugins = list('remove_button', 'drag_drop')))
  })
  
  output$xcol <- renderUI({
    df <-values$maindata
    validate(need(!is.null(df), "Please select a data set"))
    items=names(df)
    names(items)=items
    selectizeInput("x", "x variable(s):",choices=items,selected=items[2],multiple=TRUE,
                   options = list(
                     plugins = list('remove_button', 'drag_drop')))
    
  })
  
  output$xcolrug <- renderUI({
    df <-values$maindata
    validate(need(!is.null(df), "Please select a data set"))
    items=names(df)
    names(items)=items
    items= c("None",items)
    if ( !is.null(input$y) ){
      items = c(items, "yvars","yvalues") 
    }
    if ( !is.null(input$x) ){
      items = c(items, "xvars","xvalues") 
    }
    if (!is.null(input$pastevarin) && length(input$pastevarin) >1 ){
      nameofcombinedvariables<- paste(as.character(input$pastevarin),collapse="_",sep="") 
      items= c(items,nameofcombinedvariables)
    }
    selectizeInput("xrug", "rug variable(s):",choices = items,
                   multiple=TRUE,
                   options = list(plugins = list('remove_button', 'drag_drop')))  })
  
  # If an X or Y are null, switch to the Histograms tab
  observe({
    if ( (!input$show_pairs && !is.null(input$x) &&  is.null(input$y) && is.numeric(finalplotdata()[,"xvalues"])) ||
         (!input$show_pairs &&  is.null(input$x) && !is.null(input$y) && is.numeric(finalplotdata()[,"yvalues"])) ) {
      showTab("graphicaltypes", target = "color_aes_mappings")
      hideTab("graphicaltypes", target = "points_lines")
      hideTab("graphicaltypes", target = "box_plots")
      showTab("graphicaltypes", target = "histograms_density")
      hideTab("graphicaltypes", target = "barplots")
      hideTab("graphicaltypes", target = "quantile_regression")
      hideTab("graphicaltypes", target = "smooth_regression")
      hideTab("graphicaltypes", target = "mean_ci")
      hideTab("graphicaltypes", target = "median_pi")
      hideTab("graphicaltypes", target = "kaplan_meier")
      hideTab("graphicaltypes", target = "corr_coeff")
      hideTab("graphicaltypes", target = "text_labels")
      showTab("graphicaltypes", target = "rug_marks")
      hideTab("graphicaltypes", target = "pairs_plot")
      updateTabsetPanel(session, "graphicaltypes", "histograms_density")
    } 
    else if ( (!input$show_pairs && !is.null(input$x) &&  is.null(input$y) && !is.numeric(finalplotdata()[,"xvalues"])) ||
              (!input$show_pairs &&  is.null(input$x) && !is.null(input$y) && !is.numeric(finalplotdata()[,"yvalues"])) ) {
      showTab("graphicaltypes", target = "color_aes_mappings")
      hideTab("graphicaltypes", target = "points_lines")
      hideTab("graphicaltypes", target = "box_plots")
      hideTab("graphicaltypes", target = "histograms_density")
      showTab("graphicaltypes", target = "barplots")
      hideTab("graphicaltypes", target = "quantile_regression")
      hideTab("graphicaltypes", target = "smooth_regression")
      hideTab("graphicaltypes", target = "mean_ci")
      hideTab("graphicaltypes", target = "median_pi")
      hideTab("graphicaltypes", target = "kaplan_meier")
      hideTab("graphicaltypes", target = "corr_coeff")
      hideTab("graphicaltypes", target = "text_labels")
      showTab("graphicaltypes", target = "rug_marks")
      hideTab("graphicaltypes", target = "pairs_plot")
      updateTabsetPanel(session, "graphicaltypes", "barplots")
    }
    else if (!input$show_pairs && input$KM != "None") {
      showTab("graphicaltypes", target = "color_aes_mappings")
      hideTab("graphicaltypes", target = "points_lines")
      hideTab("graphicaltypes", target = "box_plots")
      hideTab("graphicaltypes", target = "histograms_density")
      hideTab("graphicaltypes", target = "barplots")
      hideTab("graphicaltypes", target = "quantile_regression")
      hideTab("graphicaltypes", target = "smooth_regression")
      hideTab("graphicaltypes", target = "mean_ci")
      hideTab("graphicaltypes", target = "median_pi")
      showTab("graphicaltypes", target = "kaplan_meier")
      hideTab("graphicaltypes", target = "corr_coeff")
      hideTab("graphicaltypes", target = "text_labels")
      hideTab("graphicaltypes", target = "rug_marks")
      hideTab("graphicaltypes", target = "pairs_plot")
      showTab("graphicaloptions", target = "custom_legends")
      showTab("graphicaloptions", target = "facet_options")
      showTab("graphicaloptions", target = "ref_line_target_options")
      updateTabsetPanel(session, "graphicaltypes", "kaplan_meier")
      showTab("filtercategorize", target = "reorder_facet_axis")
    } 
    else if (input$show_pairs) {
      hideTab("graphicaltypes", target = "color_aes_mappings")
      hideTab("graphicaltypes", target = "points_lines")
      hideTab("graphicaltypes", target = "box_plots")
      hideTab("graphicaltypes", target = "histograms_density")
      hideTab("graphicaltypes", target = "barplots")
      hideTab("graphicaltypes", target = "quantile_regression")
      hideTab("graphicaltypes", target = "smooth_regression")
      hideTab("graphicaltypes", target = "mean_ci")
      hideTab("graphicaltypes", target = "median_pi")
      hideTab("graphicaltypes", target = "kaplan_meier")
      hideTab("graphicaltypes", target = "corr_coeff")
      hideTab("graphicaltypes", target = "text_labels")
      hideTab("graphicaltypes", target = "rug_marks")
      showTab("graphicaltypes", target = "pairs_plot")
      hideTab("graphicaloptions", target = "custom_legends")
      showTab("graphicaloptions", target = "facet_options")
      hideTab("graphicaloptions", target = "ref_line_target_options")
      updateTabsetPanel(session, "graphicaltypes", "pairs_plot")
      hideTab("filtercategorize", target = "reorder_facet_axis")
    } else {
      hideTab("graphicaltypes", target = "pairs_plot")
      showTab("graphicaltypes", target = "color_aes_mappings")
      showTab("graphicaltypes", target = "points_lines")
      showTab("graphicaltypes", target = "box_plots")
      hideTab("graphicaltypes", target = "histograms_density")
      hideTab("graphicaltypes", target = "barplots")
      showTab("graphicaltypes", target = "quantile_regression")
      showTab("graphicaltypes", target = "smooth_regression")
      showTab("graphicaltypes", target = "mean_ci")
      showTab("graphicaltypes", target = "median_pi")
      showTab("graphicaltypes", target = "kaplan_meier")
      showTab("graphicaltypes", target = "corr_coeff")
      showTab("graphicaltypes", target = "text_labels")
      showTab("graphicaltypes", target = "rug_marks")
      showTab("graphicaloptions", target = "custom_legends")
      showTab("graphicaloptions", target = "facet_options")
      showTab("graphicaloptions", target = "ref_line_target_options")
      showTab("filtercategorize", target = "reorder_facet_axis")
    }
  })

  # observe({
  #   if(!input$show_pairs &&
  #      !is.null(input$x) &&  
  #       is.null(input$y) && 
  #       !is.numeric(finalplotdata()[,"xvalues"]) ) {
  #    updateNumericInput(session, "xexpansion_l_add", value = 0.6)
  #    updateNumericInput(session, "xexpansion_r_add", value = 0.6) 
  #   } else if(!input$show_pairs &&
  #             is.null(input$x) &&  
  #             !is.null(input$y) && 
  #             !is.numeric(finalplotdata()[,"yvalues"]) ){
  #     updateNumericInput(session, "yexpansion_l_add", value = 0.6)
  #     updateNumericInput(session, "yexpansion_r_add", value = 0.6) 
  #   }  else if(!input$show_pairs &&
  #              !is.null(input$x) &&  
  #              is.null(input$y) && 
  #              is.numeric(finalplotdata()[,"xvalues"]) ){
  #     updateNumericInput(session, "xexpansion_l_add", value = 0)
  #     updateNumericInput(session, "xexpansion_r_add", value = 0)
  #     updateNumericInput(session, "yexpansion_l_add", value = 0)
  #     updateNumericInput(session, "yexpansion_r_add", value = 0) 
  #   } else if(!input$show_pairs &&
  #            is.null(input$x) &&  
  #            !is.null(input$y) && 
  #            is.numeric(finalplotdata()[,"yvalues"]) ){
  #     updateNumericInput(session, "xexpansion_l_add", value = 0)
  #     updateNumericInput(session, "xexpansion_r_add", value = 0)
  #     updateNumericInput(session, "yexpansion_l_add", value = 0)
  #     updateNumericInput(session, "yexpansion_r_add", value = 0) 
  #   } else if(!input$show_pairs &&
  #             !is.null(input$x) &&  
  #             is.null(input$y) && 
  #             !is.numeric(finalplotdata()[,"xvalues"]) ){
  #     updateNumericInput(session, "xexpansion_l_add", value = 0.6)
  #     updateNumericInput(session, "xexpansion_r_add", value = 0.6)
  #     updateNumericInput(session, "yexpansion_l_add", value = 0)
  #     updateNumericInput(session, "yexpansion_r_add", value = 0)
  #   } else if(!input$show_pairs &&
  #             is.null(input$x) &&  
  #             !is.null(input$y) && 
  #             !is.numeric(finalplotdata()[,"yvalues"]) ){
  #     updateNumericInput(session, "xexpansion_l_add", value = 0)
  #     updateNumericInput(session, "xexpansion_r_add", value = 0)
  #     updateNumericInput(session, "yexpansion_l_add", value = 0.6)
  #     updateNumericInput(session, "yexpansion_r_add", value = 0.6) 
  #   } else{
  #     updateNumericInput(session, "xexpansion_l_add", value = 0)
  #     updateNumericInput(session, "xexpansion_r_add", value = 0)
  #     updateNumericInput(session, "yexpansion_l_add", value = 0)
  #     updateNumericInput(session, "yexpansion_r_add", value = 0) 
  #   }
  #   })
  
  observe({
  if   (((input$colorin!="None" &&
       input$colorin %in% names(finalplotdata()) &&
       !is.numeric(finalplotdata()[,input$colorin]) && 
       length(unique(finalplotdata()[,input$colorin])) > 20) ||
       (input$fillin!="None" &&
        input$fillin %in% names(finalplotdata()) &&
        !is.numeric(finalplotdata()[,input$fillin]) && 
        length(unique(finalplotdata()[,input$fillin])) > 20) ) 
       ) {
    updateRadioButtons(session, "themecolorswitcher", selected="themeggplot")
    updateTabsetPanel(session, "sidebar_upper_menus", selected="sidebar_Graph_Options")
    updateTabsetPanel(session, "graphicaloptions", selected="themes_color_other")
    updateSliderInput(session, "nusercol",
                      value = length(unique(finalplotdata()[,input$colorin])),
                      max = length(unique(finalplotdata()[,input$colorin]))+5)
    
  } else if (((input$colorin!="None" &&
             input$colorin %in% names(finalplotdata()) &&
             !is.numeric(finalplotdata()[,input$colorin]) &&
             (length(unique(finalplotdata()[,input$colorin])) > 10 &&
             length(unique(finalplotdata()[,input$colorin])) <= 20) ) ||
             (input$fillin!="None" &&
              input$fillin %in% names(finalplotdata()) &&
              !is.numeric(finalplotdata()[,input$fillin]) &&
              (length(unique(finalplotdata()[,input$fillin])) > 10 &&
               length(unique(finalplotdata()[,input$fillin])) <= 20) ) ) 
             ) {
    updateRadioButtons(session, "themecolorswitcher", selected="themetableau20")
    updateTabsetPanel(session, "sidebar_upper_menus", selected="sidebar_Graph_Options")
    updateTabsetPanel(session, "graphicaloptions", selected="themes_color_other")
    updateSliderInput(session, "nusercol",
                      value = length(unique(finalplotdata()[,input$colorin])),
                      max = 30)
  } else {
    updateRadioButtons(session, "themecolorswitcher", selected="themetableau10")
  }
  })#zzz 

  
  observe({
    if( (is.null(input$y) && !is.numeric(finalplotdata()[,"xvalues"] )) ||
        (is.null(input$x) && !is.numeric(finalplotdata()[,"yvalues"] ))
         ) {
      updateRadioButtons(session, "histogramaddition",selected="None")
      updateRadioButtons(session, "densityaddition"  ,selected="None")
      shinyjs::disable(id="histogramaddition")
      shinyjs::disable(id="densityaddition")
      shinyjs::enable(id="barplotaddition")
      updateCheckboxInput(session, "barplotaddition", value = TRUE)
    }
  })
  observe({
    if( (is.null(input$y) &&  is.numeric(finalplotdata()[,"xvalues"] )) ||
        (is.null(input$x) &&  is.numeric(finalplotdata()[,"yvalues"] ))
    ) {
      shinyjs::enable(id="histogramaddition")
      shinyjs::enable(id="densityaddition")
      updateRadioButtons(session, "densityaddition" , selected = "Density")
      updateCheckboxInput(session, "barplotaddition", value = FALSE)
      shinyjs::disable(id="barplotaddition")
      
    }
  })
  
  observe({
    if (input$KM!="None") {
      updateRadioButtons(session, "yaxisscale", choices = c(
        "Linear" = "lineary"))
    }
    if (input$KM=="None") {
      updateRadioButtons(session, "yaxisscale", choices = c(
        "Linear" = "lineary",
        "Log10" = "logy"))
    }
 })
  observe({
    if (input$KM=="None") {
      updateCheckboxInput(session, "addrisktable", value = FALSE)
    }
  })

  observe({
    if (input$yaxisscale=="lineary" && input$KM=="None") {
      updateRadioButtons(session, "yaxisformat", choices = c("default" = "default",
                                                             "Comma separated" = "scientificy",
                                                             "Percent" = "percenty"))
    }
    if (input$yaxisscale=="lineary" && input$KM!="None") {
      updateRadioButtons(session, "yaxisformat", choices = c("default" = "default",
                                                             "Percent" = "percenty"))
    }
    
    if (input$yaxisscale!="lineary") {
      updateRadioButtons(session, "yaxisformat", choices = c("default" = "default",
                                                             "Log 10^x Format" = "logyformat",
                                                             "Pretty Y" ="logyformat2"))
    }
  })
  observe({
    if (input$yaxisformat!="default") {
    updateCheckboxInput(session, "customytickslabel", value = FALSE)
    }
    if (input$xaxisformat!="default") {
      updateCheckboxInput(session, "customxtickslabel", value = FALSE)
    }
  })
  
  observe({
    if (input$xaxisscale=="linearx") {
      updateRadioButtons(session, "xaxisformat", choices = c("default" = "default",
                                                             "Comma separated" = "scientificx",
                                                             "Percent" = "percentx"))
    }
    if (input$xaxisscale!="linearx") {
      updateRadioButtons(session, "xaxisformat", choices = c("default" = "default",
                                                             "Log 10^x Format" = "logxformat",
                                                             "Pretty X" ="logxformat2"))
    }
  })
  
  # observe({
  #   if (length(input$y)>1) {
  #     updateRadioButtons(session, "yaxiszoom", choices = c("None" = "noyzoom",
  #                                                          "User" = "useryzoom"),inline=TRUE)
  #   }
  #   if (length(input$y)<2) {
  #     updateRadioButtons(session, "yaxiszoom", choices = c("None" = "noyzoom",
  #                                                          "Automatic" = "automaticyzoom",
  #                                                          "User" = "useryzoom"),inline=TRUE)
  #   }
  # })
  
  # observe({
  #   if (length(input$x)>1 ) {
  #     updateRadioButtons(session, "xaxiszoom", choices = c("None" = "noxzoom",
  #                                                          "User" = "userxzoom"),inline=TRUE)
  #   }
  #   if (length(input$x)<2  ) {
  #     updateRadioButtons(session, "xaxiszoom", choices = c("None" = "noxzoom",
  #                                                          "Automatic" = "automaticxzoom",
  #                                                          "User" = "userxzoom"),inline=TRUE)
  #   }
  # })

  outputOptions(output, "ycol", suspendWhenHidden=FALSE)
  outputOptions(output, "xcol", suspendWhenHidden=FALSE)
  
  output$catvar <- renderUI({
    df <-values$maindata
    validate(need(!is.null(df), "Please select a data set"))

    MODEDF <- sapply(df, function(x) is.numeric(x))
    NAMESTOKEEP2<- names(df)  [ MODEDF ]
    selectInput('catvarin',label = 'Recode into Binned Categories:',
                choices = NAMESTOKEEP2, multiple=TRUE)
  })
  
  # Show/hide the "N of cut breaks" input
  observeEvent(input$catvarin, ignoreNULL = FALSE, {
    shinyjs::toggle("ncuts", condition = !is.null(input$catvarin) && length(input$catvarin) >= 1)
  })
  
  output$catvarquant <- renderUI({
    df <-values$maindata
    validate(need(!is.null(df), "Please select a data set"))
    MODEDF <- sapply(df, function(x) is.numeric(x))
    NAMESTOKEEP2<- names(df)  [ MODEDF ]
    if (!is.null(input$catvarin) && length(input$catvarin ) >=1) {
        NAMESTOKEEP2 <- NAMESTOKEEP2 [ !is.element(NAMESTOKEEP2,input$catvarin) ]
    }
    selectInput('catvarquantin',
                label = 'Recode into Quantile Categories:',
                choices = NAMESTOKEEP2, multiple=TRUE)
  })
  
  # Show/hide the "N of cut quantiles" input
  observeEvent(input$catvarquantin, ignoreNULL = FALSE, {
    shinyjs::toggle("ncutsquant",
                    condition = !is.null(input$catvarquantin) && length(input$catvarquantin) >= 1)
  })
  observeEvent(input$catvarquantin, ignoreNULL = FALSE, {
    shinyjs::toggle("zeroplacebo",
                    condition = !is.null(input$catvarquantin) && length(input$catvarquantin) >= 1)
  })
  observeEvent(input$catvarquantin, ignoreNULL = FALSE, {
    shinyjs::toggle("missingcategory",
                    condition = !is.null(input$catvarquantin) && length(input$catvarquantin) >= 1)
  })
  
  output$catvar2 <- renderUI({
    df <-values$maindata
    validate(need(!is.null(df), "Please select a data set"))
    MODEDF <- sapply(df, function(x) !is.factor(x))
    NAMESTOKEEP2<- names(df)  [ MODEDF ]
    if (!is.null(input$catvarquantin) && (length(input$catvarquantin ) >=1 ) ) {
        NAMESTOKEEP2<-NAMESTOKEEP2 [ !is.element(NAMESTOKEEP2,input$catvarquantin) ]
    }
    if (!is.null(input$catvarin) && (length(input$catvarin ) >=1 )) {
        NAMESTOKEEP2<-NAMESTOKEEP2 [ !is.element(NAMESTOKEEP2,input$catvarin) ]
    }
    selectInput('catvar2in',label = 'Treat as Categories:',choices=NAMESTOKEEP2,multiple=TRUE)
  })
  
  output$catvar3 <- renderUI({
    df <-values$maindata
    validate(need(!is.null(df), "Please select a data set"))
    MODEDF <- sapply(df, function(x) is.numeric(x))
    NAMESTOKEEP2<- names(df)  [ MODEDF ]
    if (!is.null(input$catvarin) && length(input$catvarin ) >=1) {
      NAMESTOKEEP2 <- NAMESTOKEEP2 [ !is.element(NAMESTOKEEP2,input$catvarin) ]
    }
    if (!is.null(input$catvarquantin) && length(input$catvarquantin ) >=1) {
      NAMESTOKEEP2 <- NAMESTOKEEP2 [ !is.element(NAMESTOKEEP2,input$catvarquantin) ]
    }
    if (!is.null(input$catvar2in) && length(input$catvar2in ) >=1) {
      NAMESTOKEEP2 <- NAMESTOKEEP2 [ !is.element(NAMESTOKEEP2,input$catvar2in) ]
    }
    selectizeInput(  "catvar3in", 'Custom cuts of this variable, defaults to min, median, max before any applied filtering:',
                     choices =NAMESTOKEEP2 ,multiple=FALSE,
                     options = list(    placeholder = 'Please select a variable',
                                        onInitialize = I('function() { this.setValue(""); }')
                     )
    )
  })
  output$ncuts2 <- renderUI({
    df <-values$maindata
    validate(need(!is.null(df), "Please select a data set"))
    if (is.null(input$catvar3in)) return()
    if (!is.null(input$catvar3in) && length(input$catvar3in ) <1)  return(NULL)
    if ( input$catvar3in!=""){
      column(12,textInput("xcutoffs", label =  paste(input$catvar3in,"Cuts"),
                value = as.character(paste(
                  min(df[,input$catvar3in] ,na.rm=T),
                  median(df[,input$catvar3in],na.rm=T),
                  max(df[,input$catvar3in],na.rm=T)
                  ,sep=",")
                )
      ),
      checkboxInput('missingcategory2', 'Missing as a Category ?', value = FALSE)
      )
    }
  })
  output$asnumeric <- renderUI({
    df <-values$maindata
    validate(need(!is.null(df), "Please select a data set"))
    if (is.null(input$catvar3in)) return()
    if (!is.null(input$catvar3in) && length(input$catvar3in ) <1)  return(NULL)
    if ( input$catvar3in!=""){
      column(12,
             checkboxInput('asnumericin', 'Treat as Numeric (helpful to overlay a smooth/regression line on top of a boxplot or to convert a variable into 0/1 and overlay a logistic fit', value = FALSE)
      )
    }
  })

  outputOptions(output, "catvar", suspendWhenHidden=FALSE)
  outputOptions(output, "catvar2", suspendWhenHidden=FALSE)
  outputOptions(output, "catvar3", suspendWhenHidden=FALSE)
  outputOptions(output, "ncuts2", suspendWhenHidden=FALSE)
  outputOptions(output, "asnumeric", suspendWhenHidden=FALSE)
  outputOptions(output, "catvarquant", suspendWhenHidden=FALSE)
  
  recodedata1  <- reactive({
    df <- values$maindata 
    validate(need(!is.null(df), "Please select a data set"))
    if(!is.null(input$catvarin) && length(input$catvarin ) >=1) {
      for (i in 1:length(input$catvarin ) ) {
        varname <- input$catvarin[i]
        df[,varname] <- cut(df[,varname],input$ncuts , include.lowest = TRUE, right = FALSE, ordered_result = FALSE)
        df[,varname]   <- as.factor( df[,varname])
      }
    }
    df
  })
  
  recodedataquant  <- reactive({
    df <- recodedata1() 
    validate(need(!is.null(df), "Please select a data set"))
    ngroups<- input$ncutsquant
    zeroplacebo<- input$zeroplacebo
    missingcategory <- input$missingcategory
    if(!is.null(input$catvarquantin)&length(input$catvarquantin ) >=1) {
      for (i in 1:length(input$catvarquantin ) ) {
        varname<- input$catvarquantin[i]
        x2<- unlist(df[,varname])
        if( zeroplacebo &&  missingcategory){
          df[,varname]   <- table1::eqcut(x2, ngroups=ngroups,
                                          varlabel=varname,
                                          withhold=list(
                                            Placebo=(x2==0),
                                            Missing=(is.na(x2))))
        }
        if( zeroplacebo && !missingcategory){
          df[,varname]   <- table1::eqcut(x2, ngroups=ngroups,
                                          varlabel=varname,
                                          withhold=list(
                                            Placebo=(x2==0)))
        }
        if(!zeroplacebo &&  missingcategory){
          df[,varname]   <- table1::eqcut(x2, ngroups=ngroups,
                                          varlabel=varname,
                                          withhold=list(
                                            Missing=(is.na(x2))))
        }
        if(!zeroplacebo && !missingcategory){
          withhold<- NULL
          df[,varname]   <- table1::eqcut(x2, ngroups=ngroups,
                                          varlabel=varname,
                                          withhold=NULL)
        }
      }
    }
    df
  })
  
  recodedata2  <- reactive({
    df <- recodedataquant()
    validate(need(!is.null(df), "Please select a data set"))
    if(!is.null(input$catvar2in) ){
      if(length(input$catvar2in ) >=1) {
        for (i in 1:length(input$catvar2in ) ) {
          varname<- input$catvar2in[i]
          if( is.factor(df[,varname]))  df[,varname] 
          if( !is.factor(df[,varname])) df[,varname] <- as.factor( as.character(df[,varname]))
        }
      }  
    }
    df
  })
  
  output$contvar <- renderUI({
    df <-values$maindata
    validate(need(!is.null(df), "Please select a data set"))
    MODEDF <- sapply(df, function(x) !is.numeric(x))
    NAMESTOKEEP2<- names(df)  [ MODEDF ]
    selectInput('contvarin',label = 'Treat as Numeric:',choices=NAMESTOKEEP2,multiple=TRUE)
  })
  outputOptions(output, "contvar", suspendWhenHidden=FALSE)
  
  makedatacont  <- reactive({
    df <- recodedata2()
    validate(need(!is.null(df), "Please select a data set"))
    if(!is.null(input$contvarin) ){
      if(length(input$contvarin ) >=1) {
        for (i in 1:length(input$contvarin ) ) {
          varname<- input$contvarin[i]
          if( is.factor(df[,varname]))  df[,varname] <- as.double( as.factor(df[,varname]))-1
          if( is.character(df[,varname])) df[,varname] <- as.double( as.character(df[,varname]))
          if( inherits(df[,varname],"POSIXct"))   df[,varname]   <- as.numeric(df[,varname])
        }
      }
    }
    df
  })

  recodedata3  <- reactive({
    df <- makedatacont()
    validate(need(!is.null(df), "Please select a data set"))
    if (is.null(input$catvar3in)) return(NULL)
    if(input$catvar3in!="" && !is.null(input$xcutoffs)) {
      varname<- input$catvar3in
      xlimits <- input$xcutoffs
      nxintervals <- length(as.numeric(unique(unlist (strsplit(xlimits, ",")) ))) -1
      df[,varname] <- cut( as.numeric ( as.character(  df[,varname])),
                           breaks=   as.numeric(unique(unlist (strsplit(xlimits, ","))) ),include.lowest=TRUE)
      
      if(input$missingcategory2) {
        df[,varname] <- addNA(df[,varname])
        levels(df[,varname])[length(levels(df[,varname]))] <- "Missing"
      }
      df[,"custombins"] <-   df[,varname] 
      if(input$asnumericin) {
        df[,varname] <- as.numeric(as.factor(df[,varname]) ) -1 
      }
    }
    df
  })
  output$bintext <- renderText({
    df <- recodedata3()
    validate(need(!is.null(df), "Please select a data set"))
    bintextout <- ""
    if(input$catvar3in!="" && !is.null(input$asnumericin)) {
      varname<- input$catvar3in
      if(!input$asnumericin){
        bintextout <- levels(df[,"custombins"] )
      }
      if(input$asnumericin){
        bintextout <- paste( sort(unique(as.numeric(as.factor(df[,varname]) ) -1))  ,levels(df[,"custombins"] ),sep="/") 
      }}
    bintextout   
  })   
  
  recodedata4  <- reactive({
    df <- factor_merge_data()
    validate(need(!is.null(df), "Please select a data set"))
    # get all the "change factor levels" inputs and apply them
    for (i in seq_len(changeLblsVals$numCurrent)) {
      variable_name <- input[[paste0("factor_lvl_change_select_", i)]]
      if (is.null(variable_name) || variable_name == "") next
      labels <- input[[paste0("factor_lvl_change_labels_", i)]]
      if (is.null(labels) || labels == "") next
      labels <- gsub("\\\\n", "\\\n", labels)
      if (!variable_name %in% names(df)) next
      
      ordered_lvls <- factor_lvl_diff_tracker[[ as.character(i) ]][[ "last_value" ]]
      ordered_lvls <- ordered_lvls[ order(is.na(ordered_lvls))]
      
      if (!is.null(ordered_lvls)) {
        ordered_lvls[ is.na(ordered_lvls)] <- ""
        df[, variable_name] <- factor(df[, variable_name],
                                      levels = names(ordered_lvls))
      }
      
      new_labels <- labels[1:nlevels(df[, variable_name])]
      new_labels[is.na(new_labels)] <- ""
      levels(df[, variable_name]) <- new_labels
    }
    df
  })
  
  
  output$pastevar <- renderUI({
    df <- recodedata4()
    validate(need(!is.null(df), "Please select a data set"))
    df <- df[!names(df) %in% "custombins"]
    MODEDF <- sapply(df, function(x) is.numeric(x))
    yvariables <- input$y
    NAMESTOKEEP2<- names(df)  [! MODEDF ]
    NAMESTOKEEP2<- NAMESTOKEEP2[!NAMESTOKEEP2 %in% yvariables]
    selectizeInput("pastevarin", "Combine the categories of these two variables:",
                   choices = NAMESTOKEEP2, multiple=TRUE,
                   options = list(
                     maxItems = 2 ,
                     placeholder = 'Please select two variables',
                     onInitialize = I('function() { this.setValue(""); }'),
                     plugins = list('remove_button', 'drag_drop')
                   )
    )
  })
  
  pastedata  <- reactive({
    df <- recodedata4()
    validate(need(!is.null(df), "Please select a data set"))
    df <- df[!names(df)%in%"custombins"]
    if( !is.null(input$pastevarin)   ) {
      if (length(input$pastevarin) > 1) {
        newcol_name <- paste(as.character(input$pastevarin),collapse="_",sep="")
        df <- unite(df, !!newcol_name,
                    c(input$pastevarin[1], input$pastevarin[2] ), remove=FALSE)
        
      }
    }
    df
  })
  
  
  
  
  outputOptions(output, "pastevar", suspendWhenHidden=FALSE)
  outputOptions(output, "bintext", suspendWhenHidden=FALSE)
  
  output$maxlevels <- renderUI({
    df <-pastedata()
    validate(need(!is.null(df), "Please select a data set"))
    numericInput( inputId = "inmaxlevels",label = "Maximum number of unique values for Filter variable (1),(2),(3) (this is to avoid performance issues):",value = 500,min = 1,max = NA)
    
  })
  outputOptions(output, "maxlevels", suspendWhenHidden=FALSE)
  
  
  output$filtervar1 <- renderUI({
    df <-pastedata()
    validate(need(!is.null(df), "Please select a data set"))
    NUNIQUEDF <- sapply(df, function(x) length(unique(x)))
    NAMESTOKEEP<- names(df)  [ NUNIQUEDF  < input$inmaxlevels ]
    selectInput("infiltervar1" , "Filter variable (1):",c('None',NAMESTOKEEP ) )
  })
  
  output$filtervar2 <- renderUI({
    df <- pastedata()
    validate(need(!is.null(df), "Please select a data set"))
    NUNIQUEDF <- sapply(df, function(x) length(unique(x)))
    NAMESTOKEEP<- names(df)  [ NUNIQUEDF  < input$inmaxlevels ]
    selectInput("infiltervar2" , "Filter variable (2):",c('None',NAMESTOKEEP ) )
  })
  
  output$filtervar3 <- renderUI({
    df <- pastedata()
    validate(need(!is.null(df), "Please select a data set"))
    NUNIQUEDF <- sapply(df, function(x) length(unique(x)))
    NAMESTOKEEP<- names(df)  [ NUNIQUEDF  < input$inmaxlevels ]
    selectInput("infiltervar3" , "Filter variable (3):",c('None',NAMESTOKEEP ) )
  })
  
  
  output$filtervarcont1 <- renderUI({
    df <-pastedata()
    validate(need(!is.null(df), "Please select a data set"))
    NUNIQUEDF <- sapply(df, function(x) length(unique(x)))
    NAMESTOKEEP<- names(df)
    NAMESTOKEEP<- NAMESTOKEEP[ is.element ( NAMESTOKEEP,names(df[sapply(df,is.numeric)]))]
    selectInput("infiltervarcont1" , "Filter continuous (1):",c('None',NAMESTOKEEP ) )
  })
  output$filtervarcont2 <- renderUI({
    df <-pastedata()
    validate(need(!is.null(df), "Please select a data set"))
    NUNIQUEDF <- sapply(df, function(x) length(unique(x)))
    NAMESTOKEEP<- names(df)  
    NAMESTOKEEP<- NAMESTOKEEP[ is.element ( NAMESTOKEEP,names(df[sapply(df,is.numeric)]))]
    selectInput("infiltervarcont2" , "Filter continuous (2):",c('None',NAMESTOKEEP ) )
  })
  output$filtervarcont3 <- renderUI({
    df <-pastedata()
    validate(need(!is.null(df), "Please select a data set"))
    NUNIQUEDF <- sapply(df, function(x) length(unique(x)))
    NAMESTOKEEP<- names(df)  
    NAMESTOKEEP<- NAMESTOKEEP[ is.element ( NAMESTOKEEP,names(df[sapply(df,is.numeric)]))]
    selectInput("infiltervarcont3" , "Filter continuous (3):",c('None',NAMESTOKEEP ) )
  })
  output$filtervar1values <- renderUI({
    df <-pastedata()
    validate(need(!is.null(df), "Please select a data set"))
    if(is.null(input$infiltervar1) || input$infiltervar1=="None") {return(NULL)}
    if(!is.null(input$infiltervar1) && input$infiltervar1!="None" )  {
      choices <- levels(as.factor(df[,input$infiltervar1]))
      selectInput('infiltervar1valuesnotnull',
                  label = paste("Select values", input$infiltervar1),
                  choices = c(choices),
                  selected = choices,
                  multiple=TRUE, selectize=FALSE)   
    }
  }) 
  
  filterdata  <- reactive({
    df <-   pastedata()
    validate(need(!is.null(df), "Please select a data set"))
    if(is.null(input$infiltervar1)) {
      return(df)
    }
    if(!is.null(input$infiltervar1)&input$infiltervar1!="None") {
      
      df <-  df [ is.element(df[,input$infiltervar1],input$infiltervar1valuesnotnull),]
    }
    
    df
  })
  
  output$filtervar2values <- renderUI({
    df <- filterdata()
    validate(need(!is.null(df), "Please select a data set"))
    if (is.null(input$infiltervar2)) return()
    if(input$infiltervar2=="None") {
      selectInput('infiltervar2valuesnull',
                  label ='No filter variable 2 specified', 
                  choices = list(""),multiple=TRUE, selectize=FALSE)   
    }
    if(input$infiltervar2!="None"&&!is.null(input$infiltervar2) )  {
      choices <- levels(as.factor(as.character(df[,input$infiltervar2])))
      selectInput('infiltervar2valuesnotnull',
                  label = paste("Select values", input$infiltervar2),
                  choices = c(choices),
                  selected = choices,
                  multiple=TRUE, selectize=FALSE)   
    }
  })
  
  filterdata2  <- reactive({
    df <- filterdata()
    validate(need(!is.null(df), "Please select a data set"))
    if (is.null(input$infiltervar2)) {
      return(df)
    }
    if(input$infiltervar2 != "None") {
      df <-  df [ is.element(df[,input$infiltervar2],input$infiltervar2valuesnotnull),]
    }
    df
  }) 
  output$filtervar3values <- renderUI({
    df <- filterdata2()
    validate(need(!is.null(df), "Please select a data set"))
    if (is.null(input$infiltervar3)) return()
    if(input$infiltervar3 == "None") {
      selectInput('infiltervar3valuesnull',
                  label ='No filter variable 3 specified', 
                  choices = list(""),multiple=TRUE, selectize=FALSE)   
    } 
    if(input$infiltervar3!="None"&&!is.null(input$infiltervar3) )  {
      choices <- levels(as.factor(as.character(df[,input$infiltervar3])))
      selectizeInput('infiltervar3valuesnotnull',
                     label = paste("Select values", input$infiltervar3),
                     choices = c(choices),
                     selected = choices,
                     multiple=TRUE,
                     options = list(
                       plugins = list('remove_button'))
      )   
    }
  })
  
  filterdata3  <- reactive({
    df <- filterdata2()
    validate(need(!is.null(df), "Please select a data set"))
    if (is.null(input$infiltervar3)) {
      return(df)
    }
    if(input$infiltervar3!="None") {
      df <-  df [ is.element(df[,input$infiltervar3],input$infiltervar3valuesnotnull),]
    }
    df
  })  
  
  output$fslider1 <- renderUI({ 
    df <-  filterdata3()
    validate(need(!is.null(df), "Please select a data set"))
    xvariable<- input$infiltervarcont1
    if(is.null(xvariable) || input$infiltervarcont1=="None" ){
      return(NULL)  
    }
    if (!is.numeric(df[,xvariable]) ) return(NULL)
    if(input$infiltervarcont1!="None" ){
      sliderInput("infSlider1", paste("Select",xvariable,"Range"),
                  min=min(df[,xvariable],na.rm=T),
                  max=max(df[,xvariable],na.rm=T),
                  value=c(min(df[,xvariable],na.rm=T),max(df[,xvariable],na.rm=T)) 
      )
    }             
  })
  filterdata4  <- reactive({
    df <- filterdata3()
    validate(need(!is.null(df), "Please select a data set"))
    if (is.null(input$infiltervarcont1)) return()
    if(input$infiltervarcont1!="None" ){
      if(is.numeric( input$infSlider1[1]) && is.numeric(df[,input$infiltervarcont1])) {
        df <- df [!is.na(df[,input$infiltervarcont1]),]
        df <- df [df[,input$infiltervarcont1] >= input$infSlider1[1] &
                     df[,input$infiltervarcont1] <= input$infSlider1[2],]
      }
    }
    
    df
  })
  output$fslider2 <- renderUI({ 
    df <-  filterdata4()
    validate(need(!is.null(df), "Please select a data set"))
    xvariable<- input$infiltervarcont2
    if(input$infiltervarcont2=="None" ){
      return(NULL)  
    }
    if (!is.numeric(df[,xvariable]) ) return(NULL)
    if(input$infiltervarcont2!="None" ){
      sliderInput("infSlider2", paste("Select", xvariable,"Range"),
                  min=min(df[,xvariable],na.rm=T),
                  max=max(df[,xvariable],na.rm=T),
                  value=c(min(df[,xvariable],na.rm=T),max(df[,xvariable],na.rm=T)) 
      )
    }             
  })
  
  filterdata5  <- reactive({
    df <- filterdata4()
    validate(need(!is.null(df), "Please select a data set"))
    if(input$infiltervarcont2!="None" ){
      if(is.numeric( input$infSlider2[1]) &&
         is.numeric(df[,input$infiltervarcont2])) {
        df <- df [!is.na(df[,input$infiltervarcont2]),]
        df <- df [df[,input$infiltervarcont2] >= input$infSlider2[1] &
                  df[,input$infiltervarcont2] <= input$infSlider2[2],]
      }
    }
    df
  })
  
  output$fslider3 <- renderUI({ 
    df <-  filterdata5()
    validate(need(!is.null(df), "Please select a data set"))
    xvariable<- input$infiltervarcont3
    if(input$infiltervarcont3=="None" ){
      return(NULL)  
    }
    if (!is.numeric(df[,xvariable]) ) return(NULL)
    if(input$infiltervarcont3!="None" ){
      sliderInput("infSlider3", paste("Select", xvariable,"Range"),
                  min=min(df[,xvariable],na.rm=T),
                  max=max(df[,xvariable],na.rm=T),
                  value=c(min(df[,xvariable],na.rm=T),
                          max(df[,xvariable],na.rm=T)) 
      )
    }             
  })
  
  
  filterdata6  <- reactive({
    df <- filterdata5()
    validate(need(!is.null(df), "Please select a data set"))
    if(input$infiltervarcont3!="None" ){
      if(is.numeric( input$infSlider3[1]) &&
         is.numeric(df[,input$infiltervarcont3])) {
        df<- df[!is.na(df[,input$infiltervarcont3]),]
        df<- df[df[,input$infiltervarcont3] >= input$infSlider3[1] &
                  df[,input$infiltervarcont3] <= input$infSlider3[2],]
      }
    }
    df
  })
  
  outputOptions(output, "filtervar1", suspendWhenHidden=FALSE)
  outputOptions(output, "filtervar2", suspendWhenHidden=FALSE)
  outputOptions(output, "filtervar3", suspendWhenHidden=FALSE)
  
  outputOptions(output, "filtervarcont1", suspendWhenHidden=FALSE)
  outputOptions(output, "filtervarcont2", suspendWhenHidden=FALSE)
  outputOptions(output, "filtervarcont3", suspendWhenHidden=FALSE)
  outputOptions(output, "filtervar1values", suspendWhenHidden=FALSE)
  outputOptions(output, "filtervar2values", suspendWhenHidden=FALSE)
  outputOptions(output, "filtervar3values", suspendWhenHidden=FALSE)
  
  outputOptions(output, "fslider1", suspendWhenHidden=FALSE)
  outputOptions(output, "fslider2", suspendWhenHidden=FALSE)
  outputOptions(output, "fslider3", suspendWhenHidden=FALSE)
  
  output$onerowidgroup <- renderUI({
    df <- filterdata6()
    validate(need(!is.null(df), "Please select a data set"))
    items=names(df)
    names(items)=items
    selectizeInput("onerowidgroupin", "Keep First Row by ID(s):",
                   choices = items, multiple=TRUE,
                   options = list(
                     placeholder = 'Please select at least one variable that is not in y variable(s)',
                     onInitialize = I('function() { this.setValue(""); }'),
                     plugins = list('remove_button')
                   )
    )
    
  })
  outputOptions(output, "onerowidgroup", suspendWhenHidden=FALSE)
  filterdata7  <- reactive({
    df <- filterdata6()
    validate(need(!is.null(df), "Please select a data set"))
    if( !is.null(input$onerowidgroupin) && length(input$onerowidgroupin) >0 ){
      vars<- c(as.vector(input$onerowidgroupin) )
      df <-   df %>%
        group_by(!!!syms(vars))
      df<- df %>% filter(row_number()==1 ) %>%
        ungroup()
    }
    if(is.null(input$onerowidgroupin) || length(input$onerowidgroupin) <1 ){
      df <- df
    }
    as.data.frame(df)
  })
  
  output$onerowidlastgroup <- renderUI({
    df <- filterdata7()
    validate(need(!is.null(df), "Please select a data set"))
    items=names(df)
    names(items)=items
    selectizeInput("onerowidlastgroupin", "Keep Last Row by ID(s):",
                   choices = items, multiple=TRUE,
                   options = list(
                     placeholder = 'Please select at least one variable that is not in y variable(s)',
                     onInitialize = I('function() { this.setValue(""); }'),
                     plugins = list('remove_button')
                   )
    )
  })
  outputOptions(output, "onerowidlastgroup", suspendWhenHidden=FALSE)  
  
  filterdata8  <- reactive({
    df <- filterdata7()
    validate(need(!is.null(df), "Please select a data set"))
    if( !is.null(input$onerowidlastgroupin) && length(input$onerowidlastgroupin) >0 ){
      vars<- c(as.vector(input$onerowidlastgroupin) )
      df <-   df %>%
        group_by(!!!syms(vars))
      df<- df %>% filter(row_number()==n() ) %>%
        ungroup()
    }
    if(is.null(input$onerowidlastgroupin) || length(input$onerowidlastgroupin) <1 ){
      df <-   df
    }
    as.data.frame(df)
  })
  
  output$divideynum <- renderUI({
    df <- filterdata8()
    validate(need(!is.null(df), "Please select a data set"))
    if (!is.null(df)){
      MODEDF <- sapply(df, function(x) is.numeric(x))
      NAMESTOKEEP2<- names(df)  [MODEDF]
      selectizeInput(  "divideynumin", "Divide the Values by the specified column:", choices = NAMESTOKEEP2,multiple=TRUE,
                       options = list(
                         placeholder = 'Please select some variables',
                         onInitialize = I('function() { this.setValue(""); }')
                       )
      )
    }
  })
  outputOptions(output, "divideynum", suspendWhenHidden=FALSE)
  
  dividedata <- reactive({
    df <- filterdata8()
    validate(need(!is.null(df), "Please select a data set"))
    if(!is.null(input$divideynumin)&&length(input$divideynumin ) >=1 &&
       !is.null(input$divideydenomin)) {
      for (i in 1:length(input$divideynumin ) ) {
        varname<- input$divideynumin[i]
        dosname<- input$divideydenomin
        df[,varname]   <-  df[,varname] /as.numeric(as.character(df[,dosname]))
      }
    }
    df
  })
  
  output$divideydenom <- renderUI({
    df <- filterdata8()
    validate(need(!is.null(df), "Please select a data set"))
    if (!is.null(df)){
      MODEDF <- sapply(df, function(x) is.numeric(x) )
      NAMESTOKEEP2<- names(df)  [MODEDF]
      selectInput(  "divideydenomin", "Variable to divide by",
                    choices = NAMESTOKEEP2, multiple=FALSE)
    }
  })
  outputOptions(output, "divideydenom", suspendWhenHidden=FALSE)
  
  output$divideynum2 <- renderUI({
    df <- dividedata()
    validate(need(!is.null(df), "Please select a data set"))
    if (!is.null(df)){
      MODEDF <- sapply(df, function(x) is.numeric(x))
      NAMESTOKEEP2<- names(df)  [MODEDF]
      selectizeInput(  "divideynumin2", "Divide the Values by a constant:", choices = NAMESTOKEEP2,
                       multiple=TRUE,
                       options = list(
                         placeholder = 'Please select some variables',
                         onInitialize = I('function() { this.setValue(""); }')
                       )
      )
    }
  })
  outputOptions(output, "divideynum2", suspendWhenHidden=FALSE)
  
  dividedata2 <- reactive({
    df <- dividedata()
    validate(need(!is.null(df), "Please select a data set"))
    if(!is.null(input$divideynumin2)&&length(input$divideynumin2 ) >=1) {
      for (i in 1:length(input$divideynumin2 ) ) {
        varname<- input$divideynumin2[i]
        df[,varname]   <-  df[,varname] /input$divideyconstant
      }
    }
    df
  })
  
  output$inversenum <- renderUI({
    df <- dividedata2()
    validate(need(!is.null(df), "Please select a data set"))
    if (!is.null(df)){
      MODEDF <- sapply(df, function(x) is.numeric(x))
      NAMESTOKEEP2<- names(df)  [MODEDF]
      selectizeInput(  "inversenumin", "Inverse the Values by the specified column:",
                       choices = NAMESTOKEEP2,multiple=TRUE,
                       options = list(
                         placeholder = 'Please select some variables',
                         onInitialize = I('function() { this.setValue(""); }')
                       )
      )
    }
  })
  outputOptions(output, "inversenum", suspendWhenHidden=FALSE)

  inversedata <- reactive({
    df <- dividedata2()
    validate(need(!is.null(df), "Please select a data set"))
    if(!is.null(input$inversenumin)&&length(input$inversenumin ) >=1) {
      for (i in 1:length(input$inversenumin ) ) {
        varname<- input$inversenumin[i]
        df[,varname]   <-  1/df[,varname]
      }
    }
    df
  })
  

  
  output$roundvar <- renderUI({
    df <- inversedata()
    validate(need(!is.null(df), "Please select a data set"))
    if (!is.null(df)){
      items=names(df)
      names(items)=items
      MODEDF <- sapply(df, function(x) is.numeric(x))
      NAMESTOKEEP2<- names(df)  [MODEDF]
      selectizeInput(  "roundvarin", "Round the Values to the Specified N Digits:", choices = NAMESTOKEEP2,multiple=TRUE,
                       options = list(
                         placeholder = 'Please select some variables',
                         onInitialize = I('function() { this.setValue(""); }')
                       )
      )
    }
  }) 
  outputOptions(output, "roundvar", suspendWhenHidden=FALSE)
  
  rounddata <- reactive({
    df <- inversedata()
    validate(need(!is.null(df), "Please select a data set"))
    if(!is.null(input$roundvarin)&&length(input$roundvarin ) >=1) {
      for (i in 1:length(input$roundvarin ) ) {
        varname<- input$roundvarin[i]
        df[,varname]   <- round( df[,varname],input$rounddigits)
      }
    }
    df
  })  
  
  tabledata <- reactive({
    df <- rounddata() 
    df
  })
  
  stackdatay <- reactive({
    df <- rounddata()
    validate(need(!is.null(df), "Please select a data set"))

    if (!is.null(df)){
      validate(  need( nrow(df) > 0,
    "The dataset has to have at least one row."))
    }
    
    if (!is.null(df) && !is.null(input$x) && !is.null(input$y)){
      validate(  need(!is.element(input$x,input$y) ,
  "Please modify your x or y variable(s) so they become distinct"))
    }
    df$yvars <- "None"
    df$yvalues <- NA

      if (!is.null(df) && !is.null(input$y)){
      validate(need(all(input$y %in% names(df)), "Invalid y value(s)"))
      tidydata <- df %>%
        gather( "yvars", "yvalues", !!!input$y ,factor_key = TRUE)
      
      if (!all( sapply(df[,as.vector(input$y)], inherits, what ="POSIXct")) ) {
        if (!all( sapply(df[,as.vector(input$y)], is.numeric)) ) {
          tidydata <- tidydata %>%
            mutate(yvalues=as.factor(as.character(yvalues) ))
          ylevelsall<- vector(mode = "character", length = 0L)
          for (i in 1:length(input$y) ) {
            if( is.factor(df[,input$y[i]])) levelsvar <- levels(df[,input$y[i]])
            if(!is.factor(df[,input$y[i]])) levelsvar <- levels(as.factor(df[,input$y[i]]))
            ylevelsall<- c(ylevelsall,levelsvar)
          }
          ylevelsall <-  unique(ylevelsall, fromLast = TRUE)
          tidydata$yvalues   <- factor(tidydata$yvalues,levels=ylevelsall)
        }
      }
      tidydata <- tidydata
      }
    if (!is.null(df) && is.null(input$y)){
      tidydata <- df
    }
    tidydata    
  })
  
  stackdatax <- reactive({
    df <- stackdatay()
    validate(need(!is.null(df), "Please select a data set"))
    if (!is.null(df)){
      validate(  need( nrow(df) > 0,
                       "The dataset has to have at least one row."))
    }
    
    if (!is.null(df) && !is.null(input$x) && !is.null(input$y)){
      validate(  need(!is.element(input$x,input$y) ,
                      "Please modify your x or y variable(s) so they become distinct"))
    }
    df$xvars <- "None"
    df$xvalues <- NA
    
    if (!is.null(df) && !is.null(input$x)){
      validate(need(all(input$x %in% names(df)),
                    "Please modify your x or y variable(s) so they become distinct"))
        tidydata <- df %>%
        gather( "xvars", "xvalues", !!!input$x ,factor_key = TRUE)
        if (!all( sapply(df[,as.vector(input$x)], inherits, what ="POSIXct")) ) {
         if (!all( sapply(df[,as.vector(input$x)], is.numeric)) ) {
        tidydata <- tidydata %>%
          mutate(xvalues=as.factor(as.character(xvalues) ))
        xlevelsall<- vector(mode = "character", length = 0L)
        for (i in 1:length(input$x) ) {
          if( is.factor(df[,input$x[i]])) levelsvar <- levels(df[,input$x[i]])
          if(!is.factor(df[,input$x[i]])) levelsvar <- levels(as.factor(df[,input$x[i]]))
          xlevelsall<- c(xlevelsall,levelsvar)
        }
        xlevelsall <-  unique(xlevelsall, fromLast = TRUE)
        tidydata$xvalues   <- factor(tidydata$xvalues,levels=xlevelsall)
      }
          }
        tidydata <- tidydata
    }
    if (!is.null(df) && is.null(input$x)){
      tidydata <- df
    }
    tidydata      
  })
  
  output$reordervar <- renderUI({
    df <- stackdatax()
    validate(need(!is.null(df), "Please select a data set"))
    items=names(df)
    names(items)=items
    MODEDF <- sapply(df, function(x) is.numeric(x))
    NAMESTOKEEP2<- names(df)  [ !MODEDF ]
    selectizeInput(  "reordervarin", 'Reorder This Variable:',
                     choices =NAMESTOKEEP2 ,multiple=FALSE,
                     options = list(    placeholder = 'Please select a variable',
                                        onInitialize = I('function() { this.setValue(""); }')
                     )
    )
  })
  
  
  
  output$variabletoorderby <- renderUI({
    df <- stackdatax()
    validate(need(!is.null(df), "Please select a data set"))
    if (is.null(input$reordervarin)) return()
    if (length(input$reordervarin ) <1)  return(NULL)
    if ( input$reordervarin!=""){
      items=names(df)
      names(items)=items
      #MODEDF <- sapply(df, function(x) is.numeric(x))
      NAMESTOKEEP2<- names(df)  #[ MODEDF ]
      selectInput('varreorderin',label = 'Of this Variable: (categorical variables will be coerced to numeric)',
                  choices=NAMESTOKEEP2,multiple=FALSE,selected="yvalues")
    }
  })
  
  outputOptions(output, "reordervar", suspendWhenHidden=FALSE)
  outputOptions(output, "variabletoorderby", suspendWhenHidden=FALSE)
 
  reorderdata <- reactive({
    df <- stackdatax()
    validate(need(!is.null(df), "Please select a data set"))
    if (is.null(input$reordervarin)) {
      return(df)
    }
    if(length(input$reordervarin ) >=1 &&
       length(input$varreorderin ) >=1 && input$reordervarin!="") {
      
      variabletoorderby <- df[,input$varreorderin]
      if(!is.numeric(variabletoorderby)) variabletoorderby <- as.numeric(variabletoorderby)
      varname <- input$reordervarin[1]
      
      if(input$functionordervariable=="Median" )  {
        df[,varname]   <- reorder( df[,varname],variabletoorderby, FUN=function(x) median(x[!is.na(x)]))
      }
      if(input$functionordervariable=="Mean" )  {
        df[,varname]   <- reorder( df[,varname],variabletoorderby,  FUN=function(x) mean(x[!is.na(x)]))
      }
      if(input$functionordervariable=="Minimum" )  {
        df[,varname]   <- reorder( df[,varname],variabletoorderby,  FUN=function(x) min(x[!is.na(x)]))
      }
      if(input$functionordervariable=="Maximum" )  {
        df[,varname]   <- reorder( df[,varname],variabletoorderby,  FUN=function(x) max(x[!is.na(x)]))
      }
      if(input$functionordervariable=="N" )  {
        df[,varname]   <- reorder( df[,varname],variabletoorderby,  FUN=function(x) length(x[!is.na(x)]))
      }
      if(input$functionordervariable=="N Unique" )  {
        df[,varname]   <- reorder( df[,varname],variabletoorderby,  FUN=function(x) length(unique(x[!is.na(x)])))
      }
      if(input$functionordervariable=="SD" )  {
        df[,varname]   <- reorder( df[,varname],variabletoorderby,  FUN=function(x) sd(x[!is.na(x)]))
      }
      if(input$functionordervariable=="Sum" )  {
        df[,varname]   <- reorder( df[,varname],variabletoorderby,  FUN=function(x) sum(x[!is.na(x)]))
      }
      if(input$functionordervariable=="Min-Max Difference" )  {
        df[,varname]   <- reorder( df[,varname],variabletoorderby,  FUN=function(x) {max(x) - min(x)})
      }
      if(input$reverseorder )  {
        df[,varname] <- factor( df[,varname], levels=rev(levels( df[,varname])))
        
      }
    }
    df
  })  
  output$reordervar2 <- renderUI({
    df <- reorderdata()
    validate(need(!is.null(df), "Please select a data set"))
    MODEDF <- sapply(df, function(x) is.numeric(x))
    NAMESTOKEEP<- names(df)  [ !MODEDF ]
    if(!is.null(input$reordervarin)&&length(input$reordervarin ) >=1  ){
      NAMESTOKEEP<- NAMESTOKEEP  [ NAMESTOKEEP!=input$reordervarin ]
    }
    #NAMESTOKEEP<- NAMESTOKEEP[ NAMESTOKEEP!="yvars" ]
    selectInput("reordervar2in" , "Custom Reorder this variable:",c('None',NAMESTOKEEP ) )
  })
  
  output$reordervar2values <- renderUI({
    df <- reorderdata()
    validate(need(!is.null(df), "Please select a data set"))
    if (is.null(input$reordervar2in)) return()
    if(input$reordervar2in=="None") {
      selectInput('reordervar2valuesnull',
                  label ='No reorder variable specified', 
                  choices = list(""),multiple=TRUE, selectize=FALSE)   
    }
    if(input$reordervar2in!="None"&&!is.null(input$reordervar2in) )  {
       if(is.factor(df[,input$reordervar2in])){
        choices <- levels(df[,input$reordervar2in])
      }
      if(!is.factor(df[,input$reordervar2in])){
        choices <- levels(as.factor(as.character(df[,input$reordervar2in])))
      }
      selectizeInput('reordervar2valuesnotnull',
                     label = paste("Drag/Drop to reorder",input$reordervar2in, "values"),
                     choices = c(choices),
                     selected = choices,
                     multiple=TRUE,  options = list(
                       plugins = list('drag_drop')
                     )
      )   
    }
  })
  outputOptions(output, "reordervar2", suspendWhenHidden=FALSE)
  outputOptions(output, "reordervar2values", suspendWhenHidden=FALSE)
  
  output$reordervar3 <- renderUI({
    df <- reorderdata2()
    validate(need(!is.null(df), "Please select a data set"))
    MODEDF <- sapply(df, function(x) is.numeric(x))
    NAMESTOKEEP<- names(df)  [ !MODEDF ]
    if(!is.null(input$reordervarin)&&length(input$reordervarin ) >=1  ){
      NAMESTOKEEP<- NAMESTOKEEP  [ NAMESTOKEEP!=input$reordervarin ]
    }
    if(!is.null(input$reordervar2in)&&length(input$reordervar2in ) >=1  ){
      NAMESTOKEEP<- NAMESTOKEEP  [ NAMESTOKEEP!=input$reordervar2in ]
    }
    selectInput("reordervar3in" , "Custom Reorder this variable(2):",c('None',NAMESTOKEEP ) )
  })
  
  output$reordervar3values <- renderUI({
    df <- reorderdata2()
    validate(need(!is.null(df), "Please select a data set"))
    if (is.null(input$reordervar3in)) return()
    if(input$reordervar3in=="None") {
      selectInput('reordervar3valuesnull',
                  label ='No reorder variable specified',
                  choices = list(""),multiple=TRUE, selectize=FALSE)
    }
    if(input$reordervar3in!="None"&&!is.null(input$reordervar3in) )  {
     if(is.factor(df[,input$reordervar3in])){
       choices <- levels(df[,input$reordervar3in])
     }
      if(!is.factor(df[,input$reordervar3in])){
       choices <- levels(as.factor(as.character(df[,input$reordervar3in])))
      }
      selectizeInput('reordervar3valuesnotnull',
                     label = paste("Drag/Drop to reorder",
                                   input$reordervar3in, "values (2)"),
                     choices = c(choices),
                     selected = choices,
                     multiple=TRUE,  options = list(
                       plugins = list('drag_drop')
                     )
      )
    }
  })
   outputOptions(output, "reordervar3", suspendWhenHidden=FALSE)
   outputOptions(output, "reordervar3values", suspendWhenHidden=FALSE)
  # 
  reorderdata2 <- reactive({
    df <- reorderdata()
    validate(need(!is.null(df), "Please select a data set"))
    if (is.null(input$reordervar2in)) {
      return(df)
    }
    if(input$reordervar2in!="None"  ) {
      df [,input$reordervar2in] <- factor(df [,input$reordervar2in],
                                          levels = input$reordervar2valuesnotnull)
      
    }
    df
  })
  
  reorderdata3 <- reactive({
    df <- reorderdata2()
    validate(need(!is.null(df), "Please select a data set"))
    if (is.null(input$reordervar3in)) {
      return(df)
    }
    if(input$reordervar3in!="None"  ) {
      df [,input$reordervar3in] <- factor(df [,input$reordervar3in],
                                          levels = input$reordervar3valuesnotnull)
      
    }
    df
  })
  
  
  # Populate the "Change levels of this variable:" list
  observeEvent(stackdatax(), {
    df <- stackdatax()
    items <- names(df)
    names(items) <- items
    MODEDF <- sapply(df, function(x) is.numeric(x))
    NAMESTOKEEP2 <- names(df)[!MODEDF]
    updateSelectizeInput(session, "change_labels_stat_var", selected = "",
                         choices = NAMESTOKEEP2)
    updateSelectizeInput(session, "change_labels_stat_var_2", selected = "",
                         choices = NAMESTOKEEP2)
  })
  
  output$change_labels_stat_old <- renderText({
    df <- reorderdata3()
    req(df, input$change_labels_stat_var != "")
    paste(levels(as.factor(df[, input$change_labels_stat_var])), collapse = " ")
  })   
  output$change_labels_stat_old_2 <- renderText({
    df <- reorderdata3()
    req(df, input$change_labels_stat_var_2 != "")
    paste(levels(as.factor(df[, input$change_labels_stat_var_2])), collapse = " ")
  })  
  # Show the input of the labels the user wants to change for a stat variable
  observe({
    df <- reorderdata3()
    if (is.null(df) || is.null(input$change_labels_stat_var) || length(input$change_labels_stat_var) < 1 || input$change_labels_stat_var == "") {
      return()
    }
    nlevels <- length( unique( levels(as.factor( df[,input$change_labels_stat_var] ))))
    levelsvalues <- levels(as.factor( df[,input$change_labels_stat_var] ))
    label <- paste(input$change_labels_stat_var, "requires", nlevels, "new labels, type in a comma separated list below")
    value <- paste(as.character(levelsvalues), collapse=", ", sep="")
    updateTextInput(session, "change_labels_stat_levels", label = label, value = value)
  })
  
  observe({
    df <- reorderdata3()
    if (is.null(df) || is.null(input$change_labels_stat_var_2) || length(input$change_labels_stat_var_2) < 1 || input$change_labels_stat_var_2 == "") {
      return()
    }
    nlevels2 <- length( unique( levels(as.factor( df[,input$change_labels_stat_var_2] ))))
    levelsvalues2 <- levels(as.factor( df[,input$change_labels_stat_var_2] ))
    label2 <- paste(input$change_labels_stat_var, "requires", nlevels2, "new labels, type in a comma separated list below")
    value2 <- paste(as.character(levelsvalues2), collapse=", ", sep="")
    updateTextInput(session, "change_labels_stat_levels_2", label = label2, value = value2)
  })

  recodedata5  <- reactive({
    df <- reorderdata3()
    validate(need(!is.null(df), "Please select a data set"))
    if (is.null(input$change_labels_stat_var)) {
      return(df)
    }
    if(input$change_labels_stat_var!="" && input$change_labels_stat_levels != "") {
      varname <- input$change_labels_stat_var
      xlabels <- input$change_labels_stat_levels 
      xlabels <- gsub("\\\\n", "\\\n", xlabels)
      df[,varname] <- as.factor(df[,varname])
      levels(df[,varname])  <-  unlist (strsplit(xlabels, ",") )
    }
    df
  })
  
  recodedata6  <- reactive({
    df <- recodedata5()
    validate(need(!is.null(df), "Please select a data set"))
    if (is.null(input$change_labels_stat_var_2)) {
      return(df)
    }
    if(input$change_labels_stat_var_2!="" && input$change_labels_stat_levels_2 != "") {
      varname <- input$change_labels_stat_var_2
      xlabels <- input$change_labels_stat_levels_2
      xlabels <- gsub("\\\\n", "\\\n", xlabels)
      df[,varname] <- as.factor(df[,varname])
      levels(df[,varname])  <-  unlist (strsplit(xlabels, ",") )
    }
    df
  })
  
  # --- Merge factor levels feature ---
  
  
  # Variables to help with maintaining the dynamic number of "merge levels of
  # a factor" boxes
  factor_merge_vals <- reactiveValues(
    num_current = 0,  # How many boxes are there currently
    num_total = 0  # Max # of boxes at the same time, to prevent memory leaks
  )
  
  # Add UI and corresponding outputs+observers for a "merge factor levels"
  # section
  add_factor_merge_box <- function() {
    factor_merge_vals$num_current <- factor_merge_vals$num_current + 1
    
    df <- recodedata3()
    factors <- df %>%
      sapply(is.factor) %>%
      which() %>%
      names()
    
    insertUI(
      selector = "#factor_merge_placeholder", where = "beforeEnd",
      immediate = TRUE,
      div(
        class = "factor_merge_box",
        selectizeInput(
          paste0("factor_merge_select_", factor_merge_vals$num_current),
          sprintf("Factor to merge (%s):", factor_merge_vals$num_current),
          choices = c("", factors),
          selected = ""
        ),
        div(
          class = "blind-dropdown",
          shinyjs::hidden(
            checkboxGroupInput(
              inputId = paste0("factor_merge_levels_", factor_merge_vals$num_current),
              label = "Levels to merge",
              choices = c()
            )
          )
        )
      )
    )
    
    # if we already had this many sections before, no need to wire up any
    # new observers
    if (factor_merge_vals$num_current <= factor_merge_vals$num_total) {
      return()
    }
    
    num1 <- factor_merge_vals$num_current
    factor_merge_vals$num_total <- num1
    
    # when the user selects a factor to merge
    observeEvent(input[[paste0("factor_merge_select_", num1)]], {
      selected_var <- input[[paste0("factor_merge_select_", num1)]]
      
      if (selected_var == "") {
        shinyjs::hide(paste0("factor_merge_levels_", num1))
        return()
      }
      shinyjs::show(paste0("factor_merge_levels_", num1))
      
      df <- factor_merge_data()
      levelsvalues <- levels(df[[selected_var]])
      
      updateCheckboxGroupInput(
        session, paste0("factor_merge_levels_", num1),
        choices = levelsvalues,
        selected = c()
      )
    })
  }
  
  remove_last_factor_merge_box <- function() {
    updateSelectInput(session, paste0("factor_merge_select_", factor_merge_vals$num_current), selected = "")
    selector <- paste0("#factor_merge_placeholder .factor_merge_box:nth-child(", factor_merge_vals$num_current, ")")
    removeUI(selector, multiple = FALSE, immediate = TRUE)
    factor_merge_vals$num_current <- factor_merge_vals$num_current - 1
    shinyjs::enable("factor_merge_add")
  }
  
  # Decide if to enable/disable the remove variable labels button
  observeEvent(factor_merge_vals$num_current, {
    shinyjs::toggleState("factor_merge_remove", condition = factor_merge_vals$num_current > 0)
  })
  
  # when recodedata3 changes, reset the merge levels UI
  observeEvent(recodedata3(), {
    shinyjs::show("factor_merge_section")
    
    factor_merge_vals$num_current <- 0
    
    removeUI(selector = ".factor_merge_box",
             multiple = TRUE, immediate = TRUE)
    
    add_factor_merge_box()
  })
  
  # add another "merge factor levels" box
  observeEvent(input$factor_merge_add, {
    shinyjs::disable(paste0("factor_merge_select_", factor_merge_vals$num_current))
    shinyjs::disable(paste0("factor_merge_levels_", factor_merge_vals$num_current))
    add_factor_merge_box()
  })
  # remove the last "merge factor levels" box
  observeEvent(input$factor_merge_remove, {
    remove_last_factor_merge_box()
  })
  
  # The final dataframe that transforms the data from te previous step into data
  # after the mergings are processed
  factor_merge_data_raw <- reactive({
    df <-  recodedata3()
    if (is.null(df)) return()
    
    for (i in seq_len(factor_merge_vals$num_current)) {
      # no valid factor is selected
      variable_name <- input[[paste0("factor_merge_select_", i)]]
      if (is.null(variable_name) || variable_name == "") next
      
      # the checkboxes (levels) of a factor don't match the factor
      old_levels <- levels(df[[variable_name]])
      levels_to_merge <- input[[paste0("factor_merge_levels_", i)]]
      if (is.null(levels_to_merge) || !all(levels_to_merge %in% old_levels)) next
      
      new_level <- paste0(levels_to_merge, collapse = "/")
      new_levels <- c(
        levels(df[[variable_name]])[!levels(df[[variable_name]]) %in% levels_to_merge],
        new_level
      )
      df[[variable_name]] <-
        df[[variable_name]] %>%
        as.character() %>%
        {.[. %in% levels_to_merge] = new_level; .} %>%
        factor(levels = new_levels)
    }
    df
  })
  # so that plot doesn't update too rapidly and the user has time to select multiple labels
  factor_merge_data <- factor_merge_data_raw %>% debounce(400)
  
  # --- End: Merge Factor Levels feature
  
  finalplotdata <- reactive({
    df <- recodedata6()
    as.data.frame(df)
  })
  
  output$xaxiszoomslider <- renderUI({
    df <- finalplotdata()
    validate(need(!is.null(df), "Please select a data set"))
    if ( is.null(df) || is.null(input$x)  ) return(NULL)
    if (all(is.factor(df[,"xvalues"] ) | is.character(df[,"xvalues"] )) ||
        (length(df[,"xvalues"][!is.na( df[,"xvalues"])] ) <= 0)
    ) return(NULL)
      xvalues <- df[,"xvalues"][!is.na( df[,"xvalues"])]
        xmin <- min(xvalues)
        if(input$xaxisscale=="logx" && xmin <=0 ) xmin <- 0.01
        xmax <- max(xvalues)
        if(input$xaxisscale=="logx" && xmax <=0 ) xmax <- 0.1
        xstep <- (xmax -xmin)/100
        sliderInput('xaxiszoomin',label = 'Zoom to X variable range:',
                    min=xmin, max=xmax, value=c(xmin,xmax),step=xstep)
  })
  outputOptions(output, "xaxiszoomslider", suspendWhenHidden=FALSE)
  
  output$lowerx <- renderUI({
    df <-finalplotdata()
    validate(need(!is.null(df), "Please select a data set"))
    if (is.null(df)  ||  is.null(input$x) || is.null(df[,"xvalues"]) ) return(NULL)
    if (all(is.factor(df[,"xvalues"] ) | is.character(df[,"xvalues"] )) || 
        (length(df[,"xvalues"][!is.na( df[,"xvalues"])] ) <= 0)
        ) return(NULL)
      xvalues <- df[,"xvalues"][!is.na( df[,"xvalues"])]
      xmin <- min(xvalues)
      if(input$xaxisscale=="logx" && xmin<=0) xmin <- 0.01
      numericInput("lowerxin",label = "Lower X Limit", 
                   value = xmin, min=NA, max=NA, width='100%') 

  })
  output$upperx <- renderUI({
    df <-finalplotdata()
    validate(need(!is.null(df), "Please select a data set"))
    if (is.null(df)  ||  is.null(input$x) || is.null(df[,"xvalues"]) ) return(NULL)
    if (all(is.factor(df[,"xvalues"] ) | is.character(df[,"xvalues"] )) || 
        (length(df[,"xvalues"][!is.na( df[,"xvalues"])] ) <= 0)
    ) return(NULL)
    xvalues <- df[,"xvalues"][!is.na( df[,"xvalues"])]
    xmax <- max(xvalues)
    if(input$xaxisscale=="logx"&& xmax<=0) xmax <- 0.1
    numericInput("upperxin",label = "Upper X Limit",value = xmax,min=NA,max=NA,width='100%')
  })
  outputOptions(output, "lowerx", suspendWhenHidden=FALSE)
  outputOptions(output, "upperx", suspendWhenHidden=FALSE)
  
  output$yaxiszoomslider <- renderUI({
    df <- finalplotdata()
    validate(need(!is.null(df), "Please select a data set"))
    if ( is.null(df) || is.null(input$y)  ) return(NULL)
    if (all(is.factor(df[,"yvalues"] ) | is.character(df[,"yvalues"] )) ||
        (length(df[,"yvalues"][!is.na( df[,"yvalues"])] ) <= 0)
    ) return(NULL)
    yvalues <- df[,"yvalues"][!is.na( df[,"yvalues"])]
    ymin <- min(yvalues)
    if(input$yaxisscale=="logy" && ymin <=0 ) ymin <- 0.01
    ymax <- max(yvalues)
    if(input$yaxisscale=="logy" && ymax <=0 ) ymax <- 0.1
    ystep <- (ymax -ymin)/100
    sliderInput('yaxiszoomin',label = 'Zoom to Y variable range:',
                min=ymin, max=ymax, value=c(ymin,ymax),step=ystep)
    
  })
  outputOptions(output, "yaxiszoomslider", suspendWhenHidden=FALSE)  
  
  output$lowery <- renderUI({
    df <-finalplotdata()
    validate(need(!is.null(df), "Please select a data set"))
    if ( is.null(df) || is.null(input$y) || is.null(df[,"yvalues"]) ) return(NULL)
    if (all(is.factor(df[,"yvalues"] ) | is.character(df[,"yvalues"] )) || 
        (length(df[,"yvalues"][!is.na( df[,"yvalues"])] ) <= 0)
    ) return(NULL)
    yvalues <- df[,"yvalues"][!is.na( df[,"yvalues"])]
    ymin <- min(yvalues)
    if(input$yaxisscale=="logy" && ymin<=0) ymin <- 0.01
    numericInput("loweryin",label = "Lower Y Limit",
                 value = ymin,min=NA,max=NA,width='50%')
  })
  
  output$uppery <-  renderUI({
    df <-finalplotdata()
    validate(need(!is.null(df), "Please select a data set"))
    if ( is.null(df) || is.null(input$y) || is.null(df[,"yvalues"]) ) return(NULL)
    if (all(is.factor(df[,"yvalues"] ) | is.character(df[,"yvalues"] )) || 
        (length(df[,"yvalues"][!is.na( df[,"yvalues"])] ) <= 0)
    ) return(NULL)
    yvalues <- df[,"yvalues"][!is.na( df[,"yvalues"])]
    ymax <- max(yvalues)
    if(input$yaxisscale=="logy" && ymax<=0) ymax <- 0.1
    numericInput("upperyin",label = "Upper Y Limit",
                 value = ymax,min=NA,max=NA,width='50%')
  })
  
  outputOptions(output, "lowery", suspendWhenHidden=FALSE)
  outputOptions(output, "uppery", suspendWhenHidden=FALSE)

  output$colour <- renderUI({
    df <-values$maindata
    validate(need(!is.null(df), "Please select a data set"))
    items=names(df)
    names(items)=items
    items= c("None",items)
    if ( !is.null(input$y) ){
      items = c(items, "yvars","yvalues") 
    }
    if ( !is.null(input$x) ){
      items = c(items, "xvars","xvalues") 
    }
    if (!is.null(input$pastevarin) && length(input$pastevarin) >1 ){
      nameofcombinedvariables<- paste(as.character(input$pastevarin),collapse="_",sep="") 
      items= c(items,nameofcombinedvariables)
    }
    selectInput("colorin", "Colour By:",items) 
  })
  observe({
    df <-values$maindata
    validate(need(!is.null(df), "Please select a data set"))
    items=names(df)
    names(items)=items
    items= c("None",items)
    if ( !is.null(input$y) ){
      items = c(items, "yvars","yvalues") 
    }
    if ( !is.null(input$x) ){
      items = c(items, "xvars","xvalues") 
    }
    if (!is.null(input$pastevarin) && length(input$pastevarin) >1 ){
      nameofcombinedvariables<- paste(as.character(input$pastevarin),collapse="_",sep="") 
      items= c(items,nameofcombinedvariables)
    }
    current_color_value <- input$colorin
    if (!is.null(current_color_value) && current_color_value %in% items) {
      new_value <- current_color_value
    } else {
      new_value <- items[1]
    }
    updateSelectInput(session, "colorin",
                      choices = items, selected = new_value)
  })
  
  output$colourpairs <- renderUI({
    df <- rounddata()
    validate(need(!is.null(df), "Please select a data set"))
    MODEDF <- sapply(df, function(x) is.numeric(x))
    NAMESTOKEEP2<- names(df)  [ !MODEDF ]
    items=NAMESTOKEEP2
    names(items)=items
    items= c("None",items)
    if (!is.null(input$pastevarin) && length(input$pastevarin) >1 ){
      nameofcombinedvariables<- paste(as.character(input$pastevarin),collapse="_",sep="") 
      items= c(items,nameofcombinedvariables)
    }
    selectInput("colorpairsin", "Colour/Fill By:",items) 
  })
  observe({
    df <- rounddata()
    validate(need(!is.null(df), "Please select a data set"))
    MODEDF <- sapply(df, function(x) is.numeric(x))
    NAMESTOKEEP2<- names(df)  [ !MODEDF ]
    items=NAMESTOKEEP2
    names(items)=items
    items= c("None",items)
    if (!is.null(input$pastevarin) && length(input$pastevarin) >1 ){
      nameofcombinedvariables<- paste(as.character(input$pastevarin),collapse="_",sep="") 
      items= c(items,nameofcombinedvariables)
    }
    current_color_value <- input$colorpairsin
    if (!is.null(current_color_value) && current_color_value %in% items) {
      new_value <- current_color_value
    } else {
      new_value <- items[1]
    }
    updateSelectInput(session, "colorpairsin",
                      choices = items, selected = new_value)
  })
  
  output$group <- renderUI({
    df <-values$maindata
    validate(need(!is.null(df), "Please select a data set"))
    items=names(df)
    names(items)=items
    items= c("None",items)
    if ( !is.null(input$y) ){
      items = c(items, "yvars","yvalues") 
    }
    if ( !is.null(input$x) ){
      items = c(items, "xvars","xvalues") 
    }
    if (!is.null(input$pastevarin) && length(input$pastevarin) >1 ){
      nameofcombinedvariables<- paste(as.character(input$pastevarin),collapse="_",sep="") 
      items= c(items,nameofcombinedvariables)
    }
    selectInput("groupin", "Group By:",items)
  })
  outputOptions(output, "colour", suspendWhenHidden=FALSE)
  outputOptions(output, "colourpairs", suspendWhenHidden=FALSE)
  outputOptions(output, "group", suspendWhenHidden=FALSE)

  output$facet_col <- renderUI({
    df <-values$maindata
    validate(need(!is.null(df), "Please select a data set"))
    items=names(df)
    names(items)=items
    items= c(None='.',items)
    if ( !is.null(input$y) ){
      items = c(items, "yvars","yvalues") 
    }
    if ( !is.null(input$x) ){
      items = c(items, "xvars","xvalues") 
    }
    if (!is.null(input$pastevarin) && length(input$pastevarin) >1 ){
      nameofcombinedvariables<- paste(as.character(input$pastevarin),collapse="_",sep="") 
      items= c(items,nameofcombinedvariables)
    }
    selectInput("facetcolin", "Column Split:",items)
  })
  
  output$facet_row <- renderUI({
    df <-values$maindata
    validate(need(!is.null(df), "Please select a data set"))
    items=names(df)
    names(items)=items
    items= c(None='.',items)
    if ( !is.null(input$y) ){
      items = c(items, "yvars","yvalues") 
    }
    if ( !is.null(input$x) ){
      items = c(items, "xvars","xvalues") 
    }
    if (!is.null(input$pastevarin) && length(input$pastevarin) >1 ){
      nameofcombinedvariables<- paste(as.character(input$pastevarin),collapse="_",sep="") 
      items= c(items,nameofcombinedvariables)
    }
    selectInput("facetrowin", "Row Split:", items)
  })
  
  output$facet_col_extra <- renderUI({
    df <-values$maindata
    validate(need(!is.null(df), "Please select a data set"))
    items=names(df)
    names(items)=items
    if ( !is.null(input$y) ){
      items = c(items, "yvars","yvalues") 
    }
    if ( !is.null(input$x) ){
      items = c(items, "xvars","xvalues") 
    }
    if (!is.null(input$pastevarin) && length(input$pastevarin) >1 ){
      nameofcombinedvariables<- paste(as.character(input$pastevarin),collapse="_",sep="") 
      items= c(items,nameofcombinedvariables)
    }
    
    if (length(input$x) < 2 ){
      items= c(None=".",items)    
      }
    if (length(input$x) > 1  ){
      items= c("xvars",None=".",items[items!="xvars"])    
    }
    selectInput("facetcolextrain", "Extra Column Split:",items)
  })
  
  output$facet_row_extra <- renderUI({
    df <-values$maindata
    validate(need(!is.null(df), "Please select a data set"))
    items=names(df)
    names(items)=items
    if ( !is.null(input$y) ){
      items = c(items, "yvars","yvalues") 
    }
    if ( !is.null(input$x) ){
      items = c(items, "xvars","xvalues") 
    }
    if (!is.null(input$pastevarin) && length(input$pastevarin) >1 ){
      nameofcombinedvariables<- paste(as.character(input$pastevarin),collapse="_",sep="") 
      items= c(items,nameofcombinedvariables)
    }
    if (length(input$y) < 2 ){
      items= c(None=".",items)    
    }
    if (length(input$y) > 1  ){
      items= c("yvars",None=".",items[items!="yvars"])    
    }
    selectInput("facetrowextrain", "Extra Row Split:",items)
  })

  output$facetscales <- renderUI({
    items= c("fixed","free_x","free_y","free")   
    if (is.null(input$x) && !is.null(input$y) && length(input$y) > 1 ){
      items= c("free_y","fixed","free_x","free")    
    }
    if (is.null(input$y) && !is.null(input$x) && length(input$x) > 1 ){
      items= c("free_x","fixed","free_y","free")    
    }
    if (!is.null(input$x) && !is.null(input$y) && (length(input$y) > 1  || 
                                                   length(input$x) > 1)  ){
      items= c("free","fixed","free_x","free_y")    
    }
    selectInput('facetscalesin','Facet Scales:',items)
  })
  
  outputOptions(output, "facet_row_extra", suspendWhenHidden=FALSE)
  outputOptions(output, "facet_col_extra", suspendWhenHidden=FALSE)
  outputOptions(output, "facet_row", suspendWhenHidden=FALSE)
  outputOptions(output, "facet_col", suspendWhenHidden=FALSE)
  outputOptions(output, "facetscales", suspendWhenHidden=FALSE)
  
  output$pointsize <- renderUI({
    df <-values$maindata
    validate(need(!is.null(df), "Please select a data set"))
    items=names(df)
    names(items)=items
    items= c("None",items)
    if ( !is.null(input$y) ){
      items = c(items, "yvars","yvalues") 
    }
    if ( !is.null(input$x) ){
      items = c(items, "xvars","xvalues") 
    }
    if (!is.null(input$pastevarin)&length(input$pastevarin) >1 ){
      nameofcombinedvariables<- paste(as.character(input$pastevarin),collapse="_",sep="") 
      items= c(items,nameofcombinedvariables)
    }
    selectInput("pointsizein", "Size By:",items )
  })

  output$labeltext <- renderUI({
    df <-values$maindata
    validate(need(!is.null(df), "Please select a data set"))
    items=names(df)
    names(items)=items
    items= c("None",items)
    if ( !is.null(input$y) ){
      items = c(items, "yvars","yvalues") 
    }
    if ( !is.null(input$x) ){
      items = c(items, "xvars","xvalues") 
    }
    if (!is.null(input$pastevarin)&length(input$pastevarin) >1 ){
      nameofcombinedvariables<- paste(as.character(input$pastevarin),collapse="_",sep="") 
      items= c(items,nameofcombinedvariables)
    }
    selectInput("labeltextin", "Label By:",items )
  })

  output$pointshape <- renderUI({
    df <-values$maindata
    validate(need(!is.null(df), "Please select a data set"))
    items=names(df)
    names(items)=items
    items= c("None",items)
    if ( !is.null(input$y) ){
      items = c(items, "yvars","yvalues") 
    }
    if ( !is.null(input$x) ){
      items = c(items, "xvars","xvalues") 
    } 
    if (!is.null(input$pastevarin)&length(input$pastevarin) >1 ){
      nameofcombinedvariables<- paste(as.character(input$pastevarin),collapse="_",sep="") 
      items= c(items,nameofcombinedvariables)
    }
    selectInput("pointshapein", "Shape By:",items )
  })
  
  output$linetype <- renderUI({
    df <-values$maindata
    validate(need(!is.null(df), "Please select a data set"))
    items=names(df)
    names(items)=items
    items= c("None",items)
    if ( !is.null(input$y) ){
      items = c(items, "yvars","yvalues") 
    }
    if ( !is.null(input$x) ){
      items = c(items, "xvars","xvalues") 
    } 
    if (!is.null(input$pastevarin)&length(input$pastevarin) >1 ){
      nameofcombinedvariables<- paste(as.character(input$pastevarin),collapse="_",sep="") 
      items= c(items,nameofcombinedvariables)
    }
    selectInput("linetypein", "Linetype By:",items )
  })
  
  output$fill <- renderUI({
    df <-values$maindata
    validate(need(!is.null(df), "Please select a data set"))
    items=names(df)
    names(items)=items
    items= c("None",items)
    if ( !is.null(input$y) ){
      items = c(items, "yvars","yvalues") 
    }
    if ( !is.null(input$x) ){
      items = c(items, "xvars","xvalues") 
    } 
    if (!is.null(input$pastevarin) && length(input$pastevarin) >1 ){
      nameofcombinedvariables<- paste(as.character(input$pastevarin),collapse="_",sep="") 
      items= c(items,nameofcombinedvariables)
    }
    selectInput("fillin", "Fill By:"    ,items )
  })

  observe({
    df <-values$maindata
    validate(need(!is.null(df), "Please select a data set"))
    items=names(df)
    names(items)=items
    items= c("None",items)
    if ( !is.null(input$y) ){
      items = c(items, "yvars","yvalues") 
    }
    if ( !is.null(input$x) ){
      items = c(items, "xvars","xvalues") 
    }
    if (!is.null(input$pastevarin) && length(input$pastevarin) >1 ){
      nameofcombinedvariables<- paste(as.character(input$pastevarin),collapse="_",sep="") 
      items= c(items,nameofcombinedvariables)
    }
    current_fill_value <- input$fillin
    if (!is.null(current_fill_value) && current_fill_value %in% items) {
      new_value <- current_fill_value
    } else {
      new_value <- items[1]
    }
    updateSelectInput(session, "fillin",
                      choices = items, selected = new_value)
  })
  
  output$weight <- renderUI({
    df <- finalplotdata()
    validate(need(!is.null(df), "Please select a data set"))
    MODEDF <- sapply(df, function(x) is.numeric(x))
    NAMESTOKEEP2<- names(df)  [ MODEDF ]
    items= c("None",NAMESTOKEEP2, "yvalues") 
    selectInput("weightin", "Weight By:",items )
  })
  outputOptions(output, "pointsize", suspendWhenHidden=FALSE)
  outputOptions(output, "fill", suspendWhenHidden=FALSE)
  outputOptions(output, "weight", suspendWhenHidden=FALSE)
  outputOptions(output, "linetype", suspendWhenHidden=FALSE)
  outputOptions(output, "labeltext", suspendWhenHidden=FALSE)
  outputOptions(output, "pointshape", suspendWhenHidden=FALSE)

  output$mytablex = renderDataTable({
    if(!input$show_pairs){
      df <- finalplotdata() 
    }
    if(input$show_pairs){
      df <- rounddata()
    }
    validate(need(!is.null(df), "Please select a data set"))
    datatable(df ,
              extensions = c('ColReorder','Buttons','FixedColumns'),
              options = list(dom = 'Bfrtip',
                             searchHighlight = TRUE,
                             pageLength=5 ,
                             lengthMenu = list(c(5, 10, 15, -1), c('5','10', '15', 'All')),
                             colReorder = list(realtime = TRUE),
                             buttons = 
                               list('colvis', 'pageLength','print','copy', list(
                                 extend = 'collection',
                                 buttons = list(
                                   list(extend='csv'  ,filename = 'plotdata'),
                                   list(extend='excel',filename = 'plotdata'),
                                   list(extend='pdf'  ,filename = 'plotdata')),
                                 text = 'Download'
                               )),
                             scrollX = TRUE,scrollY = 400,
                             fixedColumns = TRUE
              ), 
              filter = 'bottom',
              style = "bootstrap")
  })
  
  output$userdefinedcolor <- renderUI({ 
    req(input$nusercol)
    lev <- 1:input$nusercol
    if( length(lev) > 10 ){
      cols <- c(tableau20)
    }
    if( length(lev) <= 10 ){
      cols <- c(tableau10)
    }
    if(input$themecolorswitcher=="themeuser"){
      lapply(seq_along(lev), function(i) {
        div(
        colourpicker::colourInput(inputId = paste0("col", lev[i]),
                                  label = paste0("Choose color", lev[i]),
                                  value = cols[i]
        ), style = "display: inline-block;")        
      })
    }
  })
  
  output$userdefinedshape <- renderUI({ 
    req(input$nusershape)
    lev <- 1:input$nusershape
      shapes <- c("circle open",
                  "triangle open",
                  "square open",
                  "plus",
                  "square cross",
                  "asterisk",
                  "circle small" ,"triangle" ,"square")
    shapes <- rep_len(shapes, input$nusershape)

    if(input$scaleshapeswitcher=="themeuser"){
      lapply(seq_along(lev), function(i) {
        div(
          selectInput(inputId = paste0("shape", lev[i]),label = paste0('Choose shape:', lev[i]),
                    c(
                      "square open"           ,
                      "circle open"           ,
                      "triangle open"         ,
                      "plus"                  ,
                      "cross"                 ,
                      "asterisk"              ,
                      "diamond open"          ,
                      "triangle down open"    ,
                      "square cross"          ,
                      "diamond plus"          ,
                      "circle plus"           ,
                      "star"                  ,
                      "square plus"           ,
                      "circle cross"          ,
                      "square triangle"       ,
                      "square"                ,
                      "circle small"          ,
                      "triangle"              ,
                      "diamond"               ,
                      "circle"                ,
                      "bullet"                ,
                      "circle filled"         ,
                      "square filled"         ,
                      "diamond filled"        ,
                      "triangle filled"       ,
                      "triangle down filled"  ,
                      "blank"
                    ), selected = shapes[i]
        ), style = "display: inline-block;")  
        
      })
    }
    
  })
  
  output$userdefinedlinetype <- renderUI({ 
    req(input$nuserlinetype)
    lev <- 1:input$nuserlinetype
    linetypes <- c("solid","dashed", "dotted", "dotdash", "longdash", "twodash","blank")
    linetypes <- rep_len(linetypes, input$nuserlinetype)
    
    if(input$scalelinetypeswitcher=="themeuser"){
      lapply(seq_along(lev), function(i) {
        div(selectInput(inputId = paste0("linetype", lev[i]),label = paste0('Choose linetype:', lev[i]),
                    c("solid","dashed", "dotted", "dotdash", "longdash", "twodash","blank"), selected = linetypes[i]
        ), style = "display: inline-block;")  
        
      })
    }
    
  })
  
  
  # output$userdefinedcontcolor <- renderUI({ 
  #     if(input$themecontcolorswitcher=="themeuser"){
  #     list(
  #       colourpicker::colourInput(
  #         "colcont1",
  #         "Starting Color",
  #         value = scales::muted("red"),
  #         showColour = "both",
  #         allowTransparent = FALSE,returnName = TRUE),
  #       
  #       colourpicker::colourInput(
  #         "colcont2",
  #         "Midpoint Color",
  #         value ="white",
  #         showColour = "both",
  #         allowTransparent = FALSE,returnName = TRUE),
  #       
  #       colourpicker::colourInput(
  #         "colcont3",
  #         "Ending Color",
  #         value =scales::muted("blue"),
  #         showColour = "both",
  #         allowTransparent = FALSE,returnName = TRUE)
  # )
  #     }
  #   })
  
  
  observeEvent(input$userdefinedcolorreset, {
    req(input$nusercol)
    lev <- 1:input$nusercol
    if( length(lev) > 10 ){
      cols <- c(tableau20)
    }
    if( length(lev) <= 10 ){
      cols <- c(tableau10)
    }
    mycolorupdatedfun <- get("updateColourInput", asNamespace("colourpicker"))
    lapply(seq_along(lev), function(i) {
      do.call(what = "mycolorupdatedfun",
              args = list(
                session = session,
                inputId = paste0("col", lev[i]),
                value = cols[i]
              )
      )
    })
  })
  
  observeEvent(input$userdefinedcolorhighlight, {
    req(input$nusercol)
    lev <- 1:input$nusercol
    cols <- c("#D62728",rep("lightgray",input$nusercol-1))
    mycolorupdatedfun <- get("updateColourInput", asNamespace("colourpicker"))
    lapply(seq_along(lev), function(i) {
      do.call(what = "mycolorupdatedfun",
              args = list(
                session = session,
                inputId = paste0("col", lev[i]),
                value = cols[i]
              )
      )
    })
  })
  observeEvent(input$userdefinedcolorblues, {
    req(input$nusercol)
    lev <- 1:input$nusercol
    cols <- colorRampPalette(RColorBrewer::brewer.pal(9,"Blues"))(length(lev))
    mycolorupdatedfun <- get("updateColourInput", asNamespace("colourpicker"))
    lapply(seq_along(lev), function(i) {
      do.call(what = "mycolorupdatedfun",
              args = list(
                session = session,
                inputId = paste0("col", lev[i]),
                value = cols[i]
              )
      )
    })
  })

  observe({
    facet_choices <- unique(c(
      input$facetcolextrain,
      input$facetcolin,
      input$facetrowin,
      input$facetrowextrain
    ))
    facet_choices <- setdiff(facet_choices, ".")
    updateSelectInput(session, "facetmargin_vars", choices = facet_choices)
  })
  
  facetmargins <- reactive(
    if (input$facetmargin == "none") {
      return(FALSE)
    } else if (input$facetmargin == "all") {
      return(TRUE)
    } else if (input$facetmargin == "some") {
      return(input$facetmargin_vars)
    } else {
      stop("Invalid facetmargin input")
    }
  )
  
  plotObject <- reactive({
    # Don't generate a new plot if the user wants to refresh manually
    if (!input$auto_update_plot) {
      if (values$updatePlot == TRUE) {
        values$updatePlot <- FALSE
      } else {
        return(values$prevPlot)
      }
    }
    
    # Retrieve the correct dataset
    if (input$show_pairs) {
      validate(need(!is.null(input$y), "Please select at least one Y variable"))
      plotdata <- rounddata()
    } else {
      validate(  need(! (is.null(input$x) && is.null(input$y)),
                      "Please select at least one x or at least one y."))
      plotdata <- finalplotdata() 
    }
    validate(need(!is.null(plotdata), "Please select a data set") )
    
    # Fix the colour palettes
    #continuous
    if (input$themecontcolorswitcher=="themeggplot"){
      scale_colour_continuous<- function(...) 
        scale_colour_gradient(...,guide = "colourbar")
      
      scale_fill_continuous<- function(...) 
        scale_fill_gradient(...,guide = "colourbar")
    }
    
    if (input$themecontcolorswitcher=="RedWhiteBlue"){
      
      scale_colour_continuous<- function(...) 
        scale_colour_gradient2(..., 
                               low = scales::muted("red"), 
                               mid = input$midcolor,
                               high = scales::muted("blue"),
                               midpoint = input$colormidpoint, space = "Lab",
                               na.value = "grey50", guide = "colourbar")
      
      scale_fill_continuous<- function(...) 
        scale_fill_gradient2(...,
                             low = scales::muted("red"),
                             mid = input$midcolor,
                               high = scales::muted("blue"),
                             midpoint = input$colormidpoint, space = "Lab",
                               na.value = "grey50", guide = "colourbar")
    }
    if (input$themecontcolorswitcher=="RedWhiteGreen"){
      
      scale_colour_continuous <- function(...) 
        scale_colour_gradient2(..., low = scales::muted("red"),
                               mid = input$midcolor,
                               high = scales::muted("darkgreen"),
                               midpoint = input$colormidpoint, space = "Lab",
                               na.value = "grey50", guide = "colourbar")
      
      scale_fill_continuous <- function(...) 
        scale_fill_gradient2(...,
                             low = scales::muted("red"),
                             mid = input$midcolor,
                            high = scales::muted("darkgreen"),
                            midpoint = input$colormidpoint, space = "Lab",
                             na.value = "grey50", guide = "colourbar")
      
    }
    if (input$themecontcolorswitcher=="themedistiller"){
      
      scale_colour_continuous <- function(...) 
        scale_colour_distiller(..., palette = input$themedistillerpalettes,
                               direction = ifelse(input$distillerdirection,-1,1) ,
                               space = "Lab",
                               na.value = "grey50",
                               guide = "colourbar")
      
      scale_fill_continuous <- function(...) 
        scale_fill_distiller(...,palette = input$themedistillerpalettes,
                             direction = ifelse(input$distillerdirection,-1,1) ,
                             space = "Lab",
                             na.value = "grey50",
                             guide = "colourbar")
      
    }
    if (input$themecontcolorswitcher=="themeuser"){
      scale_colour_continuous <- function(...) 
        scale_colour_gradient2(...,
                               low = gradientTableData()[1,1],#input$colcont1,
                               mid = gradientTableData()[2,1],#input$colcont2,
                               high =gradientTableData()[3,1],#input$colcont3,
                               midpoint = input$colormidpoint, space = "Lab",
                               na.value = "grey50", guide = "colourbar")
      
      scale_fill_continuous <- function(...) 
        scale_fill_gradient2(...,
                             low = gradientTableData()[1,1],#input$colcont1,
                             mid = gradientTableData()[2,1],#input$colcont2,
                             high =gradientTableData()[3,1],#input$colcont3,
                             midpoint = input$colormidpoint, space = "Lab",
                             na.value = "grey50", guide = "colourbar")
      
    }
    
    #discrete
    if (input$themecolorswitcher=="themetableau10"){
      scale_colour_discrete <- function(...) 
        scale_colour_manual(..., values = tableau10,drop=!input$themecolordrop,
                            na.value = "grey50")
      scale_fill_discrete <- function(...) 
        scale_fill_manual(..., values = tableau10,drop=!input$themecolordrop,
                          na.value = "grey50")
    }
    if (input$themecolorswitcher=="themeuser"){
      cols <- paste0("c(", paste0("input$col", 1:input$nusercol, collapse = ", "), ")")
      cols <- eval(parse(text = cols))
      scale_colour_discrete <- function(...) 
        scale_colour_manual(..., values = cols,drop=!input$themecolordrop,
                            na.value = "grey50")
      scale_fill_discrete <- function(...) 
        scale_fill_manual(..., values = cols,drop=!input$themecolordrop,
                          na.value = "grey50")
    }
    if (input$themecolorswitcher=="themetableau20"){
      scale_colour_discrete <- function(...) 
        scale_colour_manual(..., values = tableau20,drop=!input$themecolordrop,
                            na.value = "grey50")
      scale_fill_discrete <- function(...) 
        scale_fill_manual(..., values = tableau20,drop=!input$themecolordrop,
                          na.value = "grey50")
    }
    if (input$themecolorswitcher=="themecolorblind"){
      scale_colour_discrete <- function(...) 
        scale_colour_manual(..., values = cbPalette,drop=!input$themecolordrop,
                            na.value = "grey50")
      scale_fill_discrete <- function(...) 
        scale_fill_manual(..., values = cbPalette,drop=!input$themecolordrop,
                          na.value = "grey50")
    }
    if (input$themecolorswitcher=="themecolorblind2"){
      scale_colour_discrete <- function(...) 
        scale_colour_manual(..., values = cbbPalette,drop=!input$themecolordrop,
                            na.value = "grey50")
      scale_fill_discrete <- function(...) 
        scale_fill_manual(..., values = cbbPalette,drop=!input$themecolordrop,
                          na.value = "grey50")
    }

    if (input$scaleshapeswitcher=="themeuser"){
      shapes <- paste0("c(", paste0("input$shape", 1:input$nusershape, collapse = ", "), ")")
      shapes <- eval(parse(text = shapes))
      shapes <- translate_shape_string(shapes)
      scale_shape_discrete <- function(...)
        scale_shape_manual(..., values = shapes)
    }
    
    if (input$scalelinetypeswitcher=="themeuser"){
      linetypes <- paste0("c(", paste0("input$linetype", 1:input$nuserlinetype, collapse = ", "), ")")
      linetypes <- eval(parse(text = linetypes))
      scale_linetype_discrete <- function(...)
        scale_linetype_manual(..., values = linetypes)
    }
    
    # Determine what type of plot to show based on what variables were chosen
    if (input$show_pairs && !is.null(input$colorpairsin)) {
      facetswitch <-
        if (input$facetswitch == "none")
          NULL
      else {
        input$facetswitch
      }
      if (input$facetlabeller != "label_wrap_gen"){
        labellervalue = eval(parse(
          text=paste0("function(labs){",input$facetlabeller,
                      "(labs, multi_line = ",input$facetwrapmultiline,")}")))
          
      }
      if (input$facetlabeller == "label_wrap_gen"){
        labellervalue = label_wrap_gen(width = input$labelwrapwidth,
                                  multi_line = input$facetwrapmultiline)
        
      }
      # Matrix of pairs of plots of all the Y variables
      if (input$colorpairsin != 'None') {
        ggpairsmapping = ggplot2::aes_string(color = input$colorpairsin)
      }
      if (input$colorpairsin == 'None') {
        ggpairsmapping = NULL
      }
# 
#       GGally::wrap("cor",
#                    size = 5,
#                    align_percent = 0.8,
#                    alpha = 1)
      
        p <- sourceable(
          GGally::ggpairs(
            plotdata,
            columns = input$y,
            mapping = ggpairsmapping,
            diag = list(
              continuous = GGally::wrap(input$pairsdiagcontinuous,
                                        alpha = input$alphadiagpairs,
                                        linetype = ifelse(input$colorpairsin == 'None',1,0)),
              discrete = GGally::wrap(input$pairsdiagdiscrete,
                                      alpha = input$alphadiagpairs,
                                      linetype = ifelse(input$colorpairsin == 'None',1,0))
            ),
            lower = list(
              continuous = GGally::wrap(input$pairslowercont,
                                        alpha = ifelse(input$pairslowercont == 'cor',1,
                                                       input$alphalowerpairs),
                                        size = input$sizelowerpairs),
              combo = GGally::wrap(input$pairslowercombo,
                                   alpha = input$alphalowerpairs,
                                   position = "dodge2"),
              discrete = GGally::wrap(input$pairslowerdisc,
                                      alpha = input$alphalowerpairs)
            ),
            upper = list(
              continuous = GGally::wrap(input$pairsuppercont,
                                        alpha = ifelse(input$pairsuppercont == 'cor',1,
                                                       input$alphaupperpairs),
                                        size = input$sizeupperpairs),
              combo = GGally::wrap(input$pairsuppercombo,
                                   alpha = input$alphaupperpairs,
                                   position = "dodge2"),
              discrete = GGally::wrap(input$pairsupperdisc,
                                      alpha = input$alphaupperpairs)
            ), switch= facetswitch, labeller = labellervalue ,
            progress = FALSE
          )
        )

      if (input$colorpairsin != 'None' &&
          !is.numeric(plotdata[,input$colorpairsin])){
         p <-  p +
          scale_colour_discrete() +
          scale_fill_discrete()

          if (input$themecolorswitcher=="themeggplot"){
            p <-  p +
              scale_colour_hue(drop=!input$themecolordrop) +
              scale_fill_hue(drop=!input$themecolordrop)
          }
          if (input$themecolorswitcher=="themeviridis"){
            p <-  p +
              scale_colour_viridis_d(drop=!input$themecolordrop,
                                     option = input$themeviridispalettes,
                                     direction = ifelse(input$viridisbrewerdirection,-1,1),
                                     na.value = "grey50") + 
              scale_fill_viridis_d(drop=!input$themecolordrop,
                                   option = input$themeviridispalettes,
                                   direction = ifelse(input$viridisbrewerdirection,-1,1),
                                   na.value = "grey50")
          }
         if (input$themecolorswitcher=="themebrewer"){
           p <-  p +
             scale_colour_brewer(drop=!input$themecolordrop,
                                 palette = input$themebrewerpalettes,
                                 direction = ifelse(input$viridisbrewerdirection,-1,1),
                                 na.value = "grey50") + 
             scale_fill_brewer (drop=!input$themecolordrop,
                                palette = input$themebrewerpalettes,
                                direction = ifelse(input$viridisbrewerdirection,-1,1),
                                na.value = "grey50")
         }
         
      }
      p <- attach_source_dep(p, "facetswitch")
      p <- attach_source_dep(p, "labellervalue")
      p <- attach_source_dep(p, "ggpairsmapping")
      
    } else if (is.null(input$y) || is.null(input$x)) {
      # Univariate plot X or Y plots
      
      if(is.null(input$y)){ #univariate when y is null only x it can be numeric (density) or not barplot
      if(is.numeric(plotdata[,"xvalues"]) ){
        p <- sourceable(ggplot(plotdata, aes_string(x="xvalues")))
        if (input$colorin != 'None')
          p <- p + aes_string(color=input$colorin)
        if (input$fillin != 'None')
          p <- p + aes_string(fill=input$fillin)
        if (input$groupin != 'None')
          p <- p + aes_string(group=input$groupin)
        if (input$linetypein != 'None'){
          p <- p  + aes_string(linetype=input$linetypein)
        }
        
        if (input$groupin == 'None' && !is.numeric(plotdata[,"xvalues"]) &&
            input$colorin == 'None' && input$linetypein == 'None' &&
            input$fillin  == 'None'){
          p <- p + aes(group=1L)
        }
        if ( input$histogramaddition=="Counts") {
          if ( input$histogrambinwidth =="None") {
            p <- p + geom_histogram(aes(y=..count..),
                                    alpha=input$histogramalpha,
                                    bins = input$histonbins,
                                    position =input$positionhistogram)
          }
          if ( input$histogrambinwidth =="userbinwidth") {
            p <- p + geom_histogram(aes(y=..count..),
                                    alpha=input$histogramalpha,
                                    binwidth = input$histobinwidth,
                                    position =input$positionhistogram)
          }
          if ( input$histogrambinwidth =="autobinwidth") {
            p <- p + geom_histogram(aes(y=..count..),
                                    alpha=input$histogramalpha,
                                    binwidth = function(x) { 2 * IQR(x) / (length(x)^(1/3)  )},
                                    position =input$positionhistogram)
          }
        } 
        
        if ( input$histogramaddition=="Density") { 
          if ( input$histogrambinwidth =="None") {
            p <- p + geom_histogram(aes(y=..density..),
                                    alpha=input$histogramalpha,
                                    bins = input$histonbins,
                                    position =input$positionhistogram)
          }
          if ( input$histogrambinwidth =="userbinwidth") {
            p <- p + geom_histogram(aes(y=..density..),
                                    alpha=input$histogramalpha,
                                    binwidth = input$histobinwidth,
                                    position =input$positionhistogram)
          }
          if ( input$histogrambinwidth =="autobinwidth") {
            p <- p + geom_histogram(aes(y=..density..),
                                    alpha=input$histogramalpha,
                                    binwidth = function(x) { 2 * IQR(x) / (length(x)^(1/3)  )},
                                    position =input$positionhistogram)
          } 
        }
        
        if ( input$histogramaddition=="ncounts") { 
          if ( input$histogrambinwidth =="None") {
            p <- p + geom_histogram(aes(y=..ncount..),
                                    alpha=input$histogramalpha,
                                    bins = input$histonbins,
                                    position =input$positionhistogram)
          }
          if ( input$histogrambinwidth =="userbinwidth") {
            p <- p + geom_histogram(aes(y=..ncount..),
                                    alpha=input$histogramalpha,
                                    binwidth = input$histobinwidth,
                                    position =input$positionhistogram)
          }
          if ( input$histogrambinwidth =="autobinwidth") {
            p <- p + geom_histogram(aes(y=..ncount..),
                                    alpha=input$histogramalpha,
                                    binwidth = function(x) { 2 * IQR(x) / (length(x)^(1/3)  )},
                                    position =input$positionhistogram)
          }
        }  
       
        if ( input$densityaddition=="Density"){
          p <- p + geom_density(aes(y=..density..),
                                alpha=input$densityalpha,
                                adjust=input$densityadjust)
        }
        if ( input$densityaddition=="Scaled Density"){
          p <- p + geom_density(aes(y=..scaled..),
                                alpha=input$densityalpha,
                                adjust=input$densityadjust)
        }
        if ( input$densityaddition=="Counts"){
          p <- p + geom_density(aes(y=..count..),
                                alpha=input$densityalpha,
                                adjust=input$densityadjust)
        }
        if ( input$densityaddition=="histocount"){
          p <- p + geom_density(aes(binwidth=input$histobinwidth, y=binwidth*..count..),
                                alpha=input$densityalpha,
                                adjust=input$densityadjust)
        }

        ylabeltext <- ""
        if(input$histogramaddition!="None"){
        ylabeltext <-  paste(ylabeltext,"Histogram:",input$histogramaddition)
        }
        if(input$densityaddition!="None"){
        ylabeltext <-  paste(ylabeltext,"Density:",input$densityaddition)
        }
        p <- p + ylab(ylabeltext)
        p <- attach_source_dep(p, "ylabeltext")
        
        ###### rug geom start
        if(input$addrugmarks) {
          if(! input$rugignorecol){
            p <- p + geom_rug(sides = paste(input$rugsides,collapse="",sep=""),
                       show.legend = FALSE, outside = input$rugoutside, 
                       alpha = input$ruglinealpha,
                       length = ggplot2::unit(input$ruglinelength ,"npc") 
              ) 
          }
          if(input$rugignorecol){
            p <- p + geom_rug(sides = paste(input$rugsides,collapse="",sep=""),
                       show.legend = FALSE, outside = input$rugoutside,
                       alpha = input$ruglinealpha,
                       length = ggplot2::unit(input$ruglinelength ,"npc"),
                       col = input$colrug
              ) 
          }
        }
        if(input$addextrarugmarks && 
           !is.null(input$xrug) &&
           length(as.vector(input$xrug)) > 0) {
          for(i in input$xrug) {
            if(!input$rugignorecol){
              p <- p +
                geom_rug(aes_string(x=i),
                         sides = paste(input$extrarugsides, collapse="",sep=""),
                         show.legend = FALSE, inherit.aes = FALSE, outside = input$rugoutside,
                         alpha = input$ruglinealpha,
                         length = ggplot2::unit(input$ruglinelength ,"npc")
                )
            }
            if(input$rugignorecol){
              p <- p +
                geom_rug(aes_string(x=i),
                         sides = paste(input$extrarugsides, collapse="",sep=""),
                         show.legend = FALSE, inherit.aes = FALSE, outside = input$rugoutside,
                         alpha = input$ruglinealpha,
                         length = ggplot2::unit(input$ruglinelength ,"npc"),
                         col = input$colrug 
                )
            }
          }
        } #### rug geom end

      } #numeric x ends
      } # null y ends
      if(is.null(input$x)){
      if(is.numeric(plotdata[,"yvalues"]) ){
        p <- sourceable(ggplot(plotdata, aes_string(y="yvalues")))
        if (input$colorin != 'None')
          p <- p + aes_string(color=input$colorin)
        if (input$fillin != 'None')
          p <- p + aes_string(fill=input$fillin)
        if (input$groupin != 'None')
          p <- p + aes_string(group=input$groupin)
        if (input$linetypein != 'None'){
          p <- p  + aes_string(linetype=input$linetypein)
        }
        
        if (input$groupin == 'None' && !is.numeric(plotdata[,"yvalues"]) &&
            input$colorin == 'None' && input$linetypein == 'None' &&
            input$fillin ==  'None') {
          p <- p + aes(group=1L)
        }
        
        if ( input$histogramaddition=="Counts") {
          if ( input$histogrambinwidth =="None") {
            p <- p + geom_histogram(aes(x = ..count..),
                                    alpha=input$histogramalpha,
                                    bins = input$histonbins,
                                    position =input$positionhistogram)
          }
          if ( input$histogrambinwidth =="userbinwidth" ) {
            p <- p + geom_histogram(aes(x = ..count..),
                                    alpha=input$histogramalpha,
                                    binwidth = input$histobinwidth,
                                    position =input$positionhistogram)
          }
          if ( input$histogrambinwidth =="autobinwidth" ) {
            p <- p + geom_histogram(aes(x=..count..),
                                    alpha=input$histogramalpha,
                                    binwidth = function(x) { 2 * IQR(x) / (length(x)^(1/3)  )},
                                    position =input$positionhistogram)
          }
        }
        if ( input$histogramaddition=="Density" ) {
          if (input$histogrambinwidth =="None" ){
            p <- p + geom_histogram(aes(x=..density..),
                                    alpha=input$histogramalpha,
                                    bins = input$histonbins,
                                    position =input$positionhistogram)
          }
          if (input$histogrambinwidth =="userbinwidth" ){
            p <- p + geom_histogram(aes(x=..density..),
                                    alpha=input$histogramalpha,
                                    binwidth = input$histobinwidth,
                                    position =input$positionhistogram)
          }
          if ( input$histogrambinwidth =="autobinwidth" ){
            p <- p + geom_histogram(aes(x=..density..),
                                    alpha=input$histogramalpha,
                                    binwidth = function(x) { 2 * IQR(x) / (length(x)^(1/3)  )},
                                    position =input$positionhistogram)
          }
        }
        if ( input$histogramaddition=="ncounts" ) {
          if (input$histogrambinwidth =="None" ){
            p <- p + geom_histogram(aes(x=..ncount..),
                                    alpha=input$histogramalpha,
                                    bins = input$histonbins,
                                    position =input$positionhistogram)
          }
          if (input$histogrambinwidth =="userbinwidth" ){
            p <- p + geom_histogram(aes(x=..ncount..),
                                    alpha=input$histogramalpha,
                                    binwidth = input$histobinwidth,
                                    position =input$positionhistogram)
          }
          if ( input$histogrambinwidth =="autobinwidth" ){
            p <- p + geom_histogram(aes(x=..ncount..),
                                    alpha=input$histogramalpha,
                                    binwidth = function(x) { 2 * IQR(x) / (length(x)^(1/3)  )},
                                    position =input$positionhistogram)
          }
        }

        if ( input$densityaddition=="Density"){
          p <- p + geom_density(aes(x=..density..),
                                alpha=input$densityalpha,
                                adjust=input$densityadjust)
        }
        if ( input$densityaddition=="Scaled Density"){
          p <- p + geom_density(aes(x=..scaled..),
                         alpha=input$densityalpha,
                         adjust=input$densityadjust)
        }
        if ( input$densityaddition=="Counts"){
          p <- p + geom_density(aes(x=..count..),
                                alpha=input$densityalpha,
                         adjust=input$densityadjust)
        }
        if ( input$densityaddition=="histocount"){
          p <- p +
            geom_density(aes(binwidth=input$histobinwidth,x=binwidth*..count..),
                         alpha=input$densityalpha,
                         adjust=input$densityadjust)
        }
        xlabeltext <- ""
        if(input$histogramaddition!="None"){
          xlabeltext <-  paste(xlabeltext,"Histogram:",input$histogramaddition)
        }
        if(input$densityaddition!="None"){
          xlabeltext <-  paste(xlabeltext,"Density:",input$densityaddition)
        }
        
        p <- p +
          xlab(xlabeltext)
        p <- attach_source_dep(p, "xlabeltext")
        #numeric x
        
        ###### rug geom start
        if(input$addrugmarks) {
          
          if(! input$rugignorecol){
            p <- p +
              geom_rug(sides = paste(input$rugsides,collapse="",sep=""),
                       show.legend = FALSE, outside = input$rugoutside,
                       alpha = input$ruglinealpha,
                       length = ggplot2::unit(input$ruglinelength ,"npc") 
              ) 
          }
          if(input$rugignorecol){
            p <- p +
              geom_rug(sides = paste(input$rugsides,collapse="",sep=""),
                       show.legend = FALSE, outside = input$rugoutside,
                       alpha = input$ruglinealpha,
                       length = ggplot2::unit(input$ruglinelength ,"npc"),
                       col = input$colrug
              ) 
          }
          
        }
        if(input$addextrarugmarks &&
           !is.null(input$xrug) &&
           length(as.vector(input$xrug)) > 0) {
          for(i in input$xrug) {
            if(!input$rugignorecol){
              p <- p +
                geom_rug(aes_string(y=i),
                         sides = paste(input$extrarugsides, collapse="",sep=""),
                         show.legend = FALSE, inherit.aes = FALSE, outside = input$rugoutside,
                         alpha = input$ruglinealpha,
                         length = ggplot2::unit(input$ruglinelength ,"npc")
                )
            }
            if(input$rugignorecol){
              p <- p +
                geom_rug(aes_string(y=i),
                         sides = paste(input$extrarugsides, collapse="",sep=""),
                         show.legend = FALSE, inherit.aes = FALSE, outside = input$rugoutside,
                         alpha = input$ruglinealpha,
                         length = ggplot2::unit(input$ruglinelength ,"npc"),
                         col = input$colrug 
                )
            }
          }
        }#### rug geom end
 
      }#numericyvalues
      }#nullx ends
      if(is.null(input$y)){
      if(!is.numeric(plotdata[,"xvalues"]) ){
        if(input$barplotorder=="frequency"){
          plotdata[,"xvalues"]<- factor(as.factor(plotdata[,"xvalues"]),
                                      levels=names(sort(table(plotdata[,"xvalues"]), 
                                                        decreasing=FALSE)))
        }
        if(input$barplotorder=="revfrequency"){
          plotdata[,"xvalues"]<- factor(as.factor(plotdata[,"xvalues"]),
                                      levels=names(sort(table(plotdata[,"xvalues"]), 
                                                        decreasing=TRUE)))           
        }
        p <- sourceable(ggplot(plotdata, aes_string(x="xvalues")))
        
        if (input$colorin != 'None')
          p <- p + aes_string(color=input$colorin)
        
        if (input$fillin != 'None')
          p <- p + aes_string(fill=input$fillin)
        
        if (input$groupin != 'None')
          p <- p + aes_string(group=input$groupin)

        if ( input$barplotaddition && !input$barplotpercent){
          p <- p + 
            geom_bar(alpha=input$barplotfillalpha,
                     position = eval(parse(text=input$positionbar)))+
            ylab("Count")
          
          if ( input$barplotlabel && !input$ignorebarplotlabelcolor){
            p <- p +   geom_text(aes(y = ((..count..)),
                                    label = ((..count..))),
                                stat = "count",
                                vjust = input$barplotlabelvjust,
                                hjust = input$barplotlabelhjust,
                                size = input$barplotlabelsize,
                                position = eval(parse(text=input$positionbar)),
                                show.legend = input$barplotlabellegend)
          } #input$barplotlabel && !input$ignorebarplotlabelcolor
            if ( input$barplotlabel && input$ignorebarplotlabelcolor){
              p <- p +   geom_text(aes(y = ((..count..)),
                                       label = ((..count..))),
                                   stat = "count",
                                   vjust = input$barplotlabelvjust,
                                   hjust = input$barplotlabelhjust,
                                   size = input$barplotlabelsize,
                                   position = eval(parse(text=input$positionbar)),
                                   show.legend = input$barplotlabellegend,
                                   colour = input$barplotlabelcolor)
            } #input$barplotlabel && input$ignorebarplotlabelcolor 
          
          if ( input$barplotflip){
            p <- p + coord_flip()
          }
        }
        if ( input$barplotaddition && input$barplotpercent){
          p <- p +  
            geom_bar(alpha=input$barplotfillalpha,
                     aes(y = ((..count..)/tapply(..count..,..PANEL..,sum)[..PANEL..])) ,
                     position =