Как вам l oop для n-столбцов и использовать условные выражения?

Question

Я пытаюсь создать al oop для таблицы, которая будет сгенерирована в 'xtable'.

Это то, что я сделал "вручную" здесь:

Что я хочу получить

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

Я хочу сделать al oop для n-столбцов, используя условные выражения, как показано ниже в коде ( Мой текущий уродливый и подверженный ошибкам fix ):

Lo que obtuve?

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

Answer 1

Это может быть сделано непосредственно с векторизованными операциями без использования каких-либо «примененных» функций или l oop.

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 l oop, чтобы применить его к каждой паре.

for (i in seq_along(X1_pairs)) {
    tab.out <- apply_fun(X1_pairs[i], X2_pairs[i])
}

Answer 2

Я смог решить ее для n-столбцов и добавить вывод кода в латексе.

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