Веб-очистка и циклический просмотр страниц с помощью R

Question

Я изучаю очистку данных и, кроме того, я довольно дебютант с R (для работы я использую STATA, я использую R только для очень специфических задач).Чтобы научиться скрести, я тренируюсь с Psychology Today.

Я написал функцию, которая позволяет мне собирать информацию для одного терапевта и создавать набор данных с информацией, собранной таким образом:

install.packages('rvest') #Loading the rvest package
install.packages('xml2') #Loading the xml2 package
library('rvest') #to scrape
library('xml2')  #to handle missing values (it works with html_node, not with html_nodes)

#Specifying the url for desired website to be scraped (for instance, the first therapist in Illinois)
url <- 'https://www.psychologytoday.com/us/therapists/illinois/324585?sid=5d87fb397b155&ref=1&tr=ResultsName'

#Reading the HTML code from the website
URL <- read_html(url)

#creating the function
getProfile <- function(profilescrape) {

      ##NAME
            #Using CSS selectors to name
            nam_html <- html_node(URL,'.contact-name')
            #Converting the name data to text
            nam <- html_text(nam_html)
            #Let's have a look at the rankings
            head(nam)
            #Data-Preprocessing: removing '\n' (for the next informations, I will keep \n, to help 
            #                                   me separate each item within the same type of 
            #                                   information)
            nam<-gsub("\n","",nam)
            head(nam)
            #Convering each info from text to factor
            nam<-as.factor(nam)
            #Let's have a look at the name
            head(nam)


      ##QUALIFICATIONS      
            #Using CSS selectors to scrape qualifications
            qual_html <- html_node(URL,'.profile-qualifications ul')
            #Converting the name data to text
            qual <- html_text(qual_html)
            #Let's have a look at the rankings
            head(qual)
            #Convering each info from text to factor
            qual<-as.factor(qual)
            #Let's have a look at the qualifications
            head(qual)


      ##LOCATION      
            #Using CSS selectors to scrape qualifications
            loc_html <- html_node(URL,'.location-address-phone')
            #Converting the name data to text
            loc <- html_text(loc_html)
            #Let's have a look at the rankings
            head(loc)
            #Convering each info from text to factor
            loc<-as.factor(loc)
            #Let's have a look at the location
            head(loc)                


        ##FINANCE -- ONLY INFO ON COST PER SESSION  
            #Using CSS selectors to scrape qualifications
            fin_html <- html_nodes(URL,'.top-border li')
            #Converting the name data to text
            fin <- html_text(fin_html)
            #Let's have a look at the rankings
            head(fin)
            #Data-Preprocessing: removing '\n'
            #fin<-gsub("\n","",fin)
            #head(fin)
            #Convering each info from text to factor
            fin<-as.factor(fin)
            #Let's ONLY INFO ON COST PER SESSION  
            fin<-fin[1] 
            #Let's have a look at the cost per session
            head(fin)


        ##ACCEPTED INSURANCE    
            #Using CSS selectors to scrape accepted insurance
            ins_html <- html_node(URL,'.attributes-insurance .col-split-md-2')
            #Converting the name data to text
            ins <- html_text(ins_html)
            #Let's have a look at the rankings
            head(ins)
            #Convering each info from text to factor
            ins<-as.factor(ins)
            #Let's have a look at the accepted insurance
            head(ins)


        ##MEANS OF PAYMENT (PAY BY)
            #Using CSS selectors to scrape accepted insurance
            pay_html <- html_node(URL,'.attributes-payment-method')
            #Converting the name data to text
            pay <- html_text(pay_html)
            #Let's have a look at the rankings
            head(pay)
            #Convering each info from text to factor
            pay<-as.factor(pay)
            #Let's have a look at the means of payment
            head(pay)


        ##SPECIALITIES
            #Using CSS selectors to scrape specialities
            spec_html <- html_node(URL,'.specialties-list')
            #Converting the name data to text
            spec <- html_text(spec_html)
            #Let's have a look at the rankings
            head(spec)
            #Convering each info from text to factor
            spec<-as.factor(spec)
            #Let's have a look at the specialities
            head(spec)


        ##ISSUES    
            #Using CSS selectors to scrape issues
            iss_html <- html_node(URL,'.attributes-issues .col-split-md-2')
            #Converting the name data to text
            iss <- html_text(iss_html)
            #Let's have a look at the rankings
            head(iss)
            #Convering each info from text to factor
            iss<-as.factor(iss)
            #Let's have a look at the issues
            head(iss)


        ##MENTAL HEALTH FOCUS   
            #Using CSS selectors to scrape issues
            ment_html <- html_node(URL,'.attributes-mental-health .col-split-md-2')
            #Converting the name data to text
            ment <- html_text(ment_html)
            #Let's have a look at the rankings
            head(ment)
            #Convering each info from text to factor
            ment<-as.factor(ment)
            #Let's have a look at the mental health focus
            head(ment)


      ##SEXUALITY
            #Using CSS selectors to scrape gender
            sex_html <- html_node(URL,'.attributes-sexuality .col-split-md-2')
            #Converting the name data to text
            sex <- html_text(sex_html)
            #Let's have a look at the rankings
            head(sex)
            #Convering each info from text to factor
            sex<-as.factor(sex)
            #Let's have a look at the sexuality
            head(sex)


        ##ETHNICITY FOCUS      
            #Using CSS selectors to age focus
            eth_html <- html_node(URL,'.attributes-ethnicity-focus')
            #Converting the name data to text
            eth <- html_text(eth_html)
            #Let's have a look at the rankings
            head(eth)
            #Convering each info from text to ethnicity focus
            eth<-as.factor(eth)
            #Let's have a look at the rankings
            head(eth)


      ##AGE FOCUS      
            #Using CSS selectors to age focus
            age_html <- html_node(URL,'.attributes-age-focus .copy-small')
            #Converting the name data to text
            age <- html_text(age_html)
            #Let's have a look at the rankings
            head(age)
            #Convering each info from text to factor
            age<-as.factor(age)
            #Let's have a look at the age focus
            head(age)


      ##COMMUNITIES FOCUS      
            #Using CSS selectors to therapy type
            comm_html <- html_node(URL,'.attributes-categories .copy-small')
            #Converting the name data to text
            comm <- html_text(comm_html)
            #Let's have a look at the rankings
            head(comm)
            #Convering each info from text to factor
            comm<-as.factor(comm)
            #Let's have a look at the communities focus
            head(comm)


        ##THERAPY
            #Using CSS selectors to age focus
            ter_html <- html_node(URL,'.attributes-treatment-orientation .copy-small')
            #Converting the name data to text
            ter <- html_text(ter_html)
            #Let's have a look at the rankings
            head(ter)
            #Convering each info from text to factor
            ter<-as.factor(ter)
            #Let's have a look at the therapy
            head(ter)


        ##MODALITIES
            #Using CSS selectors to modality
            mod_html <- html_node(URL,'.attributes-modality .copy-small')
            #Converting the name data to text
            mod <- html_text(mod_html)
            #Let's have a look at the rankings
            head(mod)
            #Convering each info from text to factor
            mod<-as.factor(mod)
            #Let's have a look at the rankings
            head(mod)


        ##Combining all the lists to form a data frame
              onet_df<-data.frame(Name = nam,
                                  Location = loc,
                                  Qualifications = qual,
                                  Finance = fin,
                                  Insurance = ins, 
                                  Accepted_pay = pay,
                                  Specialities = spec,
                                  Issues = iss, 
                                  Mental_health = ment,
                                  Sexuality = sex,
                                  Ethnicity = eth,
                                  Age_focus = age, 
                                  Community_focus = comm,
                                  Therapy = ter,
                                  Modality = mod)

        ##Structure of the data frame
        str(onet_df)

            }

