Dla każdej wartości określającej, czy inna kolumna zawiera większy czy mniejszy numer

Question

Patrzę na niektóre dane dla śrub. Gdybym miał na przykład

diameter  thread 
1   4 
1   6 
1   4 
2   5 
2   7 
3   9 

Chcę sposób, aby nową kolumnę, która mówi mi, jeśli jest to największy lub najmniejszy wątek dla każdej średnicy. Nigdy nie ma więcej niż 2 rozmiary gwintów dla każdej średnicy, ale czasami jest tylko 1, w takim przypadku chciałbym, aby był tak duży. Np

diameter  thread size 
    1   4  small 
    1   6  large 
    1   4  small 
    2   5  small 
    2   7  large 
    3   9  large 

Answer 1

Oto opcja zasadę R pomocą ave do grupy, diameter. Tworzę również małą funkcję pomocnika f, aby poprawić czytelność.

# define function f: 
f <- function(x) (if(length(x)==1) 1L else x == max(x)) + 1L 
# apply f to each thread by group of diameter: 
dat$size <- c("small", "large")[ave(dat$thread, dat$diameter, FUN = f)] 

# diameter thread size 
#1  1  4 small 
#2  1  6 large 
#3  2  5 small 
#4  2  7 large 
#5  3  9 large 

Answer 2

Oto dplyr rozwiązanie:

library(dplyr); 
df %>% group_by(diameter) %>% 
     mutate(size = ifelse(thread == min(thread), "small", "large")) 

Source: local data frame [5 x 3] 
Groups: diameter [3] 

    diameter thread size 
    (int) (int) (chr) 
1  1  4 small 
2  1  6 large 
3  2  5 small 
4  2  7 large 
5  3  9 large 

lub używając data.table:

data.table::setDT(df) 
df[, size := c("small", "large")[(thread == max(thread)) + 1L], .(diameter)] 

df 
    diameter thread size 
1:  1  4 small 
2:  1  6 large 
3:  2  5 small 
4:  2  7 large 
5:  3  9 large 

Answer 3

Dość łatwe przy użyciu dplyr

library(dplyr) 
data <- data.frame(diameter=c(1,1,2,2,3),thread=c(4,6,5,7,9)) 
data %>% group_by(diameter) %>% mutate(size=ifelse(thread==max(thread),"large","small")) 

    diameter thread size 
     (dbl) (dbl) (chr) 
1  1  4 small 
2  1  6 large 
3  2  5 small 
4  2  7 large 
5  3  9 large 

Answer 4

Korzystanie split + ifelse + unsplit

df$size <- factor(unsplit(lapply(split(df$thread, df$diameter), function(x) 
    ifelse(x == max(x), 'large', 'small')), df$diameter)) 

Answer 5

Jak o tym (stosując base R):

dt$size="small" 
a=aggregate(dt$thread~dt$diameter, dt, max)[,"dt$thread"] 
dt[dt$thread %in% a,]$size="large" 

OUTPUT

diameter thread size 
1  1  4 small 
2  1  6 large 
3  1  4 small 
4  2  5 small 
5  2  7 large 
6  3  9 large 

DANE

dt=structure(list(diameter = c(1L, 1L, 1L, 2L, 2L, 3L), thread = c(4L, 
    6L, 4L, 5L, 7L, 9L)), .Names = c("diameter", "thread"), class = "data.frame", row.names = c(NA, 
    -6L)) 

BENCHMARK

library(dplyr) 
library(microbenchmark) 

dt=structure(list(diameter = c(1L, 1L, 1L, 2L, 2L, 3L), thread = c(4L, 
    6L, 4L, 5L, 7L, 9L)), .Names = c("diameter", "thread"), class = "data.frame", row.names = c(NA, 
    -6L)) 

func_ZachTurn <- function(data){data %>% group_by(diameter) %>% mutate(size=ifelse(thread==max(thread),"large","small"))} 
func_m0h3n <- function(dt){dt$size="small";a=aggregate(dt$thread~dt$diameter, dt, max)[,"dt$thread"];dt[dt$thread %in% a,]$size="large";dt} 
func_Psidom <- function(df){data.table::setDT(df);df[, size := c("small", "large")[(thread == max(thread)) + 1L], .(diameter)];df[];} 
f <- function(x) (if(length(x)==1) 1L else x == max(x)) + 1L 
func_docendo.discimus <- function(dat){dat$size <- c("small", "large")[ave(dat$thread, dat$diameter, FUN = f)];dat;} 
func_Ernest.A <- function(df){df$size <- factor(unsplit(lapply(split(df$thread, df$diameter), function(x) ifelse(x == max(x), 'large', 'small')), df$diameter));df;} 

r <- func_ZachTurn(dt) 
all(r == func_m0h3n(dt)) 
# [1] TRUE 
all(r == func_docendo.discimus(dt)) 
# [1] TRUE 
all(r == func_Ernest.A(dt)) 
# [1] TRUE 
all(r == as.data.frame(func_Psidom(dt))) 
# [1] TRUE 


microbenchmark(func_ZachTurn(dt), func_m0h3n(dt), func_docendo.discimus(dt), func_Ernest.A(dt), func_Psidom(dt)) 

# Unit: microseconds 
         # expr  min  lq  mean median  uq  max neval 
     # func_ZachTurn(dt) 3477.835 3609.147 3833.5482 3679.079 3860.6490 7136.169 100 
      # func_m0h3n(dt) 4436.367 4601.042 4879.2726 4743.474 4859.8150 8578.031 100 
# func_docendo.discimus(dt) 854.168 923.673 999.2991 956.180 992.9645 4422.252 100 
     # func_Ernest.A(dt) 1032.101 1086.636 1165.4361 1129.195 1167.9040 4882.057 100 
      # func_Psidom(dt) 1537.245 1622.577 1731.0602 1678.822 1742.3395 5424.840 100