logo标签列表

矩阵：根据变量名对列和行求和

r
3

假设我有一个简单的 6x6 矩阵，就像这个：

x <- matrix(1:36, nrow = 6, dimnames = list(c("AUS1","AUS2","AUS3", "AUT1", "AUT2", "AUT3"), c("AUS1","AUS2","AUS3", "AUT1", "AUT2", "AUT3")))

     AUS1 AUS2 AUS3 AUT1 AUT2 AUT3
AUS1    1    7   13   19   25   31
AUS2    2    8   14   20   26   32
AUS3    3    9   15   21   27   33
AUT1    4   10   16   22   28   34
AUT2    5   11   17   23   29   35
AUT3    6   12   18   24   30   36

这些字母代表着一个国家（比如AUS代表澳大利亚），后面的数字代表着一个领域。现在，我想对每一列求和，但前提是只能将来自不同国家的行的数值相加。例如，第一列（AUS1）的总和应该只包含AUT1、AUT2和AUT3行中的值。AUS2和AUS3的列也是如此。 然后，AUT1列的总和应仅包括来自AUS1、AUS2和AUS3行的值。
由于我的表格比这还要大得多，我无法简单地选择单个行。
我在考虑一个函数，它将列名的一部分与行名的一部分匹配。如果它们包含相同的三个字母，则该值不会被包括在总和中。
1
你是在寻找sapply(split(as.data.frame.table(x), ~ Var2), \(a) with(a, sum(Freq[substr(Var1, 1, 3) != substr(Var2, 1, 3)])))吗？你已经相当清楚地描述了你的问题，但提供期望的输出将会更有帮助。 - Ritchie Sacramento
谢谢您的快速回复。让我试着解释一下：最终，我需要每列一个值。这应该是该列的总和。但是，每列的总和不同。它只应包括不以与该列相同的字母开头的行的值。因此，对于第一列（AUS1），总和应仅考虑行的值：AUT1、AUT2和AUT3。对于第二列和第三列也是如此。对于第四列（AUT1），它应仅考虑不包括“AUT”的行的值。因此，仅有行：AUS1、AUS2和AUS3。希望这样能清晰地说明问题。 - VBo
我的原始矩阵大小为2490x2490，包括43个不同的国家（字母组合）和每个国家的56个部门（数字）。我需要一个函数，为每个单独的列（字母组合+数字）提供一个值，该值是该列的总和，不包括以相同字母组合开头的行。 - VBo
谢谢，我（相信我）理解了你的问题 - 你会注意到下面提供的两个解决方案给出了不同的结果 - 这就是为什么提供你期望的输出是一个好主意，因为它让人们看到他们的解决方案是否得出了正确的结果。 - Ritchie Sacramento
3个回答
2

using data.table

library(data.table)

dt <- data.table(as.data.frame.table(x))

dt[which(substr(Var1, 1, 3) != substr(Var2, 1, 3)), .(sum = sum(Freq)), by = Var2]

*如果你需要“列求和”，可以使用by = Var1，但是对于“行求和”，请使用by = Var2

输出结果

#    Var2 sum
# 1: AUS1  15
# 2: AUS2  33
# 3: AUS3  51
# 4: AUT1  60
# 5: AUT2  78
# 6: AUT3  96

OP 提供的数据

x <- matrix(1:36, nrow = 6, dimnames = list(c("AUS1","AUS2","AUS3", "AUT1", "AUT2", "AUT3"), c("AUS1","AUS2","AUS3", "AUT1", "AUT2", "AUT3")))
2

这里是一个基于R的方法。它运行了三个循环，但由于前两个（lapply循环）是在行和列名称上进行的，因此这两个不应该花费太多处理时间。
然后，在一个Map循环中完成真正的工作，调用之前确定的行和列名称子集上的rowSums。

x <- matrix(1:36, nrow = 6, dimnames = list(c("AUS1","AUS2","AUS3", "AUT1", "AUT2", "AUT3"), c("AUS1","AUS2","AUS3", "AUT1", "AUT2", "AUT3")))