View(onet_df)

Этот код, кажется, работает хорошо для любого терапевта, которого я выберу.Теперь я хотел бы использовать эту функцию для нескольких профилей, чтобы создать один набор данных.Рассмотрим, например, терапевтов на первой странице Иллинойса.Я нажимаю на первый профиль (www.psychologytoday.com/us/therapists/illinois/324585?sid=5d8809e0cf775&ref=1&rec_next=1&tr=NextProf), а затем нажимаю несколько следующихраз, чтобы увидеть структуру ссылок на других терапевтов.Таким образом, я вижу, что изменяются только две части ссылки: первая цифра, выделенная жирным шрифтом, является уникальным идентификатором терапевта (по крайней мере, в штате Иллинойс), тогда как вторая цифра, выделенная жирным шрифтом, представляет собой порядковый номер терапевта в штате (например, еслив Иллинойсе 553 терапевта, это число от 1 до 553) Скажем, я хочу применить вышеуказанную функцию «getProfile» к первым 20 терапевтам в Иллинойсе и ввести информацию для этих 20 терапевтов в наборе данных с именем «onet_df»."

j <- 1
MHP_codes <-  c(324585 : 449807) #therapist identifier
withinpage_codes <-  c(1 : 20) #therapist running number
  for(code1 in withinpage_codes) {
    for(code2 in MHP_codes) {
      URL <- paste0('https://www.psychologytoday.com/us/therapists/illinois/', code2, '?sid=5d87f874630bd&ref=', code1, '&rec_next=1&tr=NextProf')
      record_profile <- getProfile <- function(profilescrape)
      onet_df[[j]] <- rbind.fill(onet_df, record_profile)
      j <- j + 1
      }
}

