Как выполнить логический тест на имена векторов внутри функции применения в R - PullRequest
0 голосов
/ 04 января 2019

Я использую функцию apply для очистки нескольких веб-страниц с сайта stat.NCAA.org с целью объединения всех данных в одну таблицу. Я пытаюсь очистить данные в рамках функции применения, чтобы избежать присвоения имен переменных данным, извлеченным с каждой веб-страницы, что может замедлить процесс (это для проекта, который в конечном итоге очистит несколько тысяч страниц).

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

#Load Libraries
library(RSelenium)
library(XML)
library(dplyr)

#Define URLs for stat tables (URL order must be in the order of the vector of names in row 22)
Wartburg_2018_url_vector <- c('https://stats.ncaa.org/team/750/stats?game_sport_year_ctl_id=14280&id=14280&year_stat_category_id=14355',
                              'https://stats.ncaa.org/team/750/stats?game_sport_year_ctl_id=14280&id=14280&year_stat_category_id=14349',
                              'https://stats.ncaa.org/team/750/stats?game_sport_year_ctl_id=14280&id=14280&year_stat_category_id=14350',
                              'https://stats.ncaa.org/team/750/stats?game_sport_year_ctl_id=14280&id=14280&year_stat_category_id=14353',
                              'https://stats.ncaa.org/team/750/stats?game_sport_year_ctl_id=14280&id=14280&year_stat_category_id=14357',
                              'https://stats.ncaa.org/team/750/stats?game_sport_year_ctl_id=14280&id=14280&year_stat_category_id=14348',
                              'https://stats.ncaa.org/team/750/stats?game_sport_year_ctl_id=14280&id=14280&year_stat_category_id=14341',
                              'https://stats.ncaa.org/team/750/stats?game_sport_year_ctl_id=14280&id=14280&year_stat_category_id=14352',
                              'https://stats.ncaa.org/team/750/stats?game_sport_year_ctl_id=14280&id=14280&year_stat_category_id=14351',
                              'https://stats.ncaa.org/team/750/stats?game_sport_year_ctl_id=14280&id=14280&year_stat_category_id=14342',
                              'https://stats.ncaa.org/team/750/stats?game_sport_year_ctl_id=14280&id=14280&year_stat_category_id=14340',
                              'https://stats.ncaa.org/team/750/stats?game_sport_year_ctl_id=14280&id=14280&year_stat_category_id=14346',
                              'https://stats.ncaa.org/team/750/stats?game_sport_year_ctl_id=14280&id=14280&year_stat_category_id=14345',
                              'https://stats.ncaa.org/team/750/stats?game_sport_year_ctl_id=14280&id=14280&year_stat_category_id=14347',
                              'https://stats.ncaa.org/team/750/stats?game_sport_year_ctl_id=14280&id=14280&year_stat_category_id=14356')
names(Wartburg_2018_url_vector) <- c('Defense',
                                     'Fumbles',
                                     'Kicking',
                                     'Kickoffs and KO Returns',
                                     'Participation',
                                     'Passes Defended',
                                     'Passing',
                                     'Punt Returns',
                                     'Punting',
                                     'Receiving',
                                     'Rushing',
                                     'Sacks',
                                     'Scoring',
                                     'Tackles',
                                     'Turnover Margin')

#launch RSelenium
shell('docker run -d -p 4445:4444 selenium/standalone-chrome')
remDr <- remoteDriver(remoteServerAddr = "localhost", port = 4445L, browserName = "chrome")
remDr$open()

#access webpage, parse the html, read the table/list, select the stat grid, convert to data frame, 
#convert to tibble, convert player names to character string, and name list elements
Wartburg_2018_stat_grid <- Wartburg_2018_url_vector %>%
  lapply(
    function(x) {
      remDr$navigate(x)
      htmlParse(remDr$getPageSource()[[1]]) %>%
        readHTMLTable(stringsAsFactors = FALSE) %>%
        (function(y) {
          y[3]
        }) %>%
        as.data.frame() %>%
        as_tibble() %>%
        mutate(Player = stat_grid.Player) %>%
        if(names(x) == 'Defense') {
          mutate(FR = as.double(gsub(",","",stat_grid.Fumbles.Recovered)),
                 Blocks = as.double(gsub(",","",stat_grid.Blkd))
          ) %>%
            select(Player:Blocks)
        }
    }
  )

Я получаю следующую ошибку:

Ошибка в if (.) Names (x) == "Defense" else {: аргумент не интерпретируемый как логический

Когда я пытаюсь запустить простую функцию применения, где мне нужно получить доступ к именам внутри функции, моя проблема заключается в том, что names(x) возвращает нулевое значение.

1 Ответ

0 голосов
/ 04 января 2019

Вы путаете идентификатор списка с names()

При использовании lapply() вы конвертируете Wartburg_2018_stat_grid в список, а затем запускаете указанные вами функции.
Точно так же вы можете сделать:

myList <- as.list(Wartburg_2018_stat_grid)
myList

Вы можете извлечь значение из списка, используя его идентификатор. например

myList$Defense

Возвращает элемент, сохраненный под этим идентификатором. Это отличается от названия этого элемента.

Имя не указано. следовательно:

names(myList$Defense)

NULL

Вы можете указать имя, используя:

names(myList$Defense) <- 'name1'
myList$Defense

                                          name1
"https://stats.ncaa.org/team/750/(...)id=14355" 

Это добавит имя к элементу в вашем списке myList, который находится под идентификатором Defense

...