我创建了一个R Shiny应用程序，以帮助我简化一些用于处理高维化学成分数据的常见数据清洗任务。具体来说，该应用程序使用fluidPage ui和ggplot / plotly界面创建具有用户选择的X和Y变量以及颜色/符号属性的双线图。 event_data函数允许用户查看与他们通过矩形选择或套索交互选择的点相关的属性。我是Shiny的新手，所以代码不是很好，但是我已经完成了所有上述操作。
我希望添加一个附加功能，并且坚持使用最好的方法来解决此问题。具体来说，我希望能够为给定图中当前选择的点更改数据集中的一个字段。我当前的想法是输入文本字段，该文本字段使我可以在该字段中输入想要的新值，并使用actionButton执行更改。
我发现链接到here的问题的答案非常有用，但是我仍然没有设法使它起作用。下面是我当前的应用程序脚本和现在的输出屏幕截图。
对于新方法的任何帮助或建议，将不胜感激。
library(plotly)
library(shiny)
library(knitr)
library(kableExtra)
myApp <- function(attributes,dat1) {
dataset <- cbind(attributes,dat1)
ui <- fluidPage(
plotlyOutput('plot', width='1000px', height='600px'),
fluidRow(
column(2,
selectInput('xvar','X',names(dat1)),
selectInput('yvar','Y',names(dat1))),
column(3,offset=0.5,
selectInput('Code','GROUP',names(attributes)),
checkboxInput('Conf','Confidence Hull',value=TRUE)),
column(3,offset=0.5,
actionButton('Change','Change Group Assignment'),
textInput('NewGroup', label = 'Enter new group designation')),
column(3,offset=0.5,
actionButton("exit", label = "Return to R and write data"))),
verbatimTextOutput('brush')
)
server <- function(input, output) {
data.sel <- reactive({
dataset[,c(input$xvar,input$yvar,input$Code)]
})
output$plot <- renderPlotly({
p <- ggplot(data.sel(), aes(x=data.sel()[,1], y=data.sel()[,2],
color=data.sel()[,3], shape=data.sel()[,3])) +
geom_point() +
labs(x=input$xvar,y=input$yvar)
if(input$Conf) {p <- p + stat_ellipse(level=0.95)}
ggplotly(p) %>% layout(dragmode = 'select')
})
output$brush <- renderPrint({
d <- event_data('plotly_selected')
dd <- round(cbind(d[[3]],d[[4]]),3)
vv <- attributes[which(round(data.sel()[,1],3) %in% dd[,1] &
round(data.sel()[,2],3) %in% dd[,2]),]
if (is.null(d)) 'Click and drag events (i.e., select/lasso) appear here
(double-click to clear)' else kable(vv)
})
observe({
if(input$exit > 0)
stopApp()})
}
runApp(shinyApp(ui, server))
return(dataset)
}
为了对此进行测试，您可以使用虹膜数据的修改版本，如下所示。本质上，我希望能够更改要添加到虹膜数据中的新变量中的文本。
iris2 <- cbind(iris,rep('A',150))
names(iris2)[6] <- 'Assignment'
myApp(iris2[,5:6],iris2[,-(5:6)])
这是正在运行的应用程序的屏幕截图。我已经包括了与建议的解决方案一起使用的按钮，但是它们目前不起作用。
屏幕截图:
最佳答案
一旦了解了响应式语句中的范围分配在Shiny中的工作原理，便能够按我最初的意图工作。现在，该应用程序几乎可以完成我想要做的所有事情，尽管我觉得此时代码实际上已经拼凑在一起，并且需要在许多方面进行修复。特别是我有一个非常麻烦的解决方案，可以在原始数据框中查找选定的项目，因为我真的不喜欢curvenumber / pointnumber索引系统。
library(plotly)
library(shiny)
library(knitr)
library(kableExtra)
theme_set(theme_light())
myApp <- function(attributes,dat1) {
dataset <- cbind(attributes,dat1)
vv <- NULL
ui <- fluidPage(
plotlyOutput('plot', width='1000px', height='600px'),
fluidRow(
column(2,
selectInput('xvar','X',names(dat1),selected='cs'),
selectInput('yvar','Y',names(dat1),selected='ta')),
column(3,offset=0.5,
selectInput('Code','GROUP',names(attributes),selected='CORE'),
checkboxInput('Conf','Confidence Elipse',value=TRUE),
sliderInput('int.set','Set Confidence Interval',min=0.80,max=0.99,step=0.01,value=0.95)),
column(3,offset=0.5,
br(),
actionButton('Change','Change Group Assignment'),
textInput('NewGroup', label = 'Enter new group designation')),
column(3,offset=0.5,
br(),
actionButton('refresh', label='Refresh Plot with New Assignments'),
br(),br(),
actionButton("exit", label = "Return to R and write data"))),
verbatimTextOutput('brush')
)
server <- function(input, output) {
values <- reactiveValues(vv = NULL)
data.sel <- reactive({
dataset[,c(input$xvar,input$yvar,input$Code)]
})
output$plot <- renderPlotly({
g1 <- data.sel()
p <- ggplot(g1, aes(x=g1[,1], y=g1[,2], color=g1[,3], shape=g1[,3])) +
geom_point() +
labs(x=input$xvar,y=input$yvar,color=input$Code,shape=input$Code)
if(input$Conf) {p <- p + stat_ellipse(level=input$int.set)}
ggplotly(p) %>% layout(dragmode = 'select')
})
output$brush<- renderPrint({
g1 <- data.sel()
d <- event_data('plotly_selected')
dd <- round(cbind(d[[3]],d[[4]]),3)
vv <- attributes[which(round(g1[,1],3) %in% dd[,1] & round(g1[,2],3) %in% dd[,2]),]
vv <<- vv
if (is.null(vv)) "Click and drag events (i.e., select/lasso) appear here (double-click to clear)" else kable(vv)
})
observeEvent(input$Change > 0, {
if (!is.null(vv)) {
dataset[which(row.names(dataset) %in% row.names(vv)),]$CORE <<-
input$NewGroup
}})
observe({
if(input$exit > 0)
stopApp()})
}
runApp(shinyApp(ui, server))
return(dataset)
}
还有一些测试数据
data(iris)
iris2 <- cbind(iris,rep('a',nrow(iris)))
names(iris2)[6] <- 'CORE'
out <- myApp(iris2[,5:6],iris2[,1:4])
关于r - Shiny R应用程序，允许用户通过套索选择来修改数据框，我们在Stack Overflow上找到一个类似的问题：https://stackoverflow.com/questions/49462384/