Чтение Json файла в файл data.frame без вложенных списков

Ответ 1

Обновление: 21 февраля 2016 г.

col_fixer обновлен, чтобы включить аргумент vec2col, который позволяет сгладить столбец списка в одну строку или набор столбцов.

В data.frame, который вы загрузили, я вижу несколько разных типов столбцов. Существуют нормальные столбцы, содержащие векторы того же типа. Есть столбцы списка, где элементы могут быть NULL или сами могут быть плоскими. Есть столбцы списка, в которых в элементе списка есть data.frame. Существуют столбцы списка, содержащие data.frame того же количества строк, что и основной data.frame.

Здесь образец набора данных, который воссоздает эти условия:

mydf <- data.frame(id = 1:3, type = c("A", "A", "B"), 
                   facility = I(list(c("x", "y"), NULL, "x")),
  address = I(list(data.frame(v1 = 1, v2 = 2, v4 = 3), 
                   data.frame(v1 = 1:2, v2 = 3:4, v3 = 5), 
                   data.frame(v1 = 1, v2 = NA, v3 = 3))))

mydf$person <- data.frame(name = c("AA", "BB", "CC"), age = c(20, 32, 23),
                          preference = c(TRUE, FALSE, TRUE))

str этого образца data.frame выглядит следующим образом:

str(mydf)
## 'data.frame':    3 obs. of  5 variables:
##  $ id      : int  1 2 3
##  $ type    : Factor w/ 2 levels "A","B": 1 1 2
##  $ facility:List of 3
##   ..$ : chr  "x" "y"
##   ..$ : NULL
##   ..$ : chr "x"
##   ..- attr(*, "class")= chr "AsIs"
##  $ address :List of 3
##   ..$ :'data.frame': 1 obs. of  3 variables:
##   .. ..$ v1: num 1
##   .. ..$ v2: num 2
##   .. ..$ v4: num 3
##   ..$ :'data.frame': 2 obs. of  3 variables:
##   .. ..$ v1: int  1 2
##   .. ..$ v2: int  3 4
##   .. ..$ v3: num  5 5
##   ..$ :'data.frame': 1 obs. of  3 variables:
##   .. ..$ v1: num 1
##   .. ..$ v2: logi NA
##   .. ..$ v3: num 3
##   ..- attr(*, "class")= chr "AsIs"
##  $ person  :'data.frame':    3 obs. of  3 variables:
##   ..$ name      : Factor w/ 3 levels "AA","BB","CC": 1 2 3
##   ..$ age       : num  20 32 23
##   ..$ preference: logi  TRUE FALSE TRUE
## NULL

Один из способов "сгладить" это "исправить" столбцы списка. Есть три исправления.

• flatten (из "jsonlite" ) позаботится о столбцах, таких как столбец "человек".
• Столбцы, такие как столбец "объект", могут быть исправлены с помощью toString, который преобразует каждый элемент в элемент, разделенный запятой, или который может быть преобразован в несколько столбцов.
• Столбцы, в которых есть data.frame s, некоторые с несколькими строками, сначала должны быть сплющены в одну строку (путем преобразования в "широкий" формат), а затем должны быть связаны вместе как один data.table. (Я использую "data.table" для изменения формы и для связывания строк вместе).

Мы можем позаботиться о второй и третьей точках с такой функцией, как:

col_fixer <- function(x, vec2col = FALSE) {
  if (!is.list(x[[1]])) {
    if (isTRUE(vec2col)) {
      as.data.table(data.table::transpose(x))
    } else {
      vapply(x, toString, character(1L))
    }
  } else {
    temp <- rbindlist(x, use.names = TRUE, fill = TRUE, idcol = TRUE)
    temp[, .time := sequence(.N), by = .id]
    value_vars <- setdiff(names(temp), c(".id", ".time"))
    dcast(temp, .id ~ .time, value.var = value_vars)[, .id := NULL]
  }
}

Мы будем интегрировать эту функцию и функцию flatten в другую функцию, которая будет выполнять большую часть обработки.

Flattener <- function(indf, vec2col = FALSE) {
  require(data.table)
  require(jsonlite)
  indf <- flatten(indf)
  listcolumns <- sapply(indf, is.list)
  newcols <- do.call(cbind, lapply(indf[listcolumns], col_fixer, vec2col))
  indf[listcolumns] <- list(NULL)
  cbind(indf, newcols)
}

Запуск функции дает нам:

Flattener(mydf)
##   id type person.name person.age person.preference facility address.v1_1
## 1  1    A          AA         20              TRUE     x, y            1
## 2  2    A          BB         32             FALSE                     1
## 3  3    B          CC         23              TRUE        x            1
##   address.v1_2 address.v2_1 address.v2_2 address.v4_1 address.v4_2 address.v3_1
## 1           NA            2           NA            3           NA           NA
## 2            2            3            4           NA           NA            5
## 3           NA           NA           NA           NA           NA            3
##   address.v3_2
## 1           NA
## 2            5
## 3           NA

