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