") #HTML(tmp.res3,File=File) } else { cat(newtitle) cat(tmp.res3) } } #cat("got to here (4): end of function declaration print.CSC\n\n") print.RC.change <- function(rc.chge,title,HTML=TRUE,File) { if (!is.factor(rc.chge)) { stop("RC change data must be factor\n") } if (sum(is.na(rc.chge))) { stop("RC change data must be complete\n") } require(Hmisc) # requires binconf() ###### tabular summary of reliable change n.all <- length(rc.chge) tmp.res <- table(rc.chge) tmp.perc <- round(100*tmp.res[1:3]/n.all,1) tmp.res2 <- rbind(tmp.res[1:3],tmp.perc) tmp.res2 <- cbind(tmp.res2,c(sum(tmp.res2[1,]),sum(tmp.res2[2,]))) tmp.ci1 <- binconf(tmp.res[1],n.all) tmp.ci2 <- binconf(tmp.res[2],n.all) tmp.ci3 <- binconf(tmp.res[3],n.all) tmp.ci1b <- paste(round(100*tmp.ci1[2],1),"to",round(100*tmp.ci1[3],1)) tmp.ci2b <- paste(round(100*tmp.ci2[2],1),"to",round(100*tmp.ci2[3],1)) tmp.ci3b <- paste(round(100*tmp.ci3[2],1),"to",round(100*tmp.ci3[3],1)) tmp.res3 <- rbind(tmp.res2,c(tmp.ci1b,tmp.ci2b,tmp.ci3b,"")) dimnames(tmp.res3) <- list(c("n","%","CI"),c(names(tmp.res[1:3]),"Total")) newtitle <- paste("Breakdown of reliable change",title) if (HTML) { newtitle <- paste("
")
}
#cat("got to here (5): end of function declaration print.RC.change\n\n")
RC.change <- function(diffs,rc.crit) {
## little function that returns a vector of reliable change
## given the differences and the criterion
if (!is.numeric(diffs)) { stop("Diffs must be numeric\n") }
if (sum(is.na(diffs)>0)) { stop("Missing values in diffs\n") }
if (!is.numeric(rc.crit)) { stop("RC criterion must be numeric\n") }
sign <- sign(diffs)
rc.chge <- abs(diffs)
rc.chge <- ifelse(rc.chge got inside to here (1) \n")
# and rows as individuals' data
# var1,var2 are column numbers of variables in the dataset to analyse: initial, later
# varname is the name of measure (used for the output filename)
# gender is column number of the gender variable
# male is value indicating male
# female is value indicating female
# malecrit is male CSC criterion
# femcrit is female CSC criterion
call <- match.call() # allows you to get at the dataset name as text you can use as a label
data.name <- as.vector(as.character(call[[2]])) # it's the 2nd in that list
if (HTML) {
filename <- paste(data.name,".",varname,sep="")
File <- HTMLInitFile(filename=filename,outdir=outdir)
}
## this just produces a data.frame of the data with ID and group markers if they exist
cleandata <- cleandata(data,var1,var2,gender,ID=ID,group=group)
vecdata1 <- cleandata$"First.score"
vecdata2<- cleandata$"Second.score"
gendata <- cleandata$Gender
## OK now do more with what we've selected
n.all <- length(vecdata1)
idx.men <- (1:n.all)[gendata==male]
idx.women <- (1:n.all)[gendata==female]
n.women <- length(gendata[idx.women])
n.men <- length(gendata[idx.men])
#
# now get the parameters you need for RC
rc.crit <- RC.crit.scores(vecdata1,alpha)
## now do some work with that
diffs <- vecdata2 - vecdata1
rc.chge <- RC.change(diffs,rc.crit)
idx.rel.worse <- (1:n.all)[rc.chge==1] # index of who got reliably worse
idx.rel.unchg <- (1:n.all)[rc.chge==0] # unchanged
idx.rel.better <- (1:n.all)[rc.chge==-1] # reliably better
# get things right for outputting
rc.crit <- round(rc.crit,3)
param <- rbind(data.name,var1,var2,alpha,varname,gender,male,female,malecrit,femcrit,n.all,n.women,n.men,rc.crit)
if (HTML) {
cat(" ")
cat(" ")
cat(" ")
csc <- CSC.categories(vecdata1,vecdata2,gendata,male,female,malecrit,femcrit)
cat(" ")
cat(" ")
cat(" ")
cat(" ")
cat(" ")
#cat(names(formData))
#cat(" ")
# cat(unlist(formData))
#cat(" ")
name <- formData$name
#cat(" ")
#cat(name)
title <- formData$title
#cat(" ")
#cat(title)
alpha <- as.numeric(scanText(formData$alpha))
#cat(" ")
#cat(alpha)
what1 <- formData$what
#cat(" what1:")
#cat(what1)
#cat(" is.character(what1):")
#tmp <- is.character(what1)
#cat(tmp)
#tmp <- is.list(what1)
#cat(" is.list(what1):")
#cat(tmp)
#tmp <- dim(what1)
#cat(" dim(what1):")
#cat(tmp)
#tmp <- nchar(what1)
#cat(" nchar(what1)")
#cat(tmp)
#cat(" what2:")
what2 <- strsplit(what1," ",extended=FALSE)
#tmp <- unlist(what2)
#cat(tmp)
nvars <- length(unlist(what2))
#cat(" nvars:")
#cat(nvars)
dat <- unlist(scanText(formData$data,what=what2[1]))
#cat(" dat:")
#cat(dat)
#cat(" length")
length.dat <- length(dat)
nrows <- length.dat/nvars
md <- matrix(dat,ncol=nvars,byrow=TRUE)
#cat(" md:")
#cat(md)
#tmp <- dim(md)
#cat(" dim(md): length.dat: var1: var2: gender: ID: group: male: female: femcrit: malecrit: now: host: class(md)")
vecdat1 <- as.numeric(md[,var1])
#cat(" vecdat1: vecdat2: gendat: iddat: grpdat: newdat: ")
# cat(i)
# cat(" ")
# cat(class(newdat[,i]))
# cat(" ")
#}
#cat("entering main function call")
RCSC.from.datasheet(newdat,1,2,alpha,varname=name,3,male,female,malecrit,femcrit,alldata=1,ID=ID,group=group,HTML=TRUE,outdir="//var//psyctc//psyctc.org//stats//COREtools//scratch//",extension="html",printdata=TRUE)
untag(BODY)
untag(HTML)
lf()
sink(paste("/home/xychris0/R/CGIwithR-log/RCSC1.R.",as.character(now),sep=""))
cat("program = RCSC1.R ; host = ",host, "; ", now, "; grid.title = ",name,"\n")
sink()
Checking on the input")
x <- xtable(param,caption="Values")
print(x,type="html")
} else {
cat(param)
}
cat("
Analyses of whether or how often reliable change or deterioration seen
")
print.RC.change(rc.chge,"Men and Women",HTML=HTML,File=File)
print.RC.change(rc.chge[idx.men],"Men only",HTML=HTML,File=File)
print.RC.change(rc.chge[idx.women],"Women only",HTML=HTML,File=File)
cat("Analyses of whether or how often clinically significant change was seen
")
print.CSC(csc,"Men and Women",HTML=HTML,File=File)
print.CSC(csc[idx.men],"Men only",HTML=HTML,File=File)
print.CSC(csc[idx.women],"Women only",HTML=HTML,File=File)
cat("Analyses of reliable change against clinically significant change
")
print.CSC.by.RC(csc,rc.chge,"Men and Women",HTML=HTML,File=File)
print.CSC.by.RC(csc[idx.men],rc.chge[idx.men],"Men only",HTML=HTML,File=File)
print.CSC.by.RC(csc[idx.women],rc.chge[idx.women],"Women only",HTML=HTML,File=File)
cat("Jacobson plots
")
Jacobson.plot(vecdata1,vecdata2,"CORE-OM",gendata,male,female,rc.crit,malecrit,femcrit,title="Men and Women",outdir,File,HTML=HTML)
Jacobson.plot(vecdata1[idx.men],vecdata2[idx.men],"CORE-OM",gendata[idx.men],male,female,rc.crit,malecrit,femcrit,title="Men only",outdir,File,HTML=HTML)
Jacobson.plot(vecdata1[idx.women],vecdata2[idx.women],"CORE-OM",gendata[idx.women],male,female,rc.crit,malecrit,femcrit,title="Women only",outdir,File,HTML=HTML)
##### tabulation of who did what
results <- cbind(cleandata,diffs,rc.chge,csc)
if (printdata) {
if (HTML) {
cat("Listing of the data
")
x <- xtable(results,caption="Original data with change, RC and CSC")
print(x,type="html")
#HTML(results,File=File)
} else {
cat("Listing of data")
cat(results)
}
}
#return(results)
}
## end of functions
#cat("got to here (10): end of function declarations\n\n")
tag(HTML)
tag(HEAD)
tag(TITLE)
cat("RCSC analysis")
untag(TITLE)
untag(HEAD)
lf(2)
tag(BODY, bgcolor = "lime")
lf(2)
tag(center)
prob <- 0
comments("Get the data")
#cat("
")
#cat(tmp)
#cat("
")
#cat(length.dat)
#cat(" ")
var1 <- as.numeric(formData$var1)
#cat("
")
#cat(var1)
var2 <- as.numeric(formData$var2)
#cat("
")
#cat(var2)
gender <- as.numeric(formData$gender)
#cat("
")
#cat(gender)
ID <- as.numeric(formData$ID)
#cat("
")
#cat(ID)
group <- as.numeric(formData$group)
#cat("
")
#cat(group)
male <- formData$male
#cat("
")
#cat(male)
female <- formData$female
#cat("
")
#cat(female)
femcrit <- as.numeric(formData$femcrit)
#cat("
")
#cat(femcrit)
malecrit <- as.numeric(formData$malecrit)
#cat("
")
#cat(malecrit)
#cat("
")
now <- system('date +%Y-%m-%d,%T', intern=TRUE)
#cat(now)
#cat("
")
host <- system("echo $REMOTE_ADDR", intern=TRUE)
#cat(host)
#cat("
")
#cat(vecdat1)
vecdat2 <- as.numeric(md[,var2])
#cat("
")
#cat(vecdat2)
gendat <- md[,gender]
#cat("
")
#cat(gendat)
iddat <- md[,ID]
#cat("
")
#cat(iddat)
grpdat <- md[,group]
#cat("
")
#cat(grpdat)
if (!is.na(ID) & !is.na(group)) {
# cat("Both ID and group")
newdat <- data.frame(I(vecdat1),I(vecdat2),I(gendat),I(iddat),I(grpdat))
colnames(newdat) <- c("Initial","Second","Gender","ID","Group")
ID <- 4
group <- 5
}
if (is.na(ID) & !is.na(group)) {
# cat("group not ID")
newdat <- data.frame(I(vecdat1),I(vecdat2),I(gendat),I(iddat),I(grpdat))
colnames(newdat) <- c("Initial","Second","Gender","Group")
group <- 4
}
if (!is.na(ID) & is.na(group)) {
# cat("ID not group")
newdat <- data.frame(I(vecdat1),I(vecdat2),I(gendat),I(iddat),I(grpdat))
colnames(newdat) <- c("Initial","Second","Gender","ID")
ID <- 4
}
if (is.na(ID) & is.na(group)) {
# cat("neither ID nor group")
newdat <- data.frame(I(vecdat1),I(vecdat2),I(gendat),I(iddat),I(grpdat))
colnames(newdat) <- c("Initial","Second","Gender")
}
class(newdat[,3]) <- "character"
#cat("Got to making up data again\n")
#cat("
")
#cat(newdat)
#for (i in 1:nvars) { cat(class(newdat[,i])) }
##### start of testing of the input #####
#cat("Got to testing the input\n")
prob <- 0
if (is.na(alpha) || (alpha < 0) || (alpha > 1.0)) {
cat("Alpha must be a positive number such that: 0 < alpha < 1, go back and try again!
")
prob <- 1
}
if (is.na(malecrit) || is.na(femcrit)) {
cat("CSC criteria for men and women must be given and be numbers, go back and try again!
")
prob <- 1
}
if (prob) {
cat("Go back and try again!
")
cat("CGI script written by Chris Evans using David Firth's excellent GGIwithR package. ")
linkto("Contact me if something isn't working right ...", "http://www.psyctc.org/cgi-bin/mailto.pl?webmaster") ; br()
}
lf(2)
comments("end of testing")
# should have valid data
cat("Reliable and clinically significant change analysis
")
cat(" for submission name: ",name," on measure ",title,"
")
cat("In the output that follows tables usually have captions immediately after them")
cat("")
cat("")
cat("
")
# cat(newdat[,i])
# cat("