Или, когда векторы входят в отдельные столбцы:

Flattener(mydf, TRUE)
##   id type person.name person.age person.preference facility.V1 facility.V2
## 1  1    A          AA         20              TRUE           x           y
## 2  2    A          BB         32             FALSE        <NA>        <NA>
## 3  3    B          CC         23              TRUE           x        <NA>
##   address.v1_1 address.v1_2 address.v2_1 address.v2_2 address.v4_1 address.v4_2
## 1            1           NA            2           NA            3           NA
## 2            1            2            3            4           NA           NA
## 3            1           NA           NA           NA           NA           NA
##   address.v3_1 address.v3_2
## 1           NA           NA
## 2            5            5
## 3            3           NA

Здесь str:

str(Flattener(mydf))
## 'data.frame':    3 obs. of  14 variables:
##  $ id               : int  1 2 3
##  $ type             : Factor w/ 2 levels "A","B": 1 1 2
##  $ person.name      : Factor w/ 3 levels "AA","BB","CC": 1 2 3
##  $ person.age       : num  20 32 23
##  $ person.preference: logi  TRUE FALSE TRUE
##  $ facility         : chr  "x, y" "" "x"
##  $ address.v1_1     : num  1 1 1
##  $ address.v1_2     : num  NA 2 NA
##  $ address.v2_1     : num  2 3 NA
##  $ address.v2_2     : num  NA 4 NA
##  $ address.v4_1     : num  3 NA NA
##  $ address.v4_2     : num  NA NA NA
##  $ address.v3_1     : num  NA 5 3
##  $ address.v3_2     : num  NA 5 NA
## NULL

На вашем объекте "провайдеры" это выполняется очень быстро и последовательно:

library(microbenchmark)
out <- microbenchmark(Flattener(providers), Flattener(providers, TRUE), flattenList(jsonRList))
out
# Unit: milliseconds
#                        expr        min         lq      mean    median        uq       max neval
#        Flattener(providers)  104.18939  126.59295  157.3744  138.4185  174.5222  308.5218   100
#  Flattener(providers, TRUE)   67.56471   86.37789  109.8921   96.3534  121.4443  301.4856   100
#      flattenList(jsonRList) 1780.44981 2065.50533 2485.1924 2269.4496 2694.1487 4397.4793   100

library(ggplot2)
qplot(y = time, data = out, colour = expr) ## Via @TylerRinker

Ответ 2

Мой первый шаг состоял в том, чтобы загрузить данные через RCurl::getURL() и rjson::fromJSON() в соответствии с вашим вторым примером кода:

##--------------------------------------
## libraries
##--------------------------------------
library(rjson);
library(RCurl);

##--------------------------------------
## get data
##--------------------------------------
URL <- 'https://fm.formularynavigator.com/jsonFiles/publish/11/47/providers.json';
jsonRList <- fromJSON(getURL(URL)); ## recursive list representing the original JSON data

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

##--------------------------------------
## helper functions
##--------------------------------------
## apply a function to a set of nodes at the same depth level in a recursive list structure
levelApply <- function(
    nodes, ## the root node of the list (recursive calls pass deeper nodes as they drill down into the list)
    keyList, ## another list, expected to hold a sequence of keys (component names, integer indexes, or NULL for all) specifying which nodes to select at each depth level
    func=identity, ## a function to run separately on each node once keyList has been exhausted
    ..., ## further arguments passed to func()
    joinFunc=NULL ## optional function for joining the return values of func() at each successive depth, as the stack is unwound. An alternative is calling unlist() on the result, but careful not to lose the top-level index association
) {
    if (length(keyList) == 0L) {
        ret <- if (is.null(nodes)) NULL else func(nodes,...)
    } else if (is.null(keyList[[1L]]) || length(keyList[[1L]]) != 1L) {
        ret <- lapply(if (is.null(keyList[[1L]])) nodes else nodes[keyList[[1L]]],levelApply,keyList[-1L],func,...,joinFunc=joinFunc);
        if (!is.null(joinFunc))
            ret <- do.call(joinFunc,ret);
    } else {
        ret <- levelApply(nodes[[keyList[[1L]]]],keyList[-1L],func,...,joinFunc=joinFunc);
    }; ## end if
    ret;
}; ## end if
## these two wrappers automatically attempt to simplify the results of func() to a vector or matrix/data.frame, respectively
levelApplyToVec <- function(...) levelApply(...,joinFunc=c);
levelApplyToFrame <- function(...) levelApply(...,joinFunc=rbind); ## can return matrix or data.frame, depending on ret

Ключом к пониманию выше является параметр keyList. Скажем, у вас есть такой список:

list(NULL,'addresses',2:3,'city')

