Предположим, у вас есть следующий фрейм данных:
df <- data.frame(industry = c("DEU_10T12", "DEU_13T15", "DEU_16", "DEU_17", "ITA_10T12", "ITA_13T15", "ITA_16", "ITA_17"),
DEU_10T12 = c(20, 24, 26, 20, 10, 0, NA, 1.5),DEU_13T15 = c(15, 16, 4.5, NA, 7.5, 5, 3, 0),
DEU_16 = c(1.5, 6, 4, 0, 0.5, 15, 3, 0.5),DEU_17 = c(NA, 20, 10, 2, 0, 0, 0, 7),
ITA_10T12 = c(0.5, 2, 3, 4, 10, 50, 2, 15), ITA_13T15 = c(25, 0, 4.5, NA, 17.5, 5, 13, 0.9),
ITA_16 = c(2, 3, 40, 20, 0.5, 15, 3, 1),ITA_17 = c(1, 9, 0.5, 2, 10, 20, 50, 7))
И цель состоит в том, чтобы иметь следующую матрицу (она должна быть числовой и обрабатывать суммирование NA):
df2 <- data.frame(industry = c("DEU_10T12", "DEU_13T15", "DEU_16", "DEU_17", "ITA_10T12", "ITA_13T15", "ITA_16", "ITA_17"),
DEU_10T12 = c(0, 0, 0, 0, 10, 0, NA, 1.5),DEU_13T15 = c(0, 0, 0, 0, 7.5, 5, 3, 0),
DEU_16 = c(0, 0, 0, 0, 0.5, 15, 3, 0.5),DEU_17 = c(0, 0, 0, 0, 0, 0, 0, 7),
ITA_10T12 = c(0.5, 2, 3, 4, 0, 0, 0, 0), ITA_13T15 = c(25, 0, 4.5, NA, 0, 0, 0, 0),
ITA_16 = c(2, 3, 40, 20, 0, 0, 0, 0),ITA_17 = c(1, 9, 0.5, 2, 0, 0, 0, 0))
Новая матрица (df2, преобразованная в числовую) будет отражать значения исходной матрицы (df, также числовая), за исключением случаев, когда запись строки имеет те же первые три символа, что и соответствующая запись столбца. В таких случаях, как, например, DEU_10T12 в строке и столбце, начинающемся с DEU, значение будет установлено на ноль, игнорируя любые существующие значения NA.
Я попробовал следующим образом. Сначала я преобразую df в числовое значение следующим образом:
# Extract row and column names
row_names <- df$industry
col_names <- colnames(df)[-1] # Exclude 'industry' column
# Create an empty matrix
Z <- matrix(NA, nrow = length(row_names), ncol = length(col_names), dimnames = list(row_names, col_names))
# Fill in the matrix with values from the data frame
for (i in 1:length(row_names)) {
for (j in 1:length(col_names)) {
Z[i, j] <- df[i, col_names[j]]
}
}
# Create an empty matrix for Z_narrow
Z_narrow = matrix(0, nrow = nrow(Z), ncol = ncol(Z))
# Assign row and column names
rownames(Z_narrow) = rownames(Z)
colnames(Z_narrow) = colnames(Z)
# Function to get the indices of columns to be replaced with zeros based on the first three characters of the column name
get_zero_indices <- function(col_name, row_names) {substr(col_name, 1, 3) == substr(row_names, 1, 3)}
# Loop through each row of Z to populate Z_narrow
for (i in 1:nrow(Z)) {
row_name <- rownames(Z)[i]
indices_to_zero <- sapply(colnames(Z), get_zero_indices, row_names = row_name)
Z_narrow[i, indices_to_zero] <- 0
Z_narrow[i, !indices_to_zero] <- Z[i, !indices_to_zero]
}
Этот код работает при использовании этого небольшого набора данных, но вызывает сбой R при применении к более крупному набору данных. Какие-либо предложения?





