我正在尝试根据不同因素过滤反应数据集。但是，根据用户过滤数据的方式，我在更新数据集时遇到了一些困难。下面是我正在使用的数据集的子集以及用于创建闪亮Ap的ui和服务器文件。
加载包
library (shiny)
library(ggvis)
library(dplyr)
我使用的数据框：
Flux_Data_df<- structure(list(Site_ID = structure(c(1L, 3L, 5L, 7L, 8L), .Label = c("AR-Slu",
"AR-Vir", "AU-Tum", "AU-Wac", "BE-Bra", "BE-Jal", "BE-Vie", "BR-Cax",
"BR-Ma2", "BR-Sa1", "BR-Sa3", "BW-Ma1", "CA-Ca1", "CA-Ca2", "CA-Ca3",
"CA-Gro", "Ca-Man", "CA-NS1", "CA-NS2", "CA-NS3", "CA-NS4", "CA-NS5",
"CA-NS6", "CA-NS7", "CA-Oas", "CA-Obs", "CA-Ojp", "CA-Qcu", "CA-Qfo",
"CA-SF1", "CA-SF2", "CA-SF3", "CA-SJ1", "CA-SJ2", "CA-SJ3", "CA-TP1",
"CA-TP2", "CA-TP3", "CA-TP4", "CA-Wp1", "CN-Bed", "CN-Cha", "CN-Din",
"CN-Ku1", "CN-Qia", "CZ-Bk1", "De-Bay", "DE-Hai", "DE-Har", "DE-Lkb",
"DE-Meh", "DE-Obe", "DE-Tha", "DE-Wet", "DK-Sor", "ES-Es1", "FI-Hyy",
"FI-Sod", "FR-Fon", "FR-Hes", "FR-Lbr", "FR-Pue", "GF-Guy", "ID-Pag",
"IL-Yat", "IS-Gun", "IT-Col", "IT-Cpz", "IT-Lav", "IT-Lma", "IT-Noe",
"IT-Non", "IT-Pt1", "IT-Ro1", "IT-Ro2", "IT-Sro", "JP-Tak", "JP-Tef",
"JP-Tom", "MY-Pso", "NL-Loo", "PA-Spn", "PT-Esp", "RU-Fyo", "RU-Skp",
"RU-Zot", "SE-Abi", "SE-Fla", "SE-Nor", "SE-Sk1", "SE-Sk2", "SE-St1",
"UK-Gri", "UK-Ham", "US-Bar", "US-Blo", "US-Bn1", "US-Bn2", "Us-Bn3",
"US-Dk2", "US-Dk3", "US-Fmf", "US-Fuf", "US-Fwf", "US-Ha1", "US-Ha2",
"US-Ho1", "US-Ho2", "US-Lph", "US-Me1", "US-Me3", "US-Me4", "US-Me6",
"US-Moz", "US-NC1", "US-Nc2", "US-NR1", "US-Oho", "US-So2", "US-So3",
"US-Sp1", "US-Sp2", "US-Sp3", "US-Syv", "US-Umb", "US-Wbw", "US-Wcr",
"US-Wi0", "US-Wi1", "US-Wi2", "US-Wi4", "US-Wi8", "VU-Coc", "CA-Cbo",
"CN-Lao", "ID-Buk", "JP-Fuj", "RU-Ab", "RU-Be", "RU-Mix"), class = "factor"),
Ecosystem = structure(c(5L, 3L, 5L, 5L, 3L), .Label = c("DBF",
"DNF", "EBF", "ENF", "MF", "SHB", "WSA"), class = "factor"),
Climate = structure(c(3L, 3L, 3L, 3L, 4L), .Label = c("Arid",
"Continental", "Temperate", "Tropical"), class = "factor"),
Management = structure(c(4L, 2L, 3L, 4L, 4L), .Label = c("High",
"Low", "Moderate", "None"), class = "factor"), Stand_Age = c(50,
99, 77.0833333333333, 66.2, 97), NEP = c(1262.24986565392,
251.665998718498, 89.590110051402, 467.821910494384, 560),
GPP = c(2437.9937774539, 1837.82835206203, 1353.91140903122,
1740.68843840394, 3630), NEP_GPP = c(0.517741217113419, 0.143353622997247,
0.0760076059028116, 0.270737440100469, 0.1542699725), Uncert = c(7.29706486170583,
12.3483066698996, 7.59406340226036, 8.2523670901841, 12.1
), Gap_filled = c(0.953310527540233, 0.969648973753497, 0.9395474605477,
0.923408280276339, 1), MAT = c(19.0438821722383, 9.67003296799878,
10.7728316162948, 8.2796213684244, 27.341666667), MAT_An = c(-0.0413522012578611,
0.840055031446541, 0.705896226415094, 0.805524109014675,
0.191666666666667), MAT_Trend = c(0.0119577487502016, 0.0196238509917756,
0.0305871364833632, 0.0381007095629741, 0.0194619147449338
), MAP = c(351.700001291931, 1107.49999958277, 844.158499979666,
998.205467054248, 2279.5), MAP_CRU = c(592.2, 850.925, 852.591666666667,
1098.98, 2279.5), SPI_CRU_Mean = c(-0.352735702252502, 0.188298093749456,
0.0830157542916604, 0.397632136136383, 1.31028809089487),
MAP_An = c(4.14188988095238, -15.8198660714286, 5.39074900793651,
2.28799107142857, 1.55565476190476), MAP_Trend = c(1.38787584993337,
0.147192657259031, 0.747167885331603, 0.104885622031644,
0.841903850753408), CEC_Total_1km = c(14.05, 10.25, 17.975,
21, 9.95), Clay_Silt = c(36.65, 42.125, 32.275, 55, 54.825
), Clay_1km = c(26.425, 31.425, 11.25, 22.45, 38.075), Silt_1km = c(10.225,
10.7, 21.025, 32.55, 16.75), Sand_1km = c(63.35, 57.325,
67.65, 45, 45.275), NOy = c(1.73752826416889, 2.76055219091326,
4.96187381895543, 5.06857284157762, 0.90948457442513), NHx = c(2.50363534311763,
2.99675999696687, 11.2747222582845, 13.9207300067467, 1.53292533883169
), Soil_C_1km = c(3.6, 17, 23.575, 26.65, 8.15), Lat = c(-33.4648,
-35.6566, 51.3092, 50.3051, -1.72000003), Long = c(-66.4598,
148.1516, 4.5206, 5.9981, -51.4500008)), .Names = c("Site_ID",
"Ecosystem", "Climate", "Management", "Stand_Age", "NEP", "GPP",
"NEP_GPP", "Uncert", "Gap_filled", "MAT", "MAT_An", "MAT_Trend",
"MAP", "MAP_CRU", "SPI_CRU_Mean", "MAP_An", "MAP_Trend", "CEC_Total_1km",
"Clay_Silt", "Clay_1km", "Silt_1km", "Sand_1km", "NOy", "NHx",
"Soil_C_1km", "Lat", "Long"), row.names = c(NA, 5L), class = "data.frame")
选择x和y变量以选择
axis_vars <- c(
"NEP observed [gC.m-2.y-1]" = "NEP",
"NEP predicted [gC.m-2.y-1]" = "prediction",
"CUEe" = "NEP_GPP",
"GPP [gC.m-2.y-1]" = "GPP",
"Forest Age [years]" = "Stand_Age",
"MAT [°C]" = "MAT",
"SPI" = "SPI_CRU_Mean",
"MAP [mm.y-1]" = "MAP",
"MAP trend [mm.y-1]" = "MAP_Trend",
"MAT tremd [°C.y-1]" = "MAT_Trend",
"Clay content [kg.kg-1]" = "Clay_1km",
"N deposition [kg N.ha-1.y-1]" = "NHx"
)
ui文件：
ui<- shinyUI(fluidPage(
titlePanel("Data exploration"),
p('Interactive tool for data exploration'),
em('by, ', a('Simon Besnard', href = 'http://www.bgc-jena.mpg.de/bgi/index.php/People/SimonBesnard')),
fluidRow(
column(4,
wellPanel(
h4("Filter data"),
sliderInput("Gap_Filled", "Fraction gap filling", 0, 1, value = c(0, 1)),
sliderInput("Uncert", "Uncertainties", 0, 45, value = c(0, 45),
step = 1),
sliderInput("GPP", "GPP [gC.m-2.y-1]", 0, 4000, value = c(0, 4000),
0, 4000, 4000, step = 100),
checkboxGroupInput("Management", "Intensity of management", c("None", "Low", "Moderate", "High"),
selected= c("None", "Low", "Moderate", "High"), inline = T),
checkboxGroupInput("Disturbance", "Type of disturbance",
c("Afforestation\\Reforestation", "Harvest", "None", "Wildfire"),
selected = c("Afforestation\\Reforestation", "Harvest", "None", "Wildfire"), inline=T),
checkboxGroupInput("Climate", "Type of climate",
c("Arid", "Continental", "Temperate", "Tropical"),
selected=c("Arid", "Continental", "Temperate", "Tropical"), inline=T),
checkboxGroupInput("Ecosystem",
label="PFTs",
choices=list("DBF", "DNF", "EBF", "ENF", "MF", "SHB"),
selected=c("DBF", "DNF", "EBF", "ENF", "MF","SHB"), inline=T)
),
wellPanel(
selectInput("xvar", "X-axis variable", axis_vars, selected = "Stand_Age"),
selectInput("yvar", "Y-axis variable", axis_vars, selected = "NEP")
)),
column(8,
tabsetPanel(
tabPanel("Bokeh Plot", ggvisOutput("rBokeh"))
))
)))
服务器文件：
server<- shinyServer(function(input, output, session) {
# Apply filters
FLux_Data <- reactive({
gap_filled<- input$Gap_filled
uncert<- input$Uncert
gpp<- input$GPP
management<- input$Management
disturbance <- input$Disturbance
climate <- input$Climate
ecosystem <- input$Ecosystem
m<- Flux_Data_df %>%
filter(
gap_filled >= Gap_filled &
uncert >= Uncert &
gpp >= GPP &
management >= Management &
disturbance %in% Disturbance &
climate %in% Climate &
ecosystem %in% Ecosystem
)
m <- as.data.frame(m)
m
})
# Function for generating tooltip text
Site_tooltip <- function(x) {
if (is.null(x)) return(NULL)
if (is.null(x$Site_ID)) return(NULL)
# Pick out the movie with this ID
df <- isolate(FLux_Data())
Flux_ID <- df[df$Site_ID == x$Site_ID, ]
paste0("<b>", Flux_ID$Site_ID, "</b><br>",
Flux_ID$year, "<br>")
}
# A reactive expression with the ggvis plot
Bokeh <- reactive({
# Lables for axes
xvar_name <- names(axis_vars)[axis_vars == input$xvar]
yvar_name <- names(axis_vars)[axis_vars == input$yvar]
# Normally we could do something like props(x = ~BoxOffice, y = ~Reviews),
# but since the inputs are strings, we need to do a little more work.
xvar <- prop("x", as.symbol(input$xvar))
yvar <- prop("y", as.symbol(input$yvar))
FLux_Data %>%
ggvis(x = xvar, y = yvar) %>%
layer_points(size := 50, size.hover := 200,
fillOpacity := 0.2, fillOpacity.hover := 0.5) %>%
add_tooltip(Site_tooltip, "hover") %>%
add_axis("x", title = xvar_name) %>%
add_axis("y", title = yvar_name) %>%
set_options(width = 500, height = 500)
})
observe({
Bokeh %>% bind_shiny("rBokeh")
})
})
shinyApp(ui, server)
基本上，我想根据ui文件中的过滤设置，在闪亮的应用程序中完成过滤操作时更新我的数据帧。我尝试使用filter包中的dplyr函数，但无法设法执行此操作。任何人都可以帮我解决这个问题吗？
答案 0 :(得分：1)
这是一个工作版本。请注意，我删除了许多过滤条件以及工具提示功能以简化它。
library(shiny)
library(ggvis)
library(dplyr)
axis_vars <- c(
"NEP observed [gC.m-2.y-1]" = "NEP",
"NEP predicted [gC.m-2.y-1]" = "prediction",
"CUEe" = "NEP_GPP",
"GPP [gC.m-2.y-1]" = "GPP",
"Forest Age [years]" = "Stand_Age",
"MAT [°C]" = "MAT",
"SPI" = "SPI_CRU_Mean",
"MAP [mm.y-1]" = "MAP",
"MAP trend [mm.y-1]" = "MAP_Trend",
"MAT tremd [°C.y-1]" = "MAT_Trend",
"Clay content [kg.kg-1]" = "Clay_1km",
"N deposition [kg N.ha-1.y-1]" = "NHx"
)
ui<- shinyUI(fluidPage(
titlePanel("Data exploration"),
p('Interactive tool for data exploration'),
em('by, ', a('Simon Besnard', href = 'http://www.bgc-jena.mpg.de/bgi/index.php/People/SimonBesnard')),
fluidRow(
column(3,
wellPanel(
h4("Filter data"),
sliderInput("Gap_Filled", "Fraction gap filling", 0, 1, value = c(0, 1)),
sliderInput("Uncert", "Uncertainties", 0, 45, value = c(0, 45),
step = 1),
sliderInput("GPP", "GPP [gC.m-2.y-1]", 0, 4000, value = c(0, 4000),
0, 4000, 4000, step = 100),
sliderInput("Management", "Intensity of management", 0, 3, value = c(0, 3),
step = 1),
selectInput("Disturbance", "Type of disturbance", multiple = TRUE,
c("Afforestation-Reforestation", "Harvest", "Undisturbed", "Wildfire")),
selectInput("Climate", "Type of climate", multiple = TRUE,
c("Arid", "Continental", "Temperate", "Tropical"), selected = c("Temperate")),
selectInput("Ecosystem", "PFTs", multiple = TRUE,
c("DBF", "DNF", "EBF", "ENF", "MF", "SHB"), selected=c("MF"))
),
wellPanel(
selectInput("xvar", "X-axis variable", axis_vars, selected = "Stand_Age"),
selectInput("yvar", "Y-axis variable", axis_vars, selected = "NEP")
)),
column(8,
mainPanel(
ggvisOutput("ggvis"))
))
))
server<- shinyServer(function(input, output, session) {
# A reactive expression with the ggvis plot
Bokeh <- reactive({
# Lables for axes
xvar_name <- names(axis_vars)[axis_vars == input$xvar]
yvar_name <- names(axis_vars)[axis_vars == input$yvar]
xvar <- prop("x", as.symbol(input$xvar))
yvar <- prop("y", as.symbol(input$yvar))
test <- Flux_Data_df %>%
filter(
Gap_filled > input$Gap_filled[1] &
Gap_filled < input$Gap_filled[2]) %>%
filter(
Climate %in% input$Climate &
Ecosystem %in% input$Ecosystem
) %>% as.data.frame()
test %>%
ggvis(x = xvar, y = yvar) %>%
layer_points(size := 50, size.hover := 200,
fillOpacity := 0.2, fillOpacity.hover := 0.5) %>%
add_axis("x", title = xvar_name) %>%
add_axis("y", title = yvar_name) %>%
set_options(width = 500, height = 500)
})
observe({
Bokeh() %>% bind_shiny("ggvis")
})
})
shinyApp(ui, server)