Это будет выбирать все строки города под вторым и третьим элементами адреса под списком адресов под всеми элементами основного списка.

В R нет встроенных функций приложения, которые могут работать с такими "параллельными" выборками node (rapply() близок, но нет сигары), поэтому я написал свой собственный. levelApply() находит каждый из совпадающих узлов и запускает данный func() на нем (по умолчанию identity(), тем самым возвращая сам node), возвращая результаты вызывающему, либо присоединившись как joinFunc(), либо в та же рекурсивная структура списка, в которой эти узлы существовали во входном списке. Быстрая демонстрация:

unname(levelApplyToVec(jsonRList,list(4L,'addresses',1:2,c('address','city'))));
## [1] "1001 Noble St"  "Fairbanks"      "1650 Cowles St" "Fairbanks"

Вот оставшиеся вспомогательные функции, которые я написал в процессе работы над этой проблемой:

## for the given node selection key union, retrieve a data.frame of logicals representing the unique combinations of keys possessed by the selected nodes, possibly with a count
keyCombos <- function(node,keyList,allKeys) `rownames<-`(setNames(unique(as.data.frame(levelApplyToFrame(node,keyList,function(h) allKeys%in%names(h)))),allKeys),NULL);
keyCombosWithCount <- function(node,keyList,allKeys) { ks <- keyCombos(node,keyList,allKeys); ks$.count <- unname(apply(ks,1,function(combo) sum(levelApplyToVec(node,keyList,function(h) identical(sort(names(ks)[combo]),sort(names(h))))))); ks; };

## return a simple two-component list with type (list, namedlist, or atomic vector type) and len for non-namedlist types; tlStr() returns a nice stringified form of said list
tl <- function(e) { if (is.null(e)) return(NULL); ret <- typeof(e); if (ret == 'list' && !is.null(names(e))) ret <- list(type='namedlist') else ret <- list(type=ret,len=length(e)); ret; };
tlStr <- function(e) { if (is.null(e)) return(NA); ret <- tl(e); if (is.null(ret$len)) ret <- ret$type else ret <- paste0(ret$type,'[',ret$len,']'); ret; };

## stringification functions for display
mkcsv <- function(v) paste0(collapse=',',v);
keyListToStr <- function(keyList) paste0(collapse='','/',sapply(keyList,function(key) if (is.null(key)) '*' else paste0(collapse=',',key)));

## return a data.frame giving a comma-separated list of the unique types possessed by the selected nodes; useful for learning about the structure of the data
keyTypes <- function(node,keyList,allKeys) data.frame(key=allKeys,tl=sapply(allKeys,function(key) mkcsv(unique(na.omit(levelApplyToVec(node,c(keyList,key),tlStr))))),row.names=NULL);

## useful for testing; can call npiToFrame() to show the row with a specified npi value, in a nice vertical form
rowToFrame <- function(dfrow) data.frame(column=names(dfrow),value=c(as.matrix(dfrow)));
getNPIRow <- function(df,npi) which(df$npi == npi);
npiToFrame <- function(df,npi) rowToFrame(df[getNPIRow(df,npi),]);

Я попытался захватить последовательность команд, которые я запускал против данных, когда я ее сначала осмотрел. Ниже приведены результаты, показывающие команды, которые я запускал, вывод команды и ведущие комментарии, описывающие мое намерение, и мое заключение из вывода:

##--------------------------------------
## data examination
##--------------------------------------
## type of object -- plain unnamed list => array, length 3256
levelApplyToVec(jsonRList,list(),tlStr);
## [1] "list[3256]"

## unique types of main array elements => all named lists => hashes
unique(levelApplyToVec(jsonRList,list(NULL),tlStr));
## [1] "namedlist"

## get the union of keys among all hashes
allKeys <- unique(levelApplyToVec(jsonRList,list(NULL),names)); allKeys;
##  [1] "npi"             "type"            "facility_name"   "facility_type"   "addresses"       "plans"           "last_updated_on" "name"            "speciality"      "accepting"       "languages"       "gender"

## get the unique pattern of keys among all hashes, and how often each occurs => shows there are inconsistent key sets among the top-level hashes
keyCombosWithCount(jsonRList,list(NULL),allKeys);
##    npi type facility_name facility_type addresses plans last_updated_on  name speciality accepting languages gender .count
## 1 TRUE TRUE          TRUE          TRUE      TRUE  TRUE            TRUE FALSE      FALSE     FALSE     FALSE  FALSE    279
## 2 TRUE TRUE         FALSE         FALSE      TRUE  TRUE            TRUE  TRUE       TRUE      TRUE      TRUE   TRUE   2973
## 3 TRUE TRUE         FALSE         FALSE      TRUE  TRUE            TRUE  TRUE       TRUE      TRUE      TRUE  FALSE      4

