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

R: create boolean matrix based on data matrix and thresholds data frame

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

> 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

您可以在选定的列上使用 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)。

另一个基础 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