将值分配给if子句内的对象,并在plot方法中调用它

时间:2015-10-16 03:25:48

标签: r graph plot shiny shiny-server

如果条件在R中为TRUE,我想在图中指定位置。 我正在使用闪亮的R包。在Server.R中,代码如下:

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

如果第一个条件为TRUE将图中的(1,1)的位置分配给point.witch将分别位于x和y轴的(t1,在基准内)的位置。 但它没有分配它。

1 个答案:

答案 0 :(得分:1)

如果要在无功分量中更改currentstatus的值,它本身应该是无效值。以下是使用reactiveValues元素存储currentstatus的示例。它在一个renderPlot内更新,并在另一个中使用,如代码中所示。

在此示例中,当线穿过颜色障碍时,currentstatus的值会发生变化。

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