Commit 5c3712d6 authored by Laura A DeCicco's avatar Laura A DeCicco
Browse files

Catching all columns as character

parent 783c003c
......@@ -158,48 +158,7 @@ importWQP <- function(obs_url, zip=TRUE, tz="UTC",
}
retval <- suppressWarnings(readr::read_delim(doc,
col_types = readr::cols(`ActivityStartTime/Time` = readr::col_character(),
`ActivityEndTime/Time` = readr::col_character(),
USGSPCode = readr::col_character(),
ResultCommentText = readr::col_character(),
ResultSampleFractionText = readr::col_character(),
ActivityDepthAltitudeReferencePointText = readr::col_character(),
ActivityConductingOrganizationText = readr::col_character(),
ActivityCommentText = readr::col_character(),
ResultWeightBasisText = readr::col_character(),
ResultTimeBasisText = readr::col_character(),
ResultParticleSizeBasis = readr::col_character(),
ResultDepthAltitudeReferencePointText = readr::col_character(),
ResultLaboratoryCommentText = readr::col_character(),
ResultTemperatureBasisText = readr::col_character(),
ResultDetectionConditionText = readr::col_character(),
ResultParticleSizeBasisText = readr::col_character(),
`ActivityDepthHeightMeasure/MeasureValue` = readr::col_number(),
`DetectionQuantitationLimitMeasure/MeasureValue` = readr::col_number(),
ResultMeasureValue = readr::col_character(),
`WellDepthMeasure/MeasureValue` = readr::col_number(),
`WellHoleDepthMeasure/MeasureValue` = readr::col_number(),
DetectionQuantitationLimitTypeName = readr::col_character(),
LaboratoryName = readr::col_character(),
MethodDescriptionText = readr::col_character(),
`ResultAnalyticalMethod/MethodName` = readr::col_character(),
`ResultAnalyticalMethod/MethodIdentifier` = readr::col_character(),
`ResultAnalyticalMethod/MethodIdentifierContext` = readr::col_character(),
SampleTissueAnatomyName = readr::col_character(),
SubjectTaxonomicName = readr::col_character(),
ResultDepthAltitudeReferencePointText = readr::col_character(),
`ResultDepthHeightMeasure/MeasureUnitCode` = readr::col_character(),
`DetectionQuantitationLimitMeasure/MeasureUnitCode` = readr::col_character(),
`HUCEightDigitCode` = readr::col_character(),
`ActivityEndTime/TimeZoneCode` = readr::col_character(),
`ResultAnalyticalMethod/MethodIdentifier` = readr::col_character(),
`ResultAnalyticalMethod/MethodIdentifierContext` = readr::col_character(),
ResultStatusIdentifier = readr::col_character(),
`SampleCollectionMethod/MethodIdentifier` = readr::col_character(),
`SampleCollectionMethod/MethodIdentifierContext` = readr::col_character(),
MonitoringLocationIdentifier = readr::col_character(),
ProjectIdentifier = readr::col_character(),
ActivityIdentifier = readr::col_character()),
col_types = readr::cols(.default = "c"),
quote = ifelse(csv,'\"',""),
delim = ifelse(csv,",","\t"),
guess_max = totalPossible))
......@@ -211,18 +170,24 @@ importWQP <- function(obs_url, zip=TRUE, tz="UTC",
warning("Number of rows returned not matched in header")
}
}
suppressWarnings({
val <- tryCatch(as.numeric(retval$ResultMeasureValue),
warning = function(w) w)
valueCols <- names(retval)[grep("MeasureValue", names(retval))]
countCols <- names(retval)[grep("Count", names(retval))]
yearCols <- names(retval)[grep("Year", names(retval))]
for(numberCol in unique(c(valueCols, countCols, yearCols))){
suppressWarnings({
val <- tryCatch(as.numeric(retval[[numberCol]]),
warning = function(w) w)
# we don't want to convert it to numeric if there are non-numeric chars
# If we leave it to the user, it will probably break a lot of code
if(!"warning" %in% class(val)){
retval[[numberCol]] <- val
}
})
}
# we don't want to convert it to numeric if there are non-numeric chars
# they often happen after readr has decided the column type if we left it to readr
# If we leave it to the user, it will probably break a lot of code
# If we bump up readr's guess_max...the computational time becomes really really long
if(!"warning" %in% class(val)){
retval$ResultMeasureValue <- val
}
})
if(length(grep("ActivityStartTime",names(retval))) > 0){
......
......@@ -146,8 +146,10 @@ readNWISdata <- function(..., asDateTime=TRUE,convertType=TRUE,tz="UTC"){
if(any(service %in% c("qw", "qwdata"))){
.Deprecated(old = "readNWISdata", package = "dataRetrieval",
new = "readWQPdata",
msg = "NWIS qw web services are being retired. Please see the vignette
'Changes to NWIS QW services' for more information.")
msg = "NWIS qw web services are being retired.
Please see vignette('qwdata_changes', package = 'dataRetrieval')
for more information.
https://cran.r-project.org/web/packages/dataRetrieval/vignettes/qwdata_changes.html")
}
values <- sapply(valuesList$values, function(x) URLencode(x))
......
......@@ -83,7 +83,10 @@ readNWISqw <- function (siteNumbers,parameterCd,startDate="",endDate="",
expanded=TRUE,reshape=FALSE,tz="UTC"){
.Deprecated(new = "readWQPqw", package = "dataRetrieval",
msg = "NWIS qw web services are being retired. Please see vignette('qwdata_changes', package = 'dataRetrieval') for more information.")
msg = "NWIS qw web services are being retired.
Please see vignette('qwdata_changes', package = 'dataRetrieval')
for more information.
https://cran.r-project.org/web/packages/dataRetrieval/vignettes/qwdata_changes.html")
pgrp <- c("INF", "PHY", "INM", "INN", "NUT", "MBI", "BIO", "IMM", "IMN", "TOX",
"OPE", "OPC", "OOT", "RAD", "XXX", "SED", "POP",
......
......@@ -223,31 +223,19 @@ readWQPdata <- function(..., querySummary=FALSE, tz="UTC",
attr(retval, "siteInfo") <- siteInfo
if(all(c("CharacteristicName","USGSPCode",
"ResultMeasure.MeasureUnitCode","ResultSampleFractionText") %in% names(retval))){
retvalVariableInfo <- retval[,c("CharacteristicName","USGSPCode",
"ResultMeasure.MeasureUnitCode","ResultSampleFractionText")]
if(all(c("CharacteristicName",
"ResultMeasure.MeasureUnitCode",
"ResultSampleFractionText") %in% names(retval))){
retvalVariableInfo <- retval[,c("CharacteristicName",
"ResultMeasure.MeasureUnitCode",
"ResultSampleFractionText")]
retvalVariableInfo <- unique(retvalVariableInfo)
variableInfo <- data.frame(characteristicName=retval$CharacteristicName,
parameterCd=retval$USGSPCode,
param_units=retval$ResultMeasure.MeasureUnitCode,
valueType=retval$ResultSampleFractionText,
stringsAsFactors=FALSE)
if(!anyNA(variableInfo$parameterCd)){
pcodes <- unique(variableInfo$parameterCd[!is.na(variableInfo$parameterCd)])
pcodes <- pcodes["" != pcodes]
paramINFO <- readNWISpCode(pcodes)
names(paramINFO)["parameter_cd" == names(paramINFO)] <- "parameterCd"
pCodeToName <- pCodeToName
varExtras <- pCodeToName[pCodeToName$parm_cd %in% unique(variableInfo$parameterCd[!is.na(variableInfo$parameterCd)]),]
names(varExtras)[names(varExtras) == "parm_cd"] <- "parameterCd"
variableInfo <- merge(variableInfo, varExtras, by="parameterCd", all = TRUE)
variableInfo <- merge(variableInfo, paramINFO, by="parameterCd", all = TRUE)
variableInfo <- unique(variableInfo)
}
attr(retval, "variableInfo") <- variableInfo
}
......
......@@ -60,6 +60,10 @@ readWQPdots <- function(...){
names(values)[names(values) == "countyCd"] <- "countycode"
if(all(c("countycode","statecode") %in% names(values))){
stCd <- gsub("US:", "", values["statecode"])
# This will error if more than 1 state is requested
# It's possible that someone could requst more than one state
# in WQP, but if they also then request county codes,
# it gets really confusing, and the WQP developers don't recommend.
values["countycode"] <- paste(values["statecode"],
countyCdLookup(stCd, values["countycode"], "id"),
sep=":")
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment