用r中的循环计算数组中的对答案

【问题标题】：Counting couples in array with loop in r用r中的循环计算数组中的对
【发布时间】：2018-06-05 15:26:38
【问题描述】：

我在编写带有 r 条件的简单 for 循环时遇到了一些问题。我有这个数组：

Temp <- c("A", "A", "B", "A", "C", "C", "A", "B")

我想通过使用两个在循环期间递增的索引来计算这个数组中的对数。必须遵循序列的顺序。

这个数组的最终结果应该是：

CountAA = 1
CountAB = 2
CountAC = 1
CountBA = 1
CountBB = 0
CountBC = 0
CountCA = 1
CountCB = 0
CountCC = 1

我已尝试使用此代码，但它给了我一个错误

"Error in if (Temp[i] == "A" & Temp[j] == "A") { : 
  argument is of length zero"

代码

CountAA = 0
CountAB = 0
CountAC = 0
CountBA = 0
CountBB = 0
CountBC = 0
CountCA = 0
CountCB = 0
CountCC = 0
i = 1
j = 2

for (j in 1:length(Temp)-1){
    if (Temp[i]=="A" & Temp[j]=="A"){
      CountAA = CountAA + 1
      i = i + 1
      j = j + 1
    }
    if (Temp[i]=="A" & Temp[j]=="B"){
      CountAB = CountAB + 1
      i = i + 1 
      j = j + 1
    }
    if(Temp[i]=="A" & Temp[j]=="C"){
      CountAC = CountAC + 1
      i = i + 1
      j = j + 1
    }
    if(Temp[i]=="B" & Temp[j]=="A"){
      CountBA = CountBA + 1
      i = i + 1
      j = j + 1
    }
    if(Temp[i]=="B" & Temp[j]=="B"){
      CountBB = CountBB + 1
      i = i + 1
      j = j + 1
    }
    if(Temp[i]=="B" & Temp[j]=="C"){
      CountBC = CountBC + 1
      i = i + 1
      j = j + 1
    }
    if(Temp[i]=="C" & Temp[j]=="A"){
      CountCA = CountCA + 1
      i = i + 1
      j = j + 1
    }
    if(Temp[i]=="C" & Temp[j]=="B"){
      CountCB = CountCB + 1
      i = i + 1
      j = j + 1
    }
    if(Temp[i]=="C" & Temp[j]=="C"){
      CountCC = CountCC + 1
      i = i + 1
      j = j + 1
    }
}

【问题讨论】：

在您的代码中，您不必手动增加 i 和 j - 这是通过 for 循环完成的。 1:length(Temp)-1 也没有做你想做的事。
你能说清楚你想要什么格式作为输出吗？似乎我们都在为您提供不同的东西，但所有格式都可以直接转换为您喜欢的格式。
@Moody_Mudskipper：好吧，任何格式都适合我的目的。无论如何，我正在寻找像您提出的那样的数据框。您的代码的唯一问题是只计算现有的夫妇。我需要显示所有可能排列的频率。
我编辑了我的答案

标签： arrays r for-loop if-statement counter

【解决方案1】：

这是一个简单的基本解决方案：

table(sapply(1:(length(Temp) - 1), function(x) paste(Temp[x:(x+1)], collapse = "")))

AA AB AC BA CA CC 
 1  2  1  1  1  1

如果您真的想查看所有可能的排列，您可以使用任何会生成重复排列的包。下面我们使用gtools。

library(gtools)
## Same as above
vec <- table(sapply(1:(length(Temp) - 1), function(x) paste(Temp[x:(x+1)], collapse = "")))

## Generate all permutations
myNames <- apply(permutations(3, 2, unique(Temp), repeats.allowed = TRUE), 1, paste, collapse = "")

## Initialize return vector
res <- integer(length(myNames))

## Add names
names(res) <- myNames

## Subset on names
res[names(res) %in% names(vec)] <- vec

res
AA AB AC BA BB BC CA CB CC 
 1  2  1  1  0  0  1  0  1

【讨论】：

第二种解决方案是我正在寻找的，但我收到了这条消息：Error in permutations(3, 2, unique(Temp), repeats.allowed = TRUE) : unused arguments (2, unique(Temp), repeats.allowed = TRUE)
@aipam，我不确定发生了什么...我只是将代码复制并粘贴到一个新的 R 会话中，它对我来说很好。我能想到的唯一一件事是，您可能加载了其他具有名为permutations 的函数的库。例如，rje 包中有一个名为 permutations 的函数，它只接受一个参数。如果需要，您始终可以通过使用范围运算符 :: 来确保使用正确的库，例如 gtools::permutations。

【解决方案2】：

在基地R:

# unique letter values
ut <- unique(Temp)

# expand to get a data.frame with all combinations
expnd <- data.frame(pair=do.call(paste0,expand.grid(ut,ut)),stringsAsFactors = FALSE)

# merge it with the table containing counts of all pair combinations
out   <- merge(expnd, table(pair=paste0(head(Temp,-1),tail(Temp,-1))), all=TRUE)

# turn NAs into zeroes
out$Freq[is.na(out$Freq)] <- 0

#   pair Freq
# 1   AA    1
# 2   AB    2
# 3   AC    1
# 4   BA    1
# 5   BB    0
# 6   BC    0
# 7   CA    1
# 8   CB    0
# 9   CC    1

与库tidyverse

library(tidyverse)
tibble(x=head(Temp,-1),y=tail(Temp,-1)) %>%
  count(x,y) %>%              # count combinations
  complete(x,y) %>%           # add missing combinations
  replace_na(list(n=0)) %>%   # make them zero
  unite(pair,x,y,sep='') %>%  # turn 2 columns into 1
  arrange(pair)               # sort

# # A tibble: 9 x 2
#   pair      n
#   <chr> <dbl>
# 1 AA        1
# 2 AB        2
# 3 AC        1
# 4 BA        1
# 5 BB        0
# 6 BC        0
# 7 CA        1
# 8 CB        0
# 9 CC        1

【讨论】：

【解决方案3】：

你可以试试

library(tidyverse)
b <- table(sapply(seq_along(Temp), function(x) paste0(Temp[x], Temp[x+1]))[-length(Temp)])

expand.grid(unique(Temp), unique(Temp)) %>% 
 unite(Var1, Var1, Var2, sep = "") %>% 
 left_join(as.data.frame(b,stringsAsFactors = F)) %>% 
 mutate(Freq=ifelse(is.na(Freq), 0, Freq))
  Var Freq
1  AA    1
2  BA    1
3  CA    1
4  AB    2
5  BB    0
6  CB    0
7  AC    1
8  BC    0
9  CC    1

【讨论】：

【解决方案4】：

library(magrittr)
n <- length(Temp)
sapply(1:(n-1),function(i) paste(Temp[i:(i+1)], collapse = "")) %>% 
  factor(levels = paste0(rep(LETTERS[1:3], each = 3), LETTERS[1:3])) %>%
  table()

AA AB AC BA BB BC CA CB CC 
 1  2  1  1  0  0  1  0  1

【讨论】：