## for each key, get the unique set of types it takes on among all hashes, ignoring hashes where the key is omitted => some scalar strings, some multi-string, addresses is a variable-length list, plans is length-9 list, and name is a hash
keyTypes(jsonRList,list(NULL),allKeys);
##                key                                                                                        tl
## 1              npi                                                                              character[1]
## 2             type                                                                              character[1]
## 3    facility_name                                                                              character[1]
## 4    facility_type                                                    character[1],character[2],character[3]
## 5        addresses list[1],list[2],list[3],list[6],list[5],list[7],list[4],list[8],list[9],list[13],list[12]
## 6            plans                                                                                   list[9]
## 7  last_updated_on                                                                              character[1]
## 8             name                                                                                 namedlist
## 9       speciality                                       character[1],character[2],character[3],character[4]
## 10       accepting                                                                              character[1]
## 11       languages                          character[2],character[3],character[4],character[6],character[5]
## 12          gender                                                                              character[1]

## must look deeper into addresses array, plans array, and name hash; we'll have to flatten them

## ==== addresses =====
## note: the addresses key is always present under main array elements
## unique types of address elements across all hashes => all named lists, thus nested hashes
unique(levelApplyToVec(jsonRList,list(NULL,'addresses',NULL),tlStr));
## [1] "namedlist"

## union of keys among all address element hashes
allAddressKeys <- unique(levelApplyToVec(jsonRList,list(NULL,'addresses',NULL),names)); allAddressKeys;
## [1] "address"   "city"      "state"     "zip"       "phone"     "address_2"

## pattern of keys among address elements => only address_2 varies, similar frequency with it as without it
keyCombosWithCount(jsonRList,list(NULL,'addresses',NULL),allAddressKeys);
##   address city state  zip phone address_2 .count
## 1    TRUE TRUE  TRUE TRUE  TRUE     FALSE   1898
## 2    TRUE TRUE  TRUE TRUE  TRUE      TRUE   2575

## for each address element key, get the unique set of types it takes on among all hashes, ignoring hashes where the key (only address_2 in this case) is omitted => all scalar strings
keyTypes(jsonRList,list(NULL,'addresses',NULL),allAddressKeys);
##         key           tl
## 1   address character[1]
## 2      city character[1]
## 3     state character[1]
## 4       zip character[1]
## 5     phone character[1]
## 6 address_2 character[1]

## ==== plans =====
## note: the plans key is always present under main array elements
## unique types of plan elements across all hashes => all named lists, thus nested hashes
unique(levelApplyToVec(jsonRList,list(NULL,'plans',NULL),tlStr));
## [1] "namedlist"

## union of keys among all plan element hashes
allPlanKeys <- unique(levelApplyToVec(jsonRList,list(NULL,'plans',NULL),names)); allPlanKeys;
## [1] "plan_id_type" "plan_id"      "network_tier"

## pattern of keys among plan elements => good, all plan elements have all 3 keys, perfectly consistent
keyCombosWithCount(jsonRList,list(NULL,'plans',NULL),allPlanKeys);
##   plan_id_type plan_id network_tier .count
## 1         TRUE    TRUE         TRUE  29304

## for each plan element key, get the unique set of types it takes on among all hashes (note: no plan keys are ever omitted, so don't have to worry about that) => all scalar strings
keyTypes(jsonRList,list(NULL,'plans',NULL),allPlanKeys);
##            key           tl
## 1 plan_id_type character[1]
## 2      plan_id character[1]
## 3 network_tier character[1]

## ==== name =====
## note: the name key is *not* always present under main array elements
## union of keys among all name hashes
allNameKeys <- unique(levelApplyToVec(jsonRList,list(NULL,'name'),names)); allNameKeys;
## [1] "first"  "middle" "last"

## pattern of keys among name elements => sometimes middle is missing, relatively infrequently
keyCombosWithCount(jsonRList,list(NULL,'name'),allNameKeys);
##   first middle last .count
## 1  TRUE   TRUE TRUE   2679
## 2  TRUE  FALSE TRUE    298

## for each name element key, get the unique set of types it takes on among all hashes, ignoring hashes where the key (only middle in this case) is omitted => all scalar strings
keyTypes(jsonRList,list(NULL,'name'),allNameKeys);
##      key           tl
## 1  first character[1]
## 2 middle character[1]
## 3   last character[1]

Здесь мое резюме данных:

• один главный список верхнего уровня, длина 3256.
• каждый элемент является хешем с непоследовательными наборами ключей. Всего у всех основных хэшей всего 12 клавиш, в которых присутствуют 3 набора наборов клавиш.
• 6 из хэш-значений являются скалярными строками, 3 являются векторами строки переменной длины, addresses - это список переменной длины, plans - это список всегда длины 9, а name - хэш.
• каждый элемент списка addresses представляет собой хэш с 5 или 6 ключами для скалярных строк, address_2 является несогласованным.
• каждый элемент plans list - это хэш с 3 ключами для скалярных строк, без несоответствий.
• каждый хэш name имеет first и last, но не всегда middle скалярные строки.

