I am trying to pass user text into a function. The premise is to have a user type in the title ID (tt) of an IMDb listing. This will then pass into a function that will render a tree diagram. I am just running into an issue and I don't know if it is tasking 'too much'?
I am still wet behind the ears when it comes to shiny.
I have set the placeholder text for the input box to be the IMDb listing for good omens, so upon running it should start the function.
Here is the reprex:
library(rvest)
#> Loading required package: xml2
library(shiny)
library(stringr)
library(purrr)
#>
#> Attaching package: 'purrr'
#> The following object is masked from 'package:rvest':
#>
#> pluck
library(collapsibleTree)
library(htmlwidgets)
library(dplyr)
#>
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#>
#> filter, lag
#> The following objects are masked from 'package:base':
#>
#> intersect, setdiff, setequal, union
library(stringr)
ui <- fluidPage(
titlePanel("IMDb: More Like This",windowTitle = "RMDb"),
sidebarLayout(
sidebarPanel(
textInput("tt", "Show Title ID", "tt1869454"),
br(),
),
mainPanel(
verbatimTextOutput("nText"),
plotOutput("scatter")
),
position = c("left","right")
)
)
server <- function(input, output){
# Create function for text to render
output$nText <- renderUI({
# Add below
url <- paste0("https://www.imdb.com/title/",input$tt,"/")
# Show Name for later
show_name <- url %>%
read_html() %>%
html_nodes("h1") %>%
html_text()
# This extracts the titles of the shows that are similar to the one you searched.
show_tree_show <- url %>%
read_html() %>%
html_nodes(".rec-title b") %>%
html_text(trim=T)
# This extracts the tt from the shows saved in the previous step
show_morelike <- url %>%
read_html() %>%
html_nodes(".rec_item,.rec_selected") %>%
html_attr("data-tconst")
# This makes a vector of all (12) of the URLs
urls <- paste0("https://www.imdb.com/title/",show_morelike,"/")
# Since we are working with 12 URLs we need to use the map function to apply this function over a list.
doThis <- function(i){
show_tree <- read_html(i) %>%
html_nodes(".rec-title b") %>%
html_text(trim=T)
}
# This runs the function with each URL in the vector
shows_tree_like_chr <- unlist(map(urls,doThis))
# This sets up the data how we need it by repeating each show title 12 times
show_tree_showlist <- NULL
for (i in 1:12){
show_tree_showlist <- rep(show_tree_show,each=12)
}
# The name of the dataframe should be changed to reflect the show you are working with.
show_tree <- data.frame(
show=show_tree_showlist,
shows_like_shows=shows_tree_like_chr
)
head(show_tree)
# End function
})
}
shinyApp(ui, server)
#>
#> Listening on http://127.0.0.1:7793
#> Warning: Error in if: argument is of length zero
The major issue you encountered relates to the shiny ui widget choice and accompanying renderfunction.
The nText function code is set to return a dataframe, so a tableOutput should be the UI to show such a thing, this will require the renderTable servercode wrapper.
Additionally, it seems quite slow to poll the URL's to compile the data. so I added spinners from shinycssloaders, as well as the built in shiny progress bar feature.
Note that the scatter content hasnt been defined so that spinner wont stop spinning.
Hope this helps.
library(rvest)
library(shiny)
library(stringr)
library(purrr)
library(collapsibleTree)
library(htmlwidgets)
library(dplyr)
library(shinycssloaders)
ui <- fluidPage(
titlePanel("IMDb: More Like This",windowTitle = "RMDb"),
sidebarLayout(
sidebarPanel(
textInput("tt", "Show Title ID", "tt1869454"),
br(),
),
mainPanel(
tableOutput("nText") %>% withSpinner(),
plotOutput("scatter") %>% withSpinner()
),
position = c("left","right")
)
)
server <- function(input, output){
# Create function for text to render
output$nText <- renderTable({
withProgress(message = 'Fetching URLS ', value = 0, {
# Add below
url <- paste0("https://www.imdb.com/title/",input$tt,"/")
myhtml <- url %>%
read_html()
incProgress(amount=1/13)
# Show Name for later
show_name <- myhtml %>%
html_nodes("h1") %>%
html_text()
# This extracts the titles of the shows that are similar to the one you searched.
show_tree_show <-myhtml %>%
html_nodes(".rec-title b") %>%
html_text(trim=T)
# This extracts the tt from the shows saved in the previous step
show_morelike <-myhtml %>%
html_nodes(".rec_item,.rec_selected") %>%
html_attr("data-tconst")
# This makes a vector of all (12) of the URLs
urls <- paste0("https://www.imdb.com/title/",show_morelike,"/")
# Since we are working with 12 URLs we need to use the map function to apply this function over a list.
doThis <- function(i){
show_tree <- read_html(i) %>%
html_nodes(".rec-title b") %>%
html_text(trim=T)
incProgress(amount=1/13)
show_tree
}
# This runs the function with each URL in the vector
shows_tree_like_chr <- unlist(map(urls,doThis))
# This sets up the data how we need it by repeating each show title 12 times
show_tree_showlist <- NULL
for (i in 1:12){
show_tree_showlist <- rep(show_tree_show,each=12)
}
# The name of the dataframe should be changed to reflect the show you are working with.
show_tree <- data.frame(
show=show_tree_showlist,
shows_like_shows=shows_tree_like_chr
)
})
head(show_tree)
# End function
})
}
shinyApp(ui, server)
EDIT: So after deciding to play around with it for a bit, I realized that you already explained the answer! If I am correct, because the desired output was outputTable, everything could just be grouped under that output.
So for my purpose, I put all of that under renderCollapsibleTree and now it seems to be working! Thank you so much, I am beyond words!
Old post below
Wow, this is so awesome!
Thank you for taking the time to take a look at this. I am so glad that you added the loaders because I know that the user would not want to see "HTTP 404"!
So this gets the table rendered perfectly! But I am having a difficult time of getting this dataframe to be global enough that it can pass into the plotOutput() function. For my example I would like to be able to pass the tree dataframe into a renderCollapsibleTree function but it returns the following error: "Error: Object 'tree' not found"
Here is the code I've added in the ui:
collapsibleTreeOutput("tree") %>% withSpinner()
And here is the code I've added in the server, beneath the renderTable call:
Hi Dave, you must be close but tree isnt an object whose definition you've provide me yet. is it intended to be the show_tree object, or are there difference ?
Hello! I think I've used show_tree or tree before, but this is just a dataframe of the list of similar shows, show_tree_show and their similar shows show_morelike. I know my naming conventions are not the best!
What you've given me works perfectly now! I added a new function that would hopefully make it easier for the user to just type in a show title. But the progress bar keeps spinning, but only if I run the app in a window.
