Визуализация даты в блестящей - PullRequest
0 голосов
/ 10 января 2020

Я хочу создать блестящее приложение на основе этого: пример . Вот мой 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 = попытка использовать без функции

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...