Skip to content

Commit 4d7a421

Browse files
kongddkongdd
committed
format scripts
1 parent b12a23e commit 4d7a421

40 files changed

+883
-840
lines changed

‎NAMESPACE‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -156,6 +156,7 @@ export(print2)
156156
export(pro_map)
157157
export(progressively)
158158
export(qload)
159+
export(qread)
159160
export(qsave)
160161
export(qsavem)
161162
export(quantile_envelope)
@@ -317,6 +318,7 @@ importFrom(purrr,map)
317318
importFrom(purrr,map_depth)
318319
importFrom(purrr,transpose)
319320
importFrom(qs,qload)
321+
importFrom(qs,qread)
320322
importFrom(qs,qsave)
321323
importFrom(qs,qsavem)
322324
importFrom(remotes,install_git)

‎R/Ipaper-package.R‎

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,7 @@
33
#' @aliases Ipaper-package
44
#' @docType package
55
#' @keywords paper
6-
#'
6+
#'
77
#' @importFrom jsonlite fromJSON read_json
88
#' @importFrom purrr map transpose
99
#' @importFrom methods as
@@ -18,9 +18,9 @@
1818
#' @importFrom stats acf as.formula lm median na.omit pnorm qnorm density
1919
#' @importFrom utils write.table modifyList str
2020
#' @importFrom plyr llply ddply aaply
21-
#'
21+
#'
2222
#' @import magrittr
23-
#'
23+
#'
2424
#' @keywords internal
2525
"_PACKAGE"
2626

@@ -31,8 +31,8 @@
3131
NULL
3232

3333
.onLoad <- function(libname, pkgname) {
34-
options("datatable.print.class" = TRUE)
35-
invisible()
34+
options("datatable.print.class" = TRUE)
35+
invisible()
3636
}
3737

3838

‎R/add_dn.R‎

