Управление данными из файлов .txt в R - PullRequest
Новая
       65

Управление данными из файлов .txt в R

1 голос
/ 04 ноября 2019

Введение в проблему

Здравствуйте,

Я работаю над созданием плана данных для моей лаборатории, которая начнет слепое клиническое исследование, которое начнется в январе. Часть этой задачи состоит в том, чтобы настроить некоторые конвейеры обработки данных, чтобы после того, как все данные были собраны, мы могли быстро выполнить код.

Одним из показателей результата, который мы используем, является тест поведения. Кто-то разработал программу javascript, которая автоматически оценивает тест;однако на выходе отображаются 5 таблиц, расположенных друг над другом. С помощью некоторых пользователей stackoverflow я смог разработать конвейер, который реструктурирует один текстовый файл в фрейм данных, который затем может быть проанализирован. Теперь я застреваю в том, как обрабатывать все файлы одновременно.

Я думал загрузить все файлы в список, а затем манипулировать каждым элементом в списке с помощью map.list или lapply. Однако я получаю две проблемы, о которых я расскажу ниже.

Во-первых, это код и данные, которые хорошо работают для манипулирования одним кадром данных. 

input <- c("Cognitive Screen", "Subtest/Section\t\t\tScore\tT-Score", 
"1. Line Bisection\t\t9\t53", "2. Semantic Memory\t\t8\t51", 
"3. Word Fluency\t\t\t1\t56*", "4. Recognition Memory\t\t40\t59", 
"5. Gesture Object Use\t\t2\t68", "6. Arithmetic\t\t\t5\t49", 
"Cognitive TOTAL\t\t\t65", "", "Language Battery", "Part 1: Language Comprehension", 
"Spoken Language\t\t\tScore\tT-Score", "7. Spoken Words\t\t\t17\t45*", 
"9. Spoken Sentences\t\t25\t53*", "11. Spoken Paragraphs\t\t4\t60", 
"Spoken Language TOTAL\t\t46\t49*", "", "Written Language\t\tScore\tT-Score", 
"8. Written Words\t\t14\t45*", "10. Written Sentences\t\t21\t48*", 
"Written Language TOTAL\t\t35\t46*", "", "Part 2: Expressive Language", 
"Repetition\t\t\tScore\tT-Score", "12. Words\t\t\t24\t55*", "13. Complex Words\t\t8\t52*", 
"14. Nonwords\t\t\t10\t58", "15. Digit Strings\t\t8\t55", "16. Sentences\t\t\t12\t63", 
"Repetition TOTAL\t\t62\t57*", "", "Spoken Language\t\t\tScore\tT-Score", 
"17. Naming Objects\t\t30\t55*", "18. Naming Actions\t\t36\t63", 
"3. Word Fluency\t\t\t12\t56*", "Naming TOTAL\t\t\t56\t57*", 
"", "Spoken Picture Description\tScore\tT-Score", "19. Spoken Picture Description\t\t", 
"", "Reading Aloud\t\t\tScore\tT-Score", "20. Words\t\t\t25\t50*", 
"21. Complex Words\t\t8\t51*", "22. Function Words\t\t3\t62", 
"23. Nonwords\t\t\t6\t51*", "Reading TOTAL\t\t\t42\t50*", "", 
"Writing\t\t\t\tScore\tT-Score", "24. Writing: Copying\t\t26\t52", 
"25. Writing Picture Names\t14\t53*", "26. Writing to Dictation\t28\t68", 
"Writing TOTAL\t\t\t68\t58*", "", "Written Picture Description\tScore\tT-Score", 
"27. Written Picture Description\t\t")

После создания входного файлавот код, который я использую для создания фрейма данных (я знаю, что фрейм данных в символах - это исправлю позже) 

input <- read_lines('Example_data')

# do the match and keep only the second column
header <- as_tibble(str_match(input, "^(.*?)\\s+Score.*")[, 2, drop = FALSE])
colnames(header) <- 'title'

# add index to the list so we can match the scores that come after
header <- header %>%
  mutate(row = row_number()) %>%
  fill(title)  # copy title down

# pull off the scores on the numbered rows
scores <- str_match(input, "^([0-9]+[. ]+)(.*?)\\s+([0-9]+)\\s+([0-9*]+)$")
scores <- as_tibble(scores) %>%
  mutate(row = row_number())
