R дроби с библиотекой (МАССА)

У меня есть длинный список чисел в символьном формате (около 50000 терминов), которые можно очень быстро преобразовать в числовые с помощью «as.numeric»:

y = c("-1", "1", "1", ...)

Проблема в том, что я расширил функциональность, включив дроби и вызов

    y = c("-1/2", "1", "1", ...)
    y = as.numeric(y);

выдает предупреждающее сообщение "НП введены путем принуждения" при вызове

 sapply(y , function(x) {

     eval(parse(text=x));
  });

решает проблему, но требует гораздо больше времени для выполнения. Есть лучший способ сделать это?


r fractions
person Dement    schedule 22.11.2015    source источник
comment
Вы можете попробовать sapply(y, function(x) if(grepl('/', x)) eval(parse(text=x)) else as.numeric(x))   -  person akrun    schedule 22.11.2015

Ответы (1)


arrow_upward
2
arrow_downward

eval(parse(text)) работает очень медленно - поскольку вы знаете, что будете делать, вы можете написать более быструю функцию:

y = c("-1/2", "1", "1", "1/2")
fixnums <- function(x){
  temp <- as.numeric(x)
  temp[is.na(temp)] <- lapply(strsplit(x[is.na(temp)], "/"), function(x) as.numeric(x[1])/as.numeric(x[2]))
  unlist(temp)
}
fixnums(y)

Более быстрая версия, позволяющая избежать лаппи, предложена в комментарии ниже @DavidArenburg:

davidfixnums <- function(x){
  temp <- as.numeric(x)
  temp2 <- as.numeric(unlist(strsplit(y[is.na(temp)], "/", fixed = TRUE)))
  temp[is.na(temp)] <- temp2[c(T, F)]/temp2[c(F, T)]
  temp
}

Некоторые тесты с использованием предложений @akrun и @DavidArenburgs:

library(microbenchmark)
set.seed(1234)
y <- sample(c("-1/2", "1", "1", "1/2"), 10000, replace = TRUE)

akrunfixnums <- function(y){
  x1 <- as.numeric(y)
  x1[is.na(x1)] <- vapply(y[is.na(x1)], function(x) 
    eval(parse(text=x)), numeric(1))
  x1
}

microbenchmark(fixnums(y), davidfixnums(y), akrunfixnums(y))

Unit: milliseconds
            expr        min         lq       mean     median        uq       max neval cld
      fixnums(y)  22.643745  23.157345  25.326465  23.435554  23.98544 154.16316   100  b 
 davidfixnums(y)   6.676234   6.778378   6.957626   6.824459   6.93025  10.12763   100 a  
 akrunfixnums(y) 845.404840 858.031737 869.886625 865.255363 875.54351 960.86497   100   c
person jeremycg    schedule 22.11.2015
comment
Вероятно, вы могли бы векторизовать свой второй шаг и избегать одновременного lapply и двойного as.numeric на каждом шаге, используя temp2 <- as.numeric(unlist(strsplit(y[is.na(temp)], "/", fixed = TRUE))) ; temp[is.na(temp)] <- temp2[c(T, F)]/temp2[c(F, T)] - person David Arenburg; 22.11.2015
comment
хороший, в 4 раза быстрее @DavidArenburg - person jeremycg; 22.11.2015
comment
Интересно, если бы сохранение is.na(temp) в какой-то дополнительной временной переменной вместо двойного вычисления ускорило бы процесс еще больше. Хотя я не знаю, как это повлияет на память. - person David Arenburg; 22.11.2015