Search code examples
rgraphplotshinyshiny-server

Assign the value to an object inside if clause and call it within plot method


I want to assign the position in a plot if a condition is TRUE in R. I am using shiny R package. in the Server.R the codes are as following:

output$plotmahal<-renderPlot({
  #identify the current position of project
    x0<-subset(x1,Type==1)
     xc<-x0[,c(input$KPI1,input$KPI2)]
  #change list to integer
     xc1<-as.numeric(unlist(xc))
        #current point
        d0<-xc1[1]
        d1<-xc1[2]
  #Centroid point
    centroid<-colMeans(x[,c(input$KPI1,input$KPI2)])
      c0<-centroid[1]
      c1<-centroid[2]
      #Quantile of .5 to show if the current is inside 50% of benchmark space or not
      xq<-subset(x1,Type!=1)
      qKPI1high<-quantile(xq[,input$KPI1],1)
      qKPI2high<-quantile(xq[,input$KPI2],1)
      qKPI1low<-quantile(xq[,input$KPI1],0)
      qKPI2low<-quantile(xq[,input$KPI1],0)
        if((d0>qKPI1low && d0<qKPI1high) && (d1>qKPI2low && d1<qKPI2high))
          {currentstatus<-"Within Benchmark"}
        else{
            currentstatus<-"out of benchmark"}
  output$c0<-renderText({

           paste(currentstatus,input$currentstatus)
                      })
  segments(d0,d1,c0,c1,col='brown',cex=10)
    })


    output$dss<-renderPlot({
if(is.element("out of benchmark",input$currentstatus)){
  x<-c(1)
  y<-c(1)
  }
if(is.element("within benchmark",input$currentstatus)){
    x<-c(1)
    y<-c(2)
}
plot(x,y,xaxt='n',yaxt='n',cex=1,pch=19,col=ifelse(x==1,"red","green"),ylab="status",xlab="period")
  axis(1,at=1:2,labels=c("t1","t2"))
  axis(2,at=1:2,labels=c("within benchmark","out of bench"))
})

If the first condition is TRUE Assign the position of (1,1) in the graph to the point.witch will be in the position of (t1,Within benchmark) in the axis of of x and y respectively. But it does not assign it.


Solution

  • If you want to change the value of currentstatus from within a reactive component, it should be a reactive value itself. Here is an example where a reactiveValues element is used to store currentstatus. It is updated from within one renderPlot and used in another, as in your code.

    In this example, the value of currentstatus changes when the line crosses the color barrier.

    ## Sample data
    dat <- mtcars
    
    library(shiny)
    shinyApp(
        shinyUI(
            fluidPage(
                wellPanel(
                    radioButtons('column', 'Column:', choices=names(dat),
                                 selected='mpg', inline=TRUE),
                    uiOutput('ui')
                ),
                mainPanel(
                    fluidRow(column(8, plotOutput('plotmahal')),
                             column(4, plotOutput('dss')))
                )
            )
        ),
        shinyServer(function(input, output){
            ## Reactive values
            vals <- reactiveValues(currentstatus = 'Within')
    
            ## The input options
            output$ui <- renderUI({
                list(
                    sliderInput('inp', 'Range:', min=0, max=max(dat[[input$column]]),
                                value=mean(dat[[input$column]])),
                    helpText('Example: when the line crosses the color barrier, currenstatus changes.',
                             align='center', style='font-weight:800;')
                )
            })
    
            output$plotmahal <- renderPlot({
                ## Update the value of currentstatus when the input is < or > the mean
                mu <- mean(dat[[input$column]])
                vals$currentstatus <- if (input$inp < mu) 'Within' else 'Out'
    
                ## Make a random graph
                counts <- hist(dat[[input$column]], plot=FALSE)
                image(x=seq(0, mu, length=20), (y=seq(0, max(counts$counts), length=20)),
                      (z=matrix(rnorm(400), 20)), col=heat.colors(20, alpha=0.5),
                      xlim=c(0, max(counts$breaks)), xlab='', ylab='')
                image(x=seq(mu, max(counts$breaks), length=20), y=y, z=z,
                      col=colorRampPalette(c('lightblue', 'darkblue'), alpha=0.5)(20), add=TRUE)
                abline(v = input$inp, lwd=4, col='firebrick4')
            })
    
            output$dss <- renderPlot({
                ## This prints the currentstatus variable to RStudio console
                print(vals$currentstatus)
    
                if(is.element("Out", vals$currentstatus))
                    x <- y <- 1
                if(is.element("Within", vals$currentstatus)) {
                    x <- 1
                    y <- 2
                }
                plot(x, y, xaxt='n',yaxt='n',cex=1,pch=19,
                     col=ifelse(x==1,"red","green"),ylab="status",xlab="period",
                     xlim=c(0,3), ylim=c(0,3))
                axis(1,at=1:2,labels=c("t1","t2"))
                axis(2,at=1:2,labels=c("within benchmark","out of bench"))
            })
        })
    )