scores3 <- mutate(scores, row = row_number())
# keep only rows that are numbered and delete first column
scores <- scores[!is.na(scores[,1]), -1]

# merge the header with the scores to give each section
data <- left_join(scores,
                   header,
                   by = 'row'
)

#create correct header in new dataframe
data2 <- data.frame(domain = as.vector(str_replace(data$title, "Subtest/Section", "cognition")),
                                   subtest = data$V3,
                                   score = data$V4,
                                   t.score = data$V5)

head(data2)

Хорошо, теперь для нескольких файлов данных. Мой план состоит в том, чтобы все txt-файлы были в одной папке, а затем составить список, включающий все файлы, например: 

# library(rlist)
# setwd("C:/Users/Brahma/Desktop/CAT TEXT FILES/Data")
# temp = list.files(pattern = "*Example")
# myfiles = lapply(temp, readLines)

Воспроизводимый пример файла: 

myfiles <- list(c("Cognitive Screen", "Subtest/Section\t\t\tScore\tT-Score", 
"1. Line Bisection\t\t9\t53", "2. Semantic Memory\t\t8\t51", 
"3. Word Fluency\t\t\t1\t56*", "4. Recognition Memory\t\t40\t59", 
"5. Gesture Object Use\t\t2\t68", "6. Arithmetic\t\t\t5\t49", 
"Cognitive TOTAL\t\t\t65", "", "Language Battery", "Part 1: Language Comprehension", 
"Spoken Language\t\t\tScore\tT-Score", "7. Spoken Words\t\t\t17\t45*", 
"9. Spoken Sentences\t\t25\t53*", "11. Spoken Paragraphs\t\t4\t60", 
"Spoken Language TOTAL\t\t46\t49*", "", "Written Language\t\tScore\tT-Score", 
"8. Written Words\t\t14\t45*", "10. Written Sentences\t\t21\t48*", 
"Written Language TOTAL\t\t35\t46*", "", "Part 2: Expressive Language", 
"Repetition\t\t\tScore\tT-Score", "12. Words\t\t\t24\t55*", "13. Complex Words\t\t8\t52*", 
"14. Nonwords\t\t\t10\t58", "15. Digit Strings\t\t8\t55", "16. Sentences\t\t\t12\t63", 
"Repetition TOTAL\t\t62\t57*", "", "Spoken Language\t\t\tScore\tT-Score", 
"17. Naming Objects\t\t30\t55*", "18. Naming Actions\t\t36\t63", 
"3. Word Fluency\t\t\t12\t56*", "Naming TOTAL\t\t\t56\t57*", 
"", "Spoken Picture Description\tScore\tT-Score", "19. Spoken Picture Description\t\t", 
"", "Reading Aloud\t\t\tScore\tT-Score", "20. Words\t\t\t25\t50*", 
"21. Complex Words\t\t8\t51*", "22. Function Words\t\t3\t62", 
"23. Nonwords\t\t\t6\t51*", "Reading TOTAL\t\t\t42\t50*", "", 
"Writing\t\t\t\tScore\tT-Score", "24. Writing: Copying\t\t26\t52", 
"25. Writing Picture Names\t14\t53*", "26. Writing to Dictation\t28\t68", 
"Writing TOTAL\t\t\t68\t58*", "", "Written Picture Description\tScore\tT-Score", 
"27. Written Picture Description\t\t"), c("Cognitive Screen", 
"Subtest/Section\t\t\tScore\tT-Score", "1. Line Bisection\t\t9\t53", 
"2. Semantic Memory\t\t8\t51", "3. Word Fluency\t\t\t1\t56*", 
"4. Recognition Memory\t\t40\t59", "5. Gesture Object Use\t\t2\t68", 
"6. Arithmetic\t\t\t5\t49", "Cognitive TOTAL\t\t\t65", "", "Language Battery", 
"Part 1: Language Comprehension", "Spoken Language\t\t\tScore\tT-Score", 
"7. Spoken Words\t\t\t17\t45*", "9. Spoken Sentences\t\t25\t53*", 
"11. Spoken Paragraphs\t\t4\t60", "Spoken Language TOTAL\t\t46\t49*", 
"", "Written Language\t\tScore\tT-Score", "8. Written Words\t\t14\t45*", 
"10. Written Sentences\t\t21\t48*", "Written Language TOTAL\t\t35\t46*", 
"", "Part 2: Expressive Language", "Repetition\t\t\tScore\tT-Score", 
"12. Words\t\t\t24\t55*", "13. Complex Words\t\t8\t52*", "14. Nonwords\t\t\t10\t58", 
"15. Digit Strings\t\t8\t55", "16. Sentences\t\t\t12\t63", "Repetition TOTAL\t\t62\t57*", 
"", "Spoken Language\t\t\tScore\tT-Score", "17. Naming Objects\t\t30\t55*", 
"18. Naming Actions\t\t36\t63", "3. Word Fluency\t\t\t12\t56*", 
"Naming TOTAL\t\t\t56\t57*", "", "Spoken Picture Description\tScore\tT-Score", 
"19. Spoken Picture Description\t\t", "", "Reading Aloud\t\t\tScore\tT-Score", 
"20. Words\t\t\t25\t50*", "21. Complex Words\t\t8\t51*", "22. Function Words\t\t3\t62", 
"23. Nonwords\t\t\t6\t51*", "Reading TOTAL\t\t\t42\t50*", "", 
"Writing\t\t\t\tScore\tT-Score", "24. Writing: Copying\t\t26\t52", 
"25. Writing Picture Names\t14\t53*", "26. Writing to Dictation\t28\t68", 
"Writing TOTAL\t\t\t68\t58*", "", "Written Picture Description\tScore\tT-Score", 
"27. Written Picture Description\t\t"), c("Cognitive Screen", 
"Subtest/Section\t\t\tScore\tT-Score", "1. Line Bisection\t\t9\t53", 
"2. Semantic Memory\t\t8\t51", "3. Word Fluency\t\t\t1\t56*", 
"4. Recognition Memory\t\t40\t59", "5. Gesture Object Use\t\t2\t68", 
"6. Arithmetic\t\t\t5\t49", "Cognitive TOTAL\t\t\t65", "", "Language Battery", 
"Part 1: Language Comprehension", "Spoken Language\t\t\tScore\tT-Score", 
"7. Spoken Words\t\t\t17\t45*", "9. Spoken Sentences\t\t25\t53*", 
"11. Spoken Paragraphs\t\t4\t60", "Spoken Language TOTAL\t\t46\t49*", 
"", "Written Language\t\tScore\tT-Score", "8. Written Words\t\t14\t45*", 
"10. Written Sentences\t\t21\t48*", "Written Language TOTAL\t\t35\t46*", 
"", "Part 2: Expressive Language", "Repetition\t\t\tScore\tT-Score", 
"12. Words\t\t\t24\t55*", "13. Complex Words\t\t8\t52*", "14. Nonwords\t\t\t10\t58", 
"15. Digit Strings\t\t8\t55", "16. Sentences\t\t\t12\t63", "Repetition TOTAL\t\t62\t57*", 
"", "Spoken Language\t\t\tScore\tT-Score", "17. Naming Objects\t\t30\t55*", 
"18. Naming Actions\t\t36\t63", "3. Word Fluency\t\t\t12\t56*", 
"Naming TOTAL\t\t\t56\t57*", "", "Spoken Picture Description\tScore\tT-Score", 
"19. Spoken Picture Description\t\t", "", "Reading Aloud\t\t\tScore\tT-Score", 
"20. Words\t\t\t25\t50*", "21. Complex Words\t\t8\t51*", "22. Function Words\t\t3\t62", 
"23. Nonwords\t\t\t6\t51*", "Reading TOTAL\t\t\t42\t50*", "", 
"Writing\t\t\t\tScore\tT-Score", "24. Writing: Copying\t\t26\t52", 
"25. Writing Picture Names\t14\t53*", "26. Writing to Dictation\t28\t68", 
"Writing TOTAL\t\t\t68\t58*", "", "Written Picture Description\tScore\tT-Score", 
"27. Written Picture Description\t\t"))

