67 lines
6.1 KiB
R
67 lines
6.1 KiB
R
library(tidyverse)
|
|
library(janitor)
|
|
|
|
#Read the data files which include the current list of wells by subdistrict, to create indicator variables. This is the list of wells currently in the subdistrict using hydrobase search filter. Note that the time of entry is not found here and added later.
|
|
SBD_LINK <- rbind(read_csv("Data/SBD_Data/StructureList_SBD1.csv") %>% mutate(SBD=1),
|
|
read_csv("Data/SBD_Data/StructureList_SBD2.csv") %>% mutate(SBD=2),
|
|
read_csv("Data/SBD_Data/StructureList_SBD3.csv") %>% mutate(SBD=3),
|
|
read_csv("Data/SBD_Data/StructureList_SBD4.csv") %>% mutate(SBD=4),
|
|
read_csv("Data/SBD_Data/StructureList_SBD5.csv") %>% mutate(SBD=5),
|
|
read_csv("Data/SBD_Data/StructureList_SBD6.csv") %>% mutate(SBD=6)) %>% clean_names %>% mutate(wdid=as.character(wdid))
|
|
SBD_LINK <- SBD_LINK %>% pivot_wider(values_from=sbd,names_from=sbd,names_prefix="SBD") %>% replace(is.na(.), 0)
|
|
SBD_LINK[2:7][SBD_LINK[2:7]>0] <- 1
|
|
SBD1_WELLS <- SBD_LINK %>% select(wdid) %>% unique
|
|
############Data from each of the Annuall Replacement Plans or in the case of 2000 the Plan of Water Management. A list of wells in Subdistrict one was collected to create a time depdent indicator for being in SBD1.
|
|
SBD1_WELLS <- read_csv("Data/ARP/SBD1_Wells.csv")%>% group_by(wdid) %>% filter(year==min(year)) %>% mutate(wdid=as.character(wdid)) %>% rename(SBD1_year=year) %>% ungroup %>% inner_join(SBD1_WELLS)
|
|
SBD1_WELLS %>% group_by(SBD1_year) %>% summarize(n())
|
|
SBD1_WELLS %>% filter(wdid=='2706148')
|
|
######################Static Data
|
|
WELL_DATA <- read_csv("Data/Structure_Data/Structures_with_Diversions.csv")%>% clean_names() %>% mutate(wdid=as.character(wdid)) %>% select(wdid,contacts,latitude,longitude) #Start with well data
|
|
|
|
STATIC_DATA <- WELL_DATA%>% left_join(SBD1_WELLS) %>% left_join(SBD_LINK) %>% replace(is.na(.), 0) #Include subdistrict indicators
|
|
STATIC_DATA$SBD1_year <- ifelse(STATIC_DATA$SBD1_year==0,Inf,STATIC_DATA$SBD1_year )
|
|
STATIC_DATA <- STATIC_DATA %>% left_join(read_csv("Data/Output_Data/Ditch_Indicators.csv")%>% mutate(wdid=as.character(wdid)))%>% replace(is.na(.), 0)
|
|
|
|
STATIC_DATA <- STATIC_DATA%>% left_join(read_csv("Data/Output_Data/Crops_Before_2009.csv") %>% mutate(wdid=as.character(wdid))) #Add crop data
|
|
STATIC_DATA$CROPS_PRE_2009 <- ifelse(is.na(STATIC_DATA$per_alfalfa),0,1) #Make an indicator to tell if crops were grown in 2002 or 2005, or if not crop data was available.
|
|
STATIC_DATA <- STATIC_DATA %>% replace(is.na(.), 0)
|
|
SBD1_ORIG_WELLS <- STATIC_DATA %>% filter(SBD1_year==2009) %>% select(wdid,latitude,longitude)
|
|
write_csv(STATIC_DATA,"Data/Output_Data/Well_Level_Static_Data.csv")
|
|
write_csv(SBD1_ORIG_WELLS,"Data/Output_Data/Original_SBD1_Well_Location.csv")
|
|
#######Original Wells based on map
|
|
#This data comes from a manual map of SBD1 in 2009 made in QGIS. Wells are intersected with the hand drawn layer. The wells identified as being in the SBD1 region at this time should be assumed to have entered the subdistrict at the start of the program (2006 with first pumping data in 2009). This fixes the problem that some wells are identified as being in SBD1 in ARP reports but only because they were missed in earlier reports. It looks like most updated wells were missed due to category issues, such as not knowing the well was used for agriculture. This process should find most wells that were enrolled at the start, and later picked up so as to treat them as 2006/2009 wells instead of treating them as having entered in say 2016 or 2020 when they were first picked up by the SBD1 list.
|
|
SBD1_FROM_MAP <- read_csv("Data/SBD_Data/Intersect_SBD1_Area_Wells.csv")
|
|
SBD1_FROM_MAP <- SBD1_FROM_MAP %>% pull(WELL_ID) %>% unique
|
|
SBD1_FROM_MAP <- SBD1_FROM_MAP[(SBD1_FROM_MAP %in% (STATIC_DATA %>% filter(SBD1==1))$wdid )] #Remove any wells that are still not in SBD1. These were most likely picked up in error. For example if part of the parcel is in SBD1 but the well serves another parcel outside of the area, or because I drew the boundary too large.
|
|
|
|
STATIC_DATA[STATIC_DATA$wdid %in% SBD1_FROM_MAP ,"SBD1_year"] <- 2009
|
|
write_csv(STATIC_DATA,"Data/Output_Data/Well_Level_Static_Data.csv")
|
|
saveRDS(STATIC_DATA,"Data/Output_Data/Well_Level_Static_Data.rds")
|
|
|
|
|
|
###########Collect Pumping Data
|
|
LIST <- WELL_DATA %>% pull(wdid) %>% unique
|
|
ALL <- length(LIST )
|
|
|
|
if(file.exists("./Data/Output_Data/Div3_Pumping_Data.csv")){LIST <-LIST[-which(LIST %in% t(read.csv("./Data/Output_Data/Div3_Pumping_Data.csv")[,1] %>% unique))]}
|
|
CURRENT <- length(LIST )
|
|
|
|
WITH_API_KEY <- FALSE
|
|
for(C_WELL in LIST ){
|
|
if(WITH_API_KEY){try(C_DAT <- read_csv(paste0('https://dwr.state.co.us/Rest/GET/api/v2/structures/divrec/divrecyear/?format=csv&dateFormat=dateOnly&fields=wdid%2CdataMeasDate%2CdataValue&measUnits=ACFT&wcIdentifier=*Total+(Diversion)*&wdid=',C_WELL,'&apiKey=PwevUQJCStcYZfqrOYbuyztmNPlUJWby'),skip=2) %>% select(wdid,year=datameasuate,pumping=dataValue))} else{
|
|
try(C_DAT <- read_csv(paste0('https://dwr.state.co.us/Rest/GET/api/v2/structures/divrec/divrecyear/?format=csv&dateFormat=dateOnly&fields=wdid%2CdataMeasDate%2CdataValue&measUnits=ACFT&wcIdentifier=*Total+(Diversion)*&wdid=',C_WELL),skip=2) %>% select(wdid,year=dataMeasDate,pumping=dataValue))
|
|
}
|
|
if(exists("C_DAT")){ if(C_DAT[[1,1]]==C_WELL){write_csv(C_DAT,append=TRUE,file="./Data/Output_Data/Div3_Pumping_Data.csv")}}
|
|
#closeAllConnections()
|
|
}
|
|
PUMPING <- read_csv("./Data/Output_Data/Div3_Pumping_Data.csv") %>% unique %>% replace(is.na(.), 0)
|
|
|
|
if(colnames(PUMPING)[1]!='wdid'){PUMPING <- read_csv("./Data/Output_Data/Div3_Pumping_Data.csv",col_names=c("wdid","year","AF")) %>% unique} #See if the names were already added, or if they need renamed
|
|
POST_LIST <- PUMPING %>% pull(wdid) %>% unique
|
|
PUMPING$ROW <- 1:nrow(PUMPING)
|
|
PUMPING <- PUMPING %>% pivot_wider(values_from=AF,names_from=year)%>% group_by(wdid) %>% summarize(across(as.character(2009:2025),\(x) mean(x, na.rm = TRUE))) %>% pivot_longer(-wdid,names_to='year',values_to='AF') %>% mutate(wdid=as.character(wdid)) %>% unique #Pivot to add zeros when a year is missing data
|
|
write_csv(PUMPING,file="./Data/Output_Data/Div3_Pumping_Data.csv")
|
|
ALL_DATA <- PUMPING %>% left_join(STATIC_DATA) %>% clean_names()
|
|
write_csv(ALL_DATA,file="./Data/Output_Data/Full_Data_Set.csv")
|
|
|