РЕДАКТИРОВАНИЕ НАЧИНАЕТСЯ ЗДЕСЬ:

Этот цикл не создает никаких наборов данных и передает только два профиля, 324585 и 449807 (эти два URL отображаютсяв «ценностях»);кроме того, он не выдает никаких сообщений об ошибках.Может ли кто-нибудь помочь мне отладить этот цикл?Пожалуйста, имейте в виду, что я настоящий новичок.

Следуя предложениям, я изменил то, что следует в начале:

#creating the function
getProfile <- function(URL) {....}

Более того, я использовал три альтернативных цикла:

1-ая альтернатива

j <- 1
MHP_codes <-  c(324585 : 449807) #therapist identifier
withinpage_codes <-  c(1 : 20) #therapist running number
for(code1 in withinpage_codes) {
  for(code2 in MHP_codes) {
    URL <- paste0('https://www.psychologytoday.com/us/therapists/illinois/', code2, '?sid=5d87f874630bd&ref=', code1, '&rec_next=1&tr=NextProf')
    record_profile <- getProfile(URL)
      onet_df[[j]] <- rbind.fill(onet_df, record_profile)
    j <- j + 1
  }
}

, которая выдает следующее сообщение об ошибке: Ошибка в UseMethod ("xml_find_first"): нет применимого метода для "xml_find_first", примененного кобъект класса "персонаж"

2-й вариант

MHP_codes <- c(324585, 449807)  #therapist identifier 
withinpage_codes <- c(1:20)     #therapist running number 

df_list <- vector(mode = "list",
                  length = length(MHP_codes) * length(withinpage_codes))

j <- 1
for(code1 in withinpage_codes) { 
  for(code2 in MHP_codes) {
    URL <- paste0('https://www.psychologytoday.com/us/therapists/illinois/', code2, '?sid=5d87f874630bd&ref=', code1, '&rec_next=1&tr=NextProf') 
    df_list[[j]] <- getProfile(URL)
    j <- j + 1 
  } 
}

final_df <- rbind.fill(df_list)

Этот цикл выдает то же сообщение об ошибке

Я недавно понял, чтотекущая форма URL может быть проблематичной.Поэтому я изменил URL-адрес на более простой:

"URL <- paste0 ('<a href="https://www.psychologytoday.com/us/therapists/illinois/" rel="nofollow noreferrer">https://www.psychologytoday.com/us/therapists/illinois/', code1)", где code1 - это уникальный идентификатор терапевта по состоянию.Я проверил, что R очищает эту ссылку в ее текущей форме.