Самое важное замечание здесь заключается в том, что между параллельными узлами не существует несоответствий типов (кроме пробелов и разностей длин). Это означает, что мы можем объединить все параллельные узлы в векторы без учета типа принуждения. Мы можем сгладить все данные в двумерной структуре при условии, что мы сопоставляем столбцы с достаточно узкими узлами, так что все столбцы соответствуют одной скалярной строке node в списке ввода.

Ниже мое решение. Обратите внимание, что это зависит от вспомогательных функций tl(), keyListToStr() и mkcsv() I, определенных ранее.

##--------------------------------------
## solution
##--------------------------------------
## recursively traverse the list structure, building up a column at each leaf node
extractLevelColumns <- function(
    nodes, ## current level node selection
    ..., ## additional arguments to data.frame()
    keyList=list(), ## current key path under main list
    sep=NULL, ## optional string separator on which to join multi-element vectors; if NULL, will leave as separate columns
    mkname=function(keyList,maxLen) paste0(collapse='.',if (is.null(sep) && maxLen == 1L) keyList[-length(keyList)] else keyList) ## name builder from current keyList and character vector max length across node level; default to dot-separated keys, and remove last index component for scalars
) {
    cat(sprintf('extractLevelColumns(): %s\n',keyListToStr(keyList)));
    if (length(nodes) == 0L) return(list()); ## handle corner case of empty main list
    tlList <- lapply(nodes,tl);
    typeList <- do.call(c,lapply(tlList,`[[`,'type'));
    if (length(unique(typeList)) != 1L) stop(sprintf('error: inconsistent types (%s) at %s.',mkcsv(typeList),keyListToStr(keyList)));
    type <- typeList[1L];
    if (type == 'namedlist') { ## hash; recurse
        allKeys <- unique(do.call(c,lapply(nodes,names)));
        ret <- do.call(c,lapply(allKeys,function(key) extractLevelColumns(lapply(nodes,`[[`,key),...,keyList=c(keyList,key),sep=sep,mkname=mkname)));
    } else if (type == 'list') { ## array; recurse
        lenList <- do.call(c,lapply(tlList,`[[`,'len'));
        maxLen <- max(lenList,na.rm=T);
        allIndexes <- seq_len(maxLen);
        ret <- do.call(c,lapply(allIndexes,function(index) extractLevelColumns(lapply(nodes,function(node) if (length(node) < index) NULL else node[[index]]),...,keyList=c(keyList,index),sep=sep,mkname=mkname))); ## must be careful to guard out-of-bounds to NULL; happens automatically with string keys, but not with integer indexes
    } else if (type%in%c('raw','logical','integer','double','complex','character')) { ## atomic leaf node; build column
        lenList <- do.call(c,lapply(tlList,`[[`,'len'));
        maxLen <- max(lenList,na.rm=T);
        if (is.null(sep)) {
            ret <- lapply(seq_len(maxLen),function(i) setNames(data.frame(sapply(nodes,function(node) if (length(node) < i) NA else node[[i]]),...),mkname(c(keyList,i),maxLen)));
        } else {
            ## keep original type if maxLen is 1, IOW don't stringify
            ret <- list(setNames(data.frame(sapply(nodes,function(node) if (length(node) == 0L) NA else if (maxLen == 1L) node else paste(collapse=sep,node)),...),mkname(keyList,maxLen)));
        }; ## end if
    } else stop(sprintf('error: unsupported type %s at %s.',type,keyListToStr(keyList)));
    if (is.null(ret)) ret <- list(); ## handle corner case of exclusively empty sublists
    ret;
}; ## end extractLevelColumns()

## simple interface function
flattenList <- function(mainList,...) do.call(cbind,extractLevelColumns(mainList,...));

Функция extractLevelColumns() пересекает список ввода и извлекает все значения node в каждой строке node, объединяя их в вектор с NA, где это значение отсутствует, а затем преобразуется в данные с одним столбцом. Рамка. Имя столбца устанавливается немедленно, используя параметризованную функцию mkname(), чтобы определить строение keyList в имени столбца строки. Несколько столбцов возвращаются как список data.frames из каждого рекурсивного вызова, а также из вызова верхнего уровня.

Он также подтверждает, что между параллельными узлами не существует несоответствий типов. Хотя я вручную проверил согласованность данных ранее, я попытался написать как универсальное и многоразовое решение, насколько это возможно, потому что это всегда хорошая идея, поэтому этот шаг проверки является подходящим.

flattenList() - основная функция интерфейса; он просто вызывает extractLevelColumns(), а затем do.call(cbind,...), чтобы объединить столбцы в один файл data.frame.

