长 if else 循环并在 R 中重新编码答案

【问题标题】：long if else loop and recoding in R长 if else 循环并在 R 中重新编码
【发布时间】：2012-02-09 15:41:53
【问题描述】：

我知道我的问题很简单，但不适合我。这是小数据集。

mark1 <- c("AB", "BB", "AB", "BB", "BB", "AB", "--", "BB")
mark2 <- c("AB", "AB", "AA", "BB", "BB", "AA", "--", "BB")
mark3 <- c("BB", "AB", "AA", "BB", "BB", "AA", "--", "BB")
mark4 <- c("AA", "AB", "AA", "BB", "BB", "AA", "--", "BB")
mark5 <- c("AB", "AB", "AA", "BB", "BB", "AA", "--", "BB")
mark6 <- c("--", "BB", "AA", "BB", "BB", "AA", "--", "BB")
mark7 <- c("AB", "--", "AA", "BB", "BB", "AA", "--", "BB")
mark8 <- c("BB", "AA", "AA", "BB", "BB", "AA", "--", "BB")
mymark <- data.frame (mark1, mark2, mark3, mark4, mark5, mark6, mark7, mark8)
tmymark <- data.frame (t(mymark))
names (tmymark) <- c("P1", "P2","I1", "I2", "I3", "I4", "KL", "MN")

因此数据集变为：

      P1 P2 I1 I2 I3 I4 KL MN
mark1 AB BB AB BB BB AB -- BB
mark2 AB AB AA BB BB AA -- BB
mark3 BB AB AA BB BB AA -- BB
mark4 AA AB AA BB BB AA -- BB
mark5 AB AB AA BB BB AA -- BB
mark6 -- BB AA BB BB AA -- BB
mark7 AB -- AA BB BB AA -- BB
mark8 BB AA AA BB BB AA -- BB

我想根据 P1 和 P2 的比较对 mark1:8 进行分类，并提供一个代码，它将创建一个新变量：

loctype <- NULL

if (tmymark$P1 == "AB" &  tmymark$P2 == "AB"){
       loctype = "<hkxhk>"
       } else {
if (tmymark$P1== "AB" & tmymark$P2 == "BB") {
      loctype = "<lmxll>"
      } else {
      if (tmymark$P1 == "AA" & tmymark$P2 == "AB") {
       loctype = "<nnxnp>"
       } else {
        if (tmymark$P1 == "AA" & tmymark$P2 == "BB") {
        loctype = "MN"
        } else {
        if (tmymark$P1 == "BB" & tmymark$P2 == "AA"){
         loctype = "MN"
         } else {
         if (tmymark$P1 == "--" & tmymark$P2 == "AA"){
         loctype = "NR"
         }  else {
if (tmymark$P1 == "AA" & tmymark$P2 == "--"){
          loctype = "NR"
} else {
    cat ("error wrong input in P1 or P2")
    }} }}}}}

我在这里尝试比较 P1 和 P2 值并生成一个新变量。例如，如果 tmymark$P1 == "AB" & tmymark$P2 == "AB"，则 loctype 应该是 ""。如果不是，第二个条件将是应用程序，依此类推。

这是我的错误信息。

