[R] Crosstabs in R

[Martin Maechler]

>>>>> "Marc" == Marc Feldesman <feldesmanm at pdx.edu> writes:

    Marc> Before I reinvent the wheel, I have need for a
    Marc> relatively straightforward crosstabulation (2 x n)
    Marc> function.  I know that R has table(), ftable(),
    Marc> xtabs(), and summary(xtabs()), but none of these
    Marc> produce a fully "tricked" out cross-tabulation with
    Marc> marginal totals, expected cell frequencies, and an
    Marc> array of statistics about the contingency table.

    Marc> Is there a more complete (something more along the
    Marc> lines of SPSS output) crosstabulation function that
    Marc> I've missed?

    Marc> I've looked in all the usual places but can't seem to
    Marc> find anything besides the functions listed above.

I was recently asked the same thing .. and wondered.
I did vaguely remember I had written something like that for
S-plus almost 10 years ago -- for teaching purposes.

Here is the result; the main function is printTable2() 
it uses an auxiliary catCon().

Both of these reflect the style of programming I used to have in
the early nineties....

... and you should translate German to English.

Please improve and post back! ---> maybe all on R-devel instead
of R-help {and I *will* not be around for one whole week !}

Regards,
Martin Maechler <maechler at stat.math.ethz.ch>	http://stat.ethz.ch/~maechler/
Seminar fuer Statistik, ETH-Zentrum  LEO C16	Leonhardstr. 27
ETH (Federal Inst. Technology)	8092 Zurich	SWITZERLAND
phone: x-41-1-632-3408		fax: ...-1228			<><


-------------- next part --------------

printTable2 <- function(table2, digits = 3)
{
  ##-- 2-weg Kontingenztafel mit allem zusammen ... -- ruft  catCon(.)  auf
  ##-- Urspruneglich fuer NDK-Uebungen 1992
  ##-- Verbessert und Fehler korrigiert! : M.Maechler, Feb.1993
  d <- dim(table2)
  if(length(d) != 2)
    stop("Argument muss numerische Matrix sein: Die (2-Weg) Kontingenz Tafel")
  N <- sum(table2)
  cat("\nKontingenz-Tafel mit Randsummen:\n")
  catCon (table2, 0)
  cat("\nGemeinsame Verteilung mit Randverteilungen:\n")
  I <- d[1];  J <- d[2];  df <- (I-1)*(J-1)
  r <- catCon (table2/N, digits)
  joint <- r[1:I, 1:J]
  xrand <- r[I+1, 1:J]
  yrand <- r[1:I, J+1]
  condy <- joint/yrand
  condx <- t(t(joint)/xrand)
  cat("Bedingte Verteilung gegen y:\n"); print(round(condy,digits)); cat("\n")
  cat("Bedingte Verteilung gegen x:\n"); print(round(condx,digits)); cat("\n")
  exp.ind <- N * outer(yrand,xrand)#- Expected under INDEPendence: n * p_i * p_j
  cat("Freiheitsgrade: df =",df,"\n")
  cat("Chi^2 - Annahmebereich: [0,", round(qchisq(0.95,df),1),
      "] (alpha=0.05)\n\n\n", sep = "")
  test.chisq <- sum((as.matrix(table2)-exp.ind)^2/exp.ind)
  cat("Testwerte unter der Unabhaengigkeitshypothese:\n")
  cat("  Test mit Chi^2: ",format(round(test.chisq,2)),
      " (P-Wert: ",round(1-pchisq(test.chisq,df),4),")\n",sep = "")
  is.pos <- table2 != 0
  test.deviance <- 2*sum(table2[is.pos]*log(table2[is.pos]/exp.ind[is.pos]))
  cat("  Test mit Devianz:  ",format(round(test.deviance,2)),
      " (P-Wert: ",round(1-pchisq(test.deviance,df),4),")\n\n",sep = "")
  invisible(list(p.condx = condx, p.condy = condy, expected.indep = exp.ind,
		 df = df, chisq.test = test.chisq, deviance = test.deviance))
}

catCon <- function(mat, digits = 3)
{
  ##-- "CAT CONtingency table"  mit RAND-SUMMEN + "Verzierung"
  ##-- Korrigiert fuer UNsymmetr. Kont.tafeln und stark vereinfacht: M.Maechler
  ## Gibt Resultat zurueck !
  ##>>> Hilfsfunktion fuer 'printTable2' <<<
  mat <- as.matrix(mat)
  d <- dim(mat);  N <- d[1];  M <- d[2]
  mat <- rbind(cbind(mat, mat %*% rep(1, M)),
	       c(rep(1,N) %*% mat,  sum(mat)))
  out <- format(round(mat, digits))
  "--" <- paste(rep("-", max(nchar(out))), collapse = "")
  out <- cbind(rbind(out, get("--")), "|")
  print(out[c(1:N,N+2,N+1), c(1:M,M+2,M+1)], quote = FALSE)
  invisible(mat) #--- die erweiterte Matrix --
}