Преимущество этого решения состоит в том, что он полностью общий; он может обрабатывать неограниченное количество уровней глубины за счет полной рекурсивности. Кроме того, он не имеет зависимостей пакетов, параметризует логику построения столбцов и пересылает переменные аргументы в data.frame(), поэтому вы можете передать stringsAsFactors=F, чтобы запретить автоматическую факторизацию столбцов символов, обычно выполняемых data.frame(), и/или row.names={namevector}, чтобы задать имена строк результирующего data.frame или row.names=NULL, чтобы предотвратить использование имен компонентов списка верхнего уровня в виде имен строк, если они существуют в списке ввода.

Я также добавил параметр sep, который по умолчанию равен NULL. Если NULL, многоэлементные листовые узлы будут разделены на несколько столбцов, по одному на элемент, с индексом суффикса на имя столбца для дифференцирования. В противном случае он принимается как разделитель строк, в который нужно соединить все элементы с одной строкой, и для node создается только один столбец.

С точки зрения производительности, это очень быстро. Вот демо:

## actually run it
system.time({ df <- flattenList(jsonRList); });
## extractLevelColumns(): /
## extractLevelColumns(): /npi
## extractLevelColumns(): /type
## extractLevelColumns(): /facility_name
## extractLevelColumns(): /facility_type
## extractLevelColumns(): /addresses
## extractLevelColumns(): /addresses/1
## extractLevelColumns(): /addresses/1/address
## extractLevelColumns(): /addresses/1/city
##
## ... snip ...
##
## extractLevelColumns(): /plans/9/network_tier
## extractLevelColumns(): /last_updated_on
## extractLevelColumns(): /name
## extractLevelColumns(): /name/first
## extractLevelColumns(): /name/middle
## extractLevelColumns(): /name/last
## extractLevelColumns(): /speciality
## extractLevelColumns(): /accepting
## extractLevelColumns(): /languages
## extractLevelColumns(): /gender
##    user  system elapsed
##   2.265   0.000   2.268

Результат:

class(df); dim(df); names(df);
## [1] "data.frame"
## [1] 3256  126
##   [1] "npi"                    "type"                   "facility_name"          "facility_type.1"        "facility_type.2"        "facility_type.3"        "addresses.1.address"    "addresses.1.city"       "addresses.1.state"
##  [10] "addresses.1.zip"        "addresses.1.phone"      "addresses.1.address_2"  "addresses.2.address"    "addresses.2.city"       "addresses.2.state"      "addresses.2.zip"        "addresses.2.phone"      "addresses.2.address_2"
##  [19] "addresses.3.address"    "addresses.3.city"       "addresses.3.state"      "addresses.3.zip"        "addresses.3.phone"      "addresses.3.address_2"  "addresses.4.address"    "addresses.4.city"       "addresses.4.state"
##  [28] "addresses.4.zip"        "addresses.4.phone"      "addresses.4.address_2"  "addresses.5.address"    "addresses.5.address_2"  "addresses.5.city"       "addresses.5.state"      "addresses.5.zip"        "addresses.5.phone"
##  [37] "addresses.6.address"    "addresses.6.address_2"  "addresses.6.city"       "addresses.6.state"      "addresses.6.zip"        "addresses.6.phone"      "addresses.7.address"    "addresses.7.address_2"  "addresses.7.city"
##  [46] "addresses.7.state"      "addresses.7.zip"        "addresses.7.phone"      "addresses.8.address"    "addresses.8.address_2"  "addresses.8.city"       "addresses.8.state"      "addresses.8.zip"        "addresses.8.phone"
##  [55] "addresses.9.address"    "addresses.9.address_2"  "addresses.9.city"       "addresses.9.state"      "addresses.9.zip"        "addresses.9.phone"      "addresses.10.address"   "addresses.10.address_2" "addresses.10.city"
##  [64] "addresses.10.state"     "addresses.10.zip"       "addresses.10.phone"     "addresses.11.address"   "addresses.11.address_2" "addresses.11.city"      "addresses.11.state"     "addresses.11.zip"       "addresses.11.phone"
##  [73] "addresses.12.address"   "addresses.12.address_2" "addresses.12.city"      "addresses.12.state"     "addresses.12.zip"       "addresses.12.phone"     "addresses.13.address"   "addresses.13.city"      "addresses.13.state"
##  [82] "addresses.13.zip"       "addresses.13.phone"     "plans.1.plan_id_type"   "plans.1.plan_id"        "plans.1.network_tier"   "plans.2.plan_id_type"   "plans.2.plan_id"        "plans.2.network_tier"   "plans.3.plan_id_type"
##  [91] "plans.3.plan_id"        "plans.3.network_tier"   "plans.4.plan_id_type"   "plans.4.plan_id"        "plans.4.network_tier"   "plans.5.plan_id_type"   "plans.5.plan_id"        "plans.5.network_tier"   "plans.6.plan_id_type"
## [100] "plans.6.plan_id"        "plans.6.network_tier"   "plans.7.plan_id_type"   "plans.7.plan_id"        "plans.7.network_tier"   "plans.8.plan_id_type"   "plans.8.plan_id"        "plans.8.network_tier"   "plans.9.plan_id_type"
## [109] "plans.9.plan_id"        "plans.9.network_tier"   "last_updated_on"        "name.first"             "name.middle"            "name.last"              "speciality.1"           "speciality.2"           "speciality.3"
## [118] "speciality.4"           "accepting"              "languages.1"            "languages.2"            "languages.3"            "languages.4"            "languages.5"            "languages.6"            "gender"

