How can I produce this graphic in RShiny?-CodePudding

I would like to use renderPlot in RShiny to create the graphic below (where the number 10 represents a patient's score) in the form

output$plot <- renderPlot({ ... })

The code I used to create the graphic is pasted below:

require(plotrix)

greens <- colorRampPalette(c('green','yellow'))(50)
yellows <- colorRampPalette(c('yellow','orange'))(50)
oranges <- colorRampPalette(c('orange','red'))(50)
reds <- colorRampPalette(c('red','darkred'))(60)
the.colors <- c(greens, yellows, oranges, reds)

plot(0,0, type='n', axes=FALSE, xlab='', ylab='', xlim=c(0,210), ylim=c(0,5))
gradient.rect(0,1,210,2, col=the.colors, gradient='x')
text(25,0.75, 'None')
text(75, 0.75, 'Mild')
text(125, 0.75, 'Moderate')
text(180, 0.75, 'Severe')
text(105, 4.5, 'Your score is', cex=4)
text(105, 3, '10', cex=4)
lines(c(110,110),c(1,2), lwd=3)

CodePudding user response：

I guess you want this, based on the patient, display different scores.

I created a fake patient table, you may have a different one but same concept:

library(shiny)
require(plotrix)

df <- data.frame(
    patient = LETTERS[1:5],
    score = c(1, 3, 5, 10 , 15)
)

ui <- fluidPage(
    selectInput("choose_patient", "choose patient ID", choices = df$patient),
    plotOutput("p")
)

server <- function(input, output, session) {
  output$p <- renderPlot({
      req(input$choose_patient)
      score <- df$score[df$patient == input$choose_patient]
      greens <- colorRampPalette(c('green','yellow'))(50)
      yellows <- colorRampPalette(c('yellow','orange'))(50)
      oranges <- colorRampPalette(c('orange','red'))(50)
      reds <- colorRampPalette(c('red','darkred'))(60)
      the.colors <- c(greens, yellows, oranges, reds)
      
      plot(0,0, type='n', axes=FALSE, xlab='', ylab='', xlim=c(0,210), ylim=c(0,5))
      gradient.rect(0,1,210,2, col=the.colors, gradient='x')
      text(25,0.75, 'None')
      text(75, 0.75, 'Mild')
      text(125, 0.75, 'Moderate')
      text(180, 0.75, 'Severe')
      text(105, 4.5, paste0('Patient ', input$choose_patient, ' score is'), cex=4)
      text(105, 3, score, cex=4)
      lines(rep(score*10, 2),c(1,2), lwd=3)
  })
}

shinyApp(ui, server)