Major changes, crs added

DESCRIPTION

@@ -1,17 +1,20 @@
 Package: RSurvey
-Title: Analysis of Spatially Distributed Data
+Title: Exploratory Analysis of Spatial Data
 Version: 0.8.3.9000
 Authors@R: person("Jason", "Fisher", email="jfisher@usgs.gov", role=c("aut", "cre"))
-Description: A processing program for spatially distributed data.
-  It features graphing, data management, and query building tools.
+Description: A program for processing and exploring spatially distributed data.
+  It features graphing, data management, interpolation, and query building tools.
   A graphical user interface is provided.
 Depends:
     R (>= 3.1.0)
 Imports:
+    fields,
     graphics,
     grDevices,
-    MBA,
+    inlmisc,
     methods,
+    raster,
+    rgdal,
     rgeos,
     sp,
     stats,
@@ -20,7 +23,6 @@ Imports:
 Suggests:
     colorspace,
     dichromat,
-    rgdal,
     rgl,
     tripack,
     XML

NAMESPACE

@@ -1,12 +1,10 @@
 
-export(AddAxis)
 export(Autocrop)
 export(AutocropRegion)
 export(BuildHistogram)
 export(CheckEntry)
 export(ChooseColor)
 export(ChoosePch)
-export(CutoutPolygon)
 export(Data)
 export(EditData)
 export(EditFunction)
@@ -23,16 +21,14 @@ export(ImportText)
 export(LoadPackages)
 export(ManageVariables)
 export(ManagePolygons)
-export(Plot2d)
 export(Plot3d)
-export(POSIXct2Character)
-export(ProcessData)
 export(ProgressBar)
 export(Rename)
 export(RestoreSession)
 export(Search)
 export(SetAxesLimits)
 export(SetConfiguration)
+export(SetCrs)
 export(SetInterpolation)
 export(SetPolygonLimits)
 export(SetProgressBar)
@@ -41,6 +37,7 @@ export(StartGui)
 
 import(tcltk)
 import(sp)
+import(rgdal)
 
 importFrom(grDevices,chull)
 importFrom(grDevices,col2rgb)
@@ -83,6 +80,9 @@ importFrom(graphics,rug)
 importFrom(graphics,title)
 
 importFrom(methods,as)
+importFrom(methods,slot)
+
+importFrom(raster,raster)
 
 importFrom(stats,density)
 importFrom(stats,na.omit)

R/AutocropRegion.R

