From c73795e7ce30c88b68339d9d978b34bf4a0cb2bc Mon Sep 17 00:00:00 2001
From: ranke <ranke@d1b72e20-2ee0-0310-a1c4-ad5adbbefcdc>
Date: Mon, 6 Mar 2006 09:59:51 +0000
Subject: Added the drfit-package help page, a new sample data file and a
 preliminary version of the drfit-Rnews article.

R/drfit.R
- the possibility to directly write pdf graphs was added
- the results dataframe now has numbered lines where it didn't

The checkplate and checksubstance functions are now classified
internal in their help files.



git-svn-id: http://kriemhild.uft.uni-bremen.de/svn/drfit@57 d1b72e20-2ee0-0310-a1c4-ad5adbbefcdc
---
 R/drfit.R | 31 +++++++++++++++++++++++--------
 1 file changed, 23 insertions(+), 8 deletions(-)

(limited to 'R')

diff --git a/R/drfit.R b/R/drfit.R
index 1488cd4..3a9535a 100644
--- a/R/drfit.R
+++ b/R/drfit.R
@@ -48,8 +48,8 @@ drfit <- function(data, startlogED50 = NA, chooseone=TRUE,
         linlogit = FALSE, linlogitWrong = NA, allWrong = NA,
         s0 = 0.5, b0 = 2, f0 = 0)
 {
-    if(!is.null(data$ok)) data <- subset(data,ok!="no fit") # Don't use data where ok 
-                                                            # was set to "no fit"
+    if(!is.null(data$ok)) data <- subset(data,ok!="no fit") # Don't use data with 
+                                                            # ok set to "no fit"
     substances <- levels(data$substance)
 
     ri <- rix <- 0                        # ri is the index over the result rows
@@ -57,7 +57,8 @@ drfit <- function(data, startlogED50 = NA, chooseone=TRUE,
                                           # model result was appended
     rsubstance <- array()                 # the substance names in the results
     rndl <- vector()                      # number of dose levels
-    rn <- vector()                        # mean number of replicates in each dose level
+    rn <- vector()                        # mean number of replicates 
+                                          # in each dose level
     runit <- vector()                     # vector of units for each result row
     rlhd <- rlld <- vector()              # highest and lowest doses tested
     mtype <- array()                      # the modeltypes
@@ -292,13 +293,15 @@ drfit <- function(data, startlogED50 = NA, chooseone=TRUE,
     if (linlogit) {
         results$c <- c
     }
+    rownames(results) <- 1:ri
     return(results)
 }
 
 drplot <- function(drresults, data, 
         dtype = "std", alpha = 0.95, ctype = "none",
         path = "./", fileprefix = "drplot", overlay = FALSE,
-        postscript = FALSE, png = FALSE, bw = TRUE,
+        postscript = FALSE, png = FALSE, pdf = FALSE, 
+        bw = TRUE,
         pointsize = 12,
         colors = 1:8, devoff=T, lpos="topright")
 {
@@ -353,13 +356,19 @@ drplot <- function(drresults, data,
                     paper="special",width=7,height=7,horizontal=FALSE, pointsize=pointsize)
             cat("Created File: ",filename,"\n")
         } 
+        if (pdf) {
+            filename = paste(path,fileprefix,".pdf",sep="")
+            pdf(file=filename,
+                    paper="special",width=7,height=7,horizontal=FALSE, pointsize=pointsize)
+            cat("Created File: ",filename,"\n")
+        } 
         if (png) {
             filename = paste(path,fileprefix,".png",sep="")
             png(filename=filename,
                 width=500, height=500, pointsize=pointsize)
             cat("Created File: ",filename,"\n")
         }
-        if (!postscript && !png) {
+        if (!postscript && !png && !pdf) {
             get(getOption("device"))(width=7,height=7)
         }
             
@@ -391,13 +400,19 @@ drplot <- function(drresults, data,
                                 paper="special",width=7,height=7,horizontal=FALSE,pointsize=pointsize)
                         cat("Created File: ",filename,"\n")
                     } 
+                    if (pdf) {
+                        filename = paste(path,fileprefix,sub(" ","_",i),".pdf",sep="")
+                        pdf(file=filename,
+                                paper="special",width=7,height=7,horizontal=FALSE,pointsize=pointsize)
+                        cat("Created File: ",filename,"\n")
+                    } 
                     if (png) {
                         filename = paste(path,fileprefix,sub(" ","_",i),".png",sep="")
                         png(filename=filename,
                             width=500, height=500, pointsize=pointsize)
                         cat("Created File: ",filename,"\n")
                     }
-                    if (!postscript && !png) {
+                    if (!postscript && !png && !pdf) {
                          get(getOption("device"))(width=7,height=7)
                     }
                         
@@ -484,14 +499,14 @@ drplot <- function(drresults, data,
                         }
                     }
                 }
-                if (!overlay && (postscript || png)) dev.off()
+                if (!overlay && (postscript || png || pdf)) dev.off()
             } else {
                 cat("No data for ",i,"\n")
             }
         }
     }
     if (overlay) legend(lpos, dsubstances,lty = 1, col = colors, inset=0.05)
-    if (overlay && (postscript || png)) {
+    if (overlay && (postscript || png || pdf)) {
         if (devoff) {
             dev.off()
         }
-- 
cgit v1.2.1