我正在尝试通过更改每个变量的类（字符串或字符）来更新表。我尝试了几种方法，但大部分方法都没有渲染。使用下面的代码中使用的方法，我可以只改变一次变量的类型，然后，表不再是被动的。
你知道我该怎么做吗？
library(DT)
library(shiny)
library(tidyverse)
server = shinyServer(function(input, output, session) {
current_stage <- reactiveValues(data=NULL)
mydata <- reactive({
df <- mtcars %>% rownames_to_column("model")
current_stage$data <- df
df
})
updateData = reactive({
df = mydata()
map(1:ncol(df), function(i){
if(length(input[[paste0("col", i)]])>0){
if (input[[paste0("col", i)]]=="num"){
df[,i] <<- unlist(df[,i]) %>% as.numeric
} else if (input[[paste0("col", i)]]=="cat"){
df[,i] <<- unlist(df[,i]) %>% as.character
}
}
})
#current_stage$data <- df
df
})
output$tableau <- DT::renderDataTable({
df <- current_stage$data
class <- map_df(df, typeof)
class <- gsub("double", "numeric", class)
class <- gsub("integer", "numeric", class)
tableSelectInput <- map(1:ncol(df),
function(i) {
if (class[i] =="numeric"){
opt1 <- "num"
opt2 <- "cat"
}else{
opt1 <- "cat"
opt2 <- "num"
}
selectInput(
inputId = paste0("col", i),
label = NULL, selected = opt1,
choices = c(opt1, opt2))
}
)
# I didn't find a more elegant way to turn '[[ ]]' in '[ ]'
l <- length(tableSelectInput)
selectin <- 1:l
type_cat <- 1:l
for (i in 1:l) {
selectin[i] = as.character(tableSelectInput[[i]])
pos=gregexpr("selected>",selectin[i])[[1]][1]
type_cat[i] = substr(selectin[i],(pos+9),(pos+11))
}
col_names = paste0(colnames(df), " <br/><em>(",type_cat,")</em><br/>", selectin)
isolate(DT::datatable(
current_stage$data,
options = list(
preDrawCallback = JS("function() {
Shiny.unbindAll(this.api().table().node()); }"),
drawCallback = JS("function() { Shiny.bindAll(this.api().table().node());
}")
),
colnames =col_names,
editable = TRUE,
escape=FALSE,
selection = list(target = 'column')))
}, server=FALSE)
output$log <- renderPrint({
updateData()
})
output$log2 <- renderPrint({
map_df(updateData(),class)
})
})
ui = shinyUI(
fluidPage(
titlePanel("My Awesome Shiny App"),
# Show a plot of the generated distribution
mainPanel(
DT::DTOutput("tableau"),
# Show log
verbatimTextOutput("log"),
verbatimTextOutput("log2")
)
)
)
runApp(list(ui = ui, server = server))
我认为输入按钮调用“col1”，“col2”等有问题。 我应该以不同的方式创造它们，但我不是我只是被困在那一刻。有人可以给我一个建议吗？
凯文
更新
我已经尝试过这段代码，但它看起来与Ajax有些麻烦：
DataTables警告：table id = DataTables_Table_0 - 无效的JSON响应。有关此错误的详细信息，请参阅http://datatables.net/tn/1“
library(DT)
library(shiny)
library(tidyverse)
server = shinyServer(function(input, output, session) {
current_stage <- reactiveValues(data=NULL, init=NULL,n=0)
mydata <- reactive({
df <- mtcars %>% rownames_to_column("model")
current_stage$data <- df
current_stage$init <- df
df
})
updateData = reactive({
# input$refresh
# df$ID <<- c(df$ID[n], df$ID[-n])
df = mydata()
if( !is.null(current_stage$data)){
df <- current_stage$data
map(1:ncol(df), function(i){
if(length(input[[paste0("col", i)]])>0){
if (input[[paste0("col", i)]]=="num"){
df[,i] <<- unlist(current_stage$init [,i]) %>% as.numeric
} else if (input[[paste0("col", i)]]=="cat"){
df[,i] <<- unlist(current_stage$init [,i]) %>% as.character
}
}
})}
# if(length(input[[paste0("col", 1)]])>0){
# if (input[[paste0("col", 1)]]=="num"){
# # message(proxy)
# df[,1] <- unlist(df[,1]) %>% as.numeric
# # # mydata()[,1] <- paste(proxy[,1],"ok")
# } else if (input[[paste0("col", 1)]]=="cat"){
# # # message(proxy)
# df[,1] <- unlist(df[,1]) %>% as.character
# }}
current_stage$data <- df
df
})
output$tableau <- DT::renderDataTable({
#df <- mtcars %>% rownames_to_column("model")
df <- mydata()
class <- map_df(df, typeof)
class <- gsub("double", "numeric", class)
class <- gsub("integer", "numeric", class)
tableSelectInput <- map(1:ncol(df),
function(i) {
if (class[i] =="numeric"){
opt1 <- "num"
opt2 <- "cat"
}else{
opt1 <- "cat"
opt2 <- "num"
}
selectInput(
inputId = paste0("col", i),
label = NULL, selected = opt1,
choices = c(opt1, opt2))
}
)
# I didn't find a more elegant way to turn '[[ ]]' in '[ ]'
l <- length(tableSelectInput)
selectin <- 1:l
type_cat <- 1:l
for (i in 1:l) {
selectin[i] = as.character(tableSelectInput[[i]])
pos=gregexpr("selected>",selectin[i])[[1]][1]
type_cat[i] = substr(selectin[i],(pos+9),(pos+11))
}
col_names = paste0( colnames(df), " <br/><em>(",type_cat,")</em><br/>", selectin)
DT::datatable(isolate(
updateData()),
options = list(
preDrawCallback = JS("function() {
Shiny.unbindAll(this.api().table().node()); }"),
drawCallback = JS("function() { Shiny.bindAll(this.api().table().node());
}")
),
colnames =col_names,
editable = TRUE,
escape=FALSE,
selection = list(target = 'column'))
}, server=FALSE)
proxy <- dataTableProxy('tableau')
observe({
replaceData(proxy, updateData(), resetPaging = TRUE )
})
output$log <- renderPrint({
updateData()
})
})
ui = shinyUI(
fluidPage(
titlePanel("My Awesome Shiny App"),
# Show a plot of the generated distribution
mainPanel(
DT::DTOutput("tableau"),
# Show log
verbatimTextOutput("log")
)
)
)
runApp(list(ui = ui, server = server))