У меня есть функциональное блестящее приложение, логика которого описана ниже:
Логика приложения:
Пользователь выбирает один из тестов, используя selectInput () «Метка». Это основная операция, и тогда он может изменить ее имя, например, Тест 1 на Тест А. Затем пользователь может добавить элементы в Тест с помощью numericInput () «Элементы в Тесте». Это общие предметы. Как вы увидите, количество «Предметов в тесте» совпадает со столбцом «Доступно» в таблице hot3 для выбранного теста. С помощью «Выбрать элементы» он может выбирать конкретные элементы для отображения в таблице hot5. Затем пользователь может щелкнуть таблицу hot5, чтобы выбрать конкретный элемент, и количество выбранных элементов (или строк) отобразится в таблице hot3 под столбцом «Sel» для этого конкретного теста. «Выбранные элементы» просто отображают количество элементов, выбранных в «Выбрать элементы». Обратите внимание, что каждая модификация, которая происходит с таблицей, не зависит от других виджетов. Это означает, например, что нет необходимости менять имя метки.
Выпуск:
Проблема в том, что сейчас горячая таблица 3 (слева) не обновляется, если я не изменю имя «Метка», которое не должно быть таким, поскольку это дополнительная функция, как и все остальное. Например, я могу выбрать «Тест 1», но я не хочу менять его название. Тогда, если я выберу кнопку отправки, таблица слева не обновится. Если я переименую его в sth else (даже «Тест 1»), это сработает. Но это должно работать в любом случае.
library(shiny)
library(DT)
library(rhandsontable)
#library(tidyverse)
ui <- navbarPage(
"Application",
tabPanel("Booklets",
sidebarLayout(
sidebarPanel(
uiOutput("tex2"),
rHandsontableOutput("hot3")
),
mainPanel(
fluidRow(
wellPanel(
fluidRow(
column(4,
DT::dataTableOutput("hot5")
),
column(4,
fluidRow(
uiOutput("book3"),
uiOutput("book6")
),
fluidRow(
uiOutput("book1"),
uiOutput("book10"),
uiOutput("book11")
),
fluidRow(actionButton("submit","submit"))
)
))
)
)
)
)
)
#server
server <- function(input, output, session) {
rv<-reactiveValues()
output$tex2<-renderUI({
numericInput("text2", "#tests", value = 1, min=1)
})
output$book1<-renderUI({
numericInput("bk1",
"Items in test",
value = 1,
min = 1)
})
output$book3<-renderUI({
selectInput("bk3",
"Label",
choices=(paste("Test",1:input$text2)))
})
output$book6<-renderUI({
textInput("bk6", "Change to",
value=NULL
)
})
output$book10<-renderUI({
# changed from selectize
selectizeInput(
"bk10", "Select Items", choices =1:10000,multiple =T,selected = 1,
options = list(maxItems = input$bk1))#changed from
})
output$book11<-renderUI({
textInput("bk11", "Items chosen",
value = nrow(rt5())
)
})
#rt4<-reactive({
observe({
req(input$text2)
rv$rt4 = data.frame(
SNo = rep(TRUE, input$text2),
Test=paste(1:input$text2),
Label=paste("Test",1:input$text2),
Avail=1L,
Sel =as.integer(rep.int(0,input$text2)),
stringsAsFactors = FALSE)
})
observeEvent(input$submit,{
# rt4 <- reactive({
if (is.null( rv$rt4))
return(NULL)
if(!is.null(input$bk6) && input$bk6!=""){
rv$rt4[ rv$rt4$Label==input$bk3, "Avail"] <- input$bk1
rv$rt4[ rv$rt4$Label==(input$bk3), "Sel"] <- length(input$hot5_rows_selected)
rv$rt4[ rv$rt4$Label==input$bk3, "Label"] <- input$bk6
}
# if(!is.null(input$hot5_rows_selected) && input$hot5_rows_selected!=""){
#
# }
})
observeEvent(input$submit,{
updateSelectInput(session,"bk3","Label", choices=rv$rt4$Label)
}
)
rt55<-reactive({
DF=data.frame(
Id= input$bk10,
Label=paste("Item",input$bk10),
Pf=0,
stringsAsFactors = FALSE
)
})
rt5<-reactive({
DF=data.frame(
Id= input$bk10,
Label=paste("Item",input$bk10),
Pf=0,
stringsAsFactors = FALSE
)
cbind(id=rowSelected(), DF)
})
rowSelected <- reactive({
x <- numeric(nrow(rt55()))
x[input$hot5_rows_selected] <- 1
x
})
output$hot5 <- renderDT(datatable(rt5()[,-1],
selection = list(mode = "multiple",
selected = (1:nrow(rt5()[,-1]))[as.logical(rowSelected())],
target = "row"),rownames = F)
)
output$hot3 <-renderRHandsontable({
req(input$text2)
rhandsontable(rv$rt4)
})
}
shinyApp(ui,server)