Question

这是我的R闪亮代码：

ui.R

   @Override
  public boolean preHandle(HttpServletRequest request, HttpServletResponse response, Object handler)
    throws Exception {
    HttpSession session= request.getSession();

    if(session.getAttribute("userid")!=null && session.getAttribute("isLoggedIn")!=null ){
        //user has already logged in . so therefore can access any resource
        System.out.println("Logged In");
        return true;
    }

    //if code reaches here means that user is not logged in

    //allow login http request. modify checks accordingly. like you can put strict equals.
    if (request.getRequestURI().endsWith("/login")){
        //user is not logged in but is trying to login. so allow only login requests
        return true;
    }
    else{
        //user is not logged in and is trying to access a resource. so redirect him to login page
        response.sendRedirect(request.getContextPath()+"/modulename/notLoggedIn");
        System.out.println("Not logged in");
        return false;
    }
}

server.R

shinyUI(bootstrapPage(
uiOutput("GD"),
hr(),
fluidRow(column(3, verbatimTextOutput("value")))
))

“ldate”变量是格式化为字符的日期列表，而“G”和“st”是数值列表。

我得到一个包含日期的选择列表，但是当我选择每个日期时，我只得到日期而句子中的“G是”。

当我从选择列表中选择日期时，我想得到的结果是：

2009-12-05

“G为0.55”

“st is 0.08”

我不知道如何找到解决方案。如何将G和st放在输出$ value部分代码中？

修改

以下是标签的示例数据：

shinyServer(function(input, output) {

  output$GD <- renderUI({ 
  nBads <- sum(tab[nrow(tab),3:ncol(tab)])
  nGoods <- sum(tab[(nrow(tab)-1),3:ncol(tab)])
  nTotal <- nBads + nGoods


  options(warn=-1) 
  Outcome_color <- 0
  G <- 0  
  st <-0
  ldate <- 0
  for (k in (1:(nrow(tab)/2))) {

  tabela <- data.frame(tab[1:2,3:(ncol(tab))])
  rownames(tabela) <- c("Goods", "Bads")

  wr <- (sum(tabela)^2 - (rowSums(tabela)[[1]]^2 + rowSums(tabela)[[2]]^2))
x <- which(tabela >= 0)
y <- x[lapply(x,"%%",2)==0]
y1 <- x[lapply(x,"%%",2)!=0]
n <-length(y)


a<-0; a1<-0; Nc<-0; A1x<-0; Nd<-0; D2x<-0;


for (i in n:2 ) {

  c <- a
  a <- tabela[2, (y[i]/2)] + c
  Nc[i-1] <- a * tabela[1, i-1]
  A1x[i-1] <- a

  c1 <- a1
  a1 <- tabela[1, ((y1[i]+1)/2)] + c1
  Nd[i-1] <- a1 * tabela[2, i-1]
  D2x[i-1] <- a1
}

A1x[length(y)] <- 0
D2x[length(y)] <- 0
NC <- sum(Nc)
ND <- sum(Nd)


a2 <- 0; A2x <- 0; a3 <- 0; D1x <- 0; A2x[1] <- 0; D1x[1] <- 0;

for (i in 1:(n-1)) {
  c2 <- a2
  a2 <- tabela[1, ((y1[i]+1)/2)] + c2
  A2x[i+1] <- a2 

  c3 <- a3
  a3 <- tabela[2, (y[i]/2)] + c3
  D1x[i+1] <- a3

}

A <- t(cbind(A1x, A2x))
D <- t(cbind(D1x,D2x))
d <- A-D
PQ <- 2*(NC-ND)

SD <- PQ / wr;




var <- 0

for (i in 1:2) {
  for (j in i:n) {

    var <- (tabela[i,j] * ((wr * d[i,j] - (PQ * (sum(tabela) - rowSums(tabela)[[i]])))^2)) + var
  } 
}


sterr <- sqrt(var * 4/(wr)^4)

G1 <- sprintf("%.2f%%", 100 * SD)
St1 <- sprintf("%.2f%%", 100 * sterr)

ldate[k] <-  paste(tab[[1]][[1]]) 
G[[k]] <- SD
st[[k]] <- sterr

tab <- tab[-c(1,2),]
  }

selectInput("gin", "Choose date", ldate)
  })

txt <- reactive({ input$gin }) 
output$value <- renderText({  
  paste("G is ", "\n", txt())  })


})

