вялый условно по значению переменной - PullRequest
Новая
       7

вялый условно по значению переменной

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

Я хочу дублировать две функции в наборе данных при условии значения определенной переменной. 

first_function <- function(x) {return (x + 0)}
second_function <- function(x) {return (x + 1)}

df <- data.frame(Letters = c("A","B","B"), Numbers = 1:3)

В некотором роде: 

df <- lapply(df, if(df$Letters=="A") first_function else second_function )

Для производства: 

df_desired <- data.frame(Letters = c("A","B","B"), Numbers = c(1,3,4))

Ответы [ 4 ]

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

Здесь вариант data.table для повышения производительности в случае большого количества строк данных (но также с неявной проблемой преобразования): 

library(data.table)

setDT(df)  # fast convertion from data.frame to data.table

df[  Letters == "A",  Numbers := first_function(Numbers) ]
df[!(Letters == "A"), Numbers := second_function(Numbers)]  # issues a warning, see below

df
# Letters Numbers
# 1:       A       1
# 2:       B       3
# 3:       B       4

Выдается предупреждение:

Предупреждающее сообщение: В [.data.table (df,! (Letters == "A"), := (Numbers, second_function (Numbers))): приведено двойное RHS к "integer" для соответствия типу столбца;может иметь усеченную точность.Либо сначала измените целевой столбец ['Numbers'] на 'double' (путем создания нового вектора 'double' длиной 3 (nrows всей таблицы) и назначьте его, то есть столбец 'replace'), либо приведите RHS к 'integer'(например, 1L, NA_ [real | integer] _, as. * и т. д.), чтобы прояснить свое намерение и повысить скорость.Или, при создании таблицы, правильно установите тип столбца и придерживайтесь его, пожалуйста.

Причина в том, что столбец data.frame Numbers является целым числом 

> str(df)
'data.frame':   3 obs. of  2 variables:
 $ Letters: Factor w/ 2 levels "A","B": 1 2 2
 $ Numbers: int  1 2 3

но функции возвращают двойное значение (по любой причине): 

> typeof(first_function(df$Numbers))
[1] "double"
0 голосов
/ 26 октября 2018

Вы можете сделать это с dplyr и purrr. Очевидно, что это базовая функция, но вы должны иметь возможность использовать ее для своих нужд: 

library(dplyr)
library(purrr)
calc <- function(y, x){
  first_function <- function(x) {return (x + 0)}
  second_function <- function(x) {return (x + 1)}

  if(y == "A")
    return(first_function(x))

    return(second_function(x))
}

df <- data.frame(Letters = c("A","B","B"), Numbers = 1:3)

df %>% 
  mutate(Numbers = map2_dbl(Letters, Numbers, ~calc(.x,.y)))

  Letters Numbers
1       A       1
2       B       3
3       B       4

>(df_desired <- data.frame(Letters = c("A","B","B"), Numbers = c(1,3,4)))
      Letters Numbers
1       A       1
2       B       3
3       B       4

СРАВНИТЕЛЬНЫЙ

Я не эксперт по data.table (не стесняйтесь добавлять), поэтому не включил сюда. Но @R Йода это правильно. Хотя он хорошо читается и в будущем вам будет легче читать и расширять функцию, решение purrr не такое быстрое. Мне понравился подход ifelse, поэтому я добавил case_when, который легче масштабировать при работе с несколькими функциями. Вот пара решений: 

library(dplyr)
library(purrr)
library(microbenchmark)

first_function <- function(x) {return (x + 0)}
second_function <- function(x) {return (x + 1)}

calc <- function(y, x){
  if(y == "A")
    return(first_function(x))

    return(second_function(x))
}

df <- data.frame(Letters = rep(c("A","B","B"),1000), Numbers = 1:3)

basic <- function(){
  data.frame(df$Letters, apply(df, 1, function(row) {
    num <- as.numeric(row['Numbers'])
    if (row['Letters'] == 'A') first_function(num) else second_function(num)
  }))
}

dplyr_purrr <- function(){
  df %>% 
    mutate(Numbers = map2_dbl(Letters, Numbers, ~calc(.x,.y)))
}

dplyr_case_when <- function(){
  df %>% 
    mutate(Numbers = case_when(
        Letters == "A" ~ first_function(Numbers),
        TRUE ~ second_function(Numbers)))
}

map_list <- function(){
   data.frame(df$Letters, map2_dbl(df2$Letters, df2$Numbers, ~calc(.x, .y)))
}

within_mapply <- function(){
  within(df, Numbers <- mapply(Letters, Numbers, 
                               FUN = function(x, y){
    switch(x, 
           "A" = first_function(y),
           "B" = second_function(y))
    }))
}

within_ifelse <- function(){

  within(df, Numbers <- ifelse(Letters == "A",
                               first_function(Numbers),
                               second_function(Numbers)))
}

within_case_when <- function(){

  within(df, Numbers <- case_when(
    Letters == "A" ~ first_function(Numbers),
    TRUE ~ second_function(Numbers)))
}

(mbm <- microbenchmark(
  basic(),
  dplyr_purrr(),
  dplyr_case_when(),
  map_list(),
  within_mapply(),
  within_ifelse(),
  within_case_when(),
  times = 1000
))

Unit: microseconds
               expr       min         lq       mean     median        uq        max neval    cld
            basic() 12816.427 24028.3375 27719.8182 26741.7770 29417.267 277756.650  1000      f
      dplyr_purrr()  9682.884 17817.0475 20072.2752 19736.8445 21767.001  48344.265  1000     e 
  dplyr_case_when()  1098.258  2096.2080  2426.7183  2325.7470  2625.439   9039.601  1000  b    
         map_list()  8764.319 16873.8670 18962.8540 18586.2790 20599.000  41524.564  1000    d  
    within_mapply()  6718.368 12397.1440 13806.1752 13671.8120 14942.583  24958.390  1000   c   
    within_ifelse()   279.796   586.6675   690.1919   653.3345   737.232   8131.292  1000 a     
 within_case_when()   470.155   955.8990  1170.4641  1070.5655  1219.284  46736.879  1000 a

enter image description here

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

lapply имеет трудности в этом случае, потому что он основан на столбцах.Однако вы можете попробовать транспонировать ваши данные с помощью t() и использовать lapply, если вы будете продолжать.Здесь я привожу два способа, которые используют mapply и ifelse: 

df$Letters <- as.character(df$Letters)

# Method 1
within(df, Numbers <- mapply(Letters, Numbers, FUN = function(x, y){
                             switch(x, "A" = first_function(y),
                                       "B" = second_function(y))
}))

# Method 2
within(df, Numbers <- ifelse(Letters == "A",
                             first_function(Numbers),
                             second_function(Numbers)))

Оба вышеперечисленных получили одинаковые выходные данные: 

#   Letters Numbers
# 1       A       1
# 2       B       3
# 3       B       4
0 голосов
/ 26 октября 2018

Простой способ сделать это с помощью *apply состоит в том, чтобы поместить всю логику (с условной и двумя функциями) в другую функцию и использовать apply с MARGIN=1 для передачи данных построчно ( lapply передаст данные по столбцу): 

apply(df, 1, function(row) {
    num <- as.numeric(row['Numbers'])
    if (row['Letters'] == 'A') first_function(num) else second_function(num)
    })

[1] 1 3 4

Проблема с этим подходом в @ r2evans, указанная в комментарии ниже, заключается в том, что при использовании apply с разнородным data.frame (в данном случае Letters имеет тип factor, а Numbers is type integer) каждая строка, переданная в прикладную функцию, передается как вектор, который может иметь только один тип, поэтому все в строке приводится к одному и тому же типу (в данном случае character). Вот почему необходимо использовать as.numeric(row['Numbers']), чтобы превратить Numbers обратно в тип numeric. В зависимости от ваших данных, это может быть простое исправление (как указано выше), или это может сделать вещи намного более сложными и подверженными ошибкам. В любом случае решение @ akrun намного лучше, поскольку оно сохраняет исходный тип данных каждой переменной.

...