我有一个闪亮的应用程序,接受用户输入,其中x和y变量绘制,并能够根据用户输入过滤它 .

Image of app seen here
我希望能够做的是根据用户指定的组对数据进行分组(样本中只列出了物种,但我的实际代码将使用许多不同的输入进行分组,多个= FALSE),并且具有数据调整,以便它取每个唯一用户指定组的平均值并绘制结果 . 因此,在此示例中,仅显示3个数据点,一个用于虹膜数据集中的每个物种 . 具体使用假设的用户输入x = Petal.Length和y = Petal.Width的setosa物种,数据点将绘制在x = setosa的平均值Petal.Lengths和y = setosa Petal.Widths的平均值 . 我使用基本的R plot函数运行它,这就是我希望它看起来像ggvis的结果:

Desired Result Image

这是通过以下代码在单独的脚本中完成的:

alldata <- as.data.frame(iris)


splitDataX <- split(alldata$`Petal.Length`, alldata$`Species`, drop = FALSE)
meanXvar <- lapply(splitDataX, mean)

splitDataY <- split(alldata$`Petal.Width`, alldata$`Species`, drop = FALSE)
meanYvar <- lapply(splitDataY, mean)

plot(meanXvar, meanYvar)

正如我现在所做的那样,当我尝试通过每个x和y变量的平均值对物种数据进行分组时,应用程序崩溃了 . 如果它是独立的话,else部分按预期工作 .

# GLOBAL

#Check packages to use in library
library('shiny') #allows for the shiny app to be used
library('stringr') #string opperator
library('ggvis') #allows for interactive ploting
library('dplyr')

alldata <- iris

#Establish options for drop down menus
specieschoices <- unique(as.character(alldata$Species))
petalwchoices <- unique(as.character(alldata$Petal.Width))
petallchoices <- unique(as.character(alldata$Petal.Length))
sepallchoices <- unique(as.character(alldata$Sepal.Length))
sepalwchoices <- unique(as.character(alldata$Sepal.Width))

# UI

ui<-fluidPage(
titlePanel("Explorer"),
fluidRow(
column(4,
       wellPanel(
         h4("Apply Filters"),
         selectInput(inputId = "species", label="Select a Species:", choices = sort(specieschoices), selected=specieschoices, multiple = TRUE, selectize = TRUE),
         selectInput(inputId = "petalw", label="Select Petal Width:", choices = sort(petalwchoices), selected=petalwchoices, multiple = TRUE, selectize = FALSE),
         selectInput(inputId = "petall", label="Select Petal Length", choices = sort(petallchoices), selected=petallchoices, multiple = TRUE, selectize = FALSE),
         selectInput(inputId = "sepall", label="Select Sepal Length", choices = sort(sepallchoices), selected=sepallchoices, multiple = TRUE, selectize = FALSE),
         selectInput(inputId = "sepalw", label="Select Sepal Width", choices = sort(sepalwchoices), selected=sepalwchoices, multiple = TRUE, selectize = FALSE),
         checkboxInput(inputId = "groupdata", label="Group Data for Mean Analysis", value = FALSE),
         conditionalPanel(
           condition = "input.groupdata == true",
           wellPanel(
             selectInput(inputId = "group", label = "Select Filter to Group By", choices = as.character("Species"), selected = "Species", multiple = FALSE, selectize = TRUE)
           ))
       )),
column(8,
       ggvisOutput("plot1")
),
column(4,
       wellPanel(
         h4("Data Variables"),
         selectInput(inputId = "x", label="Select x-axis Variable:", choices=as.character(names(alldata[,1:4])),selected='Petal.Length', multiple = FALSE),
         selectInput(inputId = "y", label="Select y-axis Variable:", choices=as.character(names(alldata[,1:4])),selected='Petal.Width', multiple = FALSE)
       ))
))

#SERVER
server<-function(input,output,session)
{

#Set up reactive variables
filteredData <- reactive({

#Apply filters
m <- alldata %>% filter(
  `Species` %in% input$species,
  `Petal.Width` %in% input$petalw,
  `Petal.Length` %in% input$petall,
  `Sepal.Width` %in% input$sepalw,
  `Sepal.Length` %in% input$sepall
)
m <- droplevels(as.data.frame(m))
m
})

vis <- reactive({

################## THIS IS THE SECTION THAT I NEED HELP WITH #################
if (input$groupdata == TRUE) {
  splitDataX <- split(input$x %>% filteredData(), input$group %>% alldata, drop = FALSE)
  meanXvar <- lapply(splitDataX, mean)
  xvar <- prop("x", as.symbol(meanXvar))

  splitDataY <- split(input$y %>% filteredData(), input$group %>% alldata, drop = FALSE)
  meanYvar <- lapply(splitDataY, mean)
  yvar <- prop("y", as.symbol(meanYvar))
}

else {
  xvar <- prop("x", as.symbol(input$x))
  yvar <- prop("y", as.symbol(input$y))
}
##############################################################################

#Plot Data with Visualization Customization
p1 = filteredData() %>%
  ggvis(x = xvar, y = yvar) %>%
  layer_points(size.hover := 200,
               fillOpacity:= 0.5, fillOpacity.hover := 1,
               fill = ~Species
  ) %>%

  #Specifies the size of the plot
  set_options(width = 800, height = 450, duration = 0)

})

#Actually plots the data
vis %>% bind_shiny("plot1")
}

#Run the Shiny App to Display Webpage
shinyApp(ui=ui, server=server)