# Roger Palay copyright 2016-03-04
# Saline, MI 48176
#
crosstab <- function( matrix_A )
{
## Produces a cross tab table, with row and column
## sums, along with similar tables for row percent,
## column percent, total percent, expected value,
## observed-expected values, diff squared values,
## and diff sq/expected values. These are all
## created as Views and as variables in the parent
## environment. his function alsogets the sum of the
## diff sq/expected values, the degrees of freedom,
## and the resulting attained chi squared percent.
cxt <<- matrix_A
base_dim <- dim( cxt )
num_row<-base_dim[1]
num_col<-base_dim[2]
col_names <- "c 1"
for( i in 2:num_col)
{ col_names <- c(col_names, paste("c",i))}
colnames( cxt ) <<- col_names
row_names <- "r 1"
for (i in 2:num_row)
{ row_names <- c(row_names, paste("r",i))}
rownames( cxt) <<- row_names
totals <<- cxt
rs <- rowSums( cxt )
totals <<-cbind(totals,rs)
cs <- colSums( totals )
totals <<- rbind(totals,cs)
col_names<-c(col_names,"Total")
row_names <- c(row_names,"Total")
rownames(totals)<<-row_names
colnames(totals)<<-col_names
View( totals )
# make a temp matrix with just the
# row totals in each column
# but first fix rs
t <- cs[num_col+1]
rs <- c(rs, t)
rtots <- matrix(rep(rs,num_col+1),nrow=num_row+1 )
row_percent <<- totals/rtots
View( row_percent)
ctots <- matrix(rep(cs,num_row+1),
nrow=num_row+1, byrow=TRUE)
col_percent <<- totals/ctots
View(col_percent)
ttot <- matrix( rep(t, (num_row+1)*(num_col+1)),
nrow = num_row+1)
tot_percent <<- totals/ttot
View(tot_percent)
expected <<- cxt
for ( i in 1:num_row)
{ rowtot <- rs[i]
for ( j in 1:num_col)
{ expected[i,j] <<- rowtot*cs[j]/t}
}
View(expected)
diffr <<- matrix_A - expected
View(diffr)
diff_sqr <<- diffr * diffr
View(diff_sqr)
chisqr_values <<- diff_sqr/expected
View( chisqr_values )
sum_x <- sum(chisqr_values)
use_df <- (num_row-1)*(num_col-1)
attained <- pchisq( sum_x, use_df, lower.tail=FALSE)
result <- c( sum_x, use_df, attained )
names(result) <- c("chi sq val", "deg. freedom",
"attained")
return( result )
}