CODEWITHSUNDEEP
rdataframeloopsmatrixdataset
Maximilian
Maximilian

Reputation: 313

Set matrix value to 0 if row and column names start with same prefix

Suppose you have the following dataframe:

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))

And the objective is to have the following matrix (it shall be numeric and handle NAs summation):

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))

The new matrix (df2, converted to numeric) will mirror the values of the original matrix (df, also numeric), except when a row entry shares the same initial three characters as its corresponding column entry. In such cases, like for example DEU_10T12 in row and a column starting with DEU, the value will be set to zero, disregarding any existing NA values.

I tried as follows. First, I transform df as numeric as follows

# 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]
}

This code works when using this little dataset, but it causes R to crash when applied to a larger dataset. Any suggestions?

Upvotes: 4

Views: 126

Answers (4)

jblood94
jblood94

Reputation: 16981

With outer:

df[,-1][outer(sub("_.*", "", df[,1]), sub("_.*", "", names(df)[-1]), "==")] <- 0

identical(df, df2)
#> [1] TRUE

Credit to @lotus for the use of sub.

Upvotes: 5

zephryl
zephryl

Reputation: 17079

In base R, rather than looping over individual rows and columns, find unique prefixes and just loop over those:

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
}

Result:

#> 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

Upvotes: 5

langtang
langtang

Reputation: 24722

You can melt the original dataframe, and set to 0 if the first three character match; then cast back to wide

library(data.table)
setDT(df)
dcast(
  melt(df,id.vars = "industry")[substr(industry,1,3) == substr(variable,1,3), value:=0],
  industry~variable
)

Output

    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

Another approach, without using any reshaping at all:

mask = apply(df, 1, \(x) c(F,substr(x[1],1,3)==substr(names(x[2:length(x)]),1,3)))
df[t(mask)] <- 0

Output:

   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

Upvotes: 6

George Savva
George Savva

Reputation: 5336

Same approach as @langtang, but using tidyverse function:


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

Upvotes: 6

Related Questions