Benutzer:Sigbert/Kreuztabelle

R Programm:

#' htmlMatrix
#'
#' Creates a wiki crosstable.
#'
#' @param corner character: entries for the four matrix corners 
#' @param top character: vector for the entries of the first row without corner
#' @param left character: vector for the entries of the first column without corner
#' @param right character: vector for the entries of the last row without corner, NULL = no last row
#' @param bottom character: vector for the entries of the last column without corner, NULL = no last column
#' @param common character: entry for the 
#' @param cindex character: column indices
#' @param rindex character: row indices
#' @param table character: table attributes
#' @param caption character: table caption, NULL = no caption
#'
#' @return HTML code
htmlMatrix <- function(corner=c("<math>Z\\setminus S</math>", 
                                "Randhäufig-<br>keit von <math>Z</math>", 
                                "Randhäufig-<br>keit von <math>S</math>",
                                "<math>n_{\\bullet\\bullet}=N</math>"),
                       top   ="<math>s_{%s}</math>",
                       left  ="<math>z_{%s}</math>", 
                       right ="<math>n_{%s \\bullet}</math>",
                       bottom="<math>n_{\\bullet %s}</math>",
                       common="<math>n_{%s%s}</math>",
                       cindex=c("1", "2", NA, "K"),
                       rindex=c("1", "2", NA, "J"),
                       table='class="wikitable float-right" style="text-align: center"',
                       caption=NULL) {
   ncol <- length(cindex)+2-is.null(right)
   nrow <- length(cindex)+2-is.null(bottom)
   m <- matrix(NA, nrow=nrow, ncol=ncol)
   mcol <- 1:length(cindex)
   mrow <- 1:length(rindex)
   m[1,1]                    <- corner[1]
   m[1,1+mcol] <-  ifelse(is.na(cindex), '<math>\\ldots</math>', sprintf(top, as.character(cindex)))
   m[1+mrow,1] <-  ifelse(is.na(rindex), '<math>\\vdots</math>', sprintf(left, as.character(rindex)))
   if (!is.null(right)) {
     m[1,ncol] <- corner[2]
     m[1+mrow,ncol] <- ifelse(is.na(rindex), '<math>\\vdots</math>', sprintf(right,  as.character(rindex)))
   }
   if (!is.null(bottom)) {
     m[nrow,1] <- corner[3]
     m[nrow,1+mcol] <- ifelse(is.na(cindex), '<math>\\ldots</math>', sprintf(bottom, as.character(cindex)))
   }
   if (!is.null(bottom) || !is.null(right)) m[nrow,ncol] <- corner[4]
   for (i in mcol) {
     for (j in mrow) {
       m[j+1,i+1] <- sprintf(common, as.character(rindex[j]), as.character(cindex[i]))
       if (is.na(cindex[i])) {
         m[j+1,i+1]  <- if (is.na(rindex[j])) '<math>\\ddots</math>' else '<math>\\ldots</math>'
       } else if (is.na(rindex[j])) m[j+1,i+1]  <- '<math>\\vdots</math>'
     } 
   }
   res <- c("<!--", "https://de.wikipedia.org/wiki/Benutzer:Sigbert/Kreuztabelle", "", match.call(), "-->", sprintf("{| %s", table))
   if(!is.null(caption)) res <- c(res, sprintf("|+ %s", caption))
   res <- c(res, "|-", paste(" !", m[1,]))
   for (i in 2:nrow(m)) res <- c(res, "|-", paste0(" !", m[i,1]), paste0(" |", m[i,-1]))
   res <- paste0(c(res, "|}"), collapse="\n")
}