# TeXの表の出力で上下の線の幅を太くした関数
# xtabl package の print.xtable を少し改変
# booktabs を使って上下の線幅を変えるように設定

print.xtable2 <- function (x, type = "latex", file = "", append = FALSE, floating = TRUE, 
    table.placement = "ht", caption.placement = "bottom", latex.environments = c("center"), 
    ...) 
{
    if (length(type) > 1) 
        stop("\"type\" must have length 1")
    type <- tolower(type)
    if (!all(!is.na(match(type, c("latex", "html"))))) 
        stop("\"type\" must be in {\"latex\", \"html\"}")
    if (!all(!is.na(match(unlist(strsplit(table.placement, split = "")), 
        c("h", "t", "b", "p", "!"))))) 
        stop("\"table.placement\" must contain only elements of {\"h\",\"t\",\"b\",\"p\",\"!\"}")
    if (!all(!is.na(match(caption.placement, c("bottom", "top"))))) 
        stop("\"caption.placement\" must be either {\"bottom\",\"top\"}")
    if (type == "latex") {
        BCOMMENT <- "% "
        ECOMMENT <- "\n"
        if (floating == TRUE) {
            BTABLE <- paste("\\usepackage{booktabs}\n\n\\begin{table}", 
                ifelse(!is.null(table.placement), 
                paste("[", table.placement, "]", sep = ""), ""), 
                "\n", sep = "")
            if (is.null(latex.environments) || (length(latex.environments) == 
                0)) {
                BENVIRONMENT <- ""
                EENVIRONMENT <- ""
            }
            else {
                BENVIRONMENT <- ""
                EENVIRONMENT <- ""
                for (i in 1:length(latex.environments)) {
                  if (latex.environments[i] == "") 
                    next
                  BENVIRONMENT <- paste(BENVIRONMENT, "\\begin{", 
                    latex.environments[i], "}\n", sep = "")
                  EENVIRONMENT <- paste("\\end{", latex.environments[i], 
                    "}\n", EENVIRONMENT, sep = "")
                }
            }
            ETABLE <- "\\end{table}\n"
        }
        else {
            BTABLE <- ""
            ETABLE <- ""
            BENVIRONMENT <- ""
            EENVIRONMENT <- ""
        }
        BTABULAR <- paste("\\begin{tabular}{", paste(attr(x, 
            "vsep"), c(attr(x, "align"), "}\n\\toprule\n"), sep = "", 
            collapse = ""), sep = "")
        ETABULAR <- "\\bottomrule\n\\end{tabular}\n"
        BLABEL <- "\\label{"
        ELABEL <- "}\n"
        BCAPTION <- "\\caption{"
        ECAPTION <- "}\n"
        BROW <- ""
        EROW <- " \\\\\n"
        BTH <- ""
        ETH <- ""
        STH <- " & "
        PHEADER <- "\\midrule\n"
        BTD1 <- " & "
        BTD2 <- ""
        BTD3 <- ""
        ETD <- ""
        sanitize <- function(str) {
            result <- str
            result <- gsub(">", "$>$", result)
            result <- gsub("<", "$<$", result)
            result <- gsub("\\|", "$|$", result)
            return(result)
        }
        sanitize.numbers <- function(x) {
            result <- x
            for (i in 1:length(x)) {
                result[i] <- gsub("-", "$-$", result[i])
            }
            return(result)
        }
    }
    else {
        BCOMMENT <- "<!-- "
        ECOMMENT <- " -->\n"
        BTABLE <- "<TABLE border=1>\n"
        ETABLE <- "</TABLE>\n"
        BENVIRONMENT <- ""
        EENVIRONMENT <- ""
        BTABULAR <- ""
        ETABULAR <- ""
        BLABEL <- "<A NAME="
        ELABEL <- "></A>\n"
        BCAPTION <- paste("<CAPTION ALIGN=\"", caption.placement, 
            "\"> ", sep = "")
        ECAPTION <- " </CAPTION>\n"
        BROW <- "<TR>"
        EROW <- " </TR>\n"
        BTH <- " <TH> "
        ETH <- " </TH> "
        STH <- " </TH> <TH> "
        PHEADER <- ""
        BTD1 <- " <TD align=\""
        BTD2 <- matrix(attr(x, "align"), nrow = nrow(x), ncol = ncol(x) + 
            1, byrow = TRUE)
        BTD2[BTD2 == "r"] <- "right"
        BTD2[BTD2 == "l"] <- "left"
        BTD2[BTD2 == "c"] <- "center"
        BTD3 <- "\"> "
        ETD <- " </TD>"
        sanitize <- function(str) {
            result <- str
            result <- gsub("&", "&amp ", result)
            result <- gsub(">", "&gt ", result)
            result <- gsub("<", "&lt ", result)
            return(result)
        }
        sanitize.numbers <- function(x) {
            return(x)
        }
    }
    result <- string("", file = file, append = append)
    info <- R.Version()
    result <- result + BCOMMENT + type + " table generated in " + 
        info$language + " " + info$major + "." + info$minor + 
        " by xtable 1.2-4 package" + ECOMMENT
    result <- result + BCOMMENT + date() + ECOMMENT
    result <- result + BTABLE
    result <- result + BENVIRONMENT
    if (floating == TRUE) {
        if ((!is.null(attr(x, "caption"))) && (type == "html" || 
            caption.placement == "top")) 
            result <- result + BCAPTION + attr(x, "caption") + 
                ECAPTION
        if (!is.null(attr(x, "label")) && (type == "latex" && 
            caption.placement == "top")) 
            result <- result + BLABEL + attr(x, "label") + ELABEL
    }
    result <- result + BTABULAR
    result <- result + BROW + BTH + STH + paste(sanitize(names(x)), 
        collapse = STH) + ETH + EROW
    result <- result + PHEADER
    cols <- matrix("", nrow = nrow(x), ncol = ncol(x) + 1)
    cols[, 1] <- row.names(x)
    disp <- function(y) {
        if (is.factor(y)) {
            y <- levels(y)[y]
        }
        if (is.list(y)) {
            y <- unlist(y)
        }
        return(y)
    }
    for (i in 1:ncol(x)) {
        ina <- is.na(x[, i])
        cols[, i + 1] <- formatC(disp(x[, i]), format = attr(x, 
            "display")[i + 1], digits = attr(x, "digits")[i + 
            1])
        if (any(ina)) 
            cols[ina, i + 1] <- ""
        cols[, i + 1] <- sanitize.numbers(cols[, i + 1])
    }
    multiplier <- 5
    full <- matrix("", nrow = nrow(x), ncol = multiplier * (ncol(x) + 
        1) + 2)
    full[, 1] <- BROW
    full[, multiplier * (0:ncol(x)) + 2] <- BTD1
    full[, multiplier * (0:ncol(x)) + 3] <- BTD2
    full[, multiplier * (0:ncol(x)) + 4] <- BTD3
    full[, multiplier * (0:ncol(x)) + 5] <- cols
    full[, multiplier * (0:ncol(x)) + 6] <- ETD
    full[, multiplier * (ncol(x) + 1) + 2] <- EROW
    if (type == "latex") 
        full[, 2] <- ""
    result <- result + paste(t(full), collapse = "")
    result <- result + ETABULAR
    if (floating == TRUE) {
        if ((!is.null(attr(x, "caption"))) && (type == "latex" && 
            caption.placement == "bottom")) 
            result <- result + BCAPTION + attr(x, "caption") + 
                ECAPTION
        if (!is.null(attr(x, "label")) && caption.placement == 
            "bottom") 
            result <- result + BLABEL + attr(x, "label") + ELABEL
    }
    result <- result + EENVIRONMENT
    result <- result + ETABLE
    print(result)
    return(invisible())
}