2013-11-12 2 views
3

Я пытаюсь разбить вектор строк на объект data.frame и для фиксированного порядка это не проблема (например, как написано here), но в моем конкретном случае столбцы для будущего фрейма данных в строковых объектах не завершены. Это, как результат должен выглядеть для ввода игрушек:strsplit в data.frame с неполным вводом

input <- c("an=1;bn=3;cn=45", 
      "bn=3.5;cn=76", 
      "an=2;dn=5") 

res <- do.something(input) 

> res 
     an bn cn dn 
[1,] 1 3 45 NA 
[2,] NA 3.5 76 NA 
[3,] 2 NA NA 5 

Ищу теперь для функции do.something, что может сделать это в эффективном способе. Моим наивным решением на данный момент было бы перебрать входные объекты, strsplit те для ;, затем strsplit их снова за =, а затем заполнить data.frame результат по результату. Есть ли способ сделать это более R-одинаковым? Я боюсь, что этот элемент за элементом займет довольно много времени для длинного вектора input.

EDIT: Просто для полноты картины, мое наивное решение выглядит следующим образом:

do.something <- function(x){ 
    temp <- strsplit(x,";") 
    temp2 <- sapply(temp,strsplit,"=") 
    ul.temp2 <- unlist(temp2) 
    label <- sort(unique(ul.temp2[seq(1,length(ul.temp2),2)])) 
    res <- data.frame(matrix(NA, nrow = length(x), ncol = length(label))) 
    colnames(res) <- label 
    for(i in 1:length(temp)){ 
     for(j in 1:length(label)){ 
     curInfo <- unlist(temp2[[i]]) 
     if(sum(is.element(curInfo,label[j]))>0){ 
      res[i,j] <- curInfo[which(curInfo==label[j])+1] 
     } 
     } 
    } 
    res 
    } 

EDIT2: К сожалению, мои большой ввод данные выглядят следующим образом (данные без '=' возможно):

input <- c("an=1;bn=3;cn=45", 
      "an;bn=3.5;cn=76", 
      "an=2;dn=5") 

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

do.something <- function(x){ 
    temp <- strsplit(x,";") 
    tempNames <- sort(unique(sapply(strsplit(unlist(temp),"="),"[",1))) 
    res <- data.frame(matrix(NA, nrow = length(x), ncol = length(tempNames))) 
    colnames(res) <- tempNames 

    for(i in 1:length(temp)){ 
     curSplit <- strsplit(unlist(temp[[i]]),"=") 
     curNames <- sapply(curSplit,"[",1) 
     curValues <- sapply(curSplit,"[",2) 
     for(j in 1:length(tempNames)){ 
     if(is.element(colnames(res)[j],curNames)){ 
      res[i,j] <- curValues[curNames==colnames(res)[j]] 
     } 
     } 
    } 
    res 
    } 
+0

Ваши имена столбцов всегда два символа? –

+0

Хорошо, извините, что вводит в заблуждение. Нет, это не так. Они могут быть от 2 до 10 персонажей. –

+0

Я отредактировал мое решение.Теперь он использует только базовый пакет и должен эффективно обрабатывать недостающие номера. –

ответ

3

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

# Get column names 
tag <- regmatches(input , gregexpr("[a-z]+" , input)) 

# Get numbers including floating point, replace missing values with NA 
val <- regmatches(input , gregexpr("\\d+\\.?\\d?|(?<=[a-z]);" , input , perl = TRUE)) 
val <- lapply(val , gsub , pattern = ";" , replacement = NA) 

# Column names 
nms <- unique(unlist(tag)) 

# Intermeidate matrices 
ll <- mapply(cbind , val , tag) 

# Match to appropriate columns and coerce to data.frame 
out <- data.frame(do.call(rbind , lapply(ll , function(x) x[ match(nms , x[,2]) ] ))) 
names(out) <- nms 
# an bn cn dn 
#1 1 3 45 <NA> 
#2 <NA> 3.5 76 <NA> 
#3 2 <NA> <NA> 5 
+0

Спасибо за «базовое» решение! Я попробую и сравню тайминги. –

+0

Я просто попробовал, и это кажется намного быстрее! Мне все еще приходится корректировать некоторые мелочи о регматиках, но все же это заканчивается минут через несколько часов. –

+0

@ DanielFischer Я очень рад, что это было полезно для вас! Качественный товар. cheers :-) –

2

Не очень эффективно и использовать внешний пакет.

  1. новообращенный каждая строка в data.frame
  2. rbinds их с помощью rbind.fill из plyr

Вот мой код:

ll <- lapply(input,function(x){ 
     xx <- unlist(strsplit(x,";")) 
     nn <- sub('([a-z]+)[=].*','\\1',xx) 
     vv <- sub('([a-z]+)[=]([0-9]+([.][0-9]+)?)','\\2',xx) 
     m <- t(data.frame(vv)) 
     colnames(m) <- nn 
     as.data.frame(m) 
}) 

library(plyr) 
rbind.fill(ll) 

rbind.fill(ll) 
    an bn cn dn 
1 1 3 45 <NA> 
2 <NA> 3.5 76 <NA> 
3 2 <NA> <NA> 5 
+0

Спасибо за это решение, к сожалению, я не могу принять все ответы, но не менее +1. –

3

Это своего рода плохой Techniq но иногда ept (eval parse text).

> library(plyr) 
> rbind.fill(lapply(input, function(x) {l <- new.env(); eval(parse(text = x), envir=l); as.data.frame(as.list(l))})) 
    an cn bn dn 
1 1 45 3.0 NA 
2 NA 76 3.5 NA 
3 2 NA NA 5 

Update

> z <- lapply(strsplit(input, ";"), 
+    function(x) { 
+    e <- Filter(function(y) length(y)==2, strsplit(x, "=")) 
+    r <- data.frame(lapply(e, `[`, 2)) 
+    names(r) <- lapply(e, `[`, 1) 
+    r 
+    }) 
> rbind.fill(z) 
    an bn cn dn 
1 1 3 45 <NA> 
2 <NA> 3.5 76 <NA> 
3 2 <NA> <NA> 5 
+0

Спасибо, это выглядит более кратким, чем мое решение. К сожалению, я не могу сравнивать тайминги между решениями, потому что мой вход выглядит несколько иначе, чем я думал, поэтому это решение не работает над ним (см. EDIT2). Но все же, поскольку это решение решило исходную проблему, я соглашусь с ней. –

+0

@ DanielFischer см. Обновления. – kohske

+0

Отлично, спасибо! По сравнению с моим приведенным наивным решением это примерно в 9 раз быстрее! –

1

Еще одна вариация на тему rbind.fill:

library(plyr) 

mini.df <- function(x) { 
    y <- do.call(cbind,strsplit(x,"=")) 
    z <- as.numeric(y[2,]) 
    names(z) <- y[1,] 
    return(as.data.frame(t(z))) 
} 
res <- rbind.fill(lapply(strsplit(input,";"),mini.df)) 

Это на самом деле очень похож на двух других решений. Я просто создал dataframes несколько иначе.

+0

Спасибо за это решение, к сожалению, я не могу принять все ответы, но не менее +1. –

Смежные вопросы