Я хочу создать блестящее приложение на основе этого: пример . Вот мой CSV-файл с датой: дата
Мне нужна помощь с этим кодом. Прежде всего, я думаю, что я сделал много ошибок. Я не знаю, как это сделать, что пользователь может выберите оси системы координат из: Год, Возраст, Рост, Вес. И я не уверен насчет остальной части кода. Комментарии взяты из исходного кода.
server.R
library(ggvis)
library(dplyr)
data=read.csv(file="olympic.csv")
function(input, output, session) {
# Filter the movies, returning a data frame
game <- reactive({
# Due to dplyr issue #318, we need temp variables for input values
minyear <- input$min(data$Year)
maxyear <- input$max(data$Year)
minage <- input$min(data$Age)
maxage <- input$max(data$Age)
m <- data %>%
filter(
Year >= minyear,
Year <= maxyear,
Age >= minage,
Age <= maxage
) %>%
arrange(Medal)
# Optional: filter by genre
if (input$Sex != "All") {
sex <- paste0("%", input$Sex, "%")
m <- m %>% filter(Sex %like% sex)
}
# Optional: filter by director
if (!is.null(input$Team) && input$Team != "") {
team <- paste0("%", input$Team, "%")
m <- m %>% filter(Team %like% team)
}
if (input$Sport != "All") {
sport <- paste0("%", input$Sport, "%")
m <- m %>% filter(Sport %like% sport)
}
if (input$Season != "All") {
season <- paste0("%", input$Season, "%")
m <- m %>% filter(Season %like% season)
}
m <- as.data.frame(m)
# Add column which says whether the movie won any Oscars
# Be a little careful in case we have a zero-row data frame
m$has_medal <- character(nrow(m))
m$has_medal[m$Medal == "Gold"] <- "Gold"
m$has_medal[m$Medal == "Silver"] <- "Silver"
m$has_medal[m$Medal == "Bronze"] <- "Bronze"
m
})
# Function for generating tooltip text
game_tooltip <- function(x) {
if (is.null(x)) return(NULL)
if (is.null(x$ID)) return(NULL)
# Pick out the movie with this ID
data <- isolate(game())
olymp <- data[data$ID == x$ID, ]
paste0("<b>", olymp$Name, "</b><br>",
olymp$Year, "<br>",
"$", format(olymp$Age, big.mark = ",", scientific = FALSE)
)
}
vis <- 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))
game %>%
ggvis(x = xvar, y = yvar) %>%
layer_points(size := 50, size.hover := 200,
fillOpacity := 0.2, fillOpacity.hover := 0.5,
stroke = ~has_medal, key := ~ID) %>%
add_tooltip(game_tooltip, "hover") %>%
add_axis("x", title = xvar_name) %>%
add_axis("y", title = yvar_name) %>%
add_legend("stroke", title = "Medal", values = c("Gold", "Silver","Bronze")) %>%
scale_nominal("stroke", domain = c("Gold", "Silver","Bronze"),
range = c("orange", "#aaa","#7f6b5d")) %>%
set_options(width = 500, height = 500)
})
vis %>% bind_shiny("plot1")
output$n_gamer <- renderText({ nrow(games()) })
ui.R
library(ggvis)
# For dropdown menu
actionLink <- function(inputId, ...) {
tags$a(href='javascript:void',
id=inputId,
class='action-button',
...)
}
fluidPage(
titlePanel("Olympic history"),
fluidRow(
column(3,
wellPanel(
h4("Filter"),
sliderInput("year", "Year released", 1896, 2016, value = c(1970, 2014),
sep = ""),
sliderInput("age", "Age:",
0, 97, c(0, 97), step = 1),
selectInput("sport", "Sport:",
c("All", "Basketball", "Judo", "Football", "Tug-Of-War", "Speed Skating",
"Cros Country Skating", "Athletics", "Ice Hokey", "Swimming", "Badminton", "Sailing",
"Gymnastics", "Art Competitions", "Alpine Skiing", "Handball", "Wresling", "Speed Skating",
"Luge", "Water Polo", "Hockey", "Rowing", "Bobsleigh","Football","Fencing","Equestrianism",
"Shooting","Boxing","Takewondo","Cycling"," Weightlifting")
),
selectInput("season","Season:",c("Winter","Summer")),
selectInput("sex","Sex:",c("F","M")),
textInput("team", "Nationality (e.g., German)"
),
wellPanel(
selectInput("xvar", "X-axis variable", axis_vars, selected = "Meter"),
selectInput("yvar", "Y-axis variable", axis_vars, selected = "Reviews"),
)
),
column(9,
ggvisOutput("plot1"),
wellPanel(
span("Number of gamer selected:",
textOutput("n_gamer")
)
)
)
)
))
ОБНОВЛЕНИЕ : Я создаю файл global.R
axis_vars <- c(
"Year" = "Year",
"Hight"="Hight",
"Weight"="Weight",
"Age"="Age"
)
Блестящее окно открывается, но закрывается немедленно.
Ostrzeżenie: Error in <reactive:game>: próba zastosowania nie-funkcji
150: <reactive:game> [/home/pawel/Pulpit/R2/server.R#9]
134: data
117: add_scale_from_prop
116: register_scales_from_props
115: add_mark
114: layer_points
113: function_list[[i]]
112: freduce
111: _fseq
110: eval
109: eval
107: %>%
106: <reactive:vis> [/home/pawel/Pulpit/R2/server.R#77]
90: visf
88: <reactive>
72: r_spec
59: exec_connectors
58: bind_shiny
57: function_list[[k]]
55: freduce
54: _fseq
53: eval
52: eval
50: %>%
49: server [/home/pawel/Pulpit/R2/server.R#91]
Error in `<reactive:game>`(...) : próba zastosowania nie-funkcji
Ostrzeżenie: Error in <reactive:game>: próba zastosowania nie-funkcji
48: <Anonymous>
Ostrzeżenie: Error in <reactive:game>: próba zastosowania nie-funkcji
47: <Anonymous>
próba zastosowania n ie -funkcji = попытка использовать без функции