Lines changed: 19 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -1,28 +1,29 @@
11
#' Add n-day flag
2-
#'
3-
#' To aggregated data into n-day (e.g. 8-day, 16-day) like MODIS product, a
2+
#'
3+
#' To aggregated data into n-day (e.g. 8-day, 16-day) like MODIS product, a
44
#' n-day flag is need.
5-
#'
5+
#'
66
#' @param d data.frame or data.table
77
#' @param days Integer number or vector, can't have duplicated value.
8-
#'
8+
#'
99
#' @examples
10-
#' date = seq.Date(as.Date("2010-01-01"), as.Date("2010-12-31"), by = "day")
10+
#' date <- seq.Date(as.Date("2010-01-01"), as.Date("2010-12-31"), by = "day")
1111
#' d <- data.frame(date)
1212
#' dnew <- add_dn(d, days = c(8, 16))
1313
#' @importFrom lubridate ymd year yday
1414
#' @export
15-
add_dn <- function(d, days = 8){
16-
if (class(d$date) != 'Date')
17-
d$date %<>% ymd()
18-
19-
d %<>% dplyr::mutate(d, year = year(date), doy = yday(date))
20-
21-
days <- floor(days)
22-
for (i in seq_along(days)){
23-
day <- days[i]
24-
# d$d8 = ceiling(d$doy/8)
25-
eval(parse(text = sprintf("d$d%d <- ceiling(d$doy/%d)", day, day)))
26-
}
27-
return(d)
15+
add_dn <- function(d, days = 8) {
16+
if (class(d$date) != "Date") {
17+
d$date %<>% ymd()
18+
}
19+
20+
d %<>% dplyr::mutate(d, year = year(date), doy = yday(date))
21+
22+
days <- floor(days)
23+
for (i in seq_along(days)) {
24+
day <- days[i]
25+
# d$d8 = ceiling(d$doy/8)
26+
eval(parse(text = sprintf("d$d%d <- ceiling(d$doy/%d)", day, day)))
27+
}
28+
return(d)
2829
}

‎R/addin.R‎

Lines changed: 97 additions & 95 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
#' Insert %in%.
22
#'
33
#' Call this function as an addin to insert %in% at the cursor position.
4-
#'
4+
#'
55
#' @keywords internal
66
#' @export
77
addin_insertIn <- function() {
@@ -22,128 +22,130 @@ addin_insertReturn <- function() {
2222
# If content is empty, not write
2323
#' @import clipr
2424
#' @export
25-
write_clip2 <- function(content, ...){
26-
if (!is.null(content) && content != "") {
27-
if (.Platform$OS.type == "windows") {
28-
writeLines(content, "clipboard", sep = "")
29-
# utils::writeClipboard(charToRaw(paste0(content, ' ')))
30-
} else {
31-
write_clip(content, ...)
32-
}
25+
write_clip2 <- function(content, ...) {
26+
if (!is.null(content) && content != "") {
27+
if (.Platform$OS.type == "windows") {
28+
writeLines(content, "clipboard", sep = "")
29+
# utils::writeClipboard(charToRaw(paste0(content, ' ')))
30+
} else {
31+
write_clip(content, ...)
3332
}
33+
}
3434
}
3535

3636
#' Cut lines as sublime
37-
#'
37+
#'
3838
#' @param output Boolean, whether return selection info?
39-
#'
39+
#'
4040
#' @keywords internal
4141
#' @export
4242
#' @importFrom rstudioapi modifyRange getSourceEditorContext getActiveDocumentContext
4343
#' @import clipr
4444
addin_cutLines <- function() {
45-
info <- addin_copyLines(output = TRUE)
46-
modifyRange(info$selection[[1]]$range, "", info$id)
45+
info <- addin_copyLines(output = TRUE)
46+
modifyRange(info$selection[[1]]$range, "", info$id)
4747
}
4848

4949
#' @rdname addin_cutLines
5050
#' @export
51-
addin_copyLines <- function(output = FALSE){
52-
info <- getActiveDocumentContext()
53-
54-
# set ranges
55-
rng <- info$selection[[1]]$range
56-
nline <- rng$end[1] - rng$start[1] + 1
57-
nchar <- rng$end[2] - rng$start[2] + 1
58-
59-
if (nline == 1 & nchar == 1) {
60-
rng$start[2] <- 1
61-
rng$end[1] <- rng$end[1] + 1 # row
62-
rng$end[2] <- 1 # column
63-
# rng$end[2] <- Inf
64-
info$selection[[1]]$range <- rng
65-
info$selection[[1]]$text <- info$contents[rng$start[1]] %>% paste0("\n")
66-
}
51+
addin_copyLines <- function(output = FALSE) {
52+
info <- getActiveDocumentContext()
6753

68-
str <- info$selection[[1]]$text
69-
write_clip2(str, breaks = "") # only suit for windows
70-
if (output) return(info)
54+
# set ranges
55+
rng <- info$selection[[1]]$range
56+
nline <- rng$end[1] - rng$start[1] + 1
57+
nchar <- rng$end[2] - rng$start[2] + 1
58+
59+
if (nline == 1 & nchar == 1) {
60+
rng$start[2] <- 1
61+
rng$end[1] <- rng$end[1] + 1 # row
62+
rng$end[2] <- 1 # column
63+
# rng$end[2] <- Inf
64+
info$selection[[1]]$range <- rng
65+
info$selection[[1]]$text <- info$contents[rng$start[1]] %>% paste0("\n")
66+
}
67+
68+
str <- info$selection[[1]]$text
69+
write_clip2(str, breaks = "") # only suit for windows
70+
if (output) {
71+
return(info)
72+
}
7173
}
7274

7375
#' @export
7476
addin_selectWord <- function() {
75-
info = rstudioapi::getActiveDocumentContext()
76-
rng <- info$selection[[1]]$range
77-
78-
row = rng$start[1]
79-
col = rng$start[2]
80-
nline <- rng$end[1] - rng$start[1] + 1
81-
nchar <- rng$end[2] - rng$start[2] + 1
82-
83-
# str_post = str_extract(row, glue("(?<=.{{col}})\\w+"))
84-
tryCatch({
85-
str = info$contents[row]
86-
pos = str_locate_all(str, "[\\w\\.]+") %>%
87-
.[start <= col & end >= col, ]
88-
89-
rng$start[2] = pos$start
90-
rng$end[2] = pos$end + 1
91-
info$selection[[1]]$range <- rng
92-
info$selection[[1]]$text <- info$contents[rng$start[1]]
93-
94-
rstudioapi::setSelectionRanges(rng, info$id)
95-
}, error = function(e) {
96-
message(sprintf('%s', e$message))
97-
})
77+
info <- rstudioapi::getActiveDocumentContext()
78+
rng <- info$selection[[1]]$range
79+
80+
row <- rng$start[1]
81+
col <- rng$start[2]
82+
nline <- rng$end[1] - rng$start[1] + 1
83+
nchar <- rng$end[2] - rng$start[2] + 1
84+
85+
# str_post = str_extract(row, glue("(?<=.{{col}})\\w+"))
86+
tryCatch({
87+
str <- info$contents[row]
88+
pos <- str_locate_all(str, "[\\w\\.]+") %>%
89+
.[start <= col & end >= col, ]
90+
91+
rng$start[2] <- pos$start
92+
rng$end[2] <- pos$end + 1
93+
info$selection[[1]]$range <- rng
94+
info$selection[[1]]$text <- info$contents[rng$start[1]]
95+
96+
rstudioapi::setSelectionRanges(rng, info$id)
97+
}, error = function(e) {
98+
message(sprintf("%s", e$message))
99+
})
98100
}
99101

100102
#' blind shortcuts to rstudio addin
101103
#' @export
102-
key_blind <- function(){
103-
# addins
104-
# rstudio_bindings.json
105-
file_addin <- "~/.R/rstudio/keybindings/addins.json"
106-
indir <- dirname(file_addin)
107-
108-
if (!dir.exists(indir)) mkdir(indir)
109-
if (!file.exists(file_addin)) writeLines("{}", file_addin)
110-
111-
options_addin <- list(
112-
"Ipaper::addin_copyLines" = "Alt+C",
113-
# "Ipaper::addin_cutLines" = "Ctrl+X",
114-
"Ipaper::addin_insertDo" = "Ctrl+Alt+D",
115-
"Ipaper::addin_selectWord" = "Ctrl+D",
116-
"Ipaper::addin_insertIn" = "Ctrl+Shift+I",
117-
"Ipaper::addin_insertReturn" = "Ctrl+Shift+,",
118-
"Ipaper::smerge" = "Ctrl+Shift+G",
119-
"Ipaper::subl" = "Alt+Shift+L",
120-
"Ipaper::code" = "Alt+Shift+C")
121-
122-
file_rstudio <- "~/.R/rstudio/keybindings/rstudio_bindings.json"
123-
options_rstudio <- list(
124-
"commentUncomment" = "Ctrl+/",
125-
"executeCode" = "Ctrl+R",
126-
"pasteLastYank" = "Ctrl+Shift+Y"
127-
)
128-
129-
options_update(file_addin, options_addin)
130-
options_update(file_rstudio, options_rstudio)
104+
key_blind <- function() {
105+
# addins
106+
# rstudio_bindings.json
107+
file_addin <- "~/.R/rstudio/keybindings/addins.json"
108+
indir <- dirname(file_addin)
109+
110+
if (!dir.exists(indir)) mkdir(indir)
111+
if (!file.exists(file_addin)) writeLines("{}", file_addin)
112+
113+
options_addin <- list(
114+
"Ipaper::addin_copyLines" = "Alt+C",
115+
# "Ipaper::addin_cutLines" = "Ctrl+X",
116+
"Ipaper::addin_insertDo" = "Ctrl+Alt+D",
117+
"Ipaper::addin_selectWord" = "Ctrl+D",
118+
"Ipaper::addin_insertIn" = "Ctrl+Shift+I",
119+
"Ipaper::addin_insertReturn" = "Ctrl+Shift+,",
120+
"Ipaper::smerge" = "Ctrl+Shift+G",
121+
"Ipaper::subl" = "Alt+Shift+L",
122+
"Ipaper::code" = "Alt+Shift+C"
123+
)
124+
125+
file_rstudio <- "~/.R/rstudio/keybindings/rstudio_bindings.json"
126+
options_rstudio <- list(
127+
"commentUncomment" = "Ctrl+/",
128+
"executeCode" = "Ctrl+R",
129+
"pasteLastYank" = "Ctrl+Shift+Y"
130+
)
131+
132+
options_update(file_addin, options_addin)
133+
options_update(file_rstudio, options_rstudio)
131134
}
132135

133136
#' @importFrom foreach %do% %dopar%
134137
#' @importFrom jsonlite write_json read_json
135138
#' @export
136139
options_update <- function(file, options.new) {
137-
138-
if (file.exists(file)) {
139-
options <- read_json(file)
140-
} else {
141-
mkdir(dirname(file))
142-
options <- list()
143-
}
140+
if (file.exists(file)) {
141+
options <- read_json(file)
142+
} else {
143+
mkdir(dirname(file))
144+
options <- list()
145+
}
144146

145-
temp <- foreach (name = names(options.new), value = options.new) %do% {
146-
options[[name]] <- value
147-
}
148-
write_json(options, file, pretty = TRUE)
147+
temp <- foreach(name = names(options.new), value = options.new) %do% {
148+
options[[name]] <- value
149+
}
150+
write_json(options, file, pretty = TRUE)
149151
}

‎R/aggregate.R‎

Lines changed: 10 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
1-
#' @export
1+
#' @export
22
dt_mean <- function(d, by) {
3-
by = substitute(by)
3+
by <- substitute(by)
44
d[, lapply(.SD, mean, na.rm = TRUE), by]
55
}
66

@@ -16,7 +16,7 @@ get_yearly <- function(d, by = NULL) {
1616
rlang::eval_bare(expr)
1717
}
1818

19-
#' @export
19+
#' @export
2020
dt_day2mon <- function(dat, nmiss_day_per_mon = 3, ...) {
2121
# dat %<>% fix_uncontinue()
2222
dat_mon <- dat[, .(
@@ -31,20 +31,21 @@ dt_day2mon <- function(dat, nmiss_day_per_mon = 3, ...) {
3131

3232
#' dt_day2year
3333
#' @param dat A data.table, at least with the columns of `c("site", "date", "value")`
34-
#' @export
35-
dt_day2year <- function(dat,
36-
nmiss_day_per_mon = 3, nmiss_MonPerYear = 0, nmin_year = 55, ...)
34+
#' @export
35+
dt_day2year <- function(
36+
dat,
37+
nmiss_day_per_mon = 3, nmiss_MonPerYear = 0, nmin_year = 55, ...)
3738
{
3839
dat_mon <- dt_day2mon(dat, nmiss_day_per_mon)
3940
dat_year <- dat_mon[n_miss <= nmiss_day_per_mon, .(
4041
value = mean(value, na.rm = TRUE),
4142
n_miss = 12 - .N
4243
), .(site, year(date))]
43-
44-
ans <- dat_year[n_miss <= nmiss_MonPerYear, .(site, year, value)]
44+
45+
ans <- dat_year[n_miss <= nmiss_MonPerYear, .(site, year, value)]
4546
# 最长的数据有62年，至少要有55年的数据
4647
info <- ans[, .N, site]
47-
ans = merge(ans, info[N >= nmin_year, .(site)]) # yeraly data
48+
ans <- merge(ans, info[N >= nmin_year, .(site)]) # yeraly data
4849
list(mon = dat_mon[, .(site, date, value)], year = ans)
4950
}
5051

0 commit comments

Comments
 (0)