rn <- unique(gsub("\\d", "", rownames(x)))
rows <- lapply(rn, grep, rownames(x))
cols <- lapply(rn, grep, colnames(x), invert = TRUE)

Map(\(r, c) rowSums(x[r, c]), rows, cols)
#> [[1]]
#> AUS1 AUS2 AUS3 
#>   75   78   81 
#> 
#> [[2]]
#> AUT1 AUT2 AUT3 
#>   30   33   36

由reprex package (v2.0.1)于2022年5月18日创建

1

这里是另一种使用基本R语言的方法：

matched_sum <- function(dfr){
    matched_col <- function(col_id) {
        col_pattern <- gsub("[0-9]", "", colnames(dfr[col_id]))
        dfr[grepl(col_pattern, rownames(x)),col_id] <- NA
        return(dfr[col_id])
    }
    new_col <- lapply(1:ncol(dfr), matched_col)
    new_dfr <- do.call(cbind.data.frame, new_col)
    colSums(new_dfr, na.rm = TRUE)
}

# Your data frame. You can use as.data.frame(x) in case x is not a data frame 
x
     AUS1 AUS2 AUS3 AUT1 AUT2 AUT3
AUS1    1    7   13   19   25   31
AUS2    2    8   14   20   26   32
AUS3    3    9   15   21   27   33
AUT1    4   10   16   22   28   34
AUT2    5   11   17   23   29   35
AUT3    6   12   18   24   30   36

# Apply the function to x
matched_sum(x)

AUS1 AUS2 AUS3 AUT1 AUT2 AUT3 
  15   33   51   60   78   96

函数的作用

  1. col_pattern <- gsub("[0-9]", "", colnames(dfr[col_id])) 在每个列名中查找一个模式。该模式是除数字外的任意字符串。例如：在"AUS1"中的模式为"AUS"。
  2. dfr[grepl(col_pattern, rownames(x)),col_id] <- NA 将NA分配给在第一步中找到模式的列中的任何行。例如，此步骤后的第一列将变为：
    AUS1
AUS1   NA
AUS2   NA
AUS3   NA
AUT1    4
AUT2    5
AUT3    6
  1. lapply(1:ncol(dfr), matched_col) 将第一步和第二步应用于数据框中的每一列。
  2. do.call(cbind.data.frame, new_col) 将所有列（已经在选择的行中具有NA值的列）绑定到一个数据框中。例如，如果输入是您提供的x，则在此步骤之后它将变为：
     AUS1 AUS2 AUS3 AUT1 AUT2 AUT3
AUS1   NA   NA   NA   19   25   31
AUS2   NA   NA   NA   20   26   32
AUS3   NA   NA   NA   21   27   33
AUT1    4   10   16   NA   NA   NA
AUT2    5   11   17   NA   NA   NA
AUT3    6   12   18   NA   NA   NA
  1. colSums(new_dfr, na.rm = TRUE) 会对第4步中创建的数据框中每一列的所有非NA值进行求和。

如果您想保留矩阵结构，可以使用以下代码：

matched_sum_mat <- function(mat){
    matched_col <- function(col_id) {
        col_pattern <- gsub("[0-9]", "", dimnames(mat)[[2]][col_id])
        mat[grepl(col_pattern, dimnames(mat)[[1]]),col_id] <- NA
        return(mat[,col_id])
    }
    new_col <- lapply(1:ncol(mat), matched_col)
    new_mat <- do.call(cbind, new_col)
    colnames(new_mat) <- colnames(mat)
    colSums(new_mat, na.rm = TRUE)
}

# Apply to x as a matrix

matched_sum_mat(x)

AUS1 AUS2 AUS3 AUT1 AUT2 AUT3 
  15   33   51   60   78   96

更新