Теперь мне осталось только выяснить, почему набор данных не создается с помощью цикла.Возможны две проблемы: Сначала , что-то внутри цикла не работает (я запустил оба цикла только на одной существующей странице, и набор данных не создается); Второй , когда я запускаю цикл для серии ссылок, некоторые из них могут отсутствовать, что приведет к сообщению об ошибке.

Answer 1

Рассмотрим несколько настроек:

• Настройка функции для получения параметра URL.Right profilescrape не используется нигде в функции.Функция принимает любой URL, назначенный в глобальной среде.

  getProfile <- function(URL) { 
     ...
  }
  

• Отрегулируйте окончание функции для возврата нужного объекта.Без return R вернет прочитанную последнюю строку.Поэтому замените str(onet_df) на return(onet_df).

• Передать динамический URL в цикле в метод без вызова function:

  URL <- paste0(...) 
  record_profile <- getProfile(URL)
  

• Инициализируйте список с указанной длиной (2 х 20) перед циклом.Затем на каждой итерации присваивайте индекс цикла, а не растущий объект в цикле, что приводит к неэффективности памяти.

  MHP_codes <- c(324585, 449807)  #therapist identifier 
  withinpage_codes <- c(1:20)     #therapist running number 
  
  df_list <- vector(mode = "list",
                    length = length(MHP_codes) * length(withinpade_codes))
  
  j <- 1
  for(code1 in withinpage_codes) { 
      for(code2 in MHP_codes) {
          URL <- paste0('https://www.psychologytoday.com/us/therapists/illinois/', code2, '?sid=5d87f874630bd&ref=', code1, '&rec_next=1&tr=NextProf') 
          df_list[[j]] <- tryCatch(getProfile(URL), 
                                   error = function(e) NULL)
          j <- j + 1 
      } 
  }
  

• Вызовите rbind.fill один раз вне цикла, чтобы объединить все кадры данных вместе

  final_df <- rbind.fill(df_list)
  

---

С учетом вышесказанного рассмотрим решение семейства apply , в частности Map (обертка до mapply).Таким образом вы избегаете учета инициализации списка и инкрементной переменной и «скрываете» цикл для компактного оператора.

# ALL POSSIBLE PAIRINGS
web_codes_df <- expand.grid(MHP_codes = c(324585, 449807),
                            withinpage_codes = c(1:20))

# MOVE URL ASSIGNMENT INSIDE FUNCTION
getProfile <- function(code1, code2) { 
   URL <- paste0('https://www.psychologytoday.com/us/therapists/illinois/', code2, '?sid=5d87f874630bd&ref=', code1, '&rec_next=1&tr=NextProf')

    # ...same code as before...
}

# ELEMENT-WISE LOOP PASSING PARAMS IN PARALLEL TO FUNCTION
df_list <- Map(function(code1, code2) tryCatch(getProfile(code1, code2), 
                                               error = function(e) NULL),
               code1 = web_codes_df$MHP_codes,
               code2 = web_codes_df$withinpage_codes)

final_df <- rbind.fill(df_list)

Answer 2

Один из пользователей, Parfait, помог мне разобраться в проблемах.Итак, огромное спасибо этому пользователю.Ниже я выложу полный скрипт.Я прошу прощения, если это не было предварительно прокомментировано.Это была тяжелая задача;Поскольку я новичок в R, мне трудно интерпретировать некоторые сообщения об ошибках или команды.Кроме того, большая часть сценария основана на простом методе проб и ошибок, а также на повторении того, что другие люди сделали, когда просматривали другие сайты (это означает, что я не знаю точно, что конкретно делает каждая часть кода и как это можно сделатьлучше).Мне придется больше работать над этим.

Вот код.

#Loading packages
library('rvest') #to scrape
library('xml2')  #to handle missing values (it works with html_node, not with html_nodes)
library('plyr')  #to bind together different data sets