Вот гдепроблема начинается

Я попытался использовать lapply и list.map в пакете rlist. Во-первых, похоже, что lapply не нравятся конвейерные функции, поэтому я пытаюсь работать поэтапно. Я также попытался создать функцию для этого шага.

создание тибля. это работает! 

list_header <- lapply(myfiles, as.tibble)

Пришли ошибки - попытка начать манипулирование данными 

list_header2 <- lapply(list_header, str_match(list_header, "^(.*?)\\s+Score.*")[, 2, drop = FALSE])

Эта строка кода содержит следующую ошибку:

"Ошибка в совпадении. fun (FUN): 'str_match (list_header, "^ (. ?) \ s + Score. ") [, 2, drop = FALSE]' не является функцией, символом или символом. Дополнительно: Предупреждениесообщение: In stri_match_first_regex (строка, шаблон, opts_regex = opts (шаблон)): аргумент не является атомарным вектором; принудительно "

Так что я попытался сделать функцию для размещения здесь: 

drop_rows <- function(df) {
  new_df <- str_match_all(df[[1:3]]$value, "^(.*?)\\s+Score.*")
}

list_header2 <- lapply(list_header, drop_rows)

Теперь я получаю эту ошибку:

"Ошибка в match.fun (FUN): 'str_match (list_header," ^ (. ?) \ S + Score.") [, 2, drop = FALSE] 'не является функцией, символом или символом. Дополнительно: Предупреждающее сообщение: In stri_match_first_regex (string, pattern, opts_regex = opts (pattern)): аргумент не является атомарным вектором; приведение "

