Транспонировать каждые 4 строки в 4 отдельных столбца - PullRequest
0 голосов
/ 17 февраля 2019

Я пытаюсь очистить дату, заголовок и отзывы из IMDB следующим циклом:

   library(rvest)
   library(dplyr)
   library(stringr)
   library(tidyverse)

   ID <- 4633694

data <- lapply(paste0('http://www.imdb.com/title/tt', ID, '/reviews?filter=prolific', 1:20),
                   function(url){
                     url %>% read_html() %>% 
                       html_nodes(".review-date,.rating-other-user-rating,.title,.show-more__control") %>% 
                       html_text() %>%
                       gsub('[\r\n\t]', '', .)
                   })

, который предоставляет данные о рецензировании на 20 страницах в следующем формате, повторяя тот же шаблон:

   col1
1 10/10
2 If this was..
3 14 December 2018
4 I have to say, and no...
5
6
7 10/10
8 Stan Lee Is Smiling Right Now...
9 17 December 2018
10 A movie worthy of...
11
12
13 10/10
14 the most visually stunning film I've ever seen...
15 20 December 2018
16 There's hardly anything... 
17.
18.

Мне было интересно, есть ли способ транспонировать каждые 4 строки в отдельные столбцы, чтобы каждый атрибут был выровнен в соответствующем столбце, например:

         Date          Rating     Title            Review
1. 14 December 2018    10/10    If this was..    I have to...
2. 17 December 2018    10/10   Stan Lee Is...    A movie worthy...
3. 20 December 2018    10/10  the most visually.. There's hardly anything...

Ответы [ 2 ]

0 голосов
/ 17 февраля 2019
text_data = gsub('\\b(\\d+/\\d+)\\b','\n\\1',paste(grep('\\w',x$col1,value = TRUE),collapse = ':')) 

read.csv(text=text_data,h=F,sep=":",strip.white = T,fill=T,stringsAsFactors = F)
     V1                                                V2               V3                         V4 V5
1 10/10                                     If this was.. 14 December 2018   I have to say, and no... NA
2 10/10                  Stan Lee Is Smiling Right Now... 17 December 2018       A movie worthy of... NA
3 10/10 the most visually stunning film I've ever seen... 20 December 2018 There's hardly anything... NA
0 голосов
/ 17 февраля 2019

Вот один метод.

Данные:

x <- read.csv2(header=TRUE, stringsAsFactors=FALSE, text="
col1
10/10
If this was..
14 December 2018
I have to say, and no...


10/10
Stan Lee Is Smiling Right Now...
17 December 2018
A movie worthy of...


10/10
the most visually stunning film I've ever seen...
20 December 2018
There's hardly anything... 
.
.")

Для начала мы «находим» каждую из верхних строк, в данном случае она выглядит как дата.Обратите внимание, что вам может потребоваться / необходимо настроить это регулярное выражение, чтобы свести к минимуму количество ложноположительных и ложноотрицательных результатов.

ind <- grep("^[0-9]+/[0-9]+", x$col1)
x$col1[ind]
# [1] "10/10" "10/10" "10/10"

Нижняя строка помещается в ind индексы первой строки для каждогоblock.

Отсюда давайте извлечем каждый блок до того места, где начинается следующий блок (минус 1), до конца столбца фрейма:

y <- Map(function(a,b) x$col[a:b], ind, c(ind[-1], nrow(x)))
str(y)
# List of 3
#  $ : chr [1:5] "10/10" "If this was.." "14 December 2018" "I have to say, and no..." ...
#  $ : chr [1:5] "10/10" "Stan Lee Is Smiling Right Now..." "17 December 2018" "A movie worthy of..." ...
#  $ : chr [1:6] "10/10" "the most visually stunning film I've ever seen..." "20 December 2018" "There's hardly anything... " ...

Мы могли бы попытайтесь прыгнуть вперед (к do.call ниже), но это столкнется с проблемами, потому что наши векторы имеют разный размер.Мы можем легко исправить это, установив их длину равной длине самого длинного вектора.Вот хитрость, чтобы сделать это:

z <- lapply(y, `length<-`, max(lengths(y)))
str(z)
# List of 3
#  $ : chr [1:6] "10/10" "If this was.." "14 December 2018" "I have to say, and no..." ...
#  $ : chr [1:6] "10/10" "Stan Lee Is Smiling Right Now..." "17 December 2018" "A movie worthy of..." ...
#  $ : chr [1:6] "10/10" "the most visually stunning film I've ever seen..." "20 December 2018" "There's hardly anything... " ...

И последний шаг:

setNames(do.call("rbind.data.frame", c(z, stringsAsFactors=FALSE)),
         letters[seq_len(length(z[[1]]))])
#       a                                                 b                c
# 1 10/10                                     If this was.. 14 December 2018
# 2 10/10                  Stan Lee Is Smiling Right Now... 17 December 2018
# 3 10/10 the most visually stunning film I've ever seen... 20 December 2018
#                             d     e    f
# 1    I have to say, and no... 10/10 <NA>
# 2        A movie worthy of... 10/10 <NA>
# 3 There's hardly anything...      .    .
...