Hack-R
Hack-R

Reputation: 23200

Difficulty with reactive conditional renderImage in Shiny

I'm striking out at my attempts to conditionally display images in the following Shiny app.

There are 2 problems.

The first is that while I can display a picture if I uncomment the #img(src = "dollar.png") I can't get the images to display otherwise (though the Alt text associated with the images does display).

The 2nd problem is that my attempts to make the if statements work reactively based on the value of ne have not been successful.

For ui.R I have:

library(shiny)

shinyUI(fluidPage(

  #  Application title
  titlePanel("My App that Won't Show Pics!"),

  sidebarLayout(
    sidebarPanel(
      # Simple integer interval
      sliderInput("ns", "Hypothetical NS with Treatment:", 
                  min=100, max=10000, value=4000),

      sliderInput("RPS", "RPS:", 
                  min = 0, max = 50000, value = 21594, step = 100),
      # Revenue Delta
      sliderInput("revDelta", "RPS Delta:", 
                  min = -10000, max = 5000, value = -4900, step = 100),
      # NS Lift
      sliderInput("nsLift", "NS Lift (See PPT for example results):", 
                  min = 0, max = .4, value = .18, step = .001)

    ),

    # Show a table summarizing the values entered
    mainPanel(
      tableOutput("values"),
      imageOutput("image1")
      #img(src = "dollar.png")

    )
  )
))

For server.R I have:

library(shiny)
net_effect <- function(ns, revDelta, nsLift, RPS) {
  trBase     <- (ns/(1 + nsLift)) * RPS
  trOffer    <- (ns * RPS) + (ns * revDelta)
  netEffect  <- round(trOffer - trBase)
  return(paste("$",format(netEffect, big.mark=","),sep=""))
}

shinyServer(function(input, output) {

  sliderValues <- reactive({

    # Compose data frame
    data.frame(
      Name = c("New Students with Offer", 
               "Rev per Student", "Net Effect"),
      Value = as.character(c(input$ns, 
                             input$RPS,
                             ne <- net_effect(input$ns, input$revDelta, input$nsLift, input$RPS))), 
      stringsAsFactors=FALSE)
  }) 

  # Show the values using an HTML table
  output$values <- renderTable({
    sliderValues()
  })
  # image2 sends pre-rendered images
  output$image1 <- renderImage({

    if (net_effect(input$ns, input$revDelta, input$nsLift, input$RPS) < 0) {
      return(list(
        src = "images/red_dollar.png",
        contentType = "image/png",
        alt = "We're losing money!"
      ))
    } else if (net_effect(input$ns, input$revDelta, input$nsLift, input$RPS) > 0) {
      return(list(
        src = "images/dollar.png",
        filetype = "image/png",
        alt = "We're making money!"
      ))
    }

  }, deleteFile = FALSE)
})

Upvotes: 1

Views: 1667

Answers (1)

Michal Majka
Michal Majka

Reputation: 5471

I assume that pictures dollar.png and dolar_red.png are in the folder www which is in the same directory as the server.R and ui.r.

The 2nd problem is that my attempts to make the if statements work reactively based on the value of ne have not been successful.

This is because you are comparing a character string to 0 which doesn't make sence. I've made some changes in the server code that should solve the first problem as well.

EDIT: I forgot to add changed net_effectfunction

net_effect <- function(ns, revDelta, nsLift, RPS) {
  trBase     <- (ns/(1 + nsLift)) * RPS
  trOffer    <- (ns * RPS) + (ns * revDelta)
  return(round(trOffer - trBase)) # new return value 
}

shinyServer(function(input, output) {

  net <- reactive({ 
    net_effect(input$ns, input$revDelta, input$nsLift, input$RPS)
  })


  sliderValues <- reactive({

    # Compose data frame
    data.frame(
      Name = c("New Students with Offer", 
               "Rev per Student", "Net Effect"),
      Value = as.character(c(input$ns, 
                             input$RPS,
                             ne <- paste("$",format( net(), big.mark=","),sep="") )), 
      stringsAsFactors=FALSE)
  }) 


  # Show the values using an HTML table
  output$values <- renderTable({
    sliderValues()
  })

  output$image1 <- renderImage({

    if ( net() < 0) { 
      return(list(
        src = "www/red_dollar.png",
        contentType = "image/png",
        alt = "We're losing money!"
      ))
    } else if (net() > 0) {
      return(list(
        src = "www/dollar.png",
        filetype = "image/png",
        alt = "We're making money!"
      ))
    }

  }, deleteFile = FALSE)
})

Upvotes: 2

Related Questions