Nothing
R/expFileOutput.R
In ie2misc: Irucka Embry's Miscellaneous USGS Functions
#' expFileOutput and expFileOutputBATCH
#'
#' expFileOutput and expFileOutputBATCH process raw .exp files generated by the
#' USGS PeakFQ program (\url{http://water.usgs.gov/software/PeakFQ/}). The .exp
#' output file from running PeakFQ is a shortened version of the longer
#' narrative .prt file, more suitable for tabulating the model results than the
#' .prt file; however, the information must be changed to a fixed field format.
#'
#'
#' expFileOutput converts the user-selected .exp file to 1) a tab-delimited
#' .csv file for a single station with the goodness-of-fit and trend results
#' (all station information exists in a single row) and 2) a tab-delimited .csv
#' file for a single station with the exceedance probability values on each row.
#' For the .xlsx file, tab 1 contains the goodness-of-fit and trend results and
#' tab 2 contains the exceedance probability values.
#'
#' expFileOutputBATCH converts the user-selected directory of .exp files into
#' 1) a tab-delimited .csv file as a single table, with one record for each
#' station, with the goodness-of-fit and trend results and 2) a tab-delimited
#' .csv file as a single table, with a set of records for each station, with the
#' exceedance probability values on each row. For the .xlsx file, tab 1
#' contains the goodness-of-fit and trend results and tab 2 contains the
#' exceedance probability values.
#'
#' In the Examples section, there is R code for the user to view the example
#' .exp file.
#'
#'
#'
#' @param file Input .exp file(s), using a file dialog, to obtain 1) the
#' goodness-of-fit and trend results & 2) the exceedance probability values.
#' @param output The exported format for each set of results (options are .csv,
#' .xlsx, and both file types).
#' @param overwrite logical vector that determines whether the existing
#' should be overwritten or not.
#'
#' @param path Directory path of .exp files, to be selected through a directory
#' dialog, to obtain 1) the goodness-of-fit and trend results & 2) the
#' exceedance probability values. The user will be asked where to find the
#' .exp files & then the user will be asked where to save the results files.
#'
#' @return .csv, .xlsx, or both file types with 1) the goodness-of-fit and
#' trend results & 2) the exceedance probability values for individual sites
#' in separate files. Currently, in the BATCH mode, all stations in the given
#' directory are combined in a single data.frame with both 1) and 2).
#'
#'
#'
#' @source
#' \enumerate{
#' \item r - How can I check if a file is empty? - Stack Overflow answered by Konrad Rudolph and edited by Geekuna Matata on Apr 23 2014. See \url{https://stackoverflow.com/questions/23254002/how-can-i-check-if-a-file-is-empty}.
#' \item r - Better error message for stopifnot? - Stack Overflow answered by Andrie on Dec 1 2011. See \url{https://stackoverflow.com/questions/8343509/better-error-message-for-stopifnot}.
#' \item RDocumentation: TclInterface {tcltk}. See \url{https://www.rdocumentation.org/packages/tcltk/versions/3.3.1}.
#' \item James Wettenhall & Philippe Grosjean, File Open/Save dialogs in R tcltk, December 01, 2015. See \url{https://web.archive.org/web/20160521051207/http://www.sciviews.org/recipes/tcltk/TclTk-file-open-save-dialogs/}. Retrieved thanks to the Internet Archive: Wayback Machine
#' \item r - read csv files and perform function, then bind together - Stack Overflow answered by bjoseph on Jan 8 2015. See \url{https://stackoverflow.com/questions/27846715/read-csv-files-and-perform-function-then-bind-together}.
#' \item r - Convert column classes in data.table - Stack Overflow answered by Matt Dowle on Dec 27 2013. See \url{https://stackoverflow.com/questions/7813578/convert-column-classes-in-data-table}.
#' \item r - Transpose rows to columns and remove only NAs in resulting columns - Stack Overflow answered by David Arenburg on April 22, 2014. See \url{https://stackoverflow.com/questions/23225977/transpose-rows-to-columns-and-remove-only-nas-in-resulting-columns}.
#' \item r - Add a Column to a Dataframe From a List of Values - Stack Overflow answered by Matthew Plourde on Jun 21 2012. See \url{https://stackoverflow.com/questions/11130037/add-a-column-to-a-dataframe-from-a-list-of-values/11130178}.
#' \item r - Why does is.vector() return TRUE for list? - Stack Overflow answered by Andrie on May 17 2011. See \url{https://stackoverflow.com/questions/6032772/why-does-is-vector-return-true-for-list/6032909}.
#' \item warnings - How do I get rid of the NOTE's generated by R CMD check when using for example ddply in my package? - Stack Overflow answered by shadow on Mar 4 2015 and edited by shadow on Mar 5 2015. See \url{https://stackoverflow.com/questions/28851812/how-do-i-get-rid-of-the-notes-generated-by-r-cmd-check-when-using-for-example-d}.
#' \item multiple output filenames in R - Stack Overflow asked and edited by Gabelins on Feb 1 2013. See \url{https://stackoverflow.com/questions/14651594/multiple-output-filenames-in-r}.
#' \item r - Regex return file name, remove path and file extension - Stack Overflow answered and edited by Ananda Mahto on Feb 25 20134. See \url{https://stackoverflow.com/questions/15073753/regex-return-file-name-remove-path-and-file-extension/15073919}.
#' }
#'
#' @encoding UTF-8
#'
#'
#' @author Irucka Embry, Anne Hoos
#'
#'
#'
#' @examples
#'
#' \dontrun{
#' # Example to check the input file format
#' library("ie2misc")
#'
#' # Copy and paste the following code into the R console if you
#' # wish to see the .exp input file format.
#' # Note the number of lines and the row headings.
#' file.show(system.file("extdata", "01110000_PEAK_WATSTORE.EXP",
#' package = "ie2misc"), title = paste("01110000_PEAK_WATSTORE.EXP"))
#' # opens the .exp file using the default text editor or within RStudio
#'
#'
#' # Examples to show you different output cases
#' expFileOutput(output = "csv") # returns .csv files
#' # Follow the file dialog instructions
#'
#' expFileOutput(output = "xlsx") # returns .xlsx files
#' # Follow the file dialog instructions
#'
#' expFileOutput(output = "both") # returns .csv and .xlsx files
#' # Follow the file dialog instructions
#'
#'
#'
#'
#' # Examples to show you different output cases (BATCH)
#' expFileOutputBATCH(output = "csv") # returns .csv files
#' # Follow the file dialog instructions
#'
#' expFileOutputBATCH(output = "xlsx") # returns .xlsx files
#' # Follow the file dialog instructions
#'
#' expFileOutputBATCH(output = "both") # returns .csv and .xlsx files
#' # Follow the file dialog instructions
#' }
#'
#' @importFrom stringi stri_trim_both stri_trans_toupper stri_detect_fixed
#' @importFrom data.table fread setDT setcolorder set rbindlist ":="
#' @importFrom openxlsx createWorkbook addWorksheet writeData setColWidths saveWorkbook
#' @importFrom tcltk tk_choose.files tclvalue tkgetSaveFile tk_choose.dir
#' @importFrom gWidgets2 gconfirm guiToolkit
#' @importFrom utils read.table write.csv
#' @importFrom tools file_path_sans_ext
#' @importFrom assertthat assert_that
#' @importFrom checkmate testFileExists
#'
#'
#'
#' @name expFileOutput
NULL
#' @export
#' @rdname expFileOutput
expFileOutput <- function (file = tk_choose.files(default = "",
caption = "Select file(s) to open & hold down Ctrl to choose more than 1 file",
multi = TRUE, filters = matrix(c("Text file", ".exp", "Text file", ".EXP"),
4, 2, byrow = TRUE)), output = c("csv", "xlsx", "both"), overwrite = TRUE) {
overwrite <- overwrite
station <- NULL
# Source 10
assert_that(testFileExists(file), msg = "You did not choose a file. Please select a file again.")
# Source 1 / provide a stop warning if no file was selected
assert_that((file.info(file)$size != 0), msg = "Your file is empty. Please try again with a different file.")
# Sources 1 & 2 / only process non-empty files and provide a stop warning if the input file is empty
if (length(file) == 1) {
if (!nchar(file)) {
stop("You did not choose a file. Please try again with a different file.")
# Source 2 / provide a stop warning if no file was selected
} else {
confirm <- gconfirm(toolkit = guiToolkit("tcltk"), msg =
paste0("Do you want to select", " ", file, "?"), title = "Confirm",
icon = "question")
if (confirm == FALSE) {
stop("Please try again with a different file.")
# Source 2 / provide a stop warning if the user wants to change the file
} else {
if (file.info(file)$size == 0) {
stop("Your file is empty. Please try again with a different file.")
# Sources 1 & 2 / only process non-empty files and provide a stop warning if
# the input file is empty
} else {
# to obtain the goodness-of-fit results and trend results
rddatatmp <- read.table(file, sep = "\t", stringsAsFactors = FALSE,
header = FALSE, skip = 1, nrows = 20)
# read 20 lines of each file skipping the first line as a table, there is no header
rownames(rddatatmp) <- as.character(rddatatmp[, 1])
# Source 7 / make the row names the current first column (station, Analysis, etc.)
rddatatmp <- as.data.frame(t(rddatatmp), stringsAsFactors = FALSE)
# Source 7 / transpose the rows and columns and make the data.frame out of
# characters rather than factors
rddatatmp <- setDT(rddatatmp[-1, ])
# transform the data.frame into a data.table and remove the first row
# changing columns to numeric class
# obtain the name of the column based on the column number
change_class1 <- names(rddatatmp[, c(7:15, 18:20), with = FALSE])
# name of all columns except column 1
for (col in change_class1) set(rddatatmp, j = col,
value = as.numeric(rddatatmp[[col]]))
# Source 6
# changing columns to numeric class
# obtain the name of the column based on the column number
change_class2 <- names(rddatatmp[, c(4:5, 16:17), with = FALSE])
# name of all columns except column 1
for (col in change_class2) set(rddatatmp, j = col,
value = as.integer(rddatatmp[[col]]))
# Source 6
# to obtain the exceedance probability values
rddatatmp2 <- fread(file, nrows = 1, skip = 1, header = FALSE)
# read in the 2nd line while skipping the first line with no header
getstationid <- stri_trim_both(rddatatmp2$V2, pattern = "\\P{Wspace}")
# obtain the station ID from rddatatmp and trim out any whitespace from both
# the left and right
rddatatmp3 <- fread(file, stringsAsFactors = FALSE, skip = 21,
colClasses = "character")
# read the same file in, but skip the first 21 lines. Read in as a data.table
rddatatmp3[, station := getstationid]
# create a new column with the station ID in the existing data.table
setcolorder(rddatatmp3, c(ncol(rddatatmp3), 1:(ncol(rddatatmp3)-1L)))
# move the station ID column to the beginning
# changing columns to numeric class
# obtain the name of the column based on the column number
change_class1 <- names(rddatatmp3[, 3:ncol(rddatatmp3), with = FALSE])
# name of all columns except column 1
for (col in change_class1) set(rddatatmp3, j = col,
value = as.numeric(rddatatmp3[[col]]))
# Source 6
# export the results
if (output == "csv") {
filesave1 <- tclvalue(tkgetSaveFile(title = paste0("Save goodness-of-fit and trend results", " ", stri_trans_toupper(basename(file_path_sans_ext(file))), " ", "file as"), filetypes = "{{Text file} .csv}"))
# Sources 3 & 4 / GUI file dialog to save the file
# Sources 11 & 12 / original file name minus the extension and path in uppercase
write.csv(rddatatmp, filesave1, row.names = FALSE)
# Write the table contained in rddatatmp and end with the .csv file extension
filesave2 <- tclvalue(tkgetSaveFile(title = paste0("Save exceedance probability values", " ", stri_trans_toupper(basename(file_path_sans_ext(file))), " ", "file as"), filetypes = "{{Text file} .csv}"))
# Sources 3 & 4 / GUI file dialog to save the file
# Sources 11 & 12 / original file name minus the extension and path in uppercase
write.csv(rddatatmp3, filesave2, row.names = FALSE)
# Write the table contained in rddatatmp3 and end with the .csv file extension
} else if (output == "xlsx") {
# create Microsoft Excel workbook
wb <- createWorkbook()
# use R package openxlsx to create the .xlsx spreadsheet
addWorksheet(wb, "Goodness-of-Fit_Trend Results")
# adds the worksheet with the name of Goodness-of-Fit and Trend Results
writeData(wb, "Goodness-of-Fit_Trend Results", rddatatmp)
# writes the data to the workbook
setColWidths(wb, sheet = 1, cols = 1:ncol(rddatatmp), widths = "auto")
addWorksheet(wb, "Exceedance Probability Values")
# adds the worksheet with the name of Exceedance Probability Values
writeData(wb, "Exceedance Probability Values", rddatatmp3)
# writes the data to the workbook
setColWidths(wb, sheet = 2, cols = 1:ncol(rddatatmp3), widths = "auto")
filesave3 <- tclvalue(tkgetSaveFile(title = paste0("Save", " ", stri_trans_toupper(basename(file_path_sans_ext(file))), " ", "file as"), filetypes = "{{MS Excel file} .xlsx}"))
# Sources 3 & 4 / GUI file dialog to save the spreadsheet
# Sources 11 & 12 / original file name minus the extension and path in uppercase
saveWorkbook(wb, filesave3, overwrite = overwrite)
} else if (output == "both") {
filesave3 <- tclvalue(tkgetSaveFile(title = paste0("Save goodness-of-fit and trend results", " ", stri_trans_toupper(basename(file_path_sans_ext(file))), " ", "file as"), filetypes = "{{Text file} .csv}"))
# Sources 3 & 4 / GUI file dialog to save the file
# Sources 11 & 12 / original file name minus the extension and path in uppercase
write.csv(rddatatmp, filesave3, row.names = FALSE)
# Write the table contained in rddatatmp and end with the .csv file extension
filesave4 <- tclvalue(tkgetSaveFile(title = paste0("Save exceedance probability values", " ", stri_trans_toupper(basename(file_path_sans_ext(file))), " ", "file as"), filetypes = "{{Text file} .csv}"))
# Sources 3 & 4 / GUI file dialog to save the file
# Sources 11 & 12 / original file name minus the extension and path in uppercase
write.csv(rddatatmp3, filesave4, row.names = FALSE)
# Write the table contained in rddatatmp3 and end with the .csv file extension
# create Microsoft Excel workbook
wb <- createWorkbook()
# use R package openxlsx to create the .xlsx spreadsheet
addWorksheet(wb, "Goodness-of-Fit_Trend Results")
# adds the worksheet with the name of Goodness-of-Fit and Trend Results
writeData(wb, "Goodness-of-Fit_Trend Results", rddatatmp)
# writes the data to the workbook
setColWidths(wb, sheet = 1, cols = 1:ncol(rddatatmp), widths = "auto")
addWorksheet(wb, "Exceedance Probability Values")
# adds the worksheet with the name of Exceedance Probability Values
writeData(wb, "Exceedance Probability Values", rddatatmp3)
# writes the data to the workbook
setColWidths(wb, sheet = 2, cols = 1:ncol(rddatatmp3), widths = "auto")
filesave5 <- tclvalue(tkgetSaveFile(title = paste0("Save", " ", stri_trans_toupper(basename(file_path_sans_ext(file))), " ", "file as"), filetypes = "{{MS Excel file} .xlsx}"))
# Sources 3 & 4 / GUI file dialog to save the spreadsheet
# Sources 11 & 12 / original file name minus the extension and path in uppercase
saveWorkbook(wb, filesave5, overwrite = overwrite)
}
}
}
}
} else {
for (i in 1:length(file)) { # Source 5
assert_that(testFileExists(file[i]), msg = "You did not choose a file. Please select a file again.")
# Source 1 / provide a stop warning if no file was selected
assert_that((file.info(file[i])$size != 0), msg = "Your file is empty. Please try again with a different file.")
# Sources 1 & 2 / only process non-empty files and provide a stop warning if the input file is empty
if (!nchar(file[i])) {
stop("You did not choose a file. Please try again with a different file.")
# Source 2 / provide a stop warning if no file was selected
} else {
confirm <- gconfirm(toolkit = guiToolkit("tcltk"), msg = paste0("Do you want to select", " ", file[i], "?"), title = "Confirm", icon = "question")
if (confirm == FALSE) {
stop("Please try again with a different file.")
# Source 2 / provide a stop warning if the user wants to change the file
} else {
if (file.info(file[i])$size == 0) {
stop("Your file is empty. Please try again with a different file.")
# Sources 1 & 2 / only process non-empty files and provide a stop warning if the input file is empty
} else {
rddatatmp <- vector("list", length(file))
# Source 8 and 9 / pre-allocate the list since it is being used in a for loop
rddatatmp2 <- vector("list", length(file))
# Source 8 and 9 / pre-allocate the list since it is being used in a for loop
rddatatmp3 <- vector("list", length(file))
# Source 8 and 9 / pre-allocate the list since it is being used in a for loop
getstationid <- vector("list", length(file))
# Source 8 and 9 / pre-allocate the list since it is being used in a for loop
# to obtain the goodness-of-fit results and trend results
# Source 5 begins
assign(file[i], read.table(file[i], sep = "\t", stringsAsFactors = FALSE, header = FALSE, skip = 1, nrows = 20))
# read the lines as a table
rddatatmp[[i]] <- assign(file[i], get(file[i]))
# Source 5 ends
rownames(rddatatmp[[i]]) <- as.character(rddatatmp[[i]][[1]])
# Source 7 / make the row names the current first column (station, Analysis, etc.)
rddatatmp[[i]] <- as.data.frame(t(rddatatmp[[i]]), stringsAsFactors = FALSE)
# Source 7 / transpose the rows and columns and make the data.frame out of characters rather than factors
rddatatmp[[i]] <- setDT(rddatatmp[[i]])
# transform the data.frame into a data.table
rddatatmp[[i]] <- rddatatmp[[i]][-1, ]
# remove the first row
dataas <- rbindlist(rddatatmp)
# the goodness-of-fit results and trend results
# changing columns to numeric class
# obtain the name of the column based on the column number
change_class1 <- names(dataas[, c(7:15, 18:20), with = FALSE])
# name of all columns except column 1
for (col in change_class1) set(dataas, j = col, value = as.numeric(dataas[[col]]))
# Source 6
# changing columns to numeric class
# obtain the name of the column based on the column number
change_class2 <- names(dataas[, c(4:5, 16:17), with = FALSE])
# name of all columns except column 1
for (col in change_class2) set(dataas, j = col, value = as.integer(dataas[[col]]))
# Source 6
# Source 5 begins
# to obtain the exceedance probability values
assign(file[i], fread(file[i], nrows = 1, skip = 1, header = FALSE))
# read the lines as a table
rddatatmp2[[i]] <- assign(file[i], get(file[i]))
# Source 5 ends
getstationid[[i]] <- stri_trim_both(rddatatmp2[[i]][[2]], pattern = "\\P{Wspace}")
# obtain the station ID from rddatatmp and trim out any whitespace from both the left and right
# Source 5 begins
assign(file[i], fread(file[i], stringsAsFactors = FALSE, skip = 21, colClasses = "character"))
# read the lines as a table
rddatatmp3[[i]] <- assign(file[i], get(file[i]))
# Source 5 ends
rddatatmp3[[i]][, station := getstationid[[i]]]
# create a new column with the station ID in the existing data.table
setcolorder(rddatatmp3[[i]], c(ncol(rddatatmp3[[i]]), 1:(ncol(rddatatmp3[[i]])-1L)))
# move the station ID column to the beginning
dataas2 <- rbindlist(rddatatmp3)
# the exceedance probability values
# changing columns to numeric class
# obtain the name of the column based on the column number
change_class1 <- names(dataas2[, 3:ncol(dataas2), with = FALSE])
# name of all columns except column 1
for (col in change_class1) set(dataas2, j = col, value = as.numeric(dataas2[[col]]))
# Source 6
# export the results
if (output == "csv") {
filesave1 <- tclvalue(tkgetSaveFile(title = paste0("Save goodness-of-fit and trend results", " ", stri_trans_toupper(basename(file_path_sans_ext(file[i]))), " ", "file as"), filetypes = "{{Text file} .csv}"))
# Sources 3 & 4 / GUI file dialog to save the file
# Sources 11 & 12 / original file name minus the extension and path in uppercase
write.csv(dataas, filesave1, row.names = FALSE)
# Write the table contained in dataas and end with the .csv file extension
filesave2 <- tclvalue(tkgetSaveFile(title = paste0("Save exceedance probability values", " ", stri_trans_toupper(basename(file_path_sans_ext(file[i]))), " ", "file as"), filetypes = "{{Text file} .csv}"))
# Sources 3 & 4 / GUI file dialog to save the file
# Sources 11 & 12 / original file name minus the extension and path in uppercase
write.csv(dataas2, filesave2, row.names = FALSE)
# Write the table contained in dataas2 and end with the .csv file extension
} else if (output == "xlsx") {
# create Microsoft Excel workbook
wb <- createWorkbook()
# use R package openxlsx to create the .xlsx spreadsheet
addWorksheet(wb, "Goodness-of-Fit_Trend Results")
# adds the worksheet with the name of Goodness-of-Fit and Trend Results
writeData(wb, "Goodness-of-Fit_Trend Results", dataas)
# writes the data to the workbook
setColWidths(wb, sheet = 1, cols = 1:ncol(dataas), widths = "auto")
addWorksheet(wb, "Exceedance Probability Values")
# adds the worksheet with the name of Exceedance Probability Values
writeData(wb, "Exceedance Probability Values", dataas2)
# writes the data to the workbook
setColWidths(wb, sheet = 2, cols = 1:ncol(dataas2), widths = "auto")
filesave3 <- tclvalue(tkgetSaveFile(title = paste0("Save", " ", stri_trans_toupper(basename(file_path_sans_ext(file[i]))), " ", "file as"), filetypes = "{{MS Excel file} .xlsx}"))
# Sources 3 & 4 / GUI file dialog to save the spreadsheet
# Sources 11 & 12 / original file name minus the extension and path in uppercase
saveWorkbook(wb, filesave3, overwrite = overwrite)
} else if (output == "both") {
filesave3 <- tclvalue(tkgetSaveFile(title = paste0("Save goodness-of-fit and trend results", " ", stri_trans_toupper(basename(file_path_sans_ext(file[i]))), " ", "file as"), filetypes = "{{Text file} .csv}"))
# Sources 3 & 4 / GUI file dialog to save the file
# Sources 11 & 12 / original file name minus the extension and path in uppercase
write.csv(dataas, filesave3, row.names = FALSE)
# Write the table contained in dataas and end with the .csv file extension
filesave4 <- tclvalue(tkgetSaveFile(title = paste0("Save exceedance probability values", " ", stri_trans_toupper(basename(file_path_sans_ext(file[i]))), " ", "file as"), filetypes = "{{Text file} .csv}"))
# Sources 3 & 4 / GUI file dialog to save the file
# Sources 11 & 12 / original file name minus the extension and path in uppercase
write.csv(dataas2, filesave4, row.names = FALSE)
# Write the table contained in dataas2 and end with the .csv file extension
# create Microsoft Excel workbook
wb <- createWorkbook()
# use R package openxlsx to create the .xlsx spreadsheet
addWorksheet(wb, "Goodness-of-Fit_Trend Results")
# adds the worksheet with the name of Goodness-of-Fit and Trend Results
writeData(wb, "Goodness-of-Fit_Trend Results", dataas)
# writes the data to the workbook
setColWidths(wb, sheet = 1, cols = 1:ncol(dataas), widths = "auto")
addWorksheet(wb, "Exceedance Probability Values")
# adds the worksheet with the name of Exceedance Probability Values
writeData(wb, "Exceedance Probability Values", dataas2)
# writes the data to the workbook
setColWidths(wb, sheet = 2, cols = 1:ncol(dataas2), widths = "auto")
filesave5 <- tclvalue(tkgetSaveFile(title = paste0("Save", " ", stri_trans_toupper(basename(file_path_sans_ext(file[i]))), " ", "file as"), filetypes = "{{MS Excel file} .xlsx}"))
# Sources 3 & 4 / GUI file dialog to save the spreadsheet
# Sources 11 & 12 / original file name minus the extension and path in uppercase
saveWorkbook(wb, filesave5, overwrite = overwrite)
}
}
}
}
}
}
}
#' @export
#' @rdname expFileOutput
expFileOutputBATCH <- function (path = tk_choose.dir(caption = "Select the directory with the .exp files"), output = c("csv", "xlsx", "both"), overwrite = TRUE) {
station <- NULL
# Source 10
overwrite <- overwrite
confirm <- gconfirm(toolkit = guiToolkit("tcltk"), msg = paste0("Do you want to select", " ", path, " as the directory with the .exp files?"), title = "Confirm", icon = "question")
if (confirm == FALSE) {
stop("Please try again with a different directory.")
# Source 2 / provide a stop warning if the user wants to change the directory
} else {
file <- list.files(path, pattern = "exp|EXP$", full.names = TRUE)
file <- file[stri_detect_fixed(file, ".exp", case_insensitive = TRUE)]
for (i in 1:length(file)) { # Source 5
assert_that(testFileExists(file[i]), msg = "You did not choose a file. Please select a file again.")
# Source 1 / provide a stop warning if no file was selected
assert_that((file.info(file[i])$size != 0), msg = "Your file is empty. Please try again with a different file.")
# Sources 1 & 2 / only process non-empty files and provide a stop warning if the input file is empty
if (!nchar(file[i])) {
stop("You did not choose a file. Please try again with a different file.")
# Source 2 / provide a stop warning if no file was selected
} else {
if (file.info(file[i])$size == 0) {
stop("Your file is empty. Please try again with a different file.")
# Sources 1 & 2 / only process non-empty files and provide a stop warning if the input file is empty
} else {
}
}
}
# to obtain the goodness-of-fit results and trend results
fun1 <- function(file) {
rddatatmp <- read.table(file, sep = "\t", stringsAsFactors = FALSE, header = FALSE, skip = 1, nrows = 20)
# read the lines as a table
rownames(rddatatmp) <- as.character(rddatatmp[[1]])
# Source 7 / make the row names the current first column (station, Analysis, etc.)
rddatatmp <- as.data.frame(t(rddatatmp), stringsAsFactors = FALSE)
# Source 7 / transpose the rows and columns and make the data.frame out of characters rather than factors
rddatatmp <- setDT(rddatatmp)
# transform the data.frame into a data.table
rddatatmp <- rddatatmp[-1, ]
# remove the first row
}
dataas <- rbindlist(lapply(file, fun1))
# the goodness-of-fit results and trend results
# to obtain the exceedance probability values
fun2 <- function(file) {
rddatatmp2 <- fread(file, nrows = 1, skip = 1, header = FALSE)
# read the lines as a table
getstationid <- stri_trim_both(rddatatmp2[[2]], pattern = "\\P{Wspace}")
# obtain the station ID from rddatatmp and trim out any whitespace from both the left and right
rddatatmp3 <- fread(file, stringsAsFactors = FALSE, skip = 21, colClasses = "character")
# read the lines as a table
rddatatmp3[, station := getstationid]
# create a new column with the station ID in the existing data.table
setcolorder(rddatatmp3, c(ncol(rddatatmp3), 1:(ncol(rddatatmp3)-1L)))
# move the station ID column to the beginning
}
dataas2 <- rbindlist(lapply(file, fun2))
# the exceedance probability values
# changing columns to numeric class
# obtain the name of the column based on the column number
change_class1 <- names(dataas[, c(7:15, 18:20), with = FALSE])
# name of all columns except column 1
for (col in change_class1) set(dataas, j = col, value = as.numeric(dataas[[col]]))
# Source 6
# changing columns to numeric class
# obtain the name of the column based on the column number
change_class2 <- names(dataas[, c(4:5, 16:17), with = FALSE])
# name of all columns except column 1
for (col in change_class2) set(dataas, j = col, value = as.integer(dataas[[col]]))
# Source 6
# changing columns to numeric class
# obtain the name of the column based on the column number
change_class1 <- names(dataas2[, 3:ncol(dataas2), with = FALSE])
# name of all columns except column 1
for (col in change_class1) set(dataas2, j = col, value = as.numeric(dataas2[[col]]))
# Source 6
# export the results
if (output == "csv") {
filesave1 <- tclvalue(tkgetSaveFile(title = "Save goodness-of-fit and trend results batch file as", filetypes = "{{Text file} .csv}"))
# Sources 3 & 4 / GUI file dialog to save the file
write.csv(dataas, filesave1, row.names = FALSE)
# Write the table contained in dataas and end with the .csv file extension
filesave2 <- tclvalue(tkgetSaveFile(title = "Save exceedance probability values batch file as", filetypes = "{{Text file} .csv}"))
# Sources 3 & 4 / GUI file dialog to save the file
write.csv(dataas2, filesave2, row.names = FALSE)
# Write the table contained in dataas2 and end with the .csv file extension
} else if (output == "xlsx") {
# create Microsoft Excel workbook
wb <- createWorkbook()
# use R package openxlsx to create the .xlsx spreadsheet
addWorksheet(wb, "Goodness-of-Fit_Trend Results")
# adds the worksheet with the name of Goodness-of-Fit and Trend Results
writeData(wb, "Goodness-of-Fit_Trend Results", dataas)
# writes the data to the workbook
setColWidths(wb, sheet = 1, cols = 1:ncol(dataas), widths = "auto")
addWorksheet(wb, "Exceedance Probability Values")
# adds the worksheet with the name of Exceedance Probability Values
writeData(wb, "Exceedance Probability Values", dataas2)
# writes the data to the workbook
setColWidths(wb, sheet = 2, cols = 1:ncol(dataas2), widths = "auto")
filesave3 <- tclvalue(tkgetSaveFile(title = "Save batch file as", filetypes = "{{MS Excel file} .xlsx}"))
# Sources 3 & 4 / GUI file dialog to save the spreadsheet
saveWorkbook(wb, filesave3, overwrite = overwrite)
} else if (output == "both") {
filesave3 <- tclvalue(tkgetSaveFile(title = "Save goodness-of-fit and trend results file as", filetypes = "{{Text file} .csv}"))
# Sources 3 & 4 / GUI file dialog to save the file
write.csv(dataas, filesave3, row.names = FALSE)
# Write the table contained in dataas and end with the .csv file extension
filesave4 <- tclvalue(tkgetSaveFile(title = "Save exceedance probability values file as", filetypes = "{{Text file} .csv}"))
# Sources 3 & 4 / GUI file dialog to save the file
write.csv(dataas2, filesave4, row.names = FALSE)
# Write the table contained in dataas2 and end with the .csv file extension
# create Microsoft Excel workbook
wb <- createWorkbook()
# use R package openxlsx to create the .xlsx spreadsheet
addWorksheet(wb, "Goodness-of-Fit_Trend Results")
# adds the worksheet with the name of Goodness-of-Fit and Trend Results
writeData(wb, "Goodness-of-Fit_Trend Results", dataas)
# writes the data to the workbook
setColWidths(wb, sheet = 1, cols = 1:ncol(dataas), widths = "auto")
addWorksheet(wb, "Exceedance Probability Values")
# adds the worksheet with the name of Exceedance Probability Values
writeData(wb, "Exceedance Probability Values", dataas2)
# writes the data to the workbook
setColWidths(wb, sheet = 2, cols = 1:ncol(dataas2), widths = "auto")
filesave5 <- tclvalue(tkgetSaveFile(title = "Save batch file as", filetypes = "{{MS Excel file} .xlsx}"))
# Sources 3 & 4 / GUI file dialog to save the spreadsheet
saveWorkbook(wb, filesave5, overwrite = overwrite)
}
}
}
Try the ie2misc package in your browser
Any scripts or data that you put into this service are public.
ie2misc documentation built on Sept. 20, 2023, 9:08 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
#' expFileOutput and expFileOutputBATCH
#'
#' expFileOutput and expFileOutputBATCH process raw .exp files generated by the
#' USGS PeakFQ program (\url{http://water.usgs.gov/software/PeakFQ/}). The .exp
#' output file from running PeakFQ is a shortened version of the longer
#' narrative .prt file, more suitable for tabulating the model results than the
#' .prt file; however, the information must be changed to a fixed field format.
#'
#'
#' expFileOutput converts the user-selected .exp file to 1) a tab-delimited
#' .csv file for a single station with the goodness-of-fit and trend results
#' (all station information exists in a single row) and 2) a tab-delimited .csv
#' file for a single station with the exceedance probability values on each row.
#' For the .xlsx file, tab 1 contains the goodness-of-fit and trend results and
#' tab 2 contains the exceedance probability values.
#'
#' expFileOutputBATCH converts the user-selected directory of .exp files into
#' 1) a tab-delimited .csv file as a single table, with one record for each
#' station, with the goodness-of-fit and trend results and 2) a tab-delimited
#' .csv file as a single table, with a set of records for each station, with the
#' exceedance probability values on each row. For the .xlsx file, tab 1
#' contains the goodness-of-fit and trend results and tab 2 contains the
#' exceedance probability values.
#'
#' In the Examples section, there is R code for the user to view the example
#' .exp file.
#'
#'
#'
#' @param file Input .exp file(s), using a file dialog, to obtain 1) the
#' goodness-of-fit and trend results & 2) the exceedance probability values.
#' @param output The exported format for each set of results (options are .csv,
#' .xlsx, and both file types).
#' @param overwrite logical vector that determines whether the existing
#' should be overwritten or not.
#'
#' @param path Directory path of .exp files, to be selected through a directory
#' dialog, to obtain 1) the goodness-of-fit and trend results & 2) the
#' exceedance probability values. The user will be asked where to find the
#' .exp files & then the user will be asked where to save the results files.
#'
#' @return .csv, .xlsx, or both file types with 1) the goodness-of-fit and
#' trend results & 2) the exceedance probability values for individual sites
#' in separate files. Currently, in the BATCH mode, all stations in the given
#' directory are combined in a single data.frame with both 1) and 2).
#'
#'
#'
#' @source
#' \enumerate{
#' \item r - How can I check if a file is empty? - Stack Overflow answered by Konrad Rudolph and edited by Geekuna Matata on Apr 23 2014. See \url{https://stackoverflow.com/questions/23254002/how-can-i-check-if-a-file-is-empty}.
#' \item r - Better error message for stopifnot? - Stack Overflow answered by Andrie on Dec 1 2011. See \url{https://stackoverflow.com/questions/8343509/better-error-message-for-stopifnot}.
#' \item RDocumentation: TclInterface {tcltk}. See \url{https://www.rdocumentation.org/packages/tcltk/versions/3.3.1}.
#' \item James Wettenhall & Philippe Grosjean, File Open/Save dialogs in R tcltk, December 01, 2015. See \url{https://web.archive.org/web/20160521051207/http://www.sciviews.org/recipes/tcltk/TclTk-file-open-save-dialogs/}. Retrieved thanks to the Internet Archive: Wayback Machine
#' \item r - read csv files and perform function, then bind together - Stack Overflow answered by bjoseph on Jan 8 2015. See \url{https://stackoverflow.com/questions/27846715/read-csv-files-and-perform-function-then-bind-together}.
#' \item r - Convert column classes in data.table - Stack Overflow answered by Matt Dowle on Dec 27 2013. See \url{https://stackoverflow.com/questions/7813578/convert-column-classes-in-data-table}.
#' \item r - Transpose rows to columns and remove only NAs in resulting columns - Stack Overflow answered by David Arenburg on April 22, 2014. See \url{https://stackoverflow.com/questions/23225977/transpose-rows-to-columns-and-remove-only-nas-in-resulting-columns}.
#' \item r - Add a Column to a Dataframe From a List of Values - Stack Overflow answered by Matthew Plourde on Jun 21 2012. See \url{https://stackoverflow.com/questions/11130037/add-a-column-to-a-dataframe-from-a-list-of-values/11130178}.
#' \item r - Why does is.vector() return TRUE for list? - Stack Overflow answered by Andrie on May 17 2011. See \url{https://stackoverflow.com/questions/6032772/why-does-is-vector-return-true-for-list/6032909}.
#' \item warnings - How do I get rid of the NOTE's generated by R CMD check when using for example ddply in my package? - Stack Overflow answered by shadow on Mar 4 2015 and edited by shadow on Mar 5 2015. See \url{https://stackoverflow.com/questions/28851812/how-do-i-get-rid-of-the-notes-generated-by-r-cmd-check-when-using-for-example-d}.
#' \item multiple output filenames in R - Stack Overflow asked and edited by Gabelins on Feb 1 2013. See \url{https://stackoverflow.com/questions/14651594/multiple-output-filenames-in-r}.
#' \item r - Regex return file name, remove path and file extension - Stack Overflow answered and edited by Ananda Mahto on Feb 25 20134. See \url{https://stackoverflow.com/questions/15073753/regex-return-file-name-remove-path-and-file-extension/15073919}.
#' }
#'
#' @encoding UTF-8
#'
#'
#' @author Irucka Embry, Anne Hoos
#'
#'
#'
#' @examples
#'
#' \dontrun{
#' # Example to check the input file format
#' library("ie2misc")
#'
#' # Copy and paste the following code into the R console if you
#' # wish to see the .exp input file format.
#' # Note the number of lines and the row headings.
#' file.show(system.file("extdata", "01110000_PEAK_WATSTORE.EXP",
#' package = "ie2misc"), title = paste("01110000_PEAK_WATSTORE.EXP"))
#' # opens the .exp file using the default text editor or within RStudio
#'
#'
#' # Examples to show you different output cases
#' expFileOutput(output = "csv") # returns .csv files
#' # Follow the file dialog instructions
#'
#' expFileOutput(output = "xlsx") # returns .xlsx files
#' # Follow the file dialog instructions
#'
#' expFileOutput(output = "both") # returns .csv and .xlsx files
#' # Follow the file dialog instructions
#'
#'
#'
#'
#' # Examples to show you different output cases (BATCH)
#' expFileOutputBATCH(output = "csv") # returns .csv files
#' # Follow the file dialog instructions
#'
#' expFileOutputBATCH(output = "xlsx") # returns .xlsx files
#' # Follow the file dialog instructions
#'
#' expFileOutputBATCH(output = "both") # returns .csv and .xlsx files
#' # Follow the file dialog instructions
#' }
#'
#' @importFrom stringi stri_trim_both stri_trans_toupper stri_detect_fixed
#' @importFrom data.table fread setDT setcolorder set rbindlist ":="
#' @importFrom openxlsx createWorkbook addWorksheet writeData setColWidths saveWorkbook
#' @importFrom tcltk tk_choose.files tclvalue tkgetSaveFile tk_choose.dir
#' @importFrom gWidgets2 gconfirm guiToolkit
#' @importFrom utils read.table write.csv
#' @importFrom tools file_path_sans_ext
#' @importFrom assertthat assert_that
#' @importFrom checkmate testFileExists
#'
#'
#'
#' @name expFileOutput
NULL
#' @export
#' @rdname expFileOutput
expFileOutput <- function (file = tk_choose.files(default = "",
caption = "Select file(s) to open & hold down Ctrl to choose more than 1 file",
multi = TRUE, filters = matrix(c("Text file", ".exp", "Text file", ".EXP"),
4, 2, byrow = TRUE)), output = c("csv", "xlsx", "both"), overwrite = TRUE) {
overwrite <- overwrite
station <- NULL
# Source 10
assert_that(testFileExists(file), msg = "You did not choose a file. Please select a file again.")
# Source 1 / provide a stop warning if no file was selected
assert_that((file.info(file)$size != 0), msg = "Your file is empty. Please try again with a different file.")
# Sources 1 & 2 / only process non-empty files and provide a stop warning if the input file is empty
if (length(file) == 1) {
if (!nchar(file)) {
stop("You did not choose a file. Please try again with a different file.")
# Source 2 / provide a stop warning if no file was selected
} else {
confirm <- gconfirm(toolkit = guiToolkit("tcltk"), msg =
paste0("Do you want to select", " ", file, "?"), title = "Confirm",
icon = "question")
if (confirm == FALSE) {
stop("Please try again with a different file.")
# Source 2 / provide a stop warning if the user wants to change the file
} else {
if (file.info(file)$size == 0) {
stop("Your file is empty. Please try again with a different file.")
# Sources 1 & 2 / only process non-empty files and provide a stop warning if
# the input file is empty
} else {
# to obtain the goodness-of-fit results and trend results
rddatatmp <- read.table(file, sep = "\t", stringsAsFactors = FALSE,
header = FALSE, skip = 1, nrows = 20)
# read 20 lines of each file skipping the first line as a table, there is no header
rownames(rddatatmp) <- as.character(rddatatmp[, 1])
# Source 7 / make the row names the current first column (station, Analysis, etc.)
rddatatmp <- as.data.frame(t(rddatatmp), stringsAsFactors = FALSE)
# Source 7 / transpose the rows and columns and make the data.frame out of
# characters rather than factors
rddatatmp <- setDT(rddatatmp[-1, ])
# transform the data.frame into a data.table and remove the first row
# changing columns to numeric class
# obtain the name of the column based on the column number
change_class1 <- names(rddatatmp[, c(7:15, 18:20), with = FALSE])
# name of all columns except column 1
for (col in change_class1) set(rddatatmp, j = col,
value = as.numeric(rddatatmp[[col]]))
# Source 6
# changing columns to numeric class
# obtain the name of the column based on the column number
change_class2 <- names(rddatatmp[, c(4:5, 16:17), with = FALSE])
# name of all columns except column 1
for (col in change_class2) set(rddatatmp, j = col,
value = as.integer(rddatatmp[[col]]))
# Source 6
# to obtain the exceedance probability values
rddatatmp2 <- fread(file, nrows = 1, skip = 1, header = FALSE)
# read in the 2nd line while skipping the first line with no header
getstationid <- stri_trim_both(rddatatmp2$V2, pattern = "\\P{Wspace}")
# obtain the station ID from rddatatmp and trim out any whitespace from both
# the left and right
rddatatmp3 <- fread(file, stringsAsFactors = FALSE, skip = 21,
colClasses = "character")
# read the same file in, but skip the first 21 lines. Read in as a data.table
rddatatmp3[, station := getstationid]
# create a new column with the station ID in the existing data.table
setcolorder(rddatatmp3, c(ncol(rddatatmp3), 1:(ncol(rddatatmp3)-1L)))
# move the station ID column to the beginning
# changing columns to numeric class
# obtain the name of the column based on the column number
change_class1 <- names(rddatatmp3[, 3:ncol(rddatatmp3), with = FALSE])
# name of all columns except column 1
for (col in change_class1) set(rddatatmp3, j = col,
value = as.numeric(rddatatmp3[[col]]))
# Source 6
# export the results
if (output == "csv") {
filesave1 <- tclvalue(tkgetSaveFile(title = paste0("Save goodness-of-fit and trend results", " ", stri_trans_toupper(basename(file_path_sans_ext(file))), " ", "file as"), filetypes = "{{Text file} .csv}"))
# Sources 3 & 4 / GUI file dialog to save the file
# Sources 11 & 12 / original file name minus the extension and path in uppercase
write.csv(rddatatmp, filesave1, row.names = FALSE)
# Write the table contained in rddatatmp and end with the .csv file extension
filesave2 <- tclvalue(tkgetSaveFile(title = paste0("Save exceedance probability values", " ", stri_trans_toupper(basename(file_path_sans_ext(file))), " ", "file as"), filetypes = "{{Text file} .csv}"))
# Sources 3 & 4 / GUI file dialog to save the file
# Sources 11 & 12 / original file name minus the extension and path in uppercase
write.csv(rddatatmp3, filesave2, row.names = FALSE)
# Write the table contained in rddatatmp3 and end with the .csv file extension
} else if (output == "xlsx") {
# create Microsoft Excel workbook
wb <- createWorkbook()
# use R package openxlsx to create the .xlsx spreadsheet
addWorksheet(wb, "Goodness-of-Fit_Trend Results")
# adds the worksheet with the name of Goodness-of-Fit and Trend Results
writeData(wb, "Goodness-of-Fit_Trend Results", rddatatmp)
# writes the data to the workbook
setColWidths(wb, sheet = 1, cols = 1:ncol(rddatatmp), widths = "auto")
addWorksheet(wb, "Exceedance Probability Values")
# adds the worksheet with the name of Exceedance Probability Values
writeData(wb, "Exceedance Probability Values", rddatatmp3)
# writes the data to the workbook
setColWidths(wb, sheet = 2, cols = 1:ncol(rddatatmp3), widths = "auto")
filesave3 <- tclvalue(tkgetSaveFile(title = paste0("Save", " ", stri_trans_toupper(basename(file_path_sans_ext(file))), " ", "file as"), filetypes = "{{MS Excel file} .xlsx}"))
# Sources 3 & 4 / GUI file dialog to save the spreadsheet
# Sources 11 & 12 / original file name minus the extension and path in uppercase
saveWorkbook(wb, filesave3, overwrite = overwrite)
} else if (output == "both") {
filesave3 <- tclvalue(tkgetSaveFile(title = paste0("Save goodness-of-fit and trend results", " ", stri_trans_toupper(basename(file_path_sans_ext(file))), " ", "file as"), filetypes = "{{Text file} .csv}"))
# Sources 3 & 4 / GUI file dialog to save the file
# Sources 11 & 12 / original file name minus the extension and path in uppercase
write.csv(rddatatmp, filesave3, row.names = FALSE)
# Write the table contained in rddatatmp and end with the .csv file extension
filesave4 <- tclvalue(tkgetSaveFile(title = paste0("Save exceedance probability values", " ", stri_trans_toupper(basename(file_path_sans_ext(file))), " ", "file as"), filetypes = "{{Text file} .csv}"))
# Sources 3 & 4 / GUI file dialog to save the file
# Sources 11 & 12 / original file name minus the extension and path in uppercase
write.csv(rddatatmp3, filesave4, row.names = FALSE)
# Write the table contained in rddatatmp3 and end with the .csv file extension
# create Microsoft Excel workbook
wb <- createWorkbook()
# use R package openxlsx to create the .xlsx spreadsheet
addWorksheet(wb, "Goodness-of-Fit_Trend Results")
# adds the worksheet with the name of Goodness-of-Fit and Trend Results
writeData(wb, "Goodness-of-Fit_Trend Results", rddatatmp)
# writes the data to the workbook
setColWidths(wb, sheet = 1, cols = 1:ncol(rddatatmp), widths = "auto")
addWorksheet(wb, "Exceedance Probability Values")
# adds the worksheet with the name of Exceedance Probability Values
writeData(wb, "Exceedance Probability Values", rddatatmp3)
# writes the data to the workbook
setColWidths(wb, sheet = 2, cols = 1:ncol(rddatatmp3), widths = "auto")
filesave5 <- tclvalue(tkgetSaveFile(title = paste0("Save", " ", stri_trans_toupper(basename(file_path_sans_ext(file))), " ", "file as"), filetypes = "{{MS Excel file} .xlsx}"))
# Sources 3 & 4 / GUI file dialog to save the spreadsheet
# Sources 11 & 12 / original file name minus the extension and path in uppercase
saveWorkbook(wb, filesave5, overwrite = overwrite)
}
}
}
}
} else {
for (i in 1:length(file)) { # Source 5
assert_that(testFileExists(file[i]), msg = "You did not choose a file. Please select a file again.")
# Source 1 / provide a stop warning if no file was selected
assert_that((file.info(file[i])$size != 0), msg = "Your file is empty. Please try again with a different file.")
# Sources 1 & 2 / only process non-empty files and provide a stop warning if the input file is empty
if (!nchar(file[i])) {
stop("You did not choose a file. Please try again with a different file.")
# Source 2 / provide a stop warning if no file was selected
} else {
confirm <- gconfirm(toolkit = guiToolkit("tcltk"), msg = paste0("Do you want to select", " ", file[i], "?"), title = "Confirm", icon = "question")
if (confirm == FALSE) {
stop("Please try again with a different file.")
# Source 2 / provide a stop warning if the user wants to change the file
} else {
if (file.info(file[i])$size == 0) {
stop("Your file is empty. Please try again with a different file.")
# Sources 1 & 2 / only process non-empty files and provide a stop warning if the input file is empty
} else {
rddatatmp <- vector("list", length(file))
# Source 8 and 9 / pre-allocate the list since it is being used in a for loop
rddatatmp2 <- vector("list", length(file))
# Source 8 and 9 / pre-allocate the list since it is being used in a for loop
rddatatmp3 <- vector("list", length(file))
# Source 8 and 9 / pre-allocate the list since it is being used in a for loop
getstationid <- vector("list", length(file))
# Source 8 and 9 / pre-allocate the list since it is being used in a for loop
# to obtain the goodness-of-fit results and trend results
# Source 5 begins
assign(file[i], read.table(file[i], sep = "\t", stringsAsFactors = FALSE, header = FALSE, skip = 1, nrows = 20))
# read the lines as a table
rddatatmp[[i]] <- assign(file[i], get(file[i]))
# Source 5 ends
rownames(rddatatmp[[i]]) <- as.character(rddatatmp[[i]][[1]])
# Source 7 / make the row names the current first column (station, Analysis, etc.)
rddatatmp[[i]] <- as.data.frame(t(rddatatmp[[i]]), stringsAsFactors = FALSE)
# Source 7 / transpose the rows and columns and make the data.frame out of characters rather than factors
rddatatmp[[i]] <- setDT(rddatatmp[[i]])
# transform the data.frame into a data.table
rddatatmp[[i]] <- rddatatmp[[i]][-1, ]
# remove the first row
dataas <- rbindlist(rddatatmp)
# the goodness-of-fit results and trend results
# changing columns to numeric class
# obtain the name of the column based on the column number
change_class1 <- names(dataas[, c(7:15, 18:20), with = FALSE])
# name of all columns except column 1
for (col in change_class1) set(dataas, j = col, value = as.numeric(dataas[[col]]))
# Source 6
# changing columns to numeric class
# obtain the name of the column based on the column number
change_class2 <- names(dataas[, c(4:5, 16:17), with = FALSE])
# name of all columns except column 1
for (col in change_class2) set(dataas, j = col, value = as.integer(dataas[[col]]))
# Source 6
# Source 5 begins
# to obtain the exceedance probability values
assign(file[i], fread(file[i], nrows = 1, skip = 1, header = FALSE))
# read the lines as a table
rddatatmp2[[i]] <- assign(file[i], get(file[i]))
# Source 5 ends
getstationid[[i]] <- stri_trim_both(rddatatmp2[[i]][[2]], pattern = "\\P{Wspace}")
# obtain the station ID from rddatatmp and trim out any whitespace from both the left and right
# Source 5 begins
assign(file[i], fread(file[i], stringsAsFactors = FALSE, skip = 21, colClasses = "character"))
# read the lines as a table
rddatatmp3[[i]] <- assign(file[i], get(file[i]))
# Source 5 ends
rddatatmp3[[i]][, station := getstationid[[i]]]
# create a new column with the station ID in the existing data.table
setcolorder(rddatatmp3[[i]], c(ncol(rddatatmp3[[i]]), 1:(ncol(rddatatmp3[[i]])-1L)))
# move the station ID column to the beginning
dataas2 <- rbindlist(rddatatmp3)
# the exceedance probability values
# changing columns to numeric class
# obtain the name of the column based on the column number
change_class1 <- names(dataas2[, 3:ncol(dataas2), with = FALSE])
# name of all columns except column 1
for (col in change_class1) set(dataas2, j = col, value = as.numeric(dataas2[[col]]))
# Source 6
# export the results
if (output == "csv") {
filesave1 <- tclvalue(tkgetSaveFile(title = paste0("Save goodness-of-fit and trend results", " ", stri_trans_toupper(basename(file_path_sans_ext(file[i]))), " ", "file as"), filetypes = "{{Text file} .csv}"))
# Sources 3 & 4 / GUI file dialog to save the file
# Sources 11 & 12 / original file name minus the extension and path in uppercase
write.csv(dataas, filesave1, row.names = FALSE)
# Write the table contained in dataas and end with the .csv file extension
filesave2 <- tclvalue(tkgetSaveFile(title = paste0("Save exceedance probability values", " ", stri_trans_toupper(basename(file_path_sans_ext(file[i]))), " ", "file as"), filetypes = "{{Text file} .csv}"))
# Sources 3 & 4 / GUI file dialog to save the file
# Sources 11 & 12 / original file name minus the extension and path in uppercase
write.csv(dataas2, filesave2, row.names = FALSE)
# Write the table contained in dataas2 and end with the .csv file extension
} else if (output == "xlsx") {
# create Microsoft Excel workbook
wb <- createWorkbook()
# use R package openxlsx to create the .xlsx spreadsheet
addWorksheet(wb, "Goodness-of-Fit_Trend Results")
# adds the worksheet with the name of Goodness-of-Fit and Trend Results
writeData(wb, "Goodness-of-Fit_Trend Results", dataas)
# writes the data to the workbook
setColWidths(wb, sheet = 1, cols = 1:ncol(dataas), widths = "auto")
addWorksheet(wb, "Exceedance Probability Values")
# adds the worksheet with the name of Exceedance Probability Values
writeData(wb, "Exceedance Probability Values", dataas2)
# writes the data to the workbook
setColWidths(wb, sheet = 2, cols = 1:ncol(dataas2), widths = "auto")
filesave3 <- tclvalue(tkgetSaveFile(title = paste0("Save", " ", stri_trans_toupper(basename(file_path_sans_ext(file[i]))), " ", "file as"), filetypes = "{{MS Excel file} .xlsx}"))
# Sources 3 & 4 / GUI file dialog to save the spreadsheet
# Sources 11 & 12 / original file name minus the extension and path in uppercase
saveWorkbook(wb, filesave3, overwrite = overwrite)
} else if (output == "both") {
filesave3 <- tclvalue(tkgetSaveFile(title = paste0("Save goodness-of-fit and trend results", " ", stri_trans_toupper(basename(file_path_sans_ext(file[i]))), " ", "file as"), filetypes = "{{Text file} .csv}"))
# Sources 3 & 4 / GUI file dialog to save the file
# Sources 11 & 12 / original file name minus the extension and path in uppercase
write.csv(dataas, filesave3, row.names = FALSE)
# Write the table contained in dataas and end with the .csv file extension
filesave4 <- tclvalue(tkgetSaveFile(title = paste0("Save exceedance probability values", " ", stri_trans_toupper(basename(file_path_sans_ext(file[i]))), " ", "file as"), filetypes = "{{Text file} .csv}"))
# Sources 3 & 4 / GUI file dialog to save the file
# Sources 11 & 12 / original file name minus the extension and path in uppercase
write.csv(dataas2, filesave4, row.names = FALSE)
# Write the table contained in dataas2 and end with the .csv file extension
# create Microsoft Excel workbook
wb <- createWorkbook()
# use R package openxlsx to create the .xlsx spreadsheet
addWorksheet(wb, "Goodness-of-Fit_Trend Results")
# adds the worksheet with the name of Goodness-of-Fit and Trend Results
writeData(wb, "Goodness-of-Fit_Trend Results", dataas)
# writes the data to the workbook
setColWidths(wb, sheet = 1, cols = 1:ncol(dataas), widths = "auto")
addWorksheet(wb, "Exceedance Probability Values")
# adds the worksheet with the name of Exceedance Probability Values
writeData(wb, "Exceedance Probability Values", dataas2)
# writes the data to the workbook
setColWidths(wb, sheet = 2, cols = 1:ncol(dataas2), widths = "auto")
filesave5 <- tclvalue(tkgetSaveFile(title = paste0("Save", " ", stri_trans_toupper(basename(file_path_sans_ext(file[i]))), " ", "file as"), filetypes = "{{MS Excel file} .xlsx}"))
# Sources 3 & 4 / GUI file dialog to save the spreadsheet
# Sources 11 & 12 / original file name minus the extension and path in uppercase
saveWorkbook(wb, filesave5, overwrite = overwrite)
}
}
}
}
}
}
}
#' @export
#' @rdname expFileOutput
expFileOutputBATCH <- function (path = tk_choose.dir(caption = "Select the directory with the .exp files"), output = c("csv", "xlsx", "both"), overwrite = TRUE) {
station <- NULL
# Source 10
overwrite <- overwrite
confirm <- gconfirm(toolkit = guiToolkit("tcltk"), msg = paste0("Do you want to select", " ", path, " as the directory with the .exp files?"), title = "Confirm", icon = "question")
if (confirm == FALSE) {
stop("Please try again with a different directory.")
# Source 2 / provide a stop warning if the user wants to change the directory
} else {
file <- list.files(path, pattern = "exp|EXP$", full.names = TRUE)
file <- file[stri_detect_fixed(file, ".exp", case_insensitive = TRUE)]
for (i in 1:length(file)) { # Source 5
assert_that(testFileExists(file[i]), msg = "You did not choose a file. Please select a file again.")
# Source 1 / provide a stop warning if no file was selected
assert_that((file.info(file[i])$size != 0), msg = "Your file is empty. Please try again with a different file.")
# Sources 1 & 2 / only process non-empty files and provide a stop warning if the input file is empty
if (!nchar(file[i])) {
stop("You did not choose a file. Please try again with a different file.")
# Source 2 / provide a stop warning if no file was selected
} else {
if (file.info(file[i])$size == 0) {
stop("Your file is empty. Please try again with a different file.")
# Sources 1 & 2 / only process non-empty files and provide a stop warning if the input file is empty
} else {
}
}
}
# to obtain the goodness-of-fit results and trend results
fun1 <- function(file) {
rddatatmp <- read.table(file, sep = "\t", stringsAsFactors = FALSE, header = FALSE, skip = 1, nrows = 20)
# read the lines as a table
rownames(rddatatmp) <- as.character(rddatatmp[[1]])
# Source 7 / make the row names the current first column (station, Analysis, etc.)
rddatatmp <- as.data.frame(t(rddatatmp), stringsAsFactors = FALSE)
# Source 7 / transpose the rows and columns and make the data.frame out of characters rather than factors
rddatatmp <- setDT(rddatatmp)
# transform the data.frame into a data.table
rddatatmp <- rddatatmp[-1, ]
# remove the first row
}
dataas <- rbindlist(lapply(file, fun1))
# the goodness-of-fit results and trend results
# to obtain the exceedance probability values
fun2 <- function(file) {
rddatatmp2 <- fread(file, nrows = 1, skip = 1, header = FALSE)
# read the lines as a table
getstationid <- stri_trim_both(rddatatmp2[[2]], pattern = "\\P{Wspace}")
# obtain the station ID from rddatatmp and trim out any whitespace from both the left and right
rddatatmp3 <- fread(file, stringsAsFactors = FALSE, skip = 21, colClasses = "character")
# read the lines as a table
rddatatmp3[, station := getstationid]
# create a new column with the station ID in the existing data.table
setcolorder(rddatatmp3, c(ncol(rddatatmp3), 1:(ncol(rddatatmp3)-1L)))
# move the station ID column to the beginning
}
dataas2 <- rbindlist(lapply(file, fun2))
# the exceedance probability values
# changing columns to numeric class
# obtain the name of the column based on the column number
change_class1 <- names(dataas[, c(7:15, 18:20), with = FALSE])
# name of all columns except column 1
for (col in change_class1) set(dataas, j = col, value = as.numeric(dataas[[col]]))
# Source 6
# changing columns to numeric class
# obtain the name of the column based on the column number
change_class2 <- names(dataas[, c(4:5, 16:17), with = FALSE])
# name of all columns except column 1
for (col in change_class2) set(dataas, j = col, value = as.integer(dataas[[col]]))
# Source 6
# changing columns to numeric class
# obtain the name of the column based on the column number
change_class1 <- names(dataas2[, 3:ncol(dataas2), with = FALSE])
# name of all columns except column 1
for (col in change_class1) set(dataas2, j = col, value = as.numeric(dataas2[[col]]))
# Source 6
# export the results
if (output == "csv") {
filesave1 <- tclvalue(tkgetSaveFile(title = "Save goodness-of-fit and trend results batch file as", filetypes = "{{Text file} .csv}"))
# Sources 3 & 4 / GUI file dialog to save the file
write.csv(dataas, filesave1, row.names = FALSE)
# Write the table contained in dataas and end with the .csv file extension
filesave2 <- tclvalue(tkgetSaveFile(title = "Save exceedance probability values batch file as", filetypes = "{{Text file} .csv}"))
# Sources 3 & 4 / GUI file dialog to save the file
write.csv(dataas2, filesave2, row.names = FALSE)
# Write the table contained in dataas2 and end with the .csv file extension
} else if (output == "xlsx") {
# create Microsoft Excel workbook
wb <- createWorkbook()
# use R package openxlsx to create the .xlsx spreadsheet
addWorksheet(wb, "Goodness-of-Fit_Trend Results")
# adds the worksheet with the name of Goodness-of-Fit and Trend Results
writeData(wb, "Goodness-of-Fit_Trend Results", dataas)
# writes the data to the workbook
setColWidths(wb, sheet = 1, cols = 1:ncol(dataas), widths = "auto")
addWorksheet(wb, "Exceedance Probability Values")
# adds the worksheet with the name of Exceedance Probability Values
writeData(wb, "Exceedance Probability Values", dataas2)
# writes the data to the workbook
setColWidths(wb, sheet = 2, cols = 1:ncol(dataas2), widths = "auto")
filesave3 <- tclvalue(tkgetSaveFile(title = "Save batch file as", filetypes = "{{MS Excel file} .xlsx}"))
# Sources 3 & 4 / GUI file dialog to save the spreadsheet
saveWorkbook(wb, filesave3, overwrite = overwrite)
} else if (output == "both") {
filesave3 <- tclvalue(tkgetSaveFile(title = "Save goodness-of-fit and trend results file as", filetypes = "{{Text file} .csv}"))
# Sources 3 & 4 / GUI file dialog to save the file
write.csv(dataas, filesave3, row.names = FALSE)
# Write the table contained in dataas and end with the .csv file extension
filesave4 <- tclvalue(tkgetSaveFile(title = "Save exceedance probability values file as", filetypes = "{{Text file} .csv}"))
# Sources 3 & 4 / GUI file dialog to save the file
write.csv(dataas2, filesave4, row.names = FALSE)
# Write the table contained in dataas2 and end with the .csv file extension
# create Microsoft Excel workbook
wb <- createWorkbook()
# use R package openxlsx to create the .xlsx spreadsheet
addWorksheet(wb, "Goodness-of-Fit_Trend Results")
# adds the worksheet with the name of Goodness-of-Fit and Trend Results
writeData(wb, "Goodness-of-Fit_Trend Results", dataas)
# writes the data to the workbook
setColWidths(wb, sheet = 1, cols = 1:ncol(dataas), widths = "auto")
addWorksheet(wb, "Exceedance Probability Values")
# adds the worksheet with the name of Exceedance Probability Values
writeData(wb, "Exceedance Probability Values", dataas2)
# writes the data to the workbook
setColWidths(wb, sheet = 2, cols = 1:ncol(dataas2), widths = "auto")
filesave5 <- tclvalue(tkgetSaveFile(title = "Save batch file as", filetypes = "{{MS Excel file} .xlsx}"))
# Sources 3 & 4 / GUI file dialog to save the spreadsheet
saveWorkbook(wb, filesave5, overwrite = overwrite)
}
}
}
Try the ie2misc package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.