@@ -41,7 +41,7 @@ AutocropRegion <- function(d, parent=NULL, ...) {
 
   # draw base plot and points
   DrawBasePlot <- function() {
-    do.call(Plot2d, append(list(x=d, type="p"), list(...)))
+### do.call(Plot2d, append(list(x=d, type="p"), list(...)))
     dev <<- dev.cur()
   }
 
@@ -129,7 +129,7 @@ AutocropRegion <- function(d, parent=NULL, ...) {
 
   tcl("grid", "anchor", f1, "center")
 
-  tkpack(f1, fill="both")
+  tkpack(f1, padx=50, fill="both")
 
   # bind events
   tclServiceMode(TRUE)

R/BuildHistogram.R

@@ -55,6 +55,7 @@ BuildHistogram <- function(d, var.names=NULL, var.default=1L, parent=NULL) {
     }
   }
 
+
   # adjust scale for number of cells
   AdjustScaleSingle <- function(x) {
     idx <- as.integer(tcl(f1.box.1.2, "current")) + 1L
@@ -65,17 +66,20 @@ BuildHistogram <- function(d, var.names=NULL, var.default=1L, parent=NULL) {
     }
   }
 
+
   # adjust scale for bandwidth in density estimate
   AdjustScaleBandwidth <- function(x) {
     tclvalue(bandwidth.var) <- round(as.numeric(x), digits=1)
     PlotHist()
   }
 
+
   # draw histogram
   PlotHist <- function() {
     if (dev.cur() > dev) CalcHist()
   }
 
+
   # toggle state on break options
   ToggleStateBreaks <- function() {
     tclServiceMode(FALSE)
@@ -101,6 +105,7 @@ BuildHistogram <- function(d, var.names=NULL, var.default=1L, parent=NULL) {
     PlotHist()
   }
 
+
   # toggle state on bandwidth
   ToggleStateBandwidth <- function() {
     tclServiceMode(FALSE)
@@ -213,7 +218,7 @@ BuildHistogram <- function(d, var.names=NULL, var.default=1L, parent=NULL) {
   f1.box.1.2 <- ttkcombobox(f1, state="readonly")
   tkgrid(f1.lab.1.1, f1.box.1.2, pady=c(10, 0))
 
-  tkgrid.configure(f1.lab.1.1, sticky="e", padx=c(10, 2))
+  tkgrid.configure(f1.lab.1.1, sticky="e",  padx=c(10, 2))
   tkgrid.configure(f1.box.1.2, sticky="we", padx=c(0, 10))
 
   val <- if (length(var.names) == 1) paste0("{", var.names, "}") else var.names

R/ChooseColor.R

@@ -257,8 +257,7 @@ ChooseColor <- function(col, parent=NULL) {
   m <- 12
   dx <- dy <- 20
   d1 <- cbind(colorspace::rainbow_hcl(m), colorspace::heat_hcl(m),
-              colorspace::terrain_hcl(m),
-              rev(gray.colors(m, start=0.1, end=0.9, gamma=1.0)))
+              colorspace::terrain_hcl(m), rev(gray.colors(m, start=0.1, end=0.9, gamma=1.0)))
   d2 <- c("#000000", "#000033", "#000066", "#000099", "#0000CC", "#0000FF",
           "#990000", "#990033", "#990066", "#990099", "#9900CC", "#9900FF",
           "#003300", "#003333", "#003366", "#003399", "#0033CC", "#0033FF",

R/Data.R

@@ -20,7 +20,8 @@ Data <- local({
                   "rm.pnt.line"   = 0,
                   "grid.res"      = list(x=NA, y=NA),
                   "grid.mba"      = list(n=NA, m=NA, h=11),
-                  "color.palette" = grDevices::terrain.colors
+                  "color.palette" = grDevices::terrain.colors,
+                  "crs"           = sp::CRS(as.character(NA))
               )
 
   function(option, value, which.attr=NULL, clear.proj=FALSE, clear.data=FALSE, replace.all=NULL) {
@@ -33,7 +34,7 @@ Data <- local({
 
     # save parameters
     if (clear.proj | clear.data) {
-      save.params <- c("default.dir", "win.loc", "csi", "width", "cex.pts")
+      save.params <- c("default.dir", "win.loc", "width", "cex.pts")
       if (clear.data)
         save.params <- c(save.params, "nlevels", "asp.yx", "asp.zx", "rkey",
                          "show.poly", "img.contour", "show.lines", "show.points",

R/EditData.R

@@ -60,7 +60,7 @@ EditData <- function(d, col.names=names(d), row.names=NULL, col.formats=NULL,
       fmt <- ifelse(is.fmt || is.time, col.formats[column], "")
       if (is.time) {
         if ("POSIXt" %in% col.class)
-          fmt.vals[idxs] <- POSIXct2Character(vals, fmt=fmt)
+          fmt.vals[idxs] <- inlmisc::POSIXct2Character(vals, fmt=fmt)
         else
           fmt.vals[idxs] <- format(vals, format=fmt)
       } else {
@@ -873,7 +873,7 @@ EditData <- function(d, col.names=names(d), row.names=NULL, col.formats=NULL,
   # finish top menu
   tkconfigure(tt, menu=top.menu)
 
-  # frame 0
+  # frame 0, selected cell value bar
   f0 <- ttkframe(tt, relief="flat")
   f0.ent.1.1 <- ttkentry(f0, width=10, font="TkFixedFont",
                          state=if (read.only) "readonly" else "normal",
@@ -883,7 +883,7 @@ EditData <- function(d, col.names=names(d), row.names=NULL, col.formats=NULL,
   tkgrid.columnconfigure(f0, 0, weight=1)
   tkpack(f0, fill="x", side="top")
 
-  # frame 1
+  # frame 1, close, save, cancel buttons
   f1 <- ttkframe(tt, relief="flat")
 
   if (read.only) {
@@ -914,7 +914,7 @@ EditData <- function(d, col.names=names(d), row.names=NULL, col.formats=NULL,
 
   tkpack(f1, fill="x", side="bottom", anchor="e")
 
-  # frame 2
+  # frame 2, search
   f2 <- ttkframe(tt, relief="flat", padding=0, borderwidth=0, height=200)
 
   f2.lab.1.1 <- ttklabel(f2, text="Record")
@@ -939,7 +939,7 @@ EditData <- function(d, col.names=names(d), row.names=NULL, col.formats=NULL,
 
   tkpack(f2, side="bottom", anchor="nw", padx=c(10, 0))
 
-  # frame 3
+  # frame 3, spreadsheet
   f3 <- ttkframe(tt, relief="flat", padding=0, borderwidth=0)
 
   f3.tbl <- tkwidget(f3, "table", rows=m + 1, cols=n + 1,
@@ -1000,8 +1000,7 @@ EditData <- function(d, col.names=names(d), row.names=NULL, col.formats=NULL,
 
   tkbind(tt, "<Destroy>", function() tclvalue(tt.done.var) <- 1)
 
-  tkbind(f0.ent.1.1, "<Return>",
-         paste(.Tcl.callback(BypassReturnCmd), "break", sep="; "))
+  tkbind(f0.ent.1.1, "<Return>", paste(.Tcl.callback(BypassReturnCmd), "break", sep="; "))
   tkbind(f0.ent.1.1, "<FocusIn>", function() tksee(f3.tbl, "active"))
 
   tkbind(tt, "<Control-f>", function() CallSearch(is.replace=FALSE))

R/ExportData.R

@@ -14,7 +14,7 @@ ExportData <- function(file.type="txt", parent=NULL) {
     # organize data
     vars <- Data("vars")
     cols <- Data("cols")
-    rows <- Data("data.raw", which.attr="row.names")
+    rows <- Data("rows")
 
     all.col.ids <- vapply(seq_along(cols), function(i) cols[[i]]$id, "")
     if (file.type == "shp") {
@@ -176,15 +176,15 @@ ExportData <- function(file.type="txt", parent=NULL) {
 
     # write shapefile
     } else if (file.type == "shp") {
-      # names are finicky for shapefiles, rules are convoluted,
-      # that is, 8-bit names and no periods
+      # names are finicky for shapefiles, rules are convoluted, that is, 8-bit names and no periods
       col.ids.8bit <- gsub("\\.", "", make.names(substr(col.ids, 1, 7), unique=TRUE))
       colnames(d) <- col.ids.8bit
       idx.x <- which(col.ids %in% id.x)
       idx.y <- which(col.ids %in% id.y)
       is.coord.na <- is.na(d[, idx.x]) | is.na(d[, idx.y])
       d <- d[!is.coord.na, ]  # remove coordinates containing missing values
       coordinates(d) <- col.ids.8bit[c(idx.x, idx.y)]
+      proj4string(d) <- Data("crs")
       dsn <- dirname(file.name)
       layer <- basename(file.name)
       ext <- tolower(tail(unlist(strsplit(layer, "\\."))[-1], 1))
@@ -535,7 +535,7 @@ ExportData <- function(file.type="txt", parent=NULL) {
   f4.box.2.2 <- ttkcombobox(f4, width=17, state="readonly", value=enc1)
   f4.box.3.2 <- ttkcombobox(f4, width=17, state="readonly", value=eol1)
   f4.box.4.2 <- ttkcombobox(f4, width=17, state="readonly", value=zip1)
-  txt <- "Export change log ( *.log )"
+  txt <- "Export changelog ( *.log )"
   f4.chk.2.3 <- ttkcheckbutton(f4, variable=changelog.var, text=txt)
 
   tkgrid(f4.ent.1.1, "x", "x", "x", f4.but.1.5)