У меня есть простое приложение Shiny, которое показывает мне множество картинок в таблице данных в блестящем виде.У меня 20 000 изображений, и я хочу удалить те, которые мне не нравятся.В тот момент, когда я удаляю строку, приложение переносит меня в начало таблицы данных, что бесполезно для такого количества изображений.
В качестве простого решения я подумал, что смогу убедиться, что приложение вернулось к изображению выше того, которое я только что удалил.Я предполагаю, что это будет управляться функцией JavaScript, но я не знаю, как это реализовать.Я полагаю, это должно быть размещено в разделе кода ниже tags$script.Может кто-нибудь показать мне, как / дать мне руководство о том, как реализовать эту функцию
Вот код для моего приложения:
сервер
library(shiny)
library(shinydashboard)
library(data.table)
library(DT)
server<-shinyServer(function(input, output) {
vals<-reactiveValues(myTabData = data.table(NULL))
vals$Data<-data.table(Endo_Endoscopist=DT$Endo_Endoscopist,
PatientID=DT$PatientID,
NBIorWLorFICE=DT$NBIorWLorFICE,
url=DT$url)
output$MainBody<-renderUI({
fluidPage(
box(width=12,
h3(strong("Actions on datatable with buttons"),align="center"),
hr(),
column(12,dataTableOutput("Main_table")),
tags$script("$(document).on('click', '#Main_table button', function () {
Shiny.onInputChange('lastClickId',this.id);
Shiny.onInputChange('lastClick', Math.random())
});")
)
)
})
output$Main_table<-renderDataTable({
DT=vals$Data
DT[["Actions"]]<-
paste0('
<div class="btn-group" role="group" aria-label="Basic example">
<button type="button" class="btn btn-secondary delete" id=delete_',1:nrow(vals$Data),'>Delete</button>
<button type="button" class="btn btn-secondary modify"id=modify_',1:nrow(vals$Data),'>Modify</button>
</div>
')
datatable(DT,
escape=F)}
)
output$downloadData <- downloadHandler(
filename = function() {
"Main_table.csv"
},
content = function(file) {
write.csv(vals$Data, file, row.names = FALSE)
# Warning: Error in write.table: unimplemented type 'list' in 'EncodeElement'
# write.csv(vals$Data, file, row.names = FALSE)
}
)
##Managing in row deletion
modal_modify<-modalDialog(
fluidPage(
h3(strong("Row modification"),align="center"),
hr(),
dataTableOutput('row_modif'),
actionButton("save_changes","Save changes"),
tags$script(HTML("$(document).on('click', '#save_changes', function () {
var list_value=[]
for (i = 0; i < $( '.new_input' ).length; i++)
{
list_value.push($( '.new_input' )[i].value)
}
Shiny.onInputChange('newValue', list_value)
});"))
),
size="l"
)
observeEvent(input$lastClick,
{
if (input$lastClickId%like%"delete")
{
row_to_del=as.numeric(gsub("delete_","",input$lastClickId))
vals$Data=vals$Data[-row_to_del]
}
else if (input$lastClickId%like%"modify")
{
showModal(modal_modify)
}
}
)
output$row_modif<-renderDataTable({
selected_row=as.numeric(gsub("modify_","",input$lastClickId))
old_row=vals$Data[selected_row]
row_change=list()
for (i in colnames(old_row))
{
if (is.numeric(vals$Data[[i]]))
{
row_change[[i]]<-paste0('<input class="new_input" type="number" id=new_',i,'><br>')
}
else
row_change[[i]]<-paste0('<input class="new_input" type="text" id=new_',i,'><br>')
}
row_change=as.data.table(row_change)
setnames(row_change,colnames(old_row))
browser()
DT=rbind(old_row,row_change)
rownames(DT)<-c("Current values","New values")
DT
},escape=F,options=list(dom='t',ordering=F),selection="none"
)
observeEvent(input$newValue,
{
newValue=lapply(input$newValue, function(col) {
if (suppressWarnings(all(!is.na(as.numeric(as.character(col)))))) {
as.numeric(as.character(col))
} else {
col
}
})
DF=data.frame(lapply(newValue, function(x) t(data.frame(x))))
colnames(DF)=colnames(vals$Data)
vals$Data[as.numeric(gsub("modify_","",input$lastClickId))]<-DF
}
)
})
UI
library(shiny)
library(shinydashboard)
ui<-fluidPage(dashboardBody(uiOutput("MainBody"),
downloadLink("downloadData", "Download"))
)