#get working directory
getwd()
setwd("~/YOUR OWN FOLDER HERE")

#DEFINE SCRAPING FUNCTION
getProfile <- function(URL) {


          ##NAME
                #Using CSS selectors to name
                nam_html <- html_node(URL,'.contact-name')
                #Converting the name data to text
                nam <- html_text(nam_html)
                #Let's have a look at the rankings
                head(nam)
                #Data-Preprocessing: removing '\n' (for the next informations, I will keep \n, to help 
                #                                   me separate each item within the same type of 
                #                                   information)
                nam<-gsub("\n","",nam)
                head(nam)
                #Convering each info from text to factor
                nam<-as.factor(nam)
                #Let's have a look at the name
                head(nam)
                #If I need to remove blank space do this:
                  #Data-Preprocessing: removing excess spaces
                  #variable<-gsub(" ","",variable)


          ##QUALIFICATIONS      
                #Using CSS selectors to scrape qualifications
                qual_html <- html_node(URL,'.profile-qualifications ul')
                #Converting the name data to text
                qual <- html_text(qual_html)
                #Let's have a look at the rankings
                head(qual)
                #Convering each info from text to factor
                qual<-as.factor(qual)
                #Let's have a look at the qualifications
                head(qual)


                ##LOCATION      
                #Using CSS selectors to scrape qualifications
                loc_html <- html_node(URL,'.location-address-phone')
                #Converting the name data to text
                loc <- html_text(loc_html)
                #Let's have a look at the rankings
                head(loc)
                #Convering each info from text to factor
                loc<-as.factor(loc)
                #Let's have a look at the location
                head(loc)



            ##FINANCE  -- ONLY INFO ON COST PER SESSION   
                #Using CSS selectors to scrape qualifications
                fin_html <- html_nodes(URL,'.top-border li')
                #Converting the name data to text
                fin <- html_text(fin_html)
                #Let's have a look at the rankings
                head(fin)
                #Convering each info from text to factor
                fin<-as.factor(fin)
                #Let's ONLY INFO ON COST PER SESSION  
                fin<-fin[1] 
                #Let's have a look at the cost per session
                head(fin)


            ##ACCEPTED INSURANCE    
                #Using CSS selectors to scrape accepted insurance
                ins_html <- html_node(URL,'.attributes-insurance .col-split-md-2')
                #Converting the name data to text
                ins <- html_text(ins_html)
                #Let's have a look at the rankings
                head(ins)
                #Convering each info from text to factor
                ins<-as.factor(ins)
                #Let's have a look at the accepted insurance
                head(ins)


            ##MEANS OF PAYMENT (PAY BY)
                #Using CSS selectors to scrape accepted insurance
                pay_html <- html_node(URL,'.attributes-payment-method') ##what about the reminder of finance?
                #Converting the name data to text
                pay <- html_text(pay_html)
                #Let's have a look at the rankings
                head(pay)
                #Convering each info from text to factor
                pay<-as.factor(pay)
                #Let's have a look at the meanns of payments
                head(pay)


            ##SPECIALITIES
                #Using CSS selectors to scrape specialities
                spec_html <- html_node(URL,'.specialties-list')
                #Converting the name data to text
                spec <- html_text(spec_html)
                #Let's have a look at the rankings
                head(spec)
                #Convering each info from text to factor
                spec<-as.factor(spec)
                #Let's have a look at the specialities
                head(spec)


            ##ISSUES    
                #Using CSS selectors to scrape issues
                iss_html <- html_node(URL,'.attributes-issues .col-split-md-2')
                #Converting the name data to text
                iss <- html_text(iss_html)
                #Let's have a look at the rankings
                head(iss)
                #Convering each info from text to factor
                iss<-as.factor(iss)
                #Let's have a look at the issues
                head(iss)


            ##MENTAL HEALTH    
                #Using CSS selectors to scrape issues
                ment_html <- html_node(URL,'.attributes-mental-health .col-split-md-2')
                #Converting the name data to text
                ment <- html_text(ment_html)
                #Let's have a look at the rankings
                head(ment)
                #Convering each info from text to factor
                ment<-as.factor(ment)
                #Let's have a look at the mental health focus
                head(ment)


          ##SEXUALITY
                #Using CSS selectors to scrape gender
                sex_html <- html_node(URL,'.attributes-sexuality .col-split-md-2')
                #Converting the name data to text
                sex <- html_text(sex_html)
                #Let's have a look at the rankings
                head(sex)
                #Convering each info from text to factor
                sex<-as.factor(sex)
                #Let's have a look at the sexuality focus
                head(sex)


            ##ETHNICITY FOCUS      
                #Using CSS selectors to age focus
                eth_html <- html_node(URL,'.attributes-ethnicity-focus')
                #Converting the name data to text
                eth <- html_text(eth_html)
                #Let's have a look at the rankings
                head(eth)
                #Convering each info from text to factor
                eth<-as.factor(eth)
                #Let's have a look at the ethnicity focus
                head(eth)


          ##AGE FOCUS      
                #Using CSS selectors to age focus
                age_html <- html_node(URL,'.attributes-age-focus .copy-small')
                #Converting the name data to text
                age <- html_text(age_html)
                #Let's have a look at the rankings
                head(age)
                #Convering each info from text to factor
                age<-as.factor(age)
                #Let's have a look at the age focus
                head(age)


          ##COMMUNITIES FOCUS      
                #Using CSS selectors to therapy type
                comm_html <- html_node(URL,'.attributes-categories .copy-small')
                #Converting the name data to text
                comm <- html_text(comm_html)
                #Let's have a look at the rankings
                head(comm)
                #Convering each info from text to factor
                comm<-as.factor(comm)
                #Let's have a look at the commmunities focus
                head(comm)


            ##THERAPY
                #Using CSS selectors to age focus
                ter_html <- html_node(URL,'.attributes-treatment-orientation .copy-small')
                #Converting the name data to text
                ter <- html_text(ter_html)
                #Let's have a look at the rankings
                head(ter)
                #Convering each info from text to factor
                ter<-as.factor(ter)
                #Let's have a look at the therapy
                head(ter)


            ##MODALITIES
                #Using CSS selectors to modality
                mod_html <- html_node(URL,'.attributes-modality .copy-small')
                #Converting the name data to text
                mod <- html_text(mod_html)
                #Let's have a look at the rankings
                head(mod)
                #Convering each info from text to factor
                mod<-as.factor(mod)
                #Let's have a look at the rankings
                head(mod)

                ##Combining all the lists to form a data frame
                onet_df<-data.frame(Name = nam,
                                              Location = loc,
                                              Qualifications = qual,
                                              Finance = fin,
                                              Insurance = ins, 
                                              Accepted_pay = pay,
                                              Specialities = spec,
                                              Issues = iss, 
                                              Mental_health = ment,
                                              Sexuality = sex,
                                              Ethnicity = eth,
                                              Age_focus = age, 
                                              Community_focus = comm,
                                              Therapy = ter,
                                              Modality = mod)

                return(onet_df)
}

Затем я применяю эту функцию с помощью цикла для нескольких терапевтов.В иллюстративных целях я беру четыре идентификатора соседних терапевтов, не зная априори, действительно ли каждый из этих идентификаторов был назначен (это сделано потому, что я хочу посмотреть, что произойдет, если цикл наткнется на несуществующую ссылку).

j <- 1
MHP_codes <-  c(163805:163808) #therapist identifier
df_list <- vector(mode = "list", length(MHP_codes))
  for(code1 in MHP_codes) {
    URL <- paste0('https://www.psychologytoday.com/us/therapists/illinois/', code1)
    #Reading the HTML code from the website
    URL <- read_html(URL)
    df_list[[j]] <- tryCatch(getProfile(URL), 
                             error = function(e) NULL)
    j <- j + 1
  }

final_df <- rbind.fill(df_list)
save(final_df,file="final_df.Rda")