Convert nested for loop to a function

user_5212742 0
Viewed 99

I've written a nested for loop and want to convert it to a function. This is the code I currently have:

## Sleeper function
testit <- function(x)
{
  p1 <- proc.time()
  Sys.sleep(x)
  proc.time() - p1 # The cpu usage should be negligible
}

## Set up null objects to fill in loop
episodes = NULL
l = NULL

## Scrape pages and append together
for (season in c(27:38)){
  for (episode in c(1:13)){
    tryCatch({
      if (season == 34 & episode == 3){
        l = 'l'
      }
      new_episode <- read_html(paste0('http://www.chakoteya.net/DoctorWho/', season, '-', episode, '.htm', l)) %>% 
      html_nodes("p") %>%
      html_text() %>% 
      tibble(value = .)
      episodes <- episodes %>% bind_rows(new_episode)
      cat(paste('\rseason = ', season, '; episode = ', episode))
      testit(2)
    }, error=function(e){cat("ERROR :",conditionMessage(e), "\n")})
  }
}

As you can see it's looping over seasons 27-38 and within each season episodes 1-13. Sometimes the season only has 12 episodes, hence the tryCatch(). And, for reasons I don't understand, sometimes the URL requires an .html suffix (if season >= 34 and episode >= 3) and sometimes it requires an .htm suffix, hence the if (season == 34 & episode == 3) statement.

I would like to convert this into a function, maybe using apply() or map() but my function skills are still pretty elementary and i'm struggling.

As an end output it'd be great to call a function called, say, doctor_who() like this:

episodes <- doctor_who(season = c(27:38), episode = c(1:13))
rvest web-scraping r for-loop function
2 Answers

Something like this?

library(dplyr)
library(xml2)

testit <- function(x) {
  p1 <- proc.time()
  Sys.sleep(x)
  proc.time() - p1 # The cpu usage should be negligible
}

doctor_who <- function(season = 27:38, episode = 1:13){
  ## Set up null objects to fill in loop
  episodes = NULL
  l = NULL
  
  res <- vector("list", length = length(season)* length(episodes))
  inx <- 0L
  ## Scrape pages and append together
  for (s in season){
    for (e in episode){
      tryCatch({
        if (s == 34 && e == 3){
          l = 'l'
        }
        URL <- paste0('http://www.chakoteya.net/DoctorWho/', s, '-', e, '.htm', l)
        new_episode <- read_html(URL, encoding = "shift_jis") %>% 
          html_nodes("p") %>%
          html_text() %>% 
          tibble(value = .)
        episodes <- episodes %>% bind_rows(new_episode)
        message(paste('season = ', s, '; episode = ', e))
        testit(2)
        inx <- inx + 1L
        res[[inx]] <- episodes
      }, error=function(e){cat("ERROR :",conditionMessage(e), "\n")})
    }
  }
  res
}

episodes <- doctor_who(season = 27:38, episode = 1:13)

# how many were read
length(episodes)
#[1] 137

# how many were expected
length(27:38)*length(1:13)
#[1] 156
user_82454060

I'll divide this into two functions -

First function reads the data from one file and second function creates all the urls of each season and episode and use map_df to pass them one by one.

In the first function we first try to read data from .htm and if it fails then read data from .html.

read_text <- function(url) {
  val <- tryCatch({
    read_html(url) %>%
      html_nodes("p") %>%
      html_text() %>% 
      tibble(value = .)
  }, error = function(e) return(NA))
  
  if(NROW(val) == 1) {
    url <- paste0(url, 'l')
    val <- tryCatch({
      read_html(url) %>%
        html_nodes("p") %>%
        html_text() %>% 
        tibble(value = .)
    }, error = function(e) return(NA))
  }

  if(NROW(val) > 1) val else NULL
}


doctor_who <- function(season, episode) {
  all_urls <- sprintf('http://www.chakoteya.net/DoctorWho/%s.htm', 
                      c(t(outer(season, episode, paste, sep = '-'))))
  purrr::map_df(all_urls, read_text, .id = 'id')
}

res <- doctor_who(season = 1:5, episode = 1:5)

I added an id column to differentiate each episode.

#   id    value                                                                      
#   <chr> <chr>                                                                      
# 1 1     " \r\nOriginal Airdate: 23 Nov, 1963"                                      
# 2 1     " [Coal Hill School corridor] "                                            
# 3 1     " (The bell is ringing for end of classes.)\r\nGIRL: Night, Miss Wright. \…
# 4 1     " [Laboratory] "                                                           
# 5 1     " (A man is tidying up after the class) \r\nIAN: Oh? Not gone yet? \r\nBAR…
# 6 1     " [Classroom] "                                                            
# 7 1     " (Susan is listening to guitar rock music on her\r\ntransistor radio. I'm…
# 8 1     " [Totter's Lane] "                                                        
# 9 1     " (Ian and Barbara are parked up.) \r\nBARBARA: Over there. \r\nIAN: We're…
#10 1     " [Memory - classroom] "                                                   
# … with 4,446 more rows
user_39629140
Related