Результирующий data.frame довольно широк, но мы можем использовать rowToFrame() и npiToFrame(), чтобы получить хорошую вертикальную компоновку по одной строке за раз. Например, здесь первая строка:

rowToFrame(df[1L,]);
##                     column           value
## 1                      npi      1063645026
## 2                     type        FACILITY
## 3            facility_name EXPRESS SCRIPTS
## 4          facility_type.1      Pharmacies
## 5          facility_type.2            <NA>
## 6          facility_type.3            <NA>
## 7      addresses.1.address    4750 E 450 S
## 8         addresses.1.city      WHITESTOWN
## 9        addresses.1.state              IN
## 10         addresses.1.zip           46075
## 11       addresses.1.phone      2012695236
## 12   addresses.1.address_2            <NA>
## 13     addresses.2.address            <NA>
## 14        addresses.2.city            <NA>
## 15       addresses.2.state            <NA>
## 16         addresses.2.zip            <NA>
## 17       addresses.2.phone            <NA>
## 18   addresses.2.address_2            <NA>
## 19     addresses.3.address            <NA>
## 20        addresses.3.city            <NA>
## 21       addresses.3.state            <NA>
##
## ... snip ...
##
## 77        addresses.12.zip            <NA>
## 78      addresses.12.phone            <NA>
## 79    addresses.13.address            <NA>
## 80       addresses.13.city            <NA>
## 81      addresses.13.state            <NA>
## 82        addresses.13.zip            <NA>
## 83      addresses.13.phone            <NA>
## 84    plans.1.plan_id_type    HIOS-PLAN-ID
## 85         plans.1.plan_id  38344AK0620003
## 86    plans.1.network_tier   HERITAGE-PLUS
## 87    plans.2.plan_id_type    HIOS-PLAN-ID
## 88         plans.2.plan_id  38344AK0620004
## 89    plans.2.network_tier   HERITAGE-PLUS
## 90    plans.3.plan_id_type    HIOS-PLAN-ID
## 91         plans.3.plan_id  38344AK0620006
## 92    plans.3.network_tier   HERITAGE-PLUS
## 93    plans.4.plan_id_type    HIOS-PLAN-ID
## 94         plans.4.plan_id  38344AK0620008
## 95    plans.4.network_tier   HERITAGE-PLUS
## 96    plans.5.plan_id_type    HIOS-PLAN-ID
## 97         plans.5.plan_id  38344AK0570001
## 98    plans.5.network_tier   HERITAGE-PLUS
## 99    plans.6.plan_id_type    HIOS-PLAN-ID
## 100        plans.6.plan_id  38344AK0570002
## 101   plans.6.network_tier   HERITAGE-PLUS
## 102   plans.7.plan_id_type    HIOS-PLAN-ID
## 103        plans.7.plan_id  38344AK0980003
## 104   plans.7.network_tier   HERITAGE-PLUS
## 105   plans.8.plan_id_type    HIOS-PLAN-ID
## 106        plans.8.plan_id  38344AK0980006
## 107   plans.8.network_tier   HERITAGE-PLUS
## 108   plans.9.plan_id_type    HIOS-PLAN-ID
## 109        plans.9.plan_id  38344AK0980012
## 110   plans.9.network_tier   HERITAGE-PLUS
## 111        last_updated_on      2015-10-14
## 112             name.first            <NA>
## 113            name.middle            <NA>
## 114              name.last            <NA>
## 115           speciality.1            <NA>
## 116           speciality.2            <NA>
## 117           speciality.3            <NA>
## 118           speciality.4            <NA>
## 119              accepting            <NA>
## 120            languages.1            <NA>
## 121            languages.2            <NA>
## 122            languages.3            <NA>
## 123            languages.4            <NA>
## 124            languages.5            <NA>
## 125            languages.6            <NA>
## 126                 gender            <NA>

Я тестировал результат довольно тщательно, делая много проверок на отдельных записях, и все выглядит правильно. Дайте мне знать, если у вас есть вопросы.

Ответ 3

Этот ответ скорее является предложением организации данных (и намного короче, чем привлекательные ответы);

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

