version 0.0.4

cran · Apr 25, 2017 · 7dd7f41 · 7dd7f41
1 parent f379bd3
commit 7dd7f41
Show file tree

Hide file tree

Showing 5 changed files with 67 additions and 57 deletions.
diff --git a/ChangeLog b/ChangeLog
@@ -1,5 +1,8 @@
 RchivalTag versions
 
+RchivalTag_0.0.4 -- April 25, 2017 (Robert Bauer)
+	- improving performance (speed) of plot_TS/plot_DepthTS
+
 RchivalTag_0.0.3 -- April 10, 2017 (Robert Bauer)
 	- small bugs fixed in plot_TS/plot_DepthTS and read_PDT
 

diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: RchivalTag
 Type: Package
 Title: Analyzing Archival Tagging Data
-Version: 0.0.3
+Version: 0.0.4
 Date: 2017-04-10
 Author: Robert Bauer
 Maintainer: Robert Bauer <robert.bauer@ird.fr>
@@ -11,7 +11,7 @@ Imports: plyr, akima, maptools, graphics, stats, raster, rgeos, ncdf4,
         maps, mapdata, grDevices, oceanmap, sp, methods, PBSmapping
 License: CC BY-NC-SA 4.0
 LazyLoad: yes
-Packaged: 2017-04-10 12:11:51 UTC; robert
+Packaged: 2017-04-25 09:41:56 UTC; robert
 Repository: CRAN
-Date/Publication: 2017-04-10 12:34:56 UTC
+Date/Publication: 2017-04-25 10:35:42 UTC
 NeedsCompilation: no
diff --git a/MD5 b/MD5
@@ -1,5 +1,5 @@
-49681d4aade07d5cc95d4cd17142f29c *ChangeLog
-9a40b99bcddbf35b4fa3761c6f6889a5 *DESCRIPTION
+0babae57dff471411c39bf4ef16e19f1 *ChangeLog
+7ec12fc84171dee6dd874aaa612913a3 *DESCRIPTION
 8b43c3895e01857f02fedd5ed61ff8a3 *NAMESPACE
 3e611abed9a9cac153c07f2681682a8e *R/bin_TempTS.r
 4496a3299a5b651e488ff184fb363094 *R/get_DaytTimeLimits.r
@@ -8,14 +8,14 @@ d0238a97d31e3bc0bb39758ffea3a359 *R/hidden_functions.r
 ac03eff18ad7382bce1a16ef3e447dfa *R/hist_tad.r
 983d14437b0aabbcaba53a1669868b7d *R/image_TempDepthProfiles.r
 2488fc005f517758e20112941f5bbcaa *R/interpolate_TempDepthProfiles.r
-13dc68d37dbaf040b8b5e2052ef3a9f1 *R/plot_TS.r
+e28c2a2a8bd12c5abacc6c51f9eee033 *R/plot_TS.r
 2f9e8ba0d608fcfe6c2659144482860d *R/plot_errorbars.r
 a64d0ede8100a59f1bd71108932d4c30 *R/plot_geopos.r
 3cb18a2b337441ed7d8450742ac72ac8 *R/read_PDT.r
 ee79db69ed156d837cfb299d11475653 *R/read_histos.r
 57d180cfc03aa9be75938c0f018ef197 *R/tad_summary.r
 976cabc1b75f6dbea28566ad6cfa031c *R/ts2histos.r
-ae2af4432d80cd857366253f4aa749ad *inst/doc/RchivalTag.pdf
+20e45627fcb5b7d72fd79426abb28f29 *inst/doc/RchivalTag.pdf
 5ed8535044dcec09af091dca0617ac41 *inst/example_files/104659-Histos.csv
 14919538772cfbcc8dde94b889ede6f9 *inst/example_files/104659-PDTs.csv
 ec53f903951050e6c4f96a0b7be076b8 *inst/example_files/104659-Series.csv

