1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137
|
pdsi <- function(awc, lat, climate, start, end, mode = "both", verbose = TRUE) {
the_system <- Sys.info()["sysname"]
tdir <- paste(getwd(), "/", digest(Sys.time()), sep = "") dir.create(tdir)
climate_start <- which(climate[,1] == start-1)[1] climate_end <- which(climate[,1] == end)[12] climate <- climate[climate_start:climate_end,] climate_reform <- pmat(climate, start = 1, end = 12) pmat_temp <- climate_reform[,1:12] pmat_prec <- climate_reform[,13:24] temp_path <- file.path(tdir, "monthly_T") prec_path <- file.path(tdir, "monthly_P") write.table(pmat_temp, temp_path, col.names = F, quote = F) write.table(pmat_prec, prec_path, col.names = F, quote = F) normal_temp <- round(t(as.vector(colMeans(pmat_temp))), 3) normal_prec <- round(t(as.vector(colMeans(pmat_prec))), 3) normal_temp_path <- file.path(tdir, "mon_T_normal") normal_prec_path <- file.path(tdir, "mon_P_normal") write.table(normal_temp, normal_temp_path, col.names = F, quote = F, row.names = F) write.table(normal_prec, normal_prec_path, col.names = F, quote = F, row.names = F) params <- t(c(awc, lat)) param_path <- file.path(tdir, "parameter") write.table(params, param_path, col.names = F, quote = F, row.names = F)
if (the_system == "Windows") { exec_path <- file.path(system.file(package = "pdsi"), "exec", "sc-pdsi.exe") } else { if (the_system == "Linux") { exec_path <- file.path(system.file(package = "pdsi"), "scpdsi.o") if (!file.exists(exec_path)) stop("You need to build the binary first. On a Linux machine with recent g++ installed, call function `pdsi::build_linux_binary()`.") } else { if (the_system == "Darwin") { exec_path <- file.path(system.file(package = "pdsi"), "exec", "pdsi") } else { stop("Unsupported OS.") } } }
oldwd <- getwd() setwd(tdir)
cmd <- paste(exec_path, " -m -i", shQuote(tdir), start, end) system(cmd, ignore.stdout = !verbose, ignore.stderr = !verbose)
setwd(oldwd)
scpdsi_path <- file.path(tdir, "monthly", "self_cal", "PDSI.tbl") pdsi_path <- file.path(tdir, "monthly", "original", "PDSI.tbl")
if (any(c("scpdsi", "both") == mode)) { scPDSI <- read.fwf(scpdsi_path, c(5, rep(7, 12))) colnames(scPDSI) <- c("YEAR", toupper(month.abb)) } if (any(c("pdsi", "both") == mode)) { PDSI <- read.fwf(pdsi_path, c(5, rep(7, 12))) colnames(PDSI) <- c("YEAR", toupper(month.abb)) }
unlink(tdir, recursive = TRUE)
if (mode == "both") { list(PDSI, scPDSI) } else { if (mode == "pdsi") { PDSI } else { if (mode == "scpdsi") { scPDSI } else { stop("`mode` has to be one of 'pdsi', 'scpdsi', or 'both'.") } } } }
|