pdf("g11.pdf");options(width=64) #setwd("C:\\Users\\kolassa\\Class553") setwd("~/Taught1/960-553/Data")
# Block 1 #**********************************************************/ # Stuart (1953 Biometrika 40, 105-110), quoted by Stuart */ # (1955 Biometrika 42, 412-416), and Agresti (1983 Bio- */ # metrics 39(2) 505-510), present an ordinal categoriza- */ # tion of right and left eye vision of Royal Ordinance */ # female factory workers 1943-46. */ #*********************************************************/ eyes<-read.table("eyes.dat",col.names=c("r","l","count")) #*****************************************************/ # Cohen's Kappa */ #*****************************************************/ library(psych)#For cohen.kappa; Calculates Cohen's kappa to measure agreement. cohen.kappa(xtabs(count~r+l,data=eyes)) library(TheorStat)# For fun.testpoly and fun.testplotpoly; Explores the relationship between multivariate normality and the polychoric correlation via simulation and plots the results. out<-fun.testpoly(nmc=1000) fun.plottestpoly(out) # Block 2 #**********************************************************/ #Cronbach's alpha */ #**********************************************************/ #*********************************************************/ # Data from SAS Usere's Guide, documentation for CORR pr-*/ # ocedure. Data are from 35 fish of a certain species */ # from a lake in Finland. Variables are weight, length, */ # max height as a percentage of Length3, and max width as*/ # a percentage of Length3. */ #*********************************************************/ fish <- read.table("fish.dat",na.strings=".", col.names=c("Weight","Length3","HtPct","WidthPct")) #How reliable are the four as measures of a fish's linear #size? #Rescale weight to put on dimension scale. fish$weightrt<-fish$Weight^(1/3) # Recover height from percentages. fish$Height<-fish$HtPct*fish$Length3*0.01 fish$Width<-fish$WidthPct*fish$Length3*0.01 library(psych)#For alpha; Calculate Cronbach's alpha to measure reliability. alpha(fish[,c("Length3","weightrt","Height","Width")]) xx<-fish[-14,c(2,5:7)] yy<-xx for(j in 1:4) yy[[j]]<-(yy[[j]]-mean(yy[[j]]))/sd(yy[[j]]) alpha(xx) alpha(yy) # Block 3 #************************************************************/ # Cow Mastitis Example */ # Data from Andrews and Herzberg (1985), Data: A Collection */ # of Problems from Many Fields for the Student and Research */ # Worker, Table 61. Observations represent infections in */ # udders of cows given a placebo or one of eight anti- */ # biotics. First two variables identify the table. Third */ # and fourth identify cow, fifth identifies herdd, sixth */ # treatment, and next eight represent level of infection at */ # each of eight sites. Treatment assignment is non-random. */ # http://lib.stat.cmu.edu/datasets/Andrews/T61.1 */ #************************************************************/ cows<-as.data.frame(scan("T61.1",flush=T,what=list(ex=0, ta=0,c1=0,c2=0,herd=0,treaetment=0,q11=0,q12=0,q21=0))) #*************************************************************/ # Explore relation between the first four treatments and */ # infection severity in udder 2 location 1 in two ways: both */ # variables treated as ordered, and both as unordered. */ #*************************************************************/ cat('\n Exact Tests for Assoc. betw. treatment and infection \n') #*************************************************************/ #Do a "toy" example of logistic regression. */ #*************************************************************/ #If we knew the intercept term, we would use it as an offset.*/ #The p-value depends on the value of this offset. */ #Investigate actual size of unconditional test. */ #*************************************************************/ cat('\n asy \n') glm(c(1,1,0,0)~c(-1,1,-1,1),weight=c(7,3,3,7),family=binomial) library(TheorStat)# For waldsize; Calculate true size of Wald statistic for the comparison of two proportions. out<-waldsize(10,10,201) plot(out[[1]],out[[2]],xlab="Common Probability", ylab="Size of nominal .05 test",type="l", main="Size of Wald Test from Logistic Regression") # Block 4 #*************************************************************/ #* Prostate data */ #* From Andrews and Herzberg (1985), Data: A Collection of */ #* Problems from Many Fields for the Student and Research */ #* Worker, Table 46. Observations represent subjects in a */ #* prostate cohort study, randomized to one of four dose */ #* levels of diethylstilbestrol. Rx records dose in four */ #* ordered categories, with 1 being placebo. Disease stage */ #* is 3 or 4. monfol is months of followup. surv is 0 if */ #* alive after 50 mo, and codes cause of death otherwise. */ #* http://lib.stat.cmu.edu/datasets/Andrews/T46.1 */ #* The on-line version of the data set adds 3 fields before */ #* the first field in the book. Variables of interest are */ #* stage, rx, monfol, and surv in fields 5, 6, 10, 11 of the */ #* online version, resp. Causes of death are given by var- */ #* ious positive integers in surv; I recode these to 1. The */ #* data file has more columns than we are interested in. Put*/ #* place-holding variables in for variables not of interest */ #* between variables of interest. Data were previously pub- */ #* lished by Byar and Corle (1977 Chronic Disease) and Byar */ #* and Green (1980 Bull. Cancer). Lower value of dichoto- */ #* mized dose begins with blank to make it alphabetized */ #* before high. */ #*************************************************************/ # If we omit the ones past where the data of interest stops # in the "what" list, and use flush=T, R will ignore them. prostate<-read.table("T46.1")[,c(5,6,10,11)] dimnames(prostate)[[2]]<-c("stage","rx","monfol","surv") prostate$alive<-(prostate$surv==0)+0 prostate$dose<-c(" low","high")[1+(prostate$rx>1)] stage4<-prostate[prostate$stage==4,] #*************************************************************/ #* Causes of death are given by various positive integers in */ #* surv; I recode these to 1. */ #*************************************************************/ prostate$alive<-(prostate$surv==0)+0 #*******************************************************/ #* Test whether survival is the same across treatments.*/ #*******************************************************/ chisq.test(stage4$rx,stage4$alive,simulate.p.value=TRUE) # One can score tables by inverse probability. fisher.test(stage4$rx,stage4$alive)