Резюме:

Приведенный код хорошо работает, когда загружается один текстовый файл. Однако, когда я пытаюсь запустить код для пакетной обработки нескольких списков, у меня возникают проблемы. Если кто-нибудь сможет дать некоторое представление о том, как исправить эту ошибку **, я думаю **, я смогу закончить все остальное. Однако, если вы чувствуете, что хотите помочь в реализации оставшейся части кода, я не буду спорить с этим.

1 Ответ

1 голос
/ 05 ноября 2019

Вместо того, чтобы пытаться отлаживать ваш код, я решил попытаться найти решение, которое работает с данными вашего примера. Кажется, что следующее работает с отдельными векторами и списками векторов: 

library(tidyverse)

text_to_tibb <- function(char_vec){
    str_split(char_vec, "\t") %>% 
        map_dfr(~ .[nchar(.) > 0] %>% matrix(., nrow = T) %>%
                    as_tibble
                ) %>% 
        filter(!is.na(V2), !str_detect(V1, "TOTAL")) %>%
        mutate(title = str_detect(V1, "^\\d+\\.", negate = T),
               group = cumsum(title)
               ) %>% 
        group_by(group) %>%
        mutate(domain = first(V1)) %>% 
        filter(!title) %>% 
        ungroup() %>% 
        select(domain, V1, V2, V3, -title, -group) %>% 
        mutate(V1 = str_remove(V1, "^\\d+\\. "),
               domain = str_replace(domain, "Subtest.*", "Cognition")) %>% 
        rename(subtest = V1, score = V2, t_score = V3)
}

Если вы запустите его в своей переменной input, вы должны получить чистый тиббл: 

text_to_tibb(input)

#### OUTPUT ####
# A tibble: 26 x 4
   domain           subtest            score t_score
   <chr>            <chr>              <chr> <chr>  
 1 Cognition        Line Bisection     9     53     
 2 Cognition        Semantic Memory    8     51     
 3 Cognition        Word Fluency       1     56*    
 4 Cognition        Recognition Memory 40    59     
 5 Cognition        Gesture Object Use 2     68     
 6 Cognition        Arithmetic         5     49     
 7 Spoken Language  Spoken Words       17    45*    
 8 Spoken Language  Spoken Sentences   25    53*    
 9 Spoken Language  Spoken Paragraphs  4     60     
10 Written Language Written Words      14    45*    
# … with 16 more rows

Это такжеработает в списке векторов, которые вы включили выше. Просто используйте lapply или purrr::map: 

map(myfiles, text_to_tibb)

Если вы считаете, что в какой-то таблице могут быть некоторые несоответствия, вы можете попробовать safely: 

safe_text_to_tibb <- safely(text_to_tibb)

map(myfiles, safe_text_to_tibb)
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Похожие темы

...