Hard Examples

rstats · Jun 12, 2012 · 049d820 · 049d820
1 parent 03e8620
commit 049d820
Show file tree

Hide file tree

Showing 12 changed files with 3,785 additions and 0 deletions.
diff --git a/Hmisc/brew/useR2007.rhtml b/Hmisc/brew/useR2007.rhtml
@@ -0,0 +1,71 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
+"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html>
+<head><title>Brewing with Rapache: useR2007 example with Hmisc</title>
+<link rel="stylesheet" type="text/css" href="../css/useR2007.css" />
+<script src="../javascript/prototype.js" type="text/javascript"></script>
+<script src="../javascript/useR2007.js" type="text/javascript"></script>
+</head>
+<body>
+<h2>Power and Sample Size Calculations with spower from Hmisc</h2>
+<div id="mainwrapper">
+<div id="threecolwrap"><!--holds the left col background-->
+<div id="twocolwrap"><!-- encloses the left and center columns-->
+<div id="leftcol"><!-- the left column-->
+<p>The following example<b>[1]</b> demonstrates the flexibility of spower and
+related functions from <b><a href="http://biostat.mc.vanderbilt.edu/twiki/bin/view/Main/Hmisc">Hmisc</a></b>. We simulate a 2-arm (350 subjects/arm) 5-year follow-up
+study for wich the control group's survival distribution is Weibull with 1-year
+survival of .95 and 3-year survival of .7. All subjects are followed at least
+one year, and patients enter the study with linearly increasing probability
+starting with zero. Assume (1) there is no chance of dropin for the first 6
+months, then the probability increases linearly up to .15 at 5 years; (2) there
+is a linearly increasing chance of dropout up to .3 at 5 years; and (3) the
+treatment has no effect for the first 9 months, then it has a constant effect
+(hazard ratio of .75).
+</p>
+<div id="bibliography">
+[1] Alzola CF, Harrell FE:  <a href="http://biostat.mc.vanderbilt.edu/twiki/pub/Main/RS/sintro.pdf">An Introduction to S and the Hmisc and Design Libraries</a>. Freely available electronic book.
+</div>
+<br>
+<hr>
+<br>
+<div class="clearfix">
+	<label>Web site created by:</label>
+	<a href="http://biostat.mc.vanderbilt.edu/JeffreyHorner">Jeffrey Horner</a><br>
+</div>
+<div class="clearfix">
+	<label>With the following software:</label>
+	<a href="http://biostat.mc.vanderbilt.edu/Hmisc">Hmisc</a><br>
+	<a href="http://www.rforge.net/brew/">brew</a><br>
+	<a href="http://www.rforge.net/Cairo/">Cairo</a><br>
+	<a href="http://biostat.mc.vanderbilt.edu/rapache/">rapache</a><br>
+</div>
+</div>
+<div id="content">
+<div id="plot"><% brew('useR2007plot.rhtml') %></div>
+Characteristics of control and intervention groups with a lag in the treatment effect and with non-compliance in two directions.
+</div><!--end of content div-->
+
+</div><!--end of twocolwrap-->
+
+<div id="rightcol">
+<form method="get" name="spower" action="#">
+<div class="clearfix"><label>1-year Survival Rate:</label><input type="text" name="p1" value="<%=p1%>"></input></div>
+<div class="clearfix"><label>3-year Survival Rate:</label><input type="text" name="p2" value="<%=p2%>"></input>
+<div class="clearfix"><label>Treatment Effect Start Month:</label><input type="text" name="mo" value="<%=mo%>"></input>
+<input type="button" onclick="RePlot()" value="Re-plot"></input></div>
+<div class="clearfix">
+<input type="button" onclick="ReSimulate()" value="Power Estimate:"></input>
+<img id="spinner" style="display: none" src="../images/spinner.gif"></div>
+<div id="spowerResult"></div>
+</div>
+</form>
+</div><!--end of rightcol div-->
+
+</div><!--end of threecolwrap div-->
+
+<div id="footer">
+</div> <!--end footer -->
+
+</div><!--end mainwrapper-->
+</body></html>
diff --git a/Hmisc/brew/useR2007plot.rhtml b/Hmisc/brew/useR2007plot.rhtml
@@ -0,0 +1,25 @@
+<!-- results
+<%
+GET <- req$GET()
+p1 <- ifelse(is.null(GET$p1),.95,as.numeric(GET$p1))
+p2 <- ifelse(is.null(GET$p2),.7,as.numeric(GET$p2))
+mo <- ifelse(is.null(GET$mo),9,as.numeric(GET$mo))
+options(hverbose=FALSE,verbose=FALSE)
+plotname <- paste('plot.',sprintf('%.4f.%.4f.%d',p1,p2,mo),'.png',sep='')
+filename <- file.path(imagepath,plotname)
+if (!file.exists(filename)){
+	png(filename=filename,width=600,height=600)
+	sc <- Weibull2(c(1,3),c(p1,p2))
+	rcens <- function(n) 1 + (5-1) * (runif(n) ^ .5)
+	f <- Quantile2(sc,
+		hratio=function(x) ifelse(x <= mo/12, 1, .75),
+		dropin=function(x) ifelse(x <= .5, 0, .15 * (x-.5)/(5-.5)),
+		dropout=function(x) .3*x/5
+	)
+	par(mfrow=c(2,2))
+	plot(f,'all',label.curves=list(keys='lines'))
+	dev.off()
+}
+%>
+-->
+<img src="<%=paste(imageurl,plotname,sep='')%>">
diff --git a/Hmisc/brew/useR2007sim.rhtml b/Hmisc/brew/useR2007sim.rhtml
@@ -0,0 +1,24 @@
+<%
+GET <- req$GET()
+p1 <- ifelse(is.null(GET$p1),.95,as.numeric(GET$p1))
+p2 <- ifelse(is.null(GET$p2),.7,as.numeric(GET$p2))
+mo <- ifelse(is.null(GET$mo),9,as.numeric(GET$mo))
+options(hverbose=FALSE,verbose=FALSE)
+t <- tempfile()
+sink(t)
+library(Hmisc)
+sc <- Weibull2(c(1,3),c(p1,p2))
+f <- Quantile2(sc,
+	hratio=function(x) ifelse(x <= mo/12, 1, .75),
+	dropin=function(x) ifelse(x <= .5, 0, .15 * (x-.5)/(5-.5)),
+	dropout=function(x) .3*x/5
+)
+rcens <- function(n) 1 + (5-1) * (runif(n) ^ .5)
+rcontrol <- function(n) f(n,'control')
+rinterv <- function(n) f(n,'intervention')
+set.seed(211)
+x <- spower(rcontrol,rinterv,rcens, nc=350, ni=350, test=logrank, nsim=300)
+sink()
+unlink(t)
+%>
+<%=format(x,digits=5)%>
diff --git a/Hmisc/config.R b/Hmisc/config.R
@@ -0,0 +1,16 @@
+library(Hmisc)
+dir.create(file.path(tempdir(),'plots'),showWarnings=FALSE)
+app <- Builder$new(
+   Static$new(
+      urls = c('/css','/images','/javascript'),
+      root = '.'
+   ),
+   Static$new(urls='/plots',root=tempdir()),
+   Brewery$new(
+      url='/brew',
+      root='.',
+      imagepath=file.path(tempdir(),'plots'),
+      imageurl='../plots/'
+   ),
+   Redirect$new('/brew/useR2007.rhtml')
+)
diff --git a/Hmisc/css/useR2007.css b/Hmisc/css/useR2007.css
@@ -0,0 +1,105 @@
+body {
+	font: .7em verdana, arial, sans-serif;
+	margin-top: 10px;
+	margin-left:10px; 
+	margin-right:10px;
+	/* border: 1px solid black; */
+}
+/* img { border: 1px; position: absolute; } */
+* {margin:0; padding:0;}
+div#mainwrapper {
+	/* min-width:760px;  */
+	/* max-width:880px;   */
+	margin-left:auto; 
+	margin-right:auto;} /* centers layout when > max width */
+div#header {
+	width:auto;
+}
+#threecolwrap {
+	float:left;
+	width:100%;
+}
+#twocolwrap {
+	float:left;
+	width:100%;
+	display:inline; /* stops IE doubling  margin on float*/
+	margin-right:-170px; /* CWS - neg margin move */
+}
+#leftcol {
+	float:left;
+	width:175px;
+	display:inline; /* stops IE doubling  margin on float*/
+	/* border: 1px solid black; */
+}
+#content {
+	width:600px;
+	margin-left:175px;
+	margin-top: 0px;
+	/* margin-right:170px; */
+	/* border: 1px solid black; */
+}
+#rightcol {
+	position: absolute;
+	width:175px;
+	margin-left: 775px;
+	/* width:170px;  */
+	/* width: auto;*/
+	/* border: 1px solid black; */
+}
+#footer {
+	width:100%;
+	clear:both;
+	float:left;
+	text-align: right;
+	font-size: .6em;
+	/* border: 1px solid black; */
+}
+div#yldiv {
+	float:left;
+	width:250px;
+	display: none;
+}
+select {
+	/* float: right; */
+	width: 100%;
+	font-size: .9em;
+	border: 1px solid grey;
+}
+div#formcontent {
+	/*border: 1px solid black; */
+
+}
+div.clearfix {
+	/* border: 1px solid #CCC; */
+	margin-bottom: 10px;
+}
+label  {
+	float: left;
+	font-size: .9em;
+	font-weight: bold;
+	width:100%
+}
+div#content h1,h2,h3 {
+	text-align: center	
+}
+div#content  p,ul {
+	margin: 2% 20% 2% 20%;
+	font-size: 1.2em;
+}
+div#content li {
+	margin-bottom: 3%;
+}
+div#showpdf {
+	margin-left: 20px;
+}
+div#copyright {
+	color: grey;
+	text-align: center;
+	font-size: .8em;
+	margin: 10% 20% 0px 20%;
+}
+div#bibliography {
+	margin-top: 10px;
+	font: .8em verdana, arial, sans-serif;
+	font-weight: bold;
+}
diff --git a/Hmisc/images/spinner.gif b/Hmisc/images/spinner.gif