Warning messages:
1: In if (tmymark$P1 == "AB" & tmymark$P2 == "AB") { :
  the condition has length > 1 and only the first element will be used
2: In if (tmymark$P1 == "AB" & tmymark$P2 == "BB") { :
  the condition has length > 1 and only the first element will be used

生成 loctype 向量后，我想使用此变量中的信息重新编码 tmymark：

tmymark1 <- data.frame (loctype, tmymark)      
require(car) 
for(i in 2:length(tmymark)){

        if (loctype = "<hkxhk>") {
       tmymark[[i]] <- recode (x, "AB" = "hk", "BA" = "hk", "AA" = "hh", "BB" = "kk")
       } else {
       if (loctype = "<lmxll>") {
       tmymark[[i]] <- recode ((x, "AB" = "lm", "BA" = "lm", "AA" = "--", "BB" = "kk")
       } else {

        if (loctype = "<nnxnp>") {
       tmymark[[i]] <- recode ((x, "AB" = "np", "BA" = "np", "AA" = "nn", "BB" = "--")
             } else {
       if (loctype = "MN") {
        tmymark[[i]] <- "--"
       } esle {
      if (loctype = "NR") {
        tmymark[[i]] <- "NA"
       } else {
       cat ("error wrong input code")
      } } }}}

我在正确的轨道上吗？

编辑：预期输出

      loctype  P1 P2 I1 I2 I3 I4 KL MN 
mark1  <lmxmm> lm mm lm mm mm lm -- mm 
mark2  <hkxhk> hk hk hh kk kk hh -- kk 
mark3 <nnxnp> nn np nn -- -- nn -- -- 
 and so on

【问题讨论】：

标签： r loops

【解决方案1】：

match 绝对是要走的路。我会将两个数据框作为键，如下所示：

key <- data.frame(
             P1=c("AB", "AB", "AA", "AA", "BB", "--", "AA"),
             P2=c("AB", "BB", "AB", "BB", "AA", "AA", "--"),
             loctype=c("<hkxhk>", "<lmxll>", "<nnxnp>", "MN", "MN", "NR", "NR"))

key2 <- cbind(
  `<hkxhk>` = c("hk","hk","hh","kk"),
  `<lmxll>` = c("lm", "lm", "--", "kk"),
  `<nnxnp>` = c("np", "np", "nn", "--"),
  MN = rep("--", 4),
  NR = rep("NA", 4) )
rownames(key2) = c("AB","BA", "AA", "BB")

然后在key1 上使用match 来获得loctype（正如贾斯汀也推荐的那样），并在key2 的行名和列上获得所需的替换，使用矩阵索引来获得键中的所需值。

loctype <- key$loctype[match(with(tmymark, paste(P1, P2, sep="\b")), 
                             with(key, paste(P1, P2, sep="\b")))]
ii <- match(as.vector(as.matrix(tmymark)), rownames(key2))
jj <- rep(match(loctype, colnames(key2)), nrow(tmymark))
out <- as.data.frame(matrix(key2[cbind(ii,jj)], nrow=nrow(tmymark)))
colnames(out) <- colnames(tmymark)
rownames(out) <- rownames(tmymark)
out$loctype <- loctype

结果如下所示，其中缺少值是因为我的键中没有这些组合的值。

> print(out, na="")
      P1 P2 I1 I2 I3 I4 KL MN loctype
mark1 lm kk lm kk kk lm    kk <lmxll>
mark2 hk hk hh kk kk hh    kk <hkxhk>
mark3                                
mark4 nn np nn -- -- nn    -- <nnxnp>
mark5 hk hk hh kk kk hh    kk <hkxhk>
mark6                                
mark7                                
mark8 -- -- -- -- -- --    --      MN

【讨论】：

【解决方案2】：

您的第一个错误发生是因为 if 需要单个逻辑值（或计算结果为一个的表达式）。您可以改用ifelse( )，它是“矢量化”if

ifelse(tmymark$P1 == "AB" &  tmymark$P2 == "AB", loctype = "<hkxhk>", else clauses...)

为了避免冗长的if() else() 结构（或原来的ifelse()），您可以使用匹配。制作您预期的 P1 和 P2 组合的数据框，并为所需的 loctype 添加一列：

matches <- data.frame(p1p2 = c('AB AB', 'AB BB', 'AA AB', 'AA BB', 'BB AA', '-- AA', 'AA --'),
                      loctype = c('<hkxhk>', '<lmxll>', '<nnxnp>', 'MN', 'MN', 'NR', 'NR'))
loctype <- matches$loctype[match(paste(tmymark$P1, tmymark$P2), matches$p1p2),]

第二部分可以通过多种方式完成，但我在“整洁”的部分上画了一个空白。

【讨论】：