library(dplyr)

# notice the simplifyVector=F
providers <- fromJSON( "http://fm.formularynavigator.com/jsonFiles/publish/11/47/providers.json", simplifyVector=F) 

# pick and repeat fields for each element of array
# {field1:val, field2:val2, array:[{af1:av1, af2:av2}, {af1:av3, af2:av4}]}
# gives data.frame 
# field1, field2 array.af1 array.af2
# val     val2  av1        av2
# val     val2  av3        av4
denormalize <- function(data, fields, array) {
  data.frame(
    c(
      data[fields], 
      as.list(
        bind_rows(
          lapply(data[[array]], data.frame)))))
}

plans_df <- bind_rows(lapply(providers, denormalize, c('npi'), 'plans'))
addresses_df <- bind_rows(lapply(providers, denormalize, c('npi'), 'addresses'))
npis <- bind_rows(lapply(providers, function(d, fields) data.frame(d[fields]), 
                         c('npi', 'type', 'last_updated_on')))

Затем вы можете сначала фильтровать данные и впоследствии присоединяться к другой информации:

addresses_df %>%
  filter(city == "Healy") %>%
  left_join(plans_df, by="npi") ->
  plans_in_healy

Ответ 4

Таким образом, это не подходит для решения, поскольку оно напрямую не отвечает на вопрос, но вот как я буду анализировать эти данные.

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

 providers <- fromJSON( "http://fm.formularynavigator.com/jsonFiles/publish/11/47/providers.json" , simplifyDataFrame=FALSE ) 
 types = sapply(providers,"[[","type")
 table(types)

 # FACILITY INDIVIDUAL 
 #    279       2977 

• Записи
• FACILITY имеют поля "ID" facility_name и facility_type. Записи
• INDIVIDUAL имеют поля "ID" name, speciality, accepting, languages и gender.
• Все записи имеют поля "ID" npi и last_updated_on.
• Все записи имеют два вложенных поля: addresses и plans. Например, addresses - это list, который содержит город, состояние и т.д.

Поскольку для каждого npi существует несколько адресов, я бы предпочел преобразовать их в кадр данных с столбцами для города, состояния и т.д. Я также создам аналогичный фрейм данных для plans. Затем я присоединяюсь к addresses и plans в один фрейм данных. Следовательно, если есть 4 адреса и 8 планов, в объединенном фрейме данных будет 4 * 8 = 32 строки. Наконец, я буду использовать так же денормализованный фрейм данных с информацией "ID", используя другое слияние.

library(dplyr)
unfurl_npi_data = function (x) {
  repeat_cols = c("plans","addresses")
  id_cols = setdiff(names(x),repeat_cols)
  repeat_data = x[repeat_cols]
  id_data  = x[id_cols]

  # Denormalized ID data
  id_data_df = Reduce(function(x,y) merge(x,y,by=NULL), id_data, "")[,-1]
  atomic_colnames = names(which(!sapply(id_data, is.list)))
  df_atomic_cols = unlist(sapply(id_data,function(x) if(is.list(x)) rep(FALSE, length(x)) else TRUE))
  colnames(id_data_df)[df_atomic_cols] = atomic_colnames

  # Join the plans and addresses (denormalized)
  repeated_data = lapply(repeat_data, rbind_all)
  repeated_data_crossed = Reduce(merge, repeated_data, repeated_data[[1]])

  merge(id_data_df, repeated_data_crossed)
}

providers2 = split(providers, types)
providers3 = lapply(providers2, function(x) rbind_all(lapply(x, unfurl_npi_data)))

Затем выполните некоторую очистку.

unique_df = function(x) {
  chr_col_names = names(which(sapply(x, class) == "character"))
  for( col in chr_col_names )
    x[[col]] = toupper(x[[col]])
  unique(x)
}
providers3 = lapply(providers3, unique_df)
facilities = providers3[["FACILITY"]]
individuals = providers3[["INDIVIDUAL"]]
rm(providers, providers2, providers3)

И теперь вы можете задать несколько интересных вопросов. Например, сколько адресов у каждого поставщика медицинских услуг?

 unique_providers = individuals %>% select(first, middle, last, gender, state, city, address) %>% unique()
 num_addresses = unique_providers %>% count(first, middle, last, gender)
 table(num_addresses$n)

 #    1    2    3    4    5    6    7    8    9   12   13 
 # 2258  492  119   33   43   21    6    1    2    1    1 

По адресам с более чем пятью людьми, каков процент мужчин-поставщиков медицинских услуг?

address_pcts = unique_providers %>% 
  group_by(address, city, state) %>%
  filter(n()>5) %>%
  arrange(address) %>%
  summarise(pct_male = sum(gender=="MALE")/n())
library(ggplot2)
qplot(address_pcts$pct_male, binwidth=1/7) + xlim(0,1)

И дальше и дальше...