CODEWITHSUNDEEP
rshinytabpanel
Sound
Sound

Reputation: 95

R Shiny: Switching between tabPanels causes errors

I have created an App that will use an randomforest model to predict the type of Species in the Iris dataset. The idea is that a user can select a value for the other varaibles using input widgets, which the model then use to give a prediction. This all works fine.

I recently decided to implement a log containing the different inputs, a timestamp and the estimation. I've placed this log in another tabPanel to give a better overview. Everything apperes to work fine, when I hit the save button, the inputs, timestamp and estimation are saved in the log, however, when I go back to the original tabPanel ("Calculator"), errors appear saying that the number of columns doesn't match (or something like that, I have translated it from danish).

Does anyone know why this problem occours and how to fix it?

Im also having trouble running the app by using the "Run App" button in R. It works fine when I select everything with ctrl+A and hit ctrl+enter to run the code.

Here is my code:

require(shiny)
require(tidyverse)
require(shinythemes)
require(data.table)
require(RCurl)
require(randomForest)
require(mlbench)
require(janitor)
require(caret)
require(recipes)
require(rsconnect)


# Read data
DATA <- datasets::iris

# Rearrange data so the response variable is located in column 1
DATA <- DATA[,c(names(DATA)[5],names(DATA)[-5])]

# Creating a model
model <- randomForest(DATA$Species ~ ., data = DATA, ntree = 500, mtry = 3, importance = TRUE)


.# UI -------------------------------------------------------------------------
ui <- fluidPage(
  navbarPage(title = "Dynamic Calculator",
               
    tabPanel("Calculator", 
  
            sidebarPanel(
              
              h3("Values Selected"),
              br(),
              tableOutput('show_inputs'),
              hr(),
              actionButton("submitbutton", label = "calculate", class = "btn btn-primary", icon("calculator")),
              actionButton("savebutton", label = "Save", icon("save")),
              hr(),
              tableOutput("tabledata")
              
            ), # End sidebarPanel
            
            mainPanel(
              
              h3("Variables"),
              uiOutput("select")
            ) # End mainPanel
              ), # End tabPanel Calculator

  tabPanel("Log",
           br(),
           DT::dataTableOutput("datatable15", width = 300), 
           ) # End tabPanel "Log"
  ) # End tabsetPanel
) # End UI bracket


# Server -------------------------------------------------------------------------
server <- function(input, output, session) {
  
  # Create input widgets from dataset  
  output$select <- renderUI({
    df <- req(DATA)
    tagList(map(
      names(df[-1]),
      ~ ifelse(is.numeric(df[[.]]),
               yes = tagList(sliderInput(
                 inputId = paste0(.),
                 label = .,
                 value = mean(df[[.]], na.rm = TRUE),
                 min = round(min(df[[.]], na.rm = TRUE),2),
                 max = round(max(df[[.]], na.rm = TRUE),2)
               )),
               no = tagList(selectInput(
                 inputId = paste0(.),
                 label = .,
                 choices = sort(unique(df[[.]])),
                 selected = sort(unique(df[[.]]))[1],
               ))
      ) # End ifelse
    )) # End tagList
  })
  
  
  # creating dataframe of selected values to be displayed
  AllInputs <- reactive({
    id_exclude <- c("savebutton","submitbutton")
    id_include <- setdiff(names(input), id_exclude)
    
    if (length(id_include) > 0) {
      myvalues <- NULL
      for(i in id_include) {
        myvalues <- as.data.frame(rbind(myvalues, cbind(i, input[[i]])))
        
      }
      names(myvalues) <- c("Variable", "Selected Value")
      myvalues %>% 
        slice(match(names(DATA[,-1]), Variable))
    }
  })
  
  
  # render table of selected values to be displayed
  output$show_inputs <- renderTable({
    AllInputs()
  })
  
  
  # Creating a dataframe for calculating a prediction
  datasetInput <- reactive({  
    
    df1 <- data.frame(AllInputs(), stringsAsFactors = FALSE)
    input <- transpose(rbind(df1, names(DATA[1])))
    
    write.table(input,"input.csv", sep=",", quote = FALSE, row.names = FALSE, col.names = FALSE)
    test <- read.csv(paste("input.csv", sep=""), header = TRUE)
    
    
  # Defining factor levels for factor variables
    cnames <- colnames(DATA[sapply(DATA,class)=="factor"])
    if (length(cnames)>0){
      lapply(cnames, function(par) {
        test[par] <<- factor(test[par], levels = unique(DATA[,par]))
      })
    }
    
  # Making the actual prediction and store it in a data.frame     
    Prediction <- predict(model,test)
    Output <- data.frame("Prediction"=Prediction)
    print(format(Output, nsmall=2, big.mark=","))
    
    
    
  })
  
  # display the prediction when the submit button is pressed
  output$tabledata <- renderTable({
    if (input$submitbutton>0) { 
      isolate(datasetInput()) 
    } 
  })

# -------------------------------------------------------------------------
  
  # Create the Log 
  saveData <- function(data) {
    data <- as.data.frame(t(data))
    if (exists("datatable15")) {
      datatable15 <<- rbind(datatable15, data)
    } else {
      datatable15 <<- data
    }
  }
  
  loadData <- function() {
    if (exists("datatable15")) {
      datatable15
    }
  }
  
  # Whenever a field is filled, aggregate all form data
  formData <- reactive({
    fields <- c(colnames(DATA[,-1]), "Timestamp", "Prediction")
    data <- sapply(fields, function(x) input[[x]])
    data$Timestamp <- as.character(Sys.time())
    data$Prediction <- as.character(datasetInput())
    data
  })
  
  # When the Submit button is clicked, save the form data
  observeEvent(input$savebutton, {
    saveData(formData())
  })
  
  # Show the previous responses
  # (update with current response when Submit is clicked)
  output$datatable15 <- DT::renderDataTable({
    input$savebutton
    loadData()
  })
  
} # End server bracket

# ShinyApp -------------------------------------------------------------------------
shinyApp(ui, server)

Upvotes: 0

Views: 127

Answers (1)

gdevaux
gdevaux

Reputation: 2505

When creating your reactive AllInputs, you are making a loop on id_include. The problem is that all input[[i]] are not length 1 : they can be NULL or length more than one. You cannot use a cbind on two variables of different lengths, which causes the mistake.

So I added a condition before calculating myvalues, and everything works fine :

  # creating dataframe of selected values to be displayed
  AllInputs <- reactive({
    id_exclude <- c("savebutton","submitbutton")
    id_include <- setdiff(names(input), id_exclude)
    if (length(id_include) > 0) {
      myvalues <- NULL
      for(i in id_include) {
        if(!is.null(input[[i]]) & length(input[[i]] == 1)){
          myvalues <- as.data.frame(rbind(myvalues, cbind(i, input[[i]])))
        }
      }
      names(myvalues) <- c("Variable", "Selected Value")
      myvalues %>% 
        slice(match(names(DATA[,-1]), Variable))
    }
  })

By the way, for loops are not good practice in R, you may want to have a look at apply family functions.

Upvotes: 1

Related Questions