R:根据数据矩阵和阈值数据帧创建布尔矩阵

Question

假设我有一个这样的数据矩阵:

> data(mtcars)
> my_mat <- as.matrix(mtcars[,1:7])
> head(my_mat)
mpg cyl disp  hp drat    wt  qsec
Mazda RX4         21.0   6  160 110 3.90 2.620 16.46
Mazda RX4 Wag     21.0   6  160 110 3.90 2.875 17.02
Datsun 710        22.8   4  108  93 3.85 2.320 18.61
Hornet 4 Drive    21.4   6  258 110 3.08 3.215 19.44
Hornet Sportabout 18.7   8  360 175 3.15 3.440 17.02
Valiant           18.1   6  225 105 2.76 3.460 20.22

…以及如下所示的阈值数据帧，上面的矩阵中的一些列具有阈值:

> threshold_df <- data.frame(marker=colnames(my_mat)[c(3,4,6)], threshold=apply(my_mat[,c(3,4,6)], 2, quantile, 0.75))
> threshold_df
marker threshold
disp   disp    326.00
hp       hp    180.00
wt       wt      3.61

有了这些信息，我想最终得到一个0和1的矩阵，与my_mat相同，其中除了一列的值高于该列的阈值外，所有值都是0。

到目前为止，我有一个全0矩阵，但不确定如何根据上述信息填充1…有线索吗?谢谢!

> zero_mat <- matrix(0, nrow = nrow(my_mat), ncol = ncol(my_mat))
> colnames(zero_mat) <- colnames(my_mat)
> rownames(zero_mat) <- rownames(my_mat)
> head(zero_mat)
mpg cyl disp hp drat wt qsec
Mazda RX4           0   0    0  0    0  0    0
Mazda RX4 Wag       0   0    0  0    0  0    0
Datsun 710          0   0    0  0    0  0    0
Hornet 4 Drive      0   0    0  0    0  0    0
Hornet Sportabout   0   0    0  0    0  0    0
Valiant             0   0    0  0    0  0    0

Answer 1

另一个基本R选项

u <- with(threshold_df, mapply(`>`, as.data.frame(my_mat[, marker]), threshold))
my_mat <- 0 * my_mat
my_mat[, colnames(u)] <- u

为

> my_mat
mpg cyl disp hp drat wt qsec
Mazda RX4             0   0    0  0    0  0    0
Mazda RX4 Wag         0   0    0  0    0  0    0
Datsun 710            0   0    0  0    0  0    0
Hornet 4 Drive        0   0    0  0    0  0    0
Hornet Sportabout     0   0    1  0    0  0    0
Valiant               0   0    0  0    0  0    0
Duster 360            0   0    1  1    0  0    0
Merc 240D             0   0    0  0    0  0    0
Merc 230              0   0    0  0    0  0    0
Merc 280              0   0    0  0    0  0    0
Merc 280C             0   0    0  0    0  0    0
Merc 450SE            0   0    0  0    0  1    0
Merc 450SL            0   0    0  0    0  1    0
Merc 450SLC           0   0    0  0    0  1    0
Cadillac Fleetwood    0   0    1  1    0  1    0
Lincoln Continental   0   0    1  1    0  1    0
Chrysler Imperial     0   0    1  1    0  1    0
Fiat 128              0   0    0  0    0  0    0
Honda Civic           0   0    0  0    0  0    0
Toyota Corolla        0   0    0  0    0  0    0
Toyota Corona         0   0    0  0    0  0    0
Dodge Challenger      0   0    0  0    0  0    0
AMC Javelin           0   0    0  0    0  0    0
Camaro Z28            0   0    1  1    0  1    0
Pontiac Firebird      0   0    1  0    0  1    0
Fiat X1-9             0   0    0  0    0  0    0
Porsche 914-2         0   0    0  0    0  0    0
Lotus Europa          0   0    0  0    0  0    0
Ford Pantera L        0   0    1  1    0  0    0
Ferrari Dino          0   0    0  0    0  0    0
Maserati Bora         0   0    0  1    0  0    0
Volvo 142E            0   0    0  0    0  0    0

Answer 2

您可以在选定的列上使用sweep

zero_mat[,threshold_df$marker] <- +(sweep(my_mat[, threshold_df$marker], 2, threshold_df$threshold, `>`))
zero_mat
#                    mpg cyl disp hp drat wt qsec
#Mazda RX4             0   0    0  0    0  0    0
#Mazda RX4 Wag         0   0    0  0    0  0    0
#Datsun 710            0   0    0  0    0  0    0
#Hornet 4 Drive        0   0    0  0    0  0    0
#Hornet Sportabout     0   0    1  0    0  0    0
#Valiant               0   0    0  0    0  0    0
#Duster 360            0   0    1  1    0  0    0
#Merc 240D             0   0    0  0    0  0    0
#Merc 230              0   0    0  0    0  0    0
#...
#...

同样的逻辑也适用于转置。

zero_mat[,threshold_df$marker] <- +(t(t(my_mat[, threshold_df$marker]) > threshold_df$threshold))

开头的+将逻辑值(T/F)更改为整数值(1/0)。