R/print.R

In r-tmap/tmap: Thematic Maps

#' Draw thematic map
#' 
#' @param x tmap object. 
#' @param return.asp should the aspect ratio be returned?
#' @param show show the map
#' @param vp viewport (for `"plot"` mode)
#' @param knit A logical, should knit?
#' @param options A vector of options
#' @param ... not used
#' @export
print.tmap = function(x, return.asp = FALSE, show = TRUE, vp = NULL, knit = FALSE, options = NULL, ...) {
	args = list(...)
	dev = getOption("tmap.devel.mode")
	if (dev) timing_init()
	x2 = step1_rearrange(x)
	if (dev) timing_add("step 1")
	x3 = step2_data(x2)
	if (dev) timing_add("step 2")
	x4 = step3_trans(x3)
	if (dev) timing_add("step 3")
	res = step4_plot(x4, vp = vp, return.asp = return.asp, show = show, knit = knit, args)
	if (dev) timing_add("step 4")
	if (dev) timing_eval()
	
	v3_reset_flag()
	
	#if (return.asp) return(asp) else invisible(NULL)
	if (knit && tmap_graphics_name() == "Leaflet") {
		kp = get("knit_print", asNamespace("knitr"))
		return(do.call(kp, c(list(x=res), args, list(options=options))))
	} else {
		invisible(res)
	}
}

#' @rdname print.tmap
#' @rawNamespace
#' if(getRversion() >= "3.6.0") {
#'   S3method(knitr::knit_print, tmap)
#' } else {
#'   export(knit_print.tmap)
#' }
knit_print.tmap <- function(x, ..., options=NULL) {
	print.tmap(x, knit=TRUE, options=options, ...)
}


timing_init = function() {
	ts = data.table(s1 = "---------", s2 = "---------", s3 = "---------", s4 = "---------", t = Sys.time())
	assign("timings", ts, envir = .TMAP)
}

timing_add  = function(s1 = "", s2 = "", s3 = "", s4 = "") {
	tsx = data.table(s1 = s1, s2 = s2, s3 = s3, s4 = s4, t = Sys.time())
	ts = data.table::rbindlist(list(get("timings", envir = .TMAP), tsx))
	assign("timings", ts, envir = .TMAP)
}

timing_eval = function() {
	ts = get("timings", envir = .TMAP)
	
	ts[, total := round(as.numeric(difftime(ts$t, ts$t[1], units = "secs")), 3)]
	
	i1 = ts$s1 != ""
	i2 = ts$s2 != "" | i1
	i3 = ts$s3 != "" | i2
	i4 = ts$s4 != "" | i3
	
	ts[, ':='(t1=0,t2=0,t3=0,t4=0)]
	ts[i1, t1:= c(0, ts$total[i1][-1] - head(ts$total[i1], -1))]
	ts[i2, t2:= c(0, ts$total[i2][-1] - head(ts$total[i2], -1))]
	ts[i3, t3:= c(0, ts$total[i3][-1] - head(ts$total[i3], -1))]
	ts[i4, t4:= c(0, ts$total[i4][-1] - head(ts$total[i4], -1))]
	
	ts[s2 == "", t2 := 0]
	ts[s3 == "", t3 := 0]
	ts[s4 == "", t4 := 0]
	
	form = function(l, x) {
		zero = (x==0)
		y = sprintf("%.3f", x)
		z = paste0(l, " (", y, ")")
		z[zero] = ""
		z
	}
	
	ts[, ':='(s1=form(s1, t1),
			  s2=form(s2, t2),
			  s3=form(s3, t3),
			  s4=form(s4, t4))]
	
	print(ts[, c("s1", "s2", "s3", "s4", "total")])
}