Answer 1

以下是具有无功值的修改代码。希望它有所帮助！

tab <- data.frame(Date = c("2008-11-28","", "2008-11-29",""), Category = c("Goods", "Bads", "Goods", "Bads"), 
                    "1"=c(1, 0, 2, 0), "2"=c(3,0,4, 0), "3"=c(28, 1, 29, 2), "4"=c(47,4, 48, 5), 
                    "5"=c(132, 9, 133, 10), "6"=c(123, 27, 124, 28), "7"=c(1, 2, 1, 2))

  ui <-  shinyUI(bootstrapPage(
    uiOutput("GD"),
    hr(),
    fluidRow(column(3, verbatimTextOutput("value")))
  ))

  server <- shinyServer(function(input, output) {

    vals <- reactiveValues(G = 0, st = 0, ldate = 0)


    output$GD <- renderUI({ 
      nBads <- sum(tab[nrow(tab),3:ncol(tab)])
      nGoods <- sum(tab[(nrow(tab)-1),3:ncol(tab)])
      nTotal <- nBads + nGoods


      options(warn=-1) 
      Outcome_color <- 0
      G <- 0  
      st <-0
      ldate <- 0
      for (k in (1:(nrow(tab)/2))) {

        tabela <- data.frame(tab[1:2,3:(ncol(tab))])
        rownames(tabela) <- c("Goods", "Bads")

        wr <- (sum(tabela)^2 - (rowSums(tabela)[[1]]^2 + rowSums(tabela)[[2]]^2))
        x <- which(tabela >= 0)
        y <- x[lapply(x,"%%",2)==0]
        y1 <- x[lapply(x,"%%",2)!=0]
        n <-length(y)


        a<-0; a1<-0; Nc<-0; A1x<-0; Nd<-0; D2x<-0;


        for (i in n:2 ) {

          c <- a
          a <- tabela[2, (y[i]/2)] + c
          Nc[i-1] <- a * tabela[1, i-1]
          A1x[i-1] <- a

          c1 <- a1
          a1 <- tabela[1, ((y1[i]+1)/2)] + c1
          Nd[i-1] <- a1 * tabela[2, i-1]
          D2x[i-1] <- a1
        }

        A1x[length(y)] <- 0
        D2x[length(y)] <- 0
        NC <- sum(Nc)
        ND <- sum(Nd)


        a2 <- 0; A2x <- 0; a3 <- 0; D1x <- 0; A2x[1] <- 0; D1x[1] <- 0;

        for (i in 1:(n-1)) {
          c2 <- a2
          a2 <- tabela[1, ((y1[i]+1)/2)] + c2
          A2x[i+1] <- a2 

          c3 <- a3
          a3 <- tabela[2, (y[i]/2)] + c3
          D1x[i+1] <- a3

        }

        A <- t(cbind(A1x, A2x))
        D <- t(cbind(D1x,D2x))
        d <- A-D
        PQ <- 2*(NC-ND)

        SD <- PQ / wr;




        var <- 0

        for (i in 1:2) {
          for (j in i:n) {

            var <- (tabela[i,j] * ((wr * d[i,j] - (PQ * (sum(tabela) - rowSums(tabela)[[i]])))^2)) + var
          } 
        }


        sterr <- sqrt(var * 4/(wr)^4)

        G1 <- sprintf("%.2f%%", 100 * SD)
        St1 <- sprintf("%.2f%%", 100 * sterr)

        vals$ldate[k] <-  paste(tab[[1]][[1]]) 
        vals$G[[k]] <- SD
        vals$st[[k]] <- sterr

        tab <- tab[-c(1,2),]
      }

      selectInput("gin", "Choose date", vals$ldate)
    })

    txt <- reactive({ input$gin }) 
    output$value <- renderText({  
      paste0(txt(), "\n G is" ,vals$G[which(vals$ldate == input$gin )], "\n st is", vals$st[which(vals$ldate == input$gin)])  
    })


  })  

  shinyApp(ui=ui, server=server)

Shiny中selectInput内的变量值

1 个答案: