Commit of beta version 1.5.1

Author: tmcd

R/draw.strat.grts.r

@@ -3,11 +3,13 @@ draw.strat.grts <- function(n, over.n, strat.var, alloc.type, fn, dir){
 #   draw a GRTS sample using spsurvey.  Spsurvey should already be loaded.
 #
 
-#    cat("Drawing GRTS sample...This can take a while ...\n")
+    cat("Drawing GRTS sample...This can take a while ...\n")
 
 #   Check whether the frame has been read already, and the sp object is laying around. 
     shp <- getSpFrame( fn, dir )
 
+    print(head(data.frame(shp)))
+
     if(!(strat.var %in% names(shp))){
       stop(paste("Variable", strat.var, "not found in frame"))
     }    
@@ -49,6 +51,5 @@ draw.strat.grts <- function(n, over.n, strat.var, alloc.type, fn, dir){
 
 #   Call the user visible routine that takes a SpatialX object
     ans <- grts.strat(n, over.n, strat.var, shp ) 
-
     ans
 }

R/getSpFrame.r

@@ -7,7 +7,11 @@ getSpFrame <- function( filename, dir ){
         #   The shapefile is not laying around.  Read it.
 
         #   Write the command to console and histry file
-        timestamp( paste( filename, "<- readOGR(", dir, ",", filename, ")"), prefix="", suffix=" ## SDraw")
+        # NOTE: THIS USED TO WORK. HOWEVER, WHEN WE UPGRADED TO R 3.1.3 TIMESTAMP STOPPED WORKING AND INFACT 
+        # CRASHED R WHEN RUNNING IN RSTUDIO.  SO, WE HAVE TAKEN ALL THESE OUT.  IF REQUIRED, WE WILL OPEN OUR OWN
+        # LOG FILE AND WRITE THERE. 
+        #print("writing to log")
+        #  timestamp( paste( filename, "<- readOGR(", dir, ",", filename, ")"), prefix="", suffix=" ## SDraw")
 
         shp <- readShape(dir, filename)  # a wrapper for readOGR
 

R/grts.strat.r

@@ -71,6 +71,7 @@ strata.levels<-names(table(data.frame(shp)[,strat.var]))
     attr(Stratsites, "over.n") <- over.n
     attr(Stratsites, "sp.object") <- deparse(substitute(shp))
     attr(Stratsites, "frame.type") <- sframe.type
+    attr(Stratsites, "strata.var") <- "stratum"
 
     Stratsites
 }

R/plotSample.R

@@ -35,18 +35,35 @@ plotSample <- function(button, dat){
     #   If the sample object exists, plot points on the map
     if( exists( outobj )){
         samp <- get( outobj, pos=.GlobalEnv )
-        n <- attr(samp, "n")
         stype <- attr(samp, "sample.type")
 
-        if( nrow(samp) == n ){
-            #   No oversample
-            points( samp, pch=16 )
-            legend("bottomleft", legend=paste(stype, "sample points"), pch=c(16))
+        # Is this a stratified sample -> different legend
+        strat.var <- attr(samp, "strata.var")
+        
+        # Determine if this sample has an oversample
+        has.oversamp <- "pointType" %in% names(data.frame(samp))
+        if( has.oversamp )  has.oversamp <- length(unique(data.frame(samp)[,"pointType"])) > 1
+        
+        if( !is.null( strat.var )){
+          # We have stratified sample
+          strat.ind <- data.frame(samp)[,strat.var]
+          strat.vals <- levels(factor(strat.ind))
+          strat.cols <- terrain.colors(length(strat.vals))
+          for(h in strat.vals){
+            points( samp[strat.ind == h,], pch=which(h==strat.vals)+14, col=strat.cols[which(h==strat.vals)] )
+          }
+          legend("bottomleft", legend=strat.vals, pch=1:length(strat.vals)+14, col=strat.cols, title="Strata:")
+          # Note. oversample points in stratified samples, if they exist, are not plotted.
+        } else if( has.oversamp ){
+          #   There is some oversample
+          samp.ind <- data.frame(samp)[,"pointType"]
+          points( samp[samp.ind=="Sample",], pch=16 )
+          points( samp[samp.ind=="OverSample",], pch=1 )
+          legend("bottomleft", legend=paste(stype, c("sample", "over sample")), pch=c(16,1))
         } else {
-            #   There is some oversample
-            points( samp[1:n,], pch=16 )
-            points( samp[ (n+1):nrow(samp),], pch=1 )
-            legend("bottomleft", legend=paste(stype, c("sample", "over sample")), pch=c(16,1))
+          #   No oversample
+          points( samp, pch=16 )
+          legend("bottomleft", legend=paste(stype, "sample points"), pch=c(16))
         }
 
     }

R/run.sample.R

@@ -63,12 +63,14 @@ run.sample <- function(button, dat){
 #   Write out the command to console and history file.  Must do this 
 #   here, rather than in draw.XXX routines, because I want to write out 
 #   the assignment to the output object.
-    cat(">")
-    switch( stype, 
-        "BAS " = timestamp(paste(outobj, "<- bas(", n + over.n, ",", fn, ")"), prefix="", suffix=" ## SDraw"),
-        "GRTS" = timestamp(paste(outobj, "<- grts.equi(", n, ",", over.n, ",", fn, ")"), prefix="", suffix=" ## SDraw"),
-        "SSS " = timestamp(paste(outobj, "<- sss(", n , ",", fn, ")"), prefix="", suffix=" ## SDraw")
-    )
+#   NOTE: TIMESTAMP STOPPED WORKING.  AT SOME POINT, RETURN AND WRITE THESE 
+#   COMMANDS TO A SDRAW.LOG FILE.
+#     cat(">")
+#     switch( stype, 
+#         "BAS " = timestamp(paste(outobj, "<- bas(", n + over.n, ",", fn, ")"), prefix="", suffix=" ## SDraw"),
+#         "GRTS" = timestamp(paste(outobj, "<- grts.equi(", n, ",", over.n, ",", fn, ")"), prefix="", suffix=" ## SDraw"),
+#         "SSS " = timestamp(paste(outobj, "<- sss(", n , ",", fn, ")"), prefix="", suffix=" ## SDraw")
+#     )
 
 
     #   Actually draw the sample
@@ -78,7 +80,6 @@ run.sample <- function(button, dat){
                 "GRTS" = draw.grts(n,over.n,fn,in.dir),
                 "SSS " = draw.sss(n,over.n,fn,in.dir),
                          stop(paste("Unknown sample type:",stype)))
-    print("hello2")
 
     #   Save the sample in global environment.  Type of sample is an attribute. 
     #  SDrawPackageSpace <- as.environment( "package:SDraw" )

R/run.strat.sample.r

@@ -2,6 +2,7 @@ run.strat.sample <- function(button, dat){
 #tester for running stratified sample
 
     #   Query the entry fields
+ 
     n <- dat$n.entry$getText()
     fn <- dat$shape.in.entry$getText()
     dir <- dat$shape.in.dir$getText()
@@ -70,13 +71,15 @@ run.strat.sample <- function(button, dat){
 
     #   Actually draw the sample
     #   Remember that fn is the text string name of the shapefile, without .shp, and without path.
+
     samp <- switch( stype, 
                 #"BAS " = draw.bas(n,over.n,fn),
                 "GRTS" = draw.strat.grts(n,over.n,strat.var,alloc.type,fn,dir), 
                 #"SSS " = draw.sss(n,over.n,fn),
                          stop(paste("Unknown sample type:",stype)))
 
     #   Save the sample in global environment.  Type of sample is an attribute.                         
+    print("back from draw.strat.grts in run.strat.sample")
     assign( outobj, samp, pos=.GlobalEnv )
 
     #   Tell user we are finished.

man/stratified.GUI.Rd

@@ -85,6 +85,7 @@ Following is a description of the functioning of all buttons at the bottom of th
     .GlobalEnv workspace. 
     
 }    
+}
 
 After the sample draw, one can check allocation sample sizes in each strata using the \code{table} function.  For example, if the output R name is 'samp', one can check sample sizes with \code{table(samp$strata)}.   One can plot the study area and sample points with \code{plot(frame); points(samp)}, assuming \code{frame} is the 'sp' object containing the frame