Unable to save reactive value from an html template for RShiny

Viewed 25

I've been struggling with this, below is a much simplified version of my issue but here is the idea : I have a table with 4 text areas using an html template. When the user types into one of the 4 text areas (he can only input text in one), a score is assigned - cell 1 =1, cell 2 = 2 etc. Pulling the string content is not a problem but I can't seem to get the score assigned to save properly I'm not sure of what I am doing wrong.

library(shiny)
ui <- fluidPage(
  column(
    12,
    actionButton("save_project", "save")),
  column(
    width = 12,
    h4("Assessment #1"),
    htmlTemplate(
      filename = "market_table.html",
      indicator = "market_creation_attr_1"
    )
  )
)
server <- function(input, output, session) {
  market_ table_1_score <- reactiveVal(NULL)
  observeEvent(c(input$market_creation_attr_1_market_rating_1,input$market_creation_attr_1_market_rating_2,input$market_creation_attr_1_market_rating_3,input$market_creation_attr_1_market_rating_4), {
    
    if (!is.na(input$market_creation_attr_1_market_rating_1)||is.null(input$market_creation_attr_1_market_rating_1)){
      market_table_1_score<-1
      
    } else if (!is.na(input$market_creation_attr_1_market_rating_2)){
      market_table_1_score<-2
      
    }else if (!is.na(input$market_creation_attr_1_market_rating_3)){
      market_table_1_score<-3
      
    }else if(!is.na(input$market_creation_attr_1_market_rating_4)){
      market_table_1_score<-4
      
    }
    market_table_1_score
  })
  
  observeEvent(input$save_project, {
    inputs <- reactiveValuesToList(input)
    filepath <- file.path("save", paste0("input-.rds"))
    saveRDS(inputs, file = filepath)
    all_values <- reactiveValuesToList(values)
    filepath <- file.path("save", paste0("values--.rds"))
    saveRDS(all_values, file = filepath)    
  })
  
}
shinyApp(ui=ui, server=server)

And this is the template of the html table (not sure that's relevant)


<div class="market-table">
  <ul class="market-header">
    <li style="border-right: 1px solid black"><div>Market Typology</div></li>
    <li><div>Highly Developed</div></li>
    <li><div>Moderately Developed</div></li>
    <li><div>Under Developed</div></li>
    <li><div>Highly Under Developed</div></li>
  </ul>
  <ul class="market-row">
    <li>INDICAOTR</li>
      <li>
      <textarea id="{{ paste0(indicator, '_market_rating_1')}}" rows="5" maxlength="500"></textarea>
    </li>
    <li>
      <textarea id="{{ paste0(indicator, '_market_rating_2')}}" rows="5" maxlength="500"></textarea>
    </li>
    <li>
      <textarea id="{{ paste0(indicator, '_market_rating_3')}}" rows="5" maxlength="500"></textarea>
    </li>
        <li>
      <textarea id="{{ paste0(indicator, '_market_rating_4')}}" rows="5" maxlength="500"></textarea>
    </li>
  </ul>
</div>

Any advice is greatly appreciated!

1 Answers

after spending several hours on the (I'm still a beginner), I found noticed 2 major errors : 1. in my condition, it shouldn't be !is.na, rather I should have used !='' 2. and this is pretty important, I didn't create an empty object to store the reactive values...oops.

Here is a working code (see template in my original question)

library(shiny)
ui <- fluidPage(
  column(
    12,
    actionButton("save_project", "save")),
  column(
    width = 12,
    h4("Assessment #1"),
    htmlTemplate(
      filename = "market_table.html",
      indicator = "market_creation_attr_1"
    )
  )
)
server <- function(input, output, session) {
  values <- reactiveValues()
  market_typology_table_1_score <- reactiveVal(NULL)
observeEvent(c(input$market_creation_attr_1_market_rating_1,input$market_creation_attr_1_market_rating_2,input$market_creation_attr_1_market_rating_3,input$market_creation_attr_1_market_rating_4), {

    if (input$market_creation_attr_1_market_rating_1!=''){
      market_ table_1_score<-1

    } else if (input$market_creation_attr_1_market_rating_2!=''){
      market_ table_1_score<-2

    }else if (input$market_creation_attr_1_market_rating_3!=''){
      market_ table_1_score<-3

    }else if(input$market_creation_attr_1_market_rating_4!=''){
      market_table_1_score<-4
    }
    values$market_typology_table_1_score<-isolate(market_typology_table_1_score)
  })
  observeEvent(input$save_project, {
    inputs <- reactiveValuesToList(input)
    filepath <- file.path("save", paste0("input.rds"))
    saveRDS(inputs, file = filepath)
    all_values <- reactiveValuesToList(values)
    filepath <- file.path("save", paste0("values.rds"))
    saveRDS(all_values, file = filepath)
  })
}
shinyApp(ui=ui, server=server)
Related