0

I have built a linear regression that allows the user to select the dependent and independent variables. Now I am trying to plot the predicted value againt actual value: It woks fine when the predicted value has a name with no space but when there is space in the name i get an error :

Warning:Error in h: error in evaluating the argument 'expr' in selecting a method for function 'eval': <text>:1:13: unexpected symbol
1: datak$Total Cell

The part that pose the problem is at the end in the plotly function for add_trace it's the y=...

(tester is input$property_name and the problem is for property name with space)

Thank you for the help

I deleted most of the code which I think was not relevant to make it easier to read

Ui

  fluidPage(
    fluidRow(
      box(title="Filter Settings",status="primary",solidHeader=TRUE,collapsible=FALSE,width=2,style="height:120vh",          selectInput(inputId=ns("Reference_batch"),label="Ref_batch",choices=NULL,multiple=TRUE),
          selectInput(inputId=ns("Reference_batch"),label="Reference batch to train the model",choices=NULL,multiple=TRUE),
          selectInput(inputId=ns("culture_day"),label="Culture Day to use for prediction",choices=NULL,multiple=TRUE),
          selectInput(inputId=ns("Predict_batch"),label="Pred_batch",choices=NULL,multiple=FALSE),
          selectInput(inputId=ns("property_name"),label="Property to predict",choices=NULL,multiple=FALSE),
          selectInput(inputId=ns("property_name2"),label="Property to use for prediction",choices=NULL,multiple=TRUE),
          selectInput(inputId=ns("Pred_culture_day"),label="Culture Day to predict",choices=NULL,multiple=FALSE),

      ),
      box(title="Predictive analysis",status="primary",solidHeader=TRUE,collapsible=FALSE,width=10,style="height:100vh",
          withSpinner(
            tabsetPanel(type = "tabs",
                        tabPanel("Regresion Tree Plot",plotOutput(ns("Teste_output"))),
                        tabPanel("Regression Tree Actual vs Predicted",plotlyOutput(ns("teste_output")))                  
            )
          )
      )
    )
  )

Server

offlinePredictiveAnalysisServer <- function(input,output,session) {
  values <- reactiveValues()
  # Dynamically update the batch name selection UI
  observe({
 updateSelectInput(session,inputId="Reference_batch",choices=sort(unique(getSampleHeaderData(input_product_code=input$product_code,input_equipment_scale=input$equipment_scale,input_campaign_name=input$campaign_name)$batch_name)))
  })
  
  # Dynamically update  the batch name selection UI
  
  observe({
    updateSelectInput(session,inputId="Predict_batch",choices=sort(unique(getSampleHeaderData(input_product_code=input$product_code,input_equipment_scale=input$equipment_scale,input_campaign_name=input$campaign_name)$batch_name)))
  })
  
  # Dynamically update the property selection UI
  
  observe({
    updateSelectInput(session,inputId="property_name",choices=sort(unique(getSamplePropertyData()$property_name)))
  })
  
  # Dynamically update the property selection UI
  
  observe({
    updateSelectInput(session,inputId="property_name2",choices=sort(unique(getSamplePropertyData()$property_name)))
  })
  
  
  # Dynamically update the culture day selection UI
  
  observe({
    updateSelectInput(session,inputId="culture_day",choices=sort(unique(getSampleHeaderData(input_product_code=input$product_code,input_campaign_name=input$campaign_name,input_batch_name=input$batch_name)$culture_day)))
  })
  
  
  observe({
    updateSelectInput(session,inputId="Pred_culture_day",choices=sort(unique(getSampleHeaderData(input_product_code=input$product_code,input_campaign_name=input$campaign_name,input_batch_name=input$batch_name)$culture_day)))
  })
  
  # Get the batch offline property data in line with the selection
  
  observeEvent(input$update,{
    
    # Here I Get the batch data in line with the selection parameters from de UI part( I deleted most of the parameters not relevant) 
    

    # 75% of the sample size
    smp_size <- floor(0.99 * nrow(Ref_batch_offline_data))
    
    # set the seed to make your partition reproducible
    set.seed(123)
    train_ind <- sample(seq_len(nrow(Ref_batch_offline_data)), size = smp_size)
    train.data <- Ref_batch_offline_data[train_ind, ]
    test.data <- Ref_batch_offline_data[-train_ind, ]
    
    formula=as.formula(paste0("`",input$property_name,"` ~ ",paste0("`",input$property_name2,"`",collapse="+")))
    model <- rpart(formula, data=train.data, control =rpart.control(minsplit =1,minbucket=1, cp=0))
    rpart.plot(model, box.palette="RdBu", shadow.col="gray", nn=TRUE)
    
    values[["df"]] <- model    
    # Make predictions on the test data
    predictions <- predict(model,newdata=Pred_batch_offline_data)
    
    datak2=as.data.frame(datak2)
    
    datak$predicted=predictions
    Pred_batch_offline_data$predicted=predictions
    values[["dff"]] <- datak
    
    testeee=as.name(input$property_name)
    values[["dffteste"]]=testeee

    values[["dff2"]]<- Pred_batch_offline_data
  })
  
  output$Teste_output= renderPlot({
    lm1 <-values[["df"]]
    rpart.plot(lm1, box.palette="RdBu", shadow.col="gray", nn=TRUE)
  })
  
  
  # Render the batch parameter overlay plot
  
  output$teste_output <- renderPlotly({
    datak= values[["dff"]]
    datak=as.data.frame(datak)
    Pred_batch_offline_data=values[["dff2"]]
    tester= values[["dffteste"]]
    
    fig <- plot_ly()
    # Add traces
    fig <- fig %>% add_trace(data = datak,x =datak$culture_day , y =eval(parse(text=paste0("datak$",`tester`))), mode = "lines+markers", type = "scatter",color="blue",name="Actual")
    
    fig <- fig %>% add_trace(x =Pred_batch_offline_data$culture_day , y = datak$predicted, mode = "markers", type = "scatter",color="red",name="Predicted")
    
    fig <- fig %>% layout(xaxis = list( title = "Culture Day"),
                          yaxis = list(title =eval(parse(text=paste0("datak$",`tester`))) ))
    
    
    fig 
    
    
  })
 
  
}
Phil
  • 7,287
  • 3
  • 36
  • 66
Yann
  • 5
  • 2

0 Answers0