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.
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"))
})
})
)