Selaa lähdekoodia

Initial commit

themoviedb
Maxime Wack 6 vuotta sitten
commit
d7ccfd70b6
2 muutettua tiedostoa jossa 187 lisäystä ja 0 poistoa
  1. +93
    -0
      _index.Rmd
  2. +94
    -0
      app.R

+ 93
- 0
_index.Rmd Näytä tiedosto

@@ -0,0 +1,93 @@
---
title: GraphTV
runtime: shiny
output:
html_document
---

```{r setup, message = F, warning = F, echo = F}
library(tidyverse)
library(httr)
library(rvest)
library(plotly)
library(jsonlite)
library(knitr)

opts_chunk$set(message = F,
echo = F,
warning = F)

key <- "?api_key=32e0ed1416c58777f986f3f33751fc22"
tmdb_url <- "http://api.themoviedb.org/3/"
```

```{r input}
inputPanel(
textInput("show_search", "Search show"),
actionButton("button_search", "Search show"),
uiOutput("show_choice")
)

shows <- eventReactive(input$button_search, {
req(input$show_search)

serie <- input$show_search %>% url_escape

GET(str_c(tmdb_url, "search/tv", key, "&query=", serie)) %>%
content(as = "text") %>%
fromJSON -> res

#res$results$poster_path

res$results$id %>%
as.list %>%
setNames(res$results$original_name)
})

output$show_choice <- renderUI({
req(shows())

selectizeInput("show", "Please choose…", shows())
})
```

```{r graph}
renderPlotly({
req(input$show)

show_id <- input$show

GET(str_c(tmdb_url, "tv/", show_id, key)) %>%
content(as = "text") %>%
fromJSON -> res

res$backdrop_path
1:res$number_of_seasons -> seasons
res$vote_average

seasons %>%
map(~ GET(str_c(tmdb_url, "tv/", show_id, "/season/", ., key)) %>%
content(as = "text") %>%
fromJSON) -> res

res %>%
map("episodes") %>%
reduce(bind_rows) %>%
select(season_number, episode_number, name, still_path, vote_average) -> episodes

episodes %>%
by(.$season_number, function(x){
fit <- lm(vote_average ~ episode_number, data = x)
x %>%
plot_ly(hoverinfo = "text",
text = ~str_c("S", season_number, "E", episode_number, " - ", name, "<br>",
"Rating: ", vote_average, "<br>")) %>%
add_trace(data = x, x = ~episode_number, y = ~vote_average, mode = "markers") %>%
add_trace(data = x, x = ~episode_number, y = fitted(fit), mode = "lines") %>%
layout(xaxis = list(tick0 = 0, dtick = 1),
yaxis = list(title = "Rating"))
}) %>%
subplot(shareY = T, nrows = 1) %>%
hide_legend
})
```

+ 94
- 0
app.R Näytä tiedosto

@@ -0,0 +1,94 @@
library(tidyverse)
library(httr)
library(rvest)
library(plotly)
library(jsonlite)
library(knitr)

key <- "?api_key=32e0ed1416c58777f986f3f33751fc22"
tmdb_url <- "http://api.themoviedb.org/3/"

ui <- fluidPage(
inputPanel(width = "20%", height = "100%",
textInput("show_search", "Search show"),
uiOutput("show_choice", width = "50%")
),
plotlyOutput("show_graph", width = "100%", height = "800px")
)

server <- function(input, output, session)
{
shows <- eventReactive(input$show_search, {
req(input$show_search)

serie <- input$show_search %>% url_escape

GET(str_c(tmdb_url, "search/tv", key, "&query=", serie)) %>%
content(as = "text") %>%
fromJSON -> res

#res$results$poster_path

res$results$id %>%
as.list %>%
setNames(res$results$original_name)
})

output$show_choice <- renderUI({
req(shows())

selectizeInput("show", "Please choose…", shows())
})

output$show_graph <- renderPlotly({
req(input$show)

show_id <- input$show

GET(str_c(tmdb_url, "tv/", show_id, key)) %>%
content(as = "text") %>%
fromJSON -> res

res$backdrop_path
1:res$number_of_seasons -> seasons
res$vote_average

seasons %>%
map(~ GET(str_c(tmdb_url, "tv/", show_id, "/season/", ., key)) %>%
content(as = "text") %>%
fromJSON) -> res

res %>%
map("episodes") %>%
reduce(bind_rows) %>%
select(season_number, episode_number, name, still_path, vote_average, vote_count) -> episodes

episodes %>%
by(.$season_number, function(x){
fit <- lm(vote_average ~ episode_number, data = x)
x %>%
plot_ly(hoverinfo = "text",
text = ~str_c("S", season_number, "E", episode_number, " - ", name, "<br>",
"Rating: ", vote_average, "(", vote_count, " votes)<br>")) %>%
add_trace(data = x, x = ~episode_number, y = ~vote_average, mode = "markers") %>%
add_trace(data = x, x = ~episode_number, y = fitted(fit), mode = "lines") %>%
layout(xaxis = list(tick0 = 0, dtick = 1),
yaxis = list(title = "Rating"))
}) %>%
subplot(shareY = T, nrows = 1, margin = 0) %>%
hide_legend

# episodes %>%
# arrange(season_number, episode_number) %>%
# add_rownames(var = "ep") %>%
# mutate(ep = ep %>% as.numeric, season_number = season_number %>% as.factor) %>%
# ggplot() +
# aes(x = ep, y = vote_average, group = season_number, color = season_number) +
# geom_point(aes(text = name)) +
# geom_smooth(method = "lm") +
# xlab("Episode") +
# ylab("Rating")
})
}

shinyApp(ui = ui, server = server)

Loading…
Peruuta
Tallenna