Извлечение конкретных данных из таблиц PDF в R;как получить заголовки столбцов? - PullRequest
0 голосов
/ 03 октября 2018

Этот код извлекает таблицы данных из PDF, а затем использует grepl для извлечения данных с помощью специального ключевого слова, в данном случае «малярия».Он извлекает имена строк, много пропускает заголовки столбцов и помещает NA, я думаю, из-за разной длины.Есть ли способ получить заголовки?

library(tabulizer)
library(purrr)
library(dplyr)

files <- dir(path = ".", pattern = "\\.pdf$", full.names = TRUE, recursive = TRUE)
mdata <- list()
for(i in files){
  mdata[[i]] <- extract_tables(i)
}


col_names_list <- lapply(mdata[[1]], function(x) x[1,]) # we extract the     first row (colnames)
 data <- lapply(mdata[[1]], function(x) as.data.frame(x[-1, ]))
 data <- map2(mdata, col_names_list, function(x,y) {colnames(x)[0] <- y[0] 
 x})

 searchterms <-c('malaria')#, 'cases')
 pattern <- paste(searchterms, collapse = "|")

 mdata %>% 
   map(function(x) x[grepl(pattern, x[,1], ignore.case = TRUE),, drop =    FALSE])-> df2


m1<-df2[sapply(df2, nrow)>0] #removes obs=0

1 Ответ

0 голосов
/ 04 октября 2018

Очень сложно иметь общие решения для извлечения PDF-таблиц (даже для PDF-файлов того же агентства).

Чтобы получить таблицу 3.1 в удобной для использования форме из примера документа (Gdocs - это также неплохой способ обмена PDF-файлами), вот что я бы сделал:

library(tabulizer)

fil <- "~/Downloads/GBD2016_1_0915 Gambia HIS  SERVICE STATISTICS REPORT 2005.pdf"

(table_3_1 <- tabulizer::extract_tables(file = fil, pages = 23)[[1]])
##       [,1]               [,2]   [,3]   [,4]   [,5]    [,6]   [,7]      [,8]    
##  [1,] ""                 "URD"  "CRD"  "LRD"  "NBDE"  "NBDW" "WESTERN" "TOTAL" 
##  [2,] "Total Women Seen" "910"  "1964" "749"  "1,640" "1143" "8961"    "15,367"
##  [3,] "Total Men Seen"   "936"  "613"  "530"  "687"   "150"  "2334"    "5,250" 
##  [4,] "Counselled Only"  "49"   "229"  "71"   "250"   "232"  "809"     "1640"  
##  [5,] "Pills"            "137"  "476"  "221"  "398"   "198"  "2857"    "4287"  
##  [6,] "Depo"             "286"  "725"  "405"  "456"   "511"  "3166"    "5549"  
##  [7,] "Condoms"          "888"  "4247" "1143" "1934"  "3300" "11952"   "23464" 
##  [8,] "Foam"             "0"    "0"    "10"   "2"     "8"    "41"      "61"    
##  [9,] "IUCD"             "1"    "1"    "0"    "0"     "3"    "37"      "42"    
## [10,] "VSC"              "0"    "0"    "0"    "0"     "0"    "0"       "0"     
## [11,] "Total New"        ""     ""     ""     ""      ""     ""        ""      
## [12,] "Acceptors"        "1312" "5449" "1779" "2790"  "1050" "18053"   "30433" 

table_3_1[1,1] <- "measure" # need to add the colname

(table_3_1 <- as.data.frame(table_3_1[-(11:12),], stringsAsFactors = FALSE))
##                  V1  V2   V3   V4    V5   V6      V7     V8
## 1           measure URD  CRD  LRD  NBDE NBDW WESTERN  TOTAL
## 2  Total Women Seen 910 1964  749 1,640 1143    8961 15,367
## 3    Total Men Seen 936  613  530   687  150    2334  5,250
## 4   Counselled Only  49  229   71   250  232     809   1640
## 5             Pills 137  476  221   398  198    2857   4287
## 6              Depo 286  725  405   456  511    3166   5549
## 7           Condoms 888 4247 1143  1934 3300   11952  23464
## 8              Foam   0    0   10     2    8      41     61
## 9              IUCD   1    1    0     0    3      37     42
## 10              VSC   0    0    0     0    0       0      0

(table_3_1 <- docxtractr::assign_colnames(table_3_1, 1)) # note the docxtractr package dependency
##            measure URD  CRD  LRD  NBDE NBDW WESTERN  TOTAL
## 1 Total Women Seen 910 1964  749 1,640 1143    8961 15,367
## 2   Total Men Seen 936  613  530   687  150    2334  5,250
## 3  Counselled Only  49  229   71   250  232     809   1640
## 4            Pills 137  476  221   398  198    2857   4287
## 5             Depo 286  725  405   456  511    3166   5549
## 6          Condoms 888 4247 1143  1934 3300   11952  23464
## 7             Foam   0    0   10     2    8      41     61
## 8             IUCD   1    1    0     0    3      37     42
## 9              VSC   0    0    0     0    0       0      0

table_3_1[,2:8] <- lapply(table_3_1[,2:8], readr::parse_number) # note the readr package dependency

str(table_3_1)
## 'data.frame': 9 obs. of  8 variables:
##  $ measure: chr  "Total Women Seen" "Total Men Seen" "Counselled Only" "Pills" ...
##  $ URD    : num  910 936 49 137 286 888 0 1 0
##  $ CRD    : num  1964 613 229 476 725 ...
##  $ LRD    : num  749 530 71 221 405 ...
##  $ NBDE   : num  1640 687 250 398 456 ...
##  $ NBDW   : num  1143 150 232 198 511 ...
##  $ WESTERN: num  8961 2334 809 2857 3166 ...
##  $ TOTAL  : num  15367 5250 1640 4287 5549 ...

Подобная идиома может бытьиспользуется для преобразования большинства таблиц на страницах 14-17 образца PDF:

pages_14_to_17 <- tabulizer::extract_tables(file = fil, pages = 14:17)

lapply(pages_14_to_17, function(x) {
  x[1,1] <- "measure"
  x <- as.data.frame(x, stringsAsFactors = FALSE)
  x <- docxtractr::assign_colnames(x, 1)
  x[,2:ncol(x)] <- lapply(x[,2:ncol(x)], readr::parse_number)
  x
}) -> pages_14_to_17

str(pages_14_to_17, 1)
## List of 12
##  $ :'data.frame': 11 obs. of  8 variables:
##  $ :'data.frame': 10 obs. of  8 variables:
##  $ :'data.frame': 0 obs. of  7 variables:
##  $ :'data.frame': 9 obs. of  8 variables:
##  $ :'data.frame': 11 obs. of  8 variables:
##  $ :'data.frame': 11 obs. of  8 variables:
##  $ :'data.frame': 10 obs. of  8 variables:
##  $ :'data.frame': 11 obs. of  8 variables:
##  $ :'data.frame': 11 obs. of  8 variables:
##  $ :'data.frame': 10 obs. of  8 variables:
##  $ :'data.frame': 7 obs. of  8 variables:
##  $ :'data.frame': 8 obs. of  8 variables:

(не помещая все кадры данных в ответ для экономии места).

Обратите внимание, что элемент списка 3 не имеет строк, так как таблица переносится с 14 на 15. Нет способа "один размер подходит всем", чтобы обрабатывать это, и это была бы пользовательская логика в сценарии для обработки, возвращаясь к странице 14 иполучить заголовок для него.

...