长if-else循环并在R中重新编码
我知道我的问题很简单,但对我来说不是。这是一个小数据集长if-else循环并在R中重新编码,r,loops,R,Loops,我知道我的问题很简单,但对我来说不是。这是一个小数据集 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"
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比较对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")
}} }}}}}
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矢量后,我希望使用此变量中的信息对tmymark重新编码:
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")
}} }}}}}
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")
} } }}}
tmymark1第一个错误发生,因为if需要一个逻辑值(或计算结果为1的表达式)。您可以改用ifelse()
,如果
ifelse(tmymark$P1 == "AB" & tmymark$P2 == "AB", loctype = "<hkxhk>", else clauses...)
第二部分可以通过多种方式完成,但我在“整洁”部分上画了一个空白。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")
结果如下所示,缺少的值是因为我的键中没有这些组合的值
> 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
>打印(输出,na=”“)
P1 P2 I1 I2 I3 I4 KL MN loctype
马克1米kk米kk米kk米kk
mark2 hk hk hh kk kk hh kk
马克3
标记4 nn np nn--nn--
mark5 hk hk hh kk kk hh kk
标记6
马克7
标记8----------MN
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")
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