如果您想在列名和行名之间实现精确匹配，例如在列名中的"AUS1"和行名中的"AUS1"（而不是"AUS"）之间进行匹配，可以通过以下几种方式之一实现：

# Option 1
matched_name_location <- lapply(
   colnames(x), 
   function(a_col_name) rownames(x) %in% a_col_name) |> 
   unlist() |> 
   which()
x[matched_name_location] <- NA

# The result
     AUS1 AUS2 AUS3 AUT1 AUT2 AUT3
AUS1   NA    7   13   19   25   31
AUS2    2   NA   14   20   26   32
AUS3    3    9   NA   21   27   33
AUT1    4   10   16   NA   28   34
AUT2    5   11   17   23   NA   35
AUT3    6   12   18   24   30   NA

另一种选择是使用==而非%in% ：
# Option 2
matched_name_location <- lapply(
   colnames(x), 
   function(a_col_name) rownames(x) == a_col_name) |> 
   unlist() |> 
   which()
x[matched_name_location] <- NA

%in% 在这种情况下与使用 == 得到的结果相同，因为 a_col_name 是一个单一名称。如果使用多个名称，则在 %in% 中忽略名称的顺序，但在 == 中不会忽略。例如：

y <- c("AUS1", "AUS2" ,"AUS3", "AUT1", "AUT2", "AUT3")
y %in% c("AUS2","AUS1")
#[1]  TRUE  TRUE FALSE FALSE FALSE FALSE

y == c("AUS2","AUS1")
#[1] FALSE FALSE FALSE FALSE FALSE FALSE

另一个选择是使用grepl。
# Option 3
matched_name_location <- lapply(
   colnames(x), 
   function(a_col_name) grepl(a_col_name, rownames(x))) |> 
   unlist() |> 
   which()
x[matched_name_location] <- NA

最后一个函数用于在字符串中查找模式。例如，grepl("AUS1", "AUS10")返回TRUE，而"AUS1" %in% "AUS10"和"AUS1" == "AUS10"都返回FALSE。

1
非常感谢您提供如此详细的答案，解决了我的问题。当我第一次运行函数时，出现了错误信息：Error in colSums(new_mat, na.rm = TRUE) : 'x' must be numeric但是我在这一行中将1改为2：new_col <- lapply(1:ncol(mat), matched_col)，因为我的第一列是行的代码（AUS1、AUS2等）。有没有快速的方法来调整函数，只查找匹配项（AUS1-AUS1而不是AUS1 - AUS）？这是一个非常有用的函数，我很可能将来会在各种数据集中使用它。 - VBo
1
我很高兴它有所帮助。至于你的问题，我已经更新了我的答案来回答它。请检查一下。 - Abdur Rohman
迅速跟进这个问题：代码运行得非常好。然而，我尝试了精确匹配的代码（选项1），但是收到了一个错误消息：Error in which(unlist(lapply(colnames(inter_industry.list), function(a_col_name) rownames(inter_industry.list) %in% : argument to 'which' is not logical。我认为代码必须嵌入到一个函数中，但我在使用R方面还很新，无法确定问题具体出在哪里。 - VBo
很有可能问题来自于数据结构。Option 1 中的函数旨在处理 x 作为矩阵或数据框。我怀疑你使用的 inter_industry.list 是一个列表，而不是矩阵或数据框。我尝试了一下，得到了和你一模一样的错误： lapply(colnames(as.list(x)), function(a_col_name) rownames(x) %in% a_col_name) |>unlist() |> which() - Abdur Rohman
现在它可以工作了。但我意识到了一个不同的问题。我在最初的帖子中写道，列名必须与行名匹配。我没有意识到我的第一列被称为“Code”，其初始行名为“AUS1”、“AUS2”等。真正的行名只是1、2等。这改变了整个帖子。最好写一个新帖子，对吧？因为这也改变了所有答案。真的很抱歉。 - VBo
哦，好的。是的，请为此编写一个新问题。 - Abdur Rohman
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接