Подсчет пар в массиве с циклом в г - PullRequest
0 голосов
/ 05 июня 2018

У меня проблемы с написанием простого цикла for с условиями в r.У меня есть этот массив:

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

Ответы [ 4 ]

0 голосов
/ 05 июня 2018

Вот простое базовое решение:

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
0 голосов
/ 05 июня 2018

Можно попробовать

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
0 голосов
/ 05 июня 2018
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 
0 голосов
/ 05 июня 2018

в базе 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
...