diff --git a/R/plot_TS.r b/R/plot_TS.r
@@ -56,8 +56,32 @@ plot_DepthTS <- plot_TS <- function(df, y="Depth", xlim, ylim, xticks_interval,
 
   if(!("date.long" %in% names(df))) stop('no "date.long" vector provided! please revise.')
 
+  if(!missing(xlim)){
+    if(class(xlim)[1] == 'Date' | nchar(as.character(xlim[1])) == 10){
+      xlim <- as.POSIXct(paste(xlim, '00:00:00'), tz="UTC")
+      if(length(xlim) == 1) xlim <- c(xlim, xlim)
+      xlim[2] <- xlim[2]+24*60*60
+    }
+    xlim <- .fact2Date.long(xlim,tz = "UTC")
+    if(length(xlim) == 1) xlim <- c(xlim, xlim[1]+24*60*60)
+    if(length(xlim) > 2) xlim <- range(xlim)
+    df <- df[which(df$date.long >= xlim[1] & df$date.long <= xlim[2]),]
+  }else{
+    xlim <- range(df$date.long)
+    xlim <- .fact2Date.long(xlim,tz = "UTC")
+  }
+
+  if(!missing(ylim)){
+  }else{
+    ylim <- range(df[[y]],na.rm=TRUE)
+  }
+  if(y == "Depth" & max(abs(ylim) == max(ylim))) ylim <- rev(range(c(0,max(ylim))))
+
+
   ### fill potential data gaps
+  df <- df[which(!is.na(df[[y]])),]
   tstep <- as.numeric(df$date.long[2])-as.numeric(df$date.long[1])
+  if(tstep == 0) stop("time step between first valid 'y'-records is 0. please revise!")
   add0 <- data.frame(date.long=seq(df$date.long[1],tail(df$date.long, 1), by=tstep))
   df$date.long <- as.character(df$date.long); add0$date.long <- as.character(add0$date.long)
   df <- merge(df, add0, by="date.long",all=T)
@@ -82,28 +106,6 @@ plot_DepthTS <- plot_TS <- function(df, y="Depth", xlim, ylim, xticks_interval,
     df$date <- as.Date(df$date.long)
   }
 
-  if(!missing(xlim)){
-    if(class(xlim)[1] == 'Date' | nchar(as.character(xlim[1])) == 10){
-      xlim <- as.POSIXct(paste(xlim, '00:00:00'), tz="UTC")
-      if(length(xlim) == 1) xlim <- c(xlim, xlim)
-      xlim[2] <- xlim[2]+24*60*60
-    }
-    xlim <- .fact2Date.long(xlim,tz = "UTC")
-    if(length(xlim) == 1) xlim <- c(xlim, xlim[1]+24*60*60)
-    if(length(xlim) > 2) xlim <- range(xlim)
-    df <- df[which(df$date.long >= xlim[1] & df$date.long <= xlim[2]),]
-  }else{
-    xlim <- range(df$date.long)
-    xlim <- .fact2Date.long(xlim,tz = "UTC")
-  }
-
-  if(!missing(ylim)){
-  }else{
-    ylim <- range(df[[y]],na.rm=TRUE)
-  }
-  if(y == "Depth" & max(abs(ylim) == max(ylim))) ylim <- rev(range(c(0,max(ylim))))
-
-
   ### plot TS:
   par(las=las, yaxs=yaxs, xaxs=xaxs,...)  
   plot(df$date.long, df[[y]], axes=FALSE, lwd=0, cex=0, xlab="", ylab="", xlim=xlim, ylim=ylim, ...)
@@ -120,35 +122,40 @@ plot_DepthTS <- plot_TS <- function(df, y="Depth", xlim, ylim, xticks_interval,
 
   #### plot daytime periods:
   if(plot_DayTimePeriods){
-    dawn.set <- paste0('dawn.', twilight.set)
-    dusk.set <- paste0('dusk.', twilight.set)
-    if(!all(c(dawn.set, dusk.set, 'sunrise','sunset') %in% names(df))){
-      warning("not all required day period information found. calling function: 'get_DayTimeLimits'. 
+      dawn.set <- paste0('dawn.', twilight.set)
+      dusk.set <- paste0('dusk.', twilight.set)
+      if(all(c(dawn.set, dusk.set, 'sunrise','sunset') %in% names(df)) | all(c('date.long','Lon','Lat') %in% names(df))){
+      if(!all(c(dawn.set, dusk.set, 'sunrise','sunset') %in% names(df))){
+        warning("not all required day period information found. calling function: 'get_DayTimeLimits'. 
             Consider to run this function before calling 'plot_TS' to increase performance speed.")
-      df <- get_DayTimeLimits(df) # get sunrise, sunset and dusk/dawn information
-    }
-    df$dawn <- df[[dawn.set]]
-    df$dusk <- df[[dusk.set]]
-
-    rect(xlim[1], ylim[1], xlim[2], ylim[2], col="grey", lwd=0)
-    sunrise <- sunset <- dawn <- dusk <- NA
-    for(d in days){
-      k <- df[which(df$date == d), ]
-      if(nrow(k) > 0){
-        dusk <- mean(k$dusk)
-        dawn <- mean(k$dawn)
-        sunrise <- mean(k$sunrise)
-        sunset <- mean(k$sunset)
-      }else{
-        sunrise <- sunrise+24*60*60
-        sunset <- sunset+24*60*60
-        dawn <- dawn+24*60*60
-        dusk <- dusk+24*60*60
-      }      
-      rect(sunrise, ylim[1], sunset, ylim[2], col="white", lwd=0)
-      rect(dawn, ylim[1], sunrise, ylim[2], col="grey90", lwd=0)
-      rect(sunset, ylim[1], dusk, ylim[2], col="grey90", lwd=0)
-      dawn.dusk <- F
+        df <- get_DayTimeLimits(df) # get sunrise, sunset and dusk/dawn information
+      }
+      df$dawn <- df[[dawn.set]]
+      df$dusk <- df[[dusk.set]]
+
+      rect(xlim[1], ylim[1], xlim[2], ylim[2], col="grey", lwd=0)
+      sunrise <- sunset <- dawn <- dusk <- NA
+      for(d in days){
+        k <- df[which(df$date == d), ]
+        if(nrow(k) > 0){
+          dusk <- mean(k$dusk)
+          dawn <- mean(k$dawn)
+          sunrise <- mean(k$sunrise)
+          sunset <- mean(k$sunset)
+        }else{
+          sunrise <- sunrise+24*60*60
+          sunset <- sunset+24*60*60
+          dawn <- dawn+24*60*60
+          dusk <- dusk+24*60*60
+        }      
+        rect(sunrise, ylim[1], sunset, ylim[2], col="white", lwd=0)
+        rect(dawn, ylim[1], sunrise, ylim[2], col="grey90", lwd=0)
+        rect(sunset, ylim[1], dusk, ylim[2], col="grey90", lwd=0)
+        dawn.dusk <- F
+      }
+    }else{
+      warning('no geolocation data (Lon, Lat) or daytime period information provided! setting plot_DayTimePeriods to FALSE')
+      plot_DayTimePeriods <- F
     }
   }
   df$dusk <- df$dawn <- c()

diff --git a/inst/doc/RchivalTag.pdf b/inst/doc/RchivalTag.pdf