-
Notifications
You must be signed in to change notification settings - Fork 6
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
1 parent
66a56b5
commit 4512166
Showing
51 changed files
with
1,267 additions
and
1,109 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -1,5 +1,5 @@ | ||
{ | ||
"path" : "E:/1/R/hyfo/R", | ||
"path" : "E:/1/R/hyfo", | ||
"sortOrder" : [ | ||
{ | ||
"ascending" : true, | ||
|
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -1,3 +1,3 @@ | ||
{ | ||
"activeTab" : 7 | ||
"activeTab" : 4 | ||
} |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,17 @@ | ||
{ | ||
"contents" : "hyfo 1.3.0\n==========\nDate: 2015.11.2\n\n- new generic function biasCorrect, extractPeriod, resample added, \n No need to designate inputtype any more, R will detect automatically.\n- new user manual added.\n\n\n\nhyfo 1.2.9\n==========\nDate: 2015.10.30\n\n- new biasFactor S4 class added, to avoid set the input type every time.\n- operational bias correction has been changed to generic function.\n- news file added.\n\n\n\nhyfo 1.2.8\n==========\nDate: 2015.10.10\n\n- operational bias correction added, in normal function.", | ||
"created" : 1446423165783.000, | ||
"dirty" : false, | ||
"encoding" : "ASCII", | ||
"folds" : "", | ||
"hash" : "4276368824", | ||
"id" : "222F1822", | ||
"lastKnownWriteTime" : 1446426050, | ||
"path" : "E:/1/R/hyfo/NEWS", | ||
"project_path" : "NEWS", | ||
"properties" : { | ||
}, | ||
"relative_order" : 5, | ||
"source_on_save" : false, | ||
"type" : "text" | ||
} |
This file was deleted.
Oops, something went wrong.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,17 @@ | ||
{ | ||
"contents" : "#' plot time series, with marks on missing value.\n#' \n#' @param ... input time series.\n#' @param type A string representing the type of the time series, e.g. 'line' or 'bar'.\n#' @param output A string showing which type of output you want. Default is \"data\", if \"ggplot\", the \n#' data that can be directly plotted by ggplot2 will be returned, which is easier for you to make series\n#' plots afterwards. \n#' @param name If \\code{output = 'ggplot'}, name has to be assigned to your output, in order to differentiate\n#' different outputs in the later multiplot using \\code{plotTS_comb}.\n#' @param plot representing the plot type, there are two types, \"norm\" and \"cum\", \"norm\" gives an normal\n#' plot, and \"cum\" gives a cumulative plot. Default is \"norm\".\n#' @param x label for x axis.\n#' @param y label for y axis.\n#' @param title plot title.\n#' @param list If your input is a list of time series, then use \\code{list = your time sereis list}\n#' @return A plot of the input time series.\n#' @details \n#' If your input has more than one time series, the program will only plot the common period of \n#' different time series.\n#' @examples\n#' plotTS(testdl[[1]])\n#' plotTS(testdl[[1]], x = 'xxx', y = 'yyy', title = 'aaa')\n#' \n#' # If input is a datalist\n#' plotTS(list = testdl)\n#' \n#' # Or if you want to input time series one by one\n#' # If plot = 'cum' then cumulative curve will be plotted.\n#' plotTS(testdl[[1]], testdl[[2]], plot = 'cum')\n#' \n#' # You can also directly plot multicolumn dataframe\n#' dataframe <- list2Dataframe(extractPeriod(testdl, commonPeriod = TRUE))\n#' plotTS(dataframe, plot = 'cum')\n#' \n#' # Sometimes you may want to process the dataframe and compare with the original one\n#' dataframe1 <- dataframe\n#' dataframe1[, 2:4] <- dataframe1[, 2:4] + 3\n#' plotTS(dataframe, dataframe1, plot = 'cum')\n#' # But note, if your input is a multi column dataframe, it's better to plot one using plotTS,\n#' # and compare them using plotTS_comb. If all data are in one plot, there might be too messy.\n#' \n#' \n#' # More examples can be found in the user manual on http:https://yuanchao-xu.github.io/hyfo/\n#' \n#' @references \n#' \\itemize{\n#' \\item H. Wickham. ggplot2: elegant graphics for data analysis. Springer New York, 2009.\n#' }\n#' \n#' @import ggplot2\n#' @importFrom reshape2 melt\n#' @export\nplotTS <- function(..., type = 'line', output = 'data', plot = 'norm', name = NULL, x = NULL, \n y = NULL, title = NULL, list = NULL) {\n ## arrange input TS or TS list.\n if (is.null(list)) {\n list <- list(...)\n if (!class(list[[1]]) == 'data.frame') {\n warning('Your input is probably a list, but you forget to add \"list = \" before it.\n Try again, or check help for more information.')\n }\n# Following part is for plot different time series with different date, but too complicated\n# using ggplot. and normal use doesn't need such process. So save it as backup.\n# listNames <- names(list)\n# # in order to be used later to differentiate lists, there should be a name for each element.\n# # Then assign the name column to each list element.\n# if (is.null(listNames)) listNames <- 1:length(list)\n# \n# giveName <- function(x, y) {\n# colnames(x) <- NULL\n# x$TSname <- rep(listNames[y], nrow(x))\n# return(x)\n# }\n# list1 <- mapply(FUN = giveName, x = list, y = 1:length(list), SIMPLIFY = FALSE)\n# \n# checkBind(list1, 'rbind')\n# \n# TS <- do.call('rbind', list1)\n }\n \n list_common <- extractPeriod(list, commonPeriod = TRUE)\n TS <- list2Dataframe(list_common)\n \n if (!is.null(names(list)) & (ncol(TS) - 1) == length(list)) colnames(TS)[2:(length(list) + 1)] <- names(list)\n \n # Check input, only check the first column and first row.\n if (!grepl('-|/', TS[1, 1])) {\n stop('First column is not date or Wrong Date formate, check the format in ?as.Date{base} \n and use as.Date to convert.')\n }\n \n TS[, 1] <- as.Date(TS[, 1])\n colnames(TS)[1] <- 'Date'\n \n # first column's name may not be Date, so change its name to Date\n \n data_plot <- melt(TS, id.var = 'Date')\n NAIndex <- which(is.na(data_plot$value))\n \n # assign 0 to NA values\n if (plot == 'norm') {\n data_plot$value[NAIndex] <- 0\n lineSize <- 0.7\n } else if (plot == 'cum') {\n TS[is.na(TS)] <- 0\n cum <- cbind(data.frame(Date = TS[, 1]), cumsum(TS[2:ncol(TS)]))\n \n data_plot <- melt(cum, id.var = 'Date')\n lineSize <- 1\n }\n \n \n # Assigning x, y and title\n if (is.null(x)) x <- colnames(TS)[1]\n # y aixs cannot decide if it's a multi column dataframe\n #if (is.null(y)) y <- names[2]\n \n theme_set(theme_bw())\n mainLayer <- with(data_plot, {\n ggplot(data = data_plot) +\n # It's always better to use colname to refer to\n aes(x = Date, y = value, color = variable) +\n theme(plot.title = element_text(size = rel(1.8), face = 'bold'),\n axis.text.x = element_text(size = rel(1.8)),\n axis.text.y = element_text(size = rel(1.8)),\n axis.title.x = element_text(size = rel(1.8)),\n axis.title.y = element_text(size = rel(1.8))) +\n labs(x = x, y = y, title = title)\n })\n \n \n# color <- 'dodgerblue4'\n if (type == 'bar') {\n secondLayer <- with(data_plot, {\n geom_bar(stat = 'identity')\n })\n } else if (type == 'line') {\n secondLayer <- with(data_plot, {\n geom_line(size = lineSize)\n })\n } else {\n stop(\"No such plot type.\")\n }\n \n \n missingVLayer <- with(TS, {\n geom_point(data = data_plot[NAIndex, ], group = 1, size = 3, shape = 4, color = 'black')\n })\n \n plotLayer <- mainLayer + secondLayer + missingVLayer\n \n print(plotLayer) \n \n if (output == 'ggplot') {\n if (is.null(name)) stop('\"name\" argument not found, \n If you choose \"ggplot\" as output, please assign a name.')\n \n data_plot$name <- rep(name, nrow(data_plot)) \n data_plot$nav <- rep(0, nrow(data_plot))\n data_plot$nav[NAIndex] <- 1\n return(data_plot)\n }\n}\n\n\n\n\n#' Combine time seires plot together\n#' @param ... different time series plots generated by \\code{plotTS(, output = 'ggplot')}, refer to details.\n#' @details\n#' ..., representing different ouput file generated by \\code{plotTS(, output = 'ggplot'), name = yourname}, \n#' different names must be assigned when generating different output.\n#' \n#' e.g.\n#' a1, a2, a3 are different files generated by \\code{plotTS(, output = 'ggplot'), name = yourname}, you can\n#' set \\code{plotTS(a1,a2,a3)} or \\code{plotTS(list = list(a1,a2,a3))}\n#' \n#' @param nrow A number showing the number of rows.\n#' @param type A string showing 'line' or 'bar'.\n#' @param list If input is a list containing different ggplot data, use l\\code{list = inputlist}.\n#' @param x A string of x axis name.\n#' @param y A string of y axis name.\n#' @param title A string of the title.\n#' @param output A boolean, if chosen TRUE, the output will be given.\n#' NOTE: yOU HAVE TO PUT A \\code{list = }, before your list.\n#' @return A combined time series plot.\n#' @examples\n#' a1 <- plotTS(testdl[[1]], output = 'ggplot', name = 1)\n#' a2 <- plotTS(testdl[[2]], output = 'ggplot', name = 2)\n#' \n#' plotTS_comb(a1, a2)\n#' plotTS_comb(list = list(a1, a2), y = 'y axis', nrow = 2)\n#' \n#' # More examples can be found in the user manual on http:https://yuanchao-xu.github.io/hyfo/\n#' \n#' @references \n#' \\itemize{\n#' \\item H. Wickham. ggplot2: elegant graphics for data analysis. Springer New York, 2009.\n#' }\n#' @export\n#' @import ggplot2\nplotTS_comb <- function(..., nrow = 1, type = 'line', list = NULL, x = 'Date', y = '', title = '', \n output = FALSE){\n # In ploting the time series, since the data comes from outside of hyfo, \n # It's more complicated, since they don't always have the same\n # column name, if not, there is not possible to do rbind.\n # So we need to first save the name, and rbind, and put back the name.\n \n if (!is.null(list)) {\n checkBind(list, 'rbind')\n data_ggplot <- do.call('rbind', list)\n } else {\n \n bars <- list(...)\n checkBind(bars, 'rbind')\n data_ggplot <- do.call('rbind', bars)\n }\n \n if (!class(data_ggplot) == 'data.frame') {\n warning('Your input is probably a list, but you forget to add \"list = \" before it.\n Try again, or check help for more information.')\n } else if (is.null(data_ggplot$name)) {\n stop('No \"name\" column in the input data, check the arguments in getPreciBar(), if \n output = \"ggplot\" is assigned, more info please check ?getPreciBar.')\n }\n\n \n theme_set(theme_bw())\n mainLayer <- with(data_ggplot, {\n ggplot(data = data_ggplot) +\n # It's always better to use colname to refer to\n aes(x = Date, y = value, color = variable) +\n theme(plot.title = element_text(size = rel(1.8), face = 'bold'),\n axis.text.x = element_text(angle = 90, hjust = 1, size = rel(1.8)),\n axis.text.y = element_text(size = rel(1.8)),\n axis.title.x = element_text(size = rel(1.8)),\n axis.title.y = element_text(size = rel(1.8))) +\n geom_point(data = data_ggplot[data_ggplot$nav == 1, ], size = 2, shape = 4, color = 'red') +\n facet_wrap( ~ name, nrow = nrow) +\n labs(x = x, y = y, title = title)\n \n })\n \n \n if (type == 'bar') {\n secondLayer <- with(data_ggplot, {\n geom_bar(stat = 'identity', size = 1)\n })\n } else if (type == 'line') {\n secondLayer <- with(data_ggplot, {\n geom_line(size = 1)\n })\n } else {\n stop(\"No such plot type.\")\n }\n \n print(mainLayer + secondLayer)\n \n if (output == TRUE) return(data_ggplot)\n}\n\n\n\n\n#' get L moment analysis of the input distribution\n#' \n#' @param dis A distribution, for hydrology usually a time series with only data column without time.\n#' @return The mean, L-variation, L-skewness and L-kurtosis of the input distribution\n#' @examples\n#' dis <- seq(1, 100)\n#' getLMom(dis)\n#' \n#' # More examples can be found in the user manual on http:https://yuanchao-xu.github.io/hyfo/\n#' \n#' @export\n#' @references \n#' \n#' \\itemize{\n#' \\item J. R. M. Hosking (2015). L-moments. R package, version 2.5. URL:\n#' http:https://CRAN.R-project.org/package=lmom.\n#' }\n#' \n#' \n#' @importFrom lmom samlmu\n#' \ngetLMom <- function(dis){\n \n LMom <- samlmu(dis, nmom = 4, ratios = TRUE)\n \n mean <- LMom[1]\n LCV <- LMom[2]/LMom[1]\n Lskew <- LMom[3]\n Lkur <- LMom[4]\n \n output <- data.frame(mean = mean, Lcv = LCV, Lskew = Lskew, Lkur = Lkur)\n return(output)\n}\n\n#' get moment analysis of the input distribution\n#' \n#' @param dis A distribution, for hydrology usually a time series with only data column without time.\n#' @return The mean, variation, skewness and kurtosis of the input distribution\n#' @examples\n#' dis <- seq(1, 100)\n#' getMoment(dis)\n#' \n#' # More examples can be found in the user manual on http:https://yuanchao-xu.github.io/hyfo/\n#' \n#' @export\n#' @references \n#' \n#' \\itemize{\n#' \\item Lukasz Komsta and Frederick Novomestky (2015). moments: Moments, cumulants, skewness, kurtosis and\n#' related tests. R package version 0.14. http:https://CRAN.R-project.org/package=moments\n#' \n#' \\item R Core Team (2015). R: A language and environment for statistical computing. R Foundation for\n#' Statistical Computing, Vienna, Austria. URL http:https://www.R-project.org/.\n#' }\n#' \n#' @importFrom moments skewness kurtosis\n#' @importFrom stats var\ngetMoment <- function(dis) {\n mean <- mean(dis, na.rm = TRUE)\n variance <- var(dis, na.rm = TRUE)\n skewness <- skewness(dis, na.rm = TRUE)\n kurtosis <- kurtosis(dis, na.rm = TRUE)\n \n output <- data.frame(mean=mean, Variance = variance, Skewness = skewness, Kurtosis = kurtosis)\n \n return(output)\n}\n", | ||
"created" : 1446423452048.000, | ||
"dirty" : false, | ||
"encoding" : "ASCII", | ||
"folds" : "", | ||
"hash" : "4083939771", | ||
"id" : "243E5DD6", | ||
"lastKnownWriteTime" : 1443830746, | ||
"path" : "E:/1/R/hyfo/R/analyzeTS.R", | ||
"project_path" : "R/analyzeTS.R", | ||
"properties" : { | ||
}, | ||
"relative_order" : 7, | ||
"source_on_save" : false, | ||
"type" : "r_source" | ||
} |
This file was deleted.
Oops, something went wrong.
Large diffs are not rendered by default.
Oops, something went wrong.
This file was deleted.
Oops, something went wrong.
Large diffs are not rendered by default.
Oops, something went wrong.
Oops, something went wrong.