如何循环 n 列并使用条件?
How do you loop for n-columns and use conditionals?
我正在尝试为将在 'xtable' 中生成的 table 创建一个循环。
这就是我所做的"manually"一起在这里:
我想得到什么
library(dplyr)
X1 = c(4.70e1, 4.72e1, 4.76e1, 2.73e20)
X2 = c(4.67e1, 4.69e1, 4.77e1, 2.05e20)
col.nam = c("AIC(n)", "HQ(n)", "SC(n)", "FPE(n)")
tab.out = data.frame(col.nam, X1, X2)
n.tab = tab.out %>%
mutate(test1 = if_else(tab.out$X1 < tab.out$X2,
paste0(X1,"$^{*}$"),
paste0(X1)),
test2 = if_else(tab.out$X2 < tab.out$X1,
paste0(X2,"\textsuperscript{*}"),
paste0(X2)))%>%
select(col.nam, test1, test2)
# col.nam test1 test2
#1 AIC(n) 47 46.7\textsuperscript{*}
#2 HQ(n) 47.2 46.9\textsuperscript{*}
#3 SC(n) 47.6$^{*}$ 47.7
#4 FPE(n) 2.73e+20 2.05e+20\textsuperscript{*}
我想使用条件语句为 n 列创建一个循环,如下面的代码所示(我当前的丑陋且容易出错的修复方法):
你是不是很迟钝?
tab.out = data.frame(X1, X2)
tab.out$max<-apply(tab.out, 1, max)
for(i in names(tab.out)){
tab.out[[paste(i, 'test', sep="_")]] <- if_else(tab.out[[i]] < tab.out$max,
paste0(i, "\textsuperscript{*}"),
paste0(i))
}
# X1 X2 max X1_test X2_test max_test
#1 4.70e+01 4.67e+01 4.70e+01 X1 X2\textsuperscript{*} max
#2 4.72e+01 4.69e+01 4.72e+01 X1 X2\textsuperscript{*} max
#3 4.76e+01 4.77e+01 4.77e+01 X1\textsuperscript{*} X2 max
#4 2.73e+20 2.05e+20 2.73e+20 X1 X2\textsuperscript{*} max
这可以直接通过矢量化操作完成,无需使用任何 "apply" 函数或循环。
cols <- names(tab.out)[-1]
tab.out$max <- pmax(tab.out$X1, tab.out$X2)
tab.out[paste0(cols, "_test")] <- as.list(cols)
inds <- tab.out$X1 > tab.out$X2
tab.out$X1_test[!inds] <- paste0(tab.out$X1_test[!inds], "\textsuperscript{*}")
tab.out$X2_test[inds] <- paste0(tab.out$X2_test[inds], "\textsuperscript{*}")
tab.out
# col.nam X1 X2 max X1_test X2_test
#1 AIC(n) 4.70e+01 4.67e+01 4.70e+01 X1 X2\textsuperscript{*}
#2 HQ(n) 4.72e+01 4.69e+01 4.72e+01 X1 X2\textsuperscript{*}
#3 SC(n) 4.76e+01 4.77e+01 4.77e+01 X1\textsuperscript{*} X2
#4 FPE(n) 2.73e+20 2.05e+20 2.73e+20 X1 X2\textsuperscript{*}
要对多列执行此操作,我们可以手动或使用列名称之间的通用字符串模式(我们可以在此处使用 grep
)或基于位置创建对向量。
X1_pairs <- c('X1')
X2_pairs <- c('X2')
我们可以使用上述命令创建一个函数,一次将其应用于两列。
apply_fun <- function(x, y) {
tab.out[paste0("max", x)] <- pmax(tab.out[[x]], tab.out[[y]])
tab.out[paste0(c(x, y), "_test")] <- list(x, y)
inds <- tab.out[[x]] > tab.out[[y]]
tab.out[!inds, paste0(x, "_test")] <- paste0(tab.out[[x]][!inds], "\textsuperscript{*}")
tab.out[inds, paste0(y, "_test")] <- paste0(tab.out[[y]][inds], "\textsuperscript{*}")
tab.out
}
并使用 for
循环将其应用于每一对。
for (i in seq_along(X1_pairs)) {
tab.out <- apply_fun(X1_pairs[i], X2_pairs[i])
}
我能够为 n 列解决它并在 latex 中添加代码输出。
X1 = c(4.70e1, 4.72e1, 4.76e1, 1.565)
X2 = c(4.67e1, 4.69e1, 4.77e1, 2.05e20)
X3 = c(1.67e1, 8.69e1, 2.77e1, 8.05e20)
tab.out = data.frame(X1, X2, X3)
tab.out$min<-apply(tab.out, 1, min)
for(i in names(tab.out)){
tab.out[[paste(i, 'test', sep="")]] = if_else(tab.out[[i]] == tab.out$min,
paste0(tab.out[[i]], "\textsuperscript{*}"),
paste0(tab.out[[i]]))
}
row.nam = c("AIC(n)", "HQ(n)", "SC(n)", "FPE(n)")
tab.out = data.frame(row.nam, tab.out)
tab.out = tab.out %>%
select(row.nam, X1test, X2test, X3test)
# row.nam X1test X2test X3test
#1 AIC(n) 47 46.7 16.7\textsuperscript{*}
#2 HQ(n) 47.2 46.9\textsuperscript{*} 86.9
#3 SC(n) 47.6 47.7 27.7\textsuperscript{*}
#4 FPE(n) 1.565\textsuperscript{*} 2.05e+20 8.05e+20
乳胶输出:
colnames(tab.out) = c("Parameters", "Lag 1", "Lag 2", "Lag 3") #$m^r_t$
print(xtable::xtable(tab.out,
header = F,
caption = "asdasdasdasd",
label="table:tb1",
align="llccc"),
hline.after = c(-1,0),
include.rownames=FALSE,
include.colnames = TRUE,
add.to.row = list(pos = list(nrow(tab.out)),
command = paste("\hline \n",
"\multicolumn{4}{l}{\footnotesize{$^{*}$Indicates the selected order of lag}} \\",
"\multicolumn{4}{l}{\footnotesize{\textit{Elaboration: The authors}}}",
sep = "")), comment=FALSE,
sanitize.text.function = function(x){x})
我正在尝试为将在 'xtable' 中生成的 table 创建一个循环。
这就是我所做的"manually"一起在这里:
我想得到什么
library(dplyr)
X1 = c(4.70e1, 4.72e1, 4.76e1, 2.73e20)
X2 = c(4.67e1, 4.69e1, 4.77e1, 2.05e20)
col.nam = c("AIC(n)", "HQ(n)", "SC(n)", "FPE(n)")
tab.out = data.frame(col.nam, X1, X2)
n.tab = tab.out %>%
mutate(test1 = if_else(tab.out$X1 < tab.out$X2,
paste0(X1,"$^{*}$"),
paste0(X1)),
test2 = if_else(tab.out$X2 < tab.out$X1,
paste0(X2,"\textsuperscript{*}"),
paste0(X2)))%>%
select(col.nam, test1, test2)
# col.nam test1 test2
#1 AIC(n) 47 46.7\textsuperscript{*}
#2 HQ(n) 47.2 46.9\textsuperscript{*}
#3 SC(n) 47.6$^{*}$ 47.7
#4 FPE(n) 2.73e+20 2.05e+20\textsuperscript{*}
我想使用条件语句为 n 列创建一个循环,如下面的代码所示(我当前的丑陋且容易出错的修复方法):
你是不是很迟钝?
tab.out = data.frame(X1, X2)
tab.out$max<-apply(tab.out, 1, max)
for(i in names(tab.out)){
tab.out[[paste(i, 'test', sep="_")]] <- if_else(tab.out[[i]] < tab.out$max,
paste0(i, "\textsuperscript{*}"),
paste0(i))
}
# X1 X2 max X1_test X2_test max_test
#1 4.70e+01 4.67e+01 4.70e+01 X1 X2\textsuperscript{*} max
#2 4.72e+01 4.69e+01 4.72e+01 X1 X2\textsuperscript{*} max
#3 4.76e+01 4.77e+01 4.77e+01 X1\textsuperscript{*} X2 max
#4 2.73e+20 2.05e+20 2.73e+20 X1 X2\textsuperscript{*} max
这可以直接通过矢量化操作完成,无需使用任何 "apply" 函数或循环。
cols <- names(tab.out)[-1]
tab.out$max <- pmax(tab.out$X1, tab.out$X2)
tab.out[paste0(cols, "_test")] <- as.list(cols)
inds <- tab.out$X1 > tab.out$X2
tab.out$X1_test[!inds] <- paste0(tab.out$X1_test[!inds], "\textsuperscript{*}")
tab.out$X2_test[inds] <- paste0(tab.out$X2_test[inds], "\textsuperscript{*}")
tab.out
# col.nam X1 X2 max X1_test X2_test
#1 AIC(n) 4.70e+01 4.67e+01 4.70e+01 X1 X2\textsuperscript{*}
#2 HQ(n) 4.72e+01 4.69e+01 4.72e+01 X1 X2\textsuperscript{*}
#3 SC(n) 4.76e+01 4.77e+01 4.77e+01 X1\textsuperscript{*} X2
#4 FPE(n) 2.73e+20 2.05e+20 2.73e+20 X1 X2\textsuperscript{*}
要对多列执行此操作,我们可以手动或使用列名称之间的通用字符串模式(我们可以在此处使用 grep
)或基于位置创建对向量。
X1_pairs <- c('X1')
X2_pairs <- c('X2')
我们可以使用上述命令创建一个函数,一次将其应用于两列。
apply_fun <- function(x, y) {
tab.out[paste0("max", x)] <- pmax(tab.out[[x]], tab.out[[y]])
tab.out[paste0(c(x, y), "_test")] <- list(x, y)
inds <- tab.out[[x]] > tab.out[[y]]
tab.out[!inds, paste0(x, "_test")] <- paste0(tab.out[[x]][!inds], "\textsuperscript{*}")
tab.out[inds, paste0(y, "_test")] <- paste0(tab.out[[y]][inds], "\textsuperscript{*}")
tab.out
}
并使用 for
循环将其应用于每一对。
for (i in seq_along(X1_pairs)) {
tab.out <- apply_fun(X1_pairs[i], X2_pairs[i])
}
我能够为 n 列解决它并在 latex 中添加代码输出。
X1 = c(4.70e1, 4.72e1, 4.76e1, 1.565)
X2 = c(4.67e1, 4.69e1, 4.77e1, 2.05e20)
X3 = c(1.67e1, 8.69e1, 2.77e1, 8.05e20)
tab.out = data.frame(X1, X2, X3)
tab.out$min<-apply(tab.out, 1, min)
for(i in names(tab.out)){
tab.out[[paste(i, 'test', sep="")]] = if_else(tab.out[[i]] == tab.out$min,
paste0(tab.out[[i]], "\textsuperscript{*}"),
paste0(tab.out[[i]]))
}
row.nam = c("AIC(n)", "HQ(n)", "SC(n)", "FPE(n)")
tab.out = data.frame(row.nam, tab.out)
tab.out = tab.out %>%
select(row.nam, X1test, X2test, X3test)
# row.nam X1test X2test X3test
#1 AIC(n) 47 46.7 16.7\textsuperscript{*}
#2 HQ(n) 47.2 46.9\textsuperscript{*} 86.9
#3 SC(n) 47.6 47.7 27.7\textsuperscript{*}
#4 FPE(n) 1.565\textsuperscript{*} 2.05e+20 8.05e+20
乳胶输出:
colnames(tab.out) = c("Parameters", "Lag 1", "Lag 2", "Lag 3") #$m^r_t$
print(xtable::xtable(tab.out,
header = F,
caption = "asdasdasdasd",
label="table:tb1",
align="llccc"),
hline.after = c(-1,0),
include.rownames=FALSE,
include.colnames = TRUE,
add.to.row = list(pos = list(nrow(tab.out)),
command = paste("\hline \n",
"\multicolumn{4}{l}{\footnotesize{$^{*}$Indicates the selected order of lag}} \\",
"\multicolumn{4}{l}{\footnotesize{\textit{Elaboration: The authors}}}",
sep = "")), comment=FALSE,
sanitize.text.function = function(x){x})