4B970497

{
    "contents" : "#' Get mean rainfall data.\n#' \n#' Get mean rainfall data, e.g. mean annual rainfall, mean monthly rainfall and mean winter rainfall.\n#' \n#' @param inputTS A time series with only data column (1 column).\n#' @param method A string showing the method used to calculate mean value, e.g., \"annual\".\n#' more information please refer to details.\n#' @param yearIndex A NUMERIC ARRAY showing the year index of the time series.\n#' @param monthIndex A NUMERIC ARRAY showing the month index of the time series.\n#' @param fullResults A boolean showing whether the full results are shown, default is FALSE. If \n#' FALSE, only mean value will be returned, if TRUE, the sequence of values will be returned.\n#' @param omitNA A boolean showing in the calculation, whether NA is omitted, default is FALSE.\n#' @param plot A boolean showing whether the results will be plotted.\n#' @param ..., \\code{title, x, y} showing the title and x and y axis of the plot, shoud be a string.\n#' @details\n#' There are following methods to be selected, \n#' \"annual\": annual rainfall of each year is plotted.  \n#' \"winter\", \"spring\", \"autumn\", \"summer\": seasonal rainfall of each year is plotted.\n#' Month(number 1 to 12): month rainfall of each year is plotted, e.g. march rainfall of each year.\n#' \"meanMonthly\": the mean monthly rainfall of each month over the whole period.\n#' \n#' Since \"winter\" is a crossing year, 12, 1, 2, 12 is in former year, and 1, 2 are in latter year.\n#' so winter belongs to the latter year.\n#' \n#' @return The mean value of the input time series or the full results before calculating mean.\n#' \n# data(testdl)\n# TS  <- testdl[[1]]\n# year = as.numeric(format(TS[, 1], '%Y'))\n# month = as.numeric(format(TS[, 1], '%m'))\n# \n# # Get the mean spring precipitation.\n# a <- getMeanPreci(TS[, 2], method = 'spring', yearIndex = year, monthIndex = month)\n# a\n# \n# # Get the series of spring precipitation, set fullResults = TRUE.\n# a <- getMeanPreci(TS[, 2], method = 'spring', yearIndex = year, monthIndex = month,\n#                   fullResults = TRUE)\n# a\n# \n# # If missing value is excluded, set omitNA = TRUE.\n# a <- getMeanPreci(TS[, 2], method = 'winter', yearIndex = year, monthIndex = month,\n#                   omitNA = TRUE, fullResults = TRUE)\n# a\n# \n# # Get special month precipitation, e.g. march.\n# a <- getMeanPreci(TS[, 2], method = 3, yearIndex = year, monthIndex = month,\n#                   fullResults = TRUE)\n# a\n# \n# # We can also get annual precipitation.\n# a <- getMeanPreci(TS[, 2], method = 'annual', yearIndex = year, monthIndex = month,\n#                   fullResults = TRUE)\n\ngetMeanPreci <- function(inputTS, method = NULL, yearIndex = NULL, monthIndex = NULL,\n                         fullResults = FALSE, omitNA = TRUE, plot = FALSE, ...) {\n  # First check if all the records are NA.\n  if (any(!is.na(inputTS))) {\n    #converting daily preci to the wanted preci.\n    if (method == 'annual') {\n      ###yearIndex <- startTime$year + 1900\n      annualPreci <- tapply(inputTS, INDEX = yearIndex, FUN = sum, na.rm = omitNA)#ggplot is able not to show NA, so choose TRUE\n      if (fullResults == TRUE) output <- annualPreci else output <- mean(annualPreci, na.rm = TRUE)\n      \n    } else if (method == 'meanMonthly') {\n      \n      monthlypreci <- tapply(inputTS, INDEX = list(yearIndex, monthIndex), FUN = sum, na.rm = omitNA)\n      meanMonthlyPreci <- apply(monthlypreci, MARGIN = 2, FUN = mean, na.rm = TRUE)\n      \n      if (fullResults == TRUE) output <- meanMonthlyPreci else output <- mean(meanMonthlyPreci, na.rm = TRUE)\n      \n    }else if (method == 'winter') {\n#       #winter is the most tricky part, because it starts from Dec to Feb next year, it's a year-crossing season,\n#       #so we have to make some changes to the monthIndex\n#       #e.g.data from 1950.1.1 - 2008.3.31 if we want to calculate the mean winter preci, to calculate winter month\n#       #December, we have to move the yearIndex one month forwards or two months backwards, to make 12,1,2 in one year      \n#       ###yearIndex <- startTime$year + 1900\n#       ###monthIndex <- startTime$mon + 1\n#       \n#       #we move the yearIndex one month backwards\n#       yearIndex_new <- c(yearIndex[32:length(yearIndex)], rep(tail(yearIndex, 1), 31))\n#       \n#       winterIndex <- which(monthIndex == 12 | monthIndex == 1 | monthIndex == 2)\n#       winterYear <- yearIndex_new[winterIndex]#this index is used for calculation\n#       \n#       #because we don't have 1949.Dec, so the first winter is not intact, so first two months are elemenated\n#       \n#       startIndex <- length(which(winterYear == yearIndex[1])) + 1\n#       winterOfLastYear <- length(which(winterYear == tail(yearIndex, 1)))\n#       if (winterOfLastYear > 91) {\n#         endIndex <- length(winterYear) - 31 #in case the data set ends at Dec.31\n#         \n#       } else if (winterOfLastYear < 90) { # incase the data ends at Jan 31\n#         endIndex <- length(winterYear) - length(which(winterYear == tail(yearIndex, 1)))\n#         \n#       } else {\n#         endIndex <- length(winterYear)\n#       }\n#       \n#       inputTS <- inputTS[winterIndex][startIndex:endIndex]#needs two process with inputPreci, first, extract\n#       #the winter preci, second, delete first two month of 1950\n#       \n#       winterYear <- winterYear[startIndex:endIndex]#needs one process, delete two months   \n#       seasonalPreci <- tapply(inputTS,INDEX = winterYear, FUN = sum, na.rm = omitNA)\n      \n      # upper part is the older method saved as backup.\n      \n      matrix <- tapply(inputTS, INDEX = list(monthIndex, yearIndex), FUN = sum, na.rm = omitNA)\n      col <- colnames(matrix)\n      dec <- matrix['12',] # extract December.\n      dec <- c(NA, dec[1:length(dec) - 1]) # rearrange December order to push it to next year.\n      names(dec) <- col\n      matrix <- rbind(dec, matrix[rownames(matrix) != '12', ])      \n      seasonalPreci <- apply(matrix, MARGIN = 2, function(x) sum(x[c('dec', '1', '2')]))\n      \n      if (fullResults == TRUE) output <- seasonalPreci else output <- mean(seasonalPreci, na.rm = TRUE)  \n      \n    } else if (method == 'spring') {\n      \n#       springIndex <- which(monthIndex == 3 | monthIndex == 4 | monthIndex == 5)\n#       springYear <- yearIndex[springIndex]\n#       inputTS <- inputTS[springIndex]\n#       seasonalPreci <- tapply(inputTS, INDEX = springYear, FUN = sum, na.rm = omitNA)\n      \n      \n      matrix <- tapply(inputTS, INDEX = list(monthIndex, yearIndex), FUN = sum, na.rm = omitNA)\n      seasonalPreci <- apply(matrix, MARGIN = 2, function(x) sum(x[c('3', '4', '5')]))\n      \n      if (fullResults == TRUE) output <- seasonalPreci else output <- mean(seasonalPreci, na.rm = TRUE)\n      \n    } else if (method == 'summer') {\n      \n      matrix <- tapply(inputTS, INDEX = list(monthIndex, yearIndex), FUN = sum, na.rm = omitNA)\n      seasonalPreci <- apply(matrix, MARGIN = 2, function(x) sum(x[c('6', '7', '8')]))\n      \n      if (fullResults == TRUE) output <- seasonalPreci else output <- mean(seasonalPreci, na.rm = TRUE)\n      \n    } else if (method == 'autumn') {\n      \n      matrix <- tapply(inputTS, INDEX = list(monthIndex, yearIndex), FUN = sum, na.rm = omitNA)\n      seasonalPreci <- apply(matrix, MARGIN = 2, function(x) sum(x[c('9', '10', '11')]))\n\n      if (fullResults == TRUE) output <- seasonalPreci else output <- mean(seasonalPreci, na.rm = TRUE)\n      \n    } else if (is.numeric(method)) {\n      \n      month <- method\n      \n      #check if month exist \n      e <- match(month, unique(monthIndex))\n      if (is.na(e)) {\n        e1 <- paste(unique(monthIndex), collapse = ',')\n        m <- paste('No input month exists in the dataset, choose among', e1)\n        stop(m)\n      }\n      \n      monthlyPreci <- tapply(inputTS, INDEX = list(yearIndex, monthIndex), \n                             FUN = sum, na.rm = omitNA)[, toString(month)]\n      \n      if (fullResults == TRUE) output <- monthlyPreci else output <- mean(monthlyPreci, na.rm = TRUE)\n    }\n    \n  } else {\n    output <- NA\n  }\n\n  if (plot == TRUE) {\n    a <- data.frame(Date = names(output), value = output)\n    \n    theme_set(theme_bw())\n    mainLayer <- with(a, {\n      ggplot(a) +\n        geom_bar(aes(x = Date, y = value), stat = 'identity', fill = 'cyan') +\n        labs(empty = NULL, ...) +#in order to pass \"...\", arguments shouldn't be empty.\n        theme(plot.title = element_text(size = rel(1.3), face = 'bold'),\n              axis.title.x = element_text(size = rel(1.2)),\n              axis.title.y = element_text(size = rel(1.2))) + \n        theme(axis.text.x = element_text(angle = 90, hjust = 1))\n    })\n      \n    print (mainLayer)\n  }\n  \n  return(output)\n}\n",
    "created" : 1446424240843.000,
    "dirty" : false,
    "encoding" : "ASCII",
    "folds" : "",
    "hash" : "1620316423",
    "id" : "4B970497",
    "lastKnownWriteTime" : 1446467132,
    "path" : "E:/1/R/hyfo/R/getMeanPreci.R",
    "project_path" : "R/getMeanPreci.R",
    "properties" : {
    },
    "relative_order" : 4,
    "source_on_save" : false,
    "type" : "r_source"
}