Вы можете расплавить исходный фрейм данных и установить его на 0, если первые три символа совпадают; затем отбросьте назад в ширину
library(data.table)
setDT(df)
dcast(
melt(df,id.vars = "industry")[substr(industry,1,3) == substr(variable,1,3), value:=0],
industry~variable
)
Выход
industry DEU_10T12 DEU_13T15 DEU_16 DEU_17 ITA_10T12 ITA_13T15 ITA_16 ITA_17
<char> <num> <num> <num> <num> <num> <num> <num> <num>
1: DEU_10T12 0.0 0.0 0.0 0 0.5 25.0 2 1.0
2: DEU_13T15 0.0 0.0 0.0 0 2.0 0.0 3 9.0
3: DEU_16 0.0 0.0 0.0 0 3.0 4.5 40 0.5
4: DEU_17 0.0 0.0 0.0 0 4.0 NA 20 2.0
5: ITA_10T12 10.0 7.5 0.5 0 0.0 0.0 0 0.0
6: ITA_13T15 0.0 5.0 15.0 0 0.0 0.0 0 0.0
7: ITA_16 NA 3.0 3.0 0 0.0 0.0 0 0.0
8: ITA_17 1.5 0.0 0.5 7 0.0 0.0 0 0.0
Другой подход, вообще не использующий изменения формы:
mask = apply(df, 1, \(x) c(F,substr(x[1],1,3)==substr(names(x[2:length(x)]),1,3)))
df[t(mask)] <- 0
Выход:
industry DEU_10T12 DEU_13T15 DEU_16 DEU_17 ITA_10T12 ITA_13T15 ITA_16 ITA_17
1 DEU_10T12 0.0 0.0 0.0 0 0.5 25.0 2 1.0
2 DEU_13T15 0.0 0.0 0.0 0 2.0 0.0 3 9.0
3 DEU_16 0.0 0.0 0.0 0 3.0 4.5 40 0.5
4 DEU_17 0.0 0.0 0.0 0 4.0 NA 20 2.0
5 ITA_10T12 10.0 7.5 0.5 0 0.0 0.0 0 0.0
6 ITA_13T15 0.0 5.0 15.0 0 0.0 0.0 0 0.0
7 ITA_16 NA 3.0 3.0 0 0.0 0.0 0 0.0
8 ITA_17 1.5 0.0 0.5 7 0.0 0.0 0 0.0
Тот же подход, что и @langtang, но с использованием функции tidyverse:
library(tidyverse)
df |>
pivot_longer(-industry) |>
mutate(value = ifelse(substr(industry,1,3)==substr(name,1,3),0,value)) |>
pivot_wider()
industry DEU_10T12 DEU_13T15 DEU_16 DEU_17 ITA_10T12 ITA_13T15 ITA_16 ITA_17
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 DEU_10T12 0 0 0 0 0.5 25 2 1
2 DEU_13T15 0 0 0 0 2 0 3 9
3 DEU_16 0 0 0 0 3 4.5 40 0.5
4 DEU_17 0 0 0 0 4 NA 20 2
5 ITA_10T12 10 7.5 0.5 0 0 0 0 0
6 ITA_13T15 0 5 15 0 0 0 0 0
7 ITA_16 NA 3 3 0 0 0 0 0
8 ITA_17 1.5 0 0.5 7 0 0 0 0
В базе R вместо того, чтобы перебирать отдельные строки и столбцы, найдите уникальные префиксы и просто переберите их:
out <- as.matrix(df[, -1])
rnames <- df[, 1]
rownames(out) <- rnames
cnames <- colnames(out)
prefixes <- unique(substr(rnames, 1, 3))
prefixes <- paste0("^", prefixes)
for (pfx in prefixes) {
out[grepl(pfx, rnames), grepl(pfx, cnames)] <- 0
}
Результат:
#> out
DEU_10T12 DEU_13T15 DEU_16 DEU_17 ITA_10T12 ITA_13T15 ITA_16 ITA_17
DEU_10T12 0.0 0.0 0.0 0 0.5 25.0 2 1.0
DEU_13T15 0.0 0.0 0.0 0 2.0 0.0 3 9.0
DEU_16 0.0 0.0 0.0 0 3.0 4.5 40 0.5
DEU_17 0.0 0.0 0.0 0 4.0 NA 20 2.0
ITA_10T12 10.0 7.5 0.5 0 0.0 0.0 0 0.0
ITA_13T15 0.0 5.0 15.0 0 0.0 0.0 0 0.0
ITA_16 NA 3.0 3.0 0 0.0 0.0 0 0.0
ITA_17 1.5 0.0 0.5 7 0.0 0.0 0 0.0
С outer:
df[,-1][outer(sub("_.*", "", df[,1]), sub("_.*", "", names(df)[-1]), "= = ")] <- 0
identical(df, df2)
#> [1] TRUE
Спасибо @lotus за использование sub.
Мне понравилось твое использование sub больше, чем мой неуклюжий sapply(strsplit(. Думаю, я обновлю свой ответ, поскольку вы удалили свой.
Вы говорите, что вам нужна матрица, но желаемый результат вашего примера — это фрейм данных. Чего вы на самом деле хотите?