我正在为体育比赛创建一个闪亮的应用程序。我有一个玩家列表作为输入。使用roundrubin算法（https://en.wikipedia.org/wiki/Round-robin_tournament）我创建一个圆形匹配列表。此处显示算法的代码。 （对于guyroot函数，需要＆＃34; wavethresh＆＃34;包。）
roundrubin <- function(listplayer){
n <- length(listplayer)
if(n%%2==1){
listplayer <- append(listplayer,"dummy")
n <- n+1
}
listround <- list()
round1 <- list()
for(i in 1:(n/2)){
round1[[i]] <- c(listplayer[i],listplayer[n+1-i])
}
ind <- which(!is.na(lapply(1:(n/2),function(i){
match("dummy",round1[[i]])})))
if(length(ind)!=0){
round1 <- round1[-ind]
}
listround[[1]] <- round1
for(i in 2:n-1){
listplayer <- append(guyrot(listplayer[-1],1),listplayer[1],after=0)
listround[[i]] <- list()
for(j in 1:(n/2)){
listround[[i]][[j]] <- c(listplayer[j],listplayer[n+1-j])
}
ind <- which(!is.na(lapply(1:(n/2),function(k){
match("dummy",listround[[i]][[k]])})))
if(length(ind)!=0){
listround[[i]] <- listround[[i]][-ind]
}
}
return(listround)
}
在我的闪亮应用程序中，我能够显示要与textinput一起完成的匹配列表，用户可以在其中编写分数。打印具有要评估的排名的表。
我的问题是我在实际打印表格之前有错误。
以下是该应用的代码。
shinyApp(
ui=fluidPage(
titlePanel("title"),
sidebarLayout(
sidebarPanel(uiOutput("scoreboard")),
mainPanel(uiOutput("round"))
)
),
server=function(input, output){
lengthlistplayer <- length(listplayer)
lengthlistround <- length(listround)
lengthround <- length(listround[[1]])
output$scoreboard <- renderTable({
player <- vector("list",lengthlistplayer)
for(i in 1:lengthlistplayer){
player[[i]] <- data.frame("point"=0,"diff"=0)
for(j in 1:lengthlistround){
k <- 1
while(k<=lengthround){
playerinput1 <- listround[[j]][[k]][1]
playerinput2 <- listround[[j]][[k]][2]
if(playerinput1==listplayer[i]){
winner <- ifelse(as.numeric(input[[paste(playerinput1,j,sep="")]])>
as.numeric(input[[paste(playerinput2,j,sep="")]]),
TRUE,FALSE)
diff <- as.numeric(input[[paste(playerinput1,j,sep="")]])-
as.numeric(input[[paste(playerinput2,j,sep="")]])
point <- ifelse(winner,3,0)
value <- c(point,diff)
player[[i]] <- player[[i]] + value
k <- lengthround+1
} else if(playerinput2==listplayer[i]){
winner <- ifelse(as.numeric(input[[paste(playerinput2,j,sep="")]])>
as.numeric(input[[paste(playerinput1,j,sep="")]]),
TRUE,FALSE)
diff <- as.numeric(input[[paste(playerinput2,j,sep="")]])-
as.numeric(input[[paste(playerinput1,j,sep="")]])
point <- ifelse(winner,3,0)
value <- c(point,diff)
player[[i]] <- player[[i]] + value
k <- lengthround+1
} else {
k <- k+1
}
}
}
}
scoreboard <- do.call(rbind,player)
scoreboard <- cbind("Player"=listplayer,scoreboard)
scoreboard <- scoreboard %>% arrange(desc(point),desc(diff))
scoreboard
},digits=0,include.rownames=FALSE)
output$round <- renderUI({
listobject <- lapply(1:lengthlistround,
function(i){
roundoutput <- paste("roundoutput",i,sep="")
fluidRow(uiOutput(roundoutput),
hr())
})
listobject <- lapply(split(listobject,
(seq.int(lengthlistround)-1)%/%2),function(x){
column(12/2, x)
})
do.call(tagList,listobject)
})
for(i in 1:lengthlistround){
local({
my_i <- i
list <- listround[[my_i]]
roundoutput <- paste("roundoutput",my_i,sep="")
output[[roundoutput]] <- renderUI({
listobject <- lapply(1:lengthround,function(i){
fluidRow(tags$style("display: inline-block;"),
textInputLeft(inputId=paste(list[[i]][1],my_i,sep=""),
label=list[[i]][1],value=0),
textInputRight(inputId=paste(list[[i]][2],my_i,sep=""),
label=list[[i]][2],value=0)
)
})
do.call(tagList,listobject)
})
})
}
}
)
两个调优函数＆＃34; textInputLeft＆＃34;和＆＃34; textInputRight＆＃34;在这里显示。
textInputLeft<-function (inputId, label, value = "",...){
div(style="display:inline-block;",
tags$label(label, `for` = inputId,style="text-align:right; width:80px"),
tags$input(id=inputId, type="text",size=2, value=value,
style="text-align:center;",...))
}
textInputRight<-function (inputId, label, value = "",...){
div(style="display:inline-block",
tags$label(label, `for` = inputId,style="float:right; text-align:left;"),
tags$input(id=inputId, type="text",size=2, value=value,
style="text-align:center;",...))
}
现在对我的应用程序并不重要，因为无论如何都要打印表格。但是当我尝试在textInput中使用用户给出的玩家名称时，表格根本不打印。
我找不到发生此错误的原因。我不明白我在renderTable中创建表的方式有什么问题。
你有什么建议吗？
我的会话信息：
R version 3.2.4 Revised (2016-03-16 r70336)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 7 x64 (build 7601) Service Pack 1
locale:
[1] LC_COLLATE=French_France.1252 LC_CTYPE=French_France.1252
[3] LC_MONETARY=French_France.1252 LC_NUMERIC=C
[5] LC_TIME=French_France.1252
attached base packages:
[1] stats graphics grDevices utils datasets methods base
other attached packages:
[1] dplyr_0.4.3 shiny_0.13.2 wavethresh_4.6.6 MASS_7.3-45
修改1
使用此脚本更新表时没有任何错误。
shinyApp(
ui=fluidPage(
uiOutput("output")),
server=function(input, output){
lengthlistnom <- length(listnom)
lengthlistround <- length(listround)
lengthround <- length(listround[[1]])
output$output <- renderUI({
tabsetPanel(
tabPanel("round",uiOutput("round")),
tabPanel("score",uiOutput("scoreboard"))
)
})
output$round <- renderUI({
listobject <- lapply(1:lengthlistround,
function(i){
roundoutput <- paste("roundoutput",i,sep="")
fluidRow(uiOutput(roundoutput),
hr())
})
listobject <- lapply(split(listobject,
(seq.int(lengthlistround)-1)%/%2),function(x){
column(12/2, x)
})
do.call(tagList,listobject)
})
for(i in 1:lengthlistround){
local({
my_i <- i
list <- listround[[my_i]]
roundoutput <- paste("roundoutput",my_i,sep="")
output[[roundoutput]] <- renderUI({
listobject <- lapply(1:lengthround,function(i){
fluidRow(tags$style("display: inline-block;"),
textInputLeft(inputId=paste(list[[i]][1],my_i,sep=""),
label=list[[i]][1],value=0),
textInputRight(inputId=paste(list[[i]][2],my_i,sep=""),
label=list[[i]][2],value=0)
)
})
do.call(tagList,listobject)
})
})
}
output$scoreboard <- renderTable({
player <- vector("list",lengthlistround)
for(i in 1:lengthlistnom){
player[[i]] <- data.frame("point"=0,"diff"=0)
for(j in 1:lengthlistround){
k <- 1
while(k<=lengthround){
nominput1 <- listround[[j]][[k]][1]
nominput2 <- listround[[j]][[k]][2]
if(nominput1==listnom[i]){
winner <- ifelse(as.numeric(input[[paste(nominput1,j,sep="")]])>
as.numeric(input[[paste(nominput2,j,sep="")]]),
TRUE,FALSE)
diff <- as.numeric(input[[paste(nominput1,j,sep="")]])-
as.numeric(input[[paste(nominput2,j,sep="")]])
point <- ifelse(winner,3,0)
value <- c(point,diff)
player[[i]] <- player[[i]] + value
k <- lengthround+1
} else if(nominput2==listnom[i]){
winner <- ifelse(as.numeric(input[[paste(nominput2,j,sep="")]])>
as.numeric(input[[paste(nominput1,j,sep="")]]),
TRUE,FALSE)
diff <- as.numeric(input[[paste(nominput2,j,sep="")]])-
as.numeric(input[[paste(nominput1,j,sep="")]])
point <- ifelse(winner,3,0)
value <- c(point,diff)
player[[i]] <- player[[i]] + value
k <- lengthround+1
} else {
k <- k+1
}
}
}
}
scoreboard <- do.call(rbind,player)
scoreboard <- cbind("Player"=listnom,scoreboard)
scoreboard <- scoreboard %>% arrange(desc(point),desc(diff))
scoreboard
},digits=0,include.rownames=FALSE)
}
)
不同之处在于该表位于tabPanel中，而不在侧栏中。
答案 0 :(得分：0)
确实是一个很老的问题，但我还是会回答。
问题在于，第一次调用renderTable时，尚未创建输入。正是出于这个目的，req（根据需要）可以使用。因此，您需要在input[[<whatever>]]中包装对req的第一个调用，以确保它不是NULL。在您当前的实现中，输入为NULL，而ifs返回logical(0)而不是TRUE或FALSE
output$scoreboard <- renderTable({
player <- vector("list",lengthlistplayer)
for(i in 1:lengthlistplayer){
player[[i]] <- data.frame("point"=0,"diff"=0)
for(j in 1:lengthlistround){
k <- 1
while(k<=lengthround){
playerinput1 <- listround[[j]][[k]][1]
playerinput2 <- listround[[j]][[k]][2]
score1 <- as.numeric(req(input[[paste(playerinput1,j,sep="")]]))
score2 <- as.numeric(req(input[[paste(playerinput2,j,sep="")]]))
if(playerinput1==listplayer[i]){
winner <- score1 > score2
diff <- score1 - score2
point <- ifelse(winner,3,0)
value <- c(point, diff)
player[[i]] <- player[[i]] + value
k <- lengthround+1
} else if(playerinput2==listplayer[i]){
winner <- score2 > score1
diff <- score2 - score1
point <- ifelse(winner,3,0)
value <- c(point,diff)
player[[i]] <- player[[i]] + value
k <- lengthround+1
} else {
k <- k+1
}
}
}
}
scoreboard <- do.call(rbind,player)
scoreboard <- cbind("Player"=listplayer,scoreboard)
scoreboard <- scoreboard %>% arrange(desc(point),desc(diff))
scoreboard
},digits=0,include.rownames=FALSE)
应该做到这一点。
注意。您的代码可以简化，因为ifs是非常对称的。