Finished data collection. Cleaned up files
This commit is contained in:
Alex Gebben Work
parent
317520250b
commit
0ff9a90be1
34
1_Crop_Choice.r
Normal file
34
1_Crop_Choice.r
Normal file
@ -0,0 +1,34 @@
|
|||||||
|
library(tidyverse)
|
||||||
|
CROPS <- rbind(read_csv("Data/Crop_Choice/IRRIG_2002.csv"),read_csv("Data/Crop_Choice/IRRIG_2005.csv"))
|
||||||
|
DITCH_PARCEL <- CROPS[,c(4,11:19)] %>% pivot_longer(-PARCEL_ID,values_to="ditch") %>% filter(!is.na(ditch)) %>% select(-name)
|
||||||
|
WELL_PARCEL <- CROPS[,c(4,seq(21,80,by=3))] %>% pivot_longer(-PARCEL_ID,values_to="wdid") %>% filter(!is.na(wdid)) %>% select(-name)
|
||||||
|
WELL_DITCHES <- WELL_PARCEL %>% left_join(DITCH_PARCEL) %>% mutate(ditch=as.character(ditch))
|
||||||
|
NAMED_DITCHES <- (WELL_DITCHES %>% filter(!is.na(ditch)) %>% group_by(ditch) %>% summarize(size=n()) %>% arrange(desc(size)) )[1:10,] %>% pull(ditch)
|
||||||
|
WELL_DITCHES[!(WELL_DITCHES$ditch %in% NAMED_DITCHES) & !is.na(WELL_DITCHES$ditch) ,3] <- "Other"
|
||||||
|
WELL_DITCHES <- WELL_DITCHES[-which(duplicated(WELL_DITCHES)),]
|
||||||
|
WELL_DITCHES <- WELL_DITCHES %>% filter(!is.na(ditch),!is.na(wdid))
|
||||||
|
WELL_DITCHES$ROW_NUM <- 1:nrow(WELL_DITCHES)
|
||||||
|
WELL_DITCHES <- WELL_DITCHES %>% select(-PARCEL_ID) %>% unique %>% pivot_wider(values_from=ditch,names_from=ditch,names_prefix="ditch_")
|
||||||
|
WELL_DITCHES[,-1:-2][!is.na(WELL_DITCHES[,-1:-2])] <- '1'
|
||||||
|
WELL_DITCHES[,-1:-2][is.na(WELL_DITCHES[,-1:-2])] <- '0'
|
||||||
|
WELL_DITCHES <- WELL_DITCHES %>% mutate_if(is.character,as.numeric) %>% select(-ROW_NUM) %>% unique
|
||||||
|
WELL_DITCHES <- WELL_DITCHES %>% group_by(wdid) %>% mutate(across(colnames(WELL_DITCHES)[2:12], max, na.rm = TRUE)) %>% ungroup %>% unique
|
||||||
|
dir.create("Data/Output_Data",showWarnings=FALSE)
|
||||||
|
write_csv(WELL_DITCHES,"Data/Output_Data/Ditch_Indicators.csv")
|
||||||
|
###########Determine what percentage of land supplied by a well goes to each crop, across 2002 and 2005
|
||||||
|
CROP <- CROPS %>% select(CAL_YEAR,PARCEL_ID,ACRES,CROP_TYPE)
|
||||||
|
CROP$CROP_TYPE <- ifelse(CROP$CROP_TYPE=='WHEAT_FALL','SMALL_GRAINS',CROP$CROP_TYPE)
|
||||||
|
CROP$CROP_TYPE <- ifelse(CROP$CROP_TYPE=='NEW_ALFALFA','ALFALFA',CROP$CROP_TYPE)
|
||||||
|
CROP$CROP_TYPE <- ifelse(CROP$CROP_TYPE %in% c('COVER_CROP','VEGETABLES'),'OTHER',CROP$CROP_TYPE)
|
||||||
|
|
||||||
|
CROP_2002 <- WELL_PARCEL %>% left_join(CROP %>% filter(CAL_YEAR==2002))%>% filter(!is.na(CROP_TYPE)) %>% unique
|
||||||
|
CROP_2005 <- WELL_PARCEL %>% left_join(CROP %>% filter(CAL_YEAR==2005))%>% filter(!is.na(CROP_TYPE)) %>% unique
|
||||||
|
|
||||||
|
CROP_2002 <- CROP_2002 %>% group_by(wdid,CROP_TYPE,CAL_YEAR) %>% summarize(ACRES=sum(ACRES)) %>% group_by(wdid,CAL_YEAR) %>% mutate(PERCENT=ACRES/sum(ACRES)) %>% arrange(wdid) %>% ungroup %>% select(-ACRES) %>% pivot_wider(values_from=PERCENT,names_from=CROP_TYPE,names_prefix="PER_") %>% replace(is.na(.), 0)
|
||||||
|
CROP_2005 <- CROP_2005 %>% group_by(wdid,CROP_TYPE,CAL_YEAR) %>% summarize(ACRES=sum(ACRES)) %>% group_by(wdid,CAL_YEAR) %>% mutate(PERCENT=ACRES/sum(ACRES)) %>% arrange(wdid) %>% ungroup %>% select(-ACRES) %>% pivot_wider(values_from=PERCENT,names_from=CROP_TYPE,names_prefix="PER_") %>% replace(is.na(.), 0)
|
||||||
|
PRE_2009_CROPS <- full_join(CROP_2002 %>% select(-CAL_YEAR) ,CROP_2005 %>% select(-CAL_YEAR)) %>% group_by(wdid) %>% summarize(across(colnames(CROP_2002)[3:7], mean, na.rm = TRUE))
|
||||||
|
PRE_2009_CROPS <- PRE_2009_CROPS %>% clean_names()
|
||||||
|
write_csv(PRE_2009_CROPS ,"Data/Output_Data/Crops_Before_2009.csv")
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
318
1_Data_Proc.r
318
1_Data_Proc.r
@ -1,318 +0,0 @@
|
|||||||
library(tidyverse)
|
|
||||||
library(fixest)
|
|
||||||
library(janitor)
|
|
||||||
###########
|
|
||||||
CROP_LEGAL <- read_csv("Data/Created/Crop_Legal_Int.csv") %>% clean_names() %>% select(-fid,-fid_2,-div,-district,-master_id,-master_id_2,-polygon_id,-shape_area,-int_area,-comments,-district_2,-path,-comments_2,-shape_leng_2,-shape_area_2,-master_id_2,-gwzone_2,-comments_2,-shape_leng_2,shape_area_2,-path)
|
|
||||||
#From hydrobase Water Rights -Net Amounts search, in Div 3 and for IRRIGATION
|
|
||||||
#https://dwr.state.co.us/Tools/WaterRights/NetAmounts?submitButton=Submit&SelectedGeoValue=waterDivisionDiv&SelectedWaterDivisionId=3&SelectedStructureId=2&SelectedUsageTypeId=1
|
|
||||||
WATER_RIGHTS <- read_csv("Data/Downloaded/CDSS_WaterRights_NetAmounts_Search_202604031353.csv") %>% clean_names()
|
|
||||||
#WATER_RIGHTS %>% filter(wdid=='2013695') %>% select(net_apex_absolute,net_apex_conditional,net_absolute,net_conditional,seasonal_limits)
|
|
||||||
|
|
||||||
|
|
||||||
WATER_RIGHTS <- WATER_RIGHTS %>% mutate(rights_absolute=ifelse(net_absolute>net_conditional,net_absolute,net_conditional),rights_apex=ifelse(net_apex_absolute>net_apex_conditional,net_apex_absolute,net_apex_conditional) ) %>% filter(decreed_units=='C')
|
|
||||||
WATER_RIGHTS <-WATER_RIGHTS %>% mutate(adjudication_date=year(as.POSIXct(adjudication_date, format="%m/%d/%Y %I:%M:%S %p")),previous_adj_date=year(as.POSIXct(previous_adj_date, format="%m/%d/%Y %I:%M:%S %p")))
|
|
||||||
|
|
||||||
WATER_RIGHTS <- WATER_RIGHTS %>% select(wdid,rights_absolute,rights_apex,adjudication_date,previous_adj_date)
|
|
||||||
WATER_RIGHTS %>% mutate(cal_year=ifelse(adjudication_date<=2002,2002,NA)) %>% filter(!is.na(cal_year)) %>% group_by(wdid,cal_year) %>% summarize(rights_absolute=sum(rights_absolute),rights_apex=sum(rights_apex)) %>% ungroup
|
|
||||||
CROP_LEGAL
|
|
||||||
PARCEL_YEAR_WDID <- CROP_LEGAL %>% select(parcel_id,cal_year,gw_id1,gw_id2,gw_id3,gw_id4,gw_id5,gw_id6,gw_id7,gw_id8,gw_id9,gw_id10,gw_id11,gw_id12,gw_id13,gw_id14,gw_id15,gw_id16,gw_id17,gw_id18,gw_id19,gw_id20) %>% pivot_longer(-c("parcel_id","cal_year"),values_to="wdid") %>% select(-name) %>% filter(!is.na(wdid))
|
|
||||||
WELL_LIST <- PARCEL_YEAR_WDID %>% pull(wdid) %>% unique
|
|
||||||
WATER_RIGHTS <- WATER_RIGHTS %>% filter(wdid %in% WELL_LIST)
|
|
||||||
WATER_RIGHTS
|
|
||||||
WATER_RIGHTS %>% group_by(wdid) %>% summarize(rights_absolute=sum(rights_absolute),rights_apex=sum(rights_apex)) %>% filter(rights_absolute==0,rights_apex==0)
|
|
||||||
|
|
||||||
WATER_RIGHTS %>% filter(rights_absolute==0,rights_apex==0)
|
|
||||||
read_csv("https://dwr.state.co.us/Rest/GET/api/v2/waterrights/transaction/?format=csv&wdid=2005165",skip=2)
|
|
||||||
WATER_RIGHTS %>% filter(wdid=='2013695')
|
|
||||||
WATER_RIGHTS
|
|
||||||
|
|
||||||
WATER_RIGHTS %>% select(wdid,rights_absolute,rights_apex) %>% filter(rights_absolute==0,rights_apex==0)
|
|
||||||
WATER_RIGHTS %>% filter(wdid=='2013695')%>% select(wdid,rights_absolute,rights_apex)
|
|
||||||
WATER_RIGHTS %>% group_by(wdid) %>% mutate(total=sum(rights_absolute)+sum(rights_apex)) %>% filter(total==0) %>% arrange(wdid)
|
|
||||||
TRANSACT <- 'https://dwr.state.co.us/Rest/GET/api/v2/waterrights/transaction/?format=csv&division=3&pageSize=500000+&apiKey=PwevUQJCStcYZfqrOYbuyztmNPlUJWby'
|
|
||||||
TRANSACT <- read_csv(TRANSACT,skip=2)
|
|
||||||
colnames(TRANSACT )
|
|
||||||
TEMP <- TRANSACT %>% select(WaterRightNum,wdid,associatedWdid,planWdid,adjudicationDate,appropriationDate,totalVolumetricLimit,maxDecreedRate,comments,moreInformation)
|
|
||||||
TEMP %>% filter(wdid=='2005005')
|
|
||||||
TEMP %>% filter(WaterRightNum=='99984')
|
|
||||||
%>% filter(
|
|
||||||
WATER_RIGHTS
|
|
||||||
WATER_RIGHTS %>% select(rights_absolute,rights_apex)
|
|
||||||
WATER_RIGHTS
|
|
||||||
|
|
||||||
WATER_RIGHTS <- WATER_RIGHTS %>% select(wdid,rights,previous_adj_date,adjudication_date) %>% mutate(adjudication_date=year(as.POSIXct(adjudication_date, format="%m/%d/%Y %I:%M:%S %p")),previous_adj_date=year(as.POSIXct(adjudication_date, format="%m/%d/%Y %I:%M:%S %p")))
|
|
||||||
WATER_RIGHTS %>% filter(adjudication_date>2002) %>% print(n=100)
|
|
||||||
|
|
||||||
|
|
||||||
WATER_RIGHTS %>% filter(wdid==2013837) %>% select(decreed_units,adjudication_date)
|
|
||||||
WATER_RIGHTS %>% group_by(decreed_units) %>% summarize(n())
|
|
||||||
|
|
||||||
|
|
||||||
CROP_LEGAL %>% select(farm_unit_2) %>% group_by(farm_unit_2) %>% summarize(n())
|
|
||||||
CROP_LEGAL %>% select(farm_unit_2) %>% unique
|
|
||||||
colnames(CROP_LEGAL )
|
|
||||||
nrow(CROP_LEGAL)-nrow(TEST
|
|
||||||
TEST <- CROP_LEGAL %>% group_by(parcel_id) %>% filter(calc_area==max(calc_area)) %>% ungroup
|
|
||||||
TEST %>% group_by(cal_year) %>% summarize(n())
|
|
||||||
CROP_LEGAL %>% select(layer) %>% gsub(" Parcels","")
|
|
||||||
CROP_LEGAL %>% filter(name=='3-200004-0')
|
|
||||||
/home/alex/Git/Publications/CREP_Policy_Map/Data/Processed
|
|
||||||
CROP_LEGAL %>% group_by(parcel_id) %>% filter(calc_area==max(calc_area)) %>% ungroup
|
|
||||||
read_csv("Data/Input_Data/CROPS.csv")
|
|
||||||
|
|
||||||
#function "i" needed for a factor
|
|
||||||
crop <- read_csv("./Data/Input_Data/CROPS.csv",col_types = cols(PARCEL_ID=col_character(),SW_WDID1=col_character(),SW_WDID2=col_character(),SW_WDID3=col_character(),SW_WDID4=col_character(),SW_WDID5=col_character(),GW_ID1=col_character(),GW_ID2=col_character(),GW_ID3=col_character(),GW_ID4=col_character(),GW_ID5=col_character(),GW_ID6=col_character(),GW_ID7=col_character(),GW_ID6=col_character(),GW_CLASS6=col_character(),GW_ID7=col_character(),GW_CLASS7=col_character(),GW_CLASS1=col_character(),GW_CLASS2 =col_character(),GW_CLASS3 =col_character(),GW_CLASS4 =col_character(),GW_CLASS5 =col_character(),GW_CLASS6 =col_character(),GW_CLASS7 =col_character() )) %>% select(PARCEL_ID,Year=CAL_YEAR,CROP_TYPE,IRR_TY=IRRIG_TYPE,CROP_AREA,GW_ID1,GW_ID2,GW_ID3,GW_ID4,GW_ID5,GW_ID6,GW_ID7,SW_WDID1,SW_WDID2,SW_WDID3,SW_WDID4,SW_WDID5)
|
|
||||||
|
|
||||||
crop$IRR_TY <- ifelse(crop$IRR_TY=='FLOOD','F','S')
|
|
||||||
|
|
||||||
crop$CROP_TYPE <- ifelse(crop$CROP_TYPE=="NEW_ALFALFA","ALFALFA",crop$CROP_TYPE)
|
|
||||||
crop$CROP_TYPE <- ifelse(crop$CROP_TYPE=="BARLEY","SMALL_GRAINS",crop$CROP_TYPE)
|
|
||||||
#blue grass, cover crop, sorghum grain, vegetables, wheat, fall wheat, spring wheat, and corn.
|
|
||||||
crop$CROP_TYPE <- ifelse(crop$CROP_TYPE=="COVER_CROP","OTHER",crop$CROP_TYPE)
|
|
||||||
crop$CROP_TYPE <- ifelse(crop$CROP_TYPE=="VEGETABLES","OTHER",crop$CROP_TYPE)
|
|
||||||
crop$CROP_TYPE <- ifelse(crop$CROP_TYPE=="SORGHUM_GRAIN","OTHER",crop$CROP_TYPE)
|
|
||||||
crop$CROP_TYPE <- ifelse(crop$CROP_TYPE=="WHEAT","OTHER",crop$CROP_TYPE)
|
|
||||||
crop$CROP_TYPE <- ifelse(crop$CROP_TYPE=="WHEAT_FALL","OTHER",crop$CROP_TYPE)
|
|
||||||
crop$CROP_TYPE <- ifelse(crop$CROP_TYPE=="WHEAT_SPRING","OTHER",crop$CROP_TYPE)
|
|
||||||
crop$CROP_TYPE <- ifelse(crop$CROP_TYPE=="CORN","OTHER",crop$CROP_TYPE)
|
|
||||||
crop$CROP_TYPE <- ifelse(crop$CROP_TYPE=="","OTHER",crop$CROP_TYPE)
|
|
||||||
crop$POT <- ifelse(crop$CROP_TYPE=="POTATOES",crop$CROP_AREA,0)
|
|
||||||
crop$SG<- ifelse(crop$CROP_TYPE=="SMALL_GRAINS",crop$CROP_AREA,0)
|
|
||||||
crop$ALF <- ifelse(crop$CROP_TYPE=="ALFALFA",crop$CROP_AREA,0)
|
|
||||||
crop$OT <- ifelse(crop$CROP_TYPE=="OTHER",crop$CROP_AREA,0)
|
|
||||||
crop$GP <- ifelse(crop$CROP_TYPE=="GRASS_PASTURE",crop$CROP_AREA,0)
|
|
||||||
|
|
||||||
SW_LIST <- crop %>% group_by(SW_WDID1) %>% filter(!is.na(SW_WDID1)) %>% summarize(num=n()) %>% arrange(desc(num)) %>% slice(1:10) %>% pull(SW_WDID1)
|
|
||||||
SW_COL <- paste0("SW_",SW_LIST)
|
|
||||||
SW_DUM <- function(X){
|
|
||||||
return(ifelse(crop$SW_WDID1 %in% X | crop$SW_WDID2 %in% X | crop$SW_WDID3 %in% X | crop$SW_WDID3 %in% X | crop$SW_WDID5 %in% X,1,0))
|
|
||||||
}
|
|
||||||
crop$SW_2000812 <- SW_DUM(SW_LIST[1])
|
|
||||||
crop$SW_2000623 <- SW_DUM(SW_LIST[2])
|
|
||||||
crop$SW_2000631 <- SW_DUM(SW_LIST[3])
|
|
||||||
crop$SW_2000753 <- SW_DUM(SW_LIST[4])
|
|
||||||
crop$SW_2200593 <- SW_DUM(SW_LIST[5])
|
|
||||||
crop$SW_3500570 <- SW_DUM(SW_LIST[6])
|
|
||||||
crop$SW_2000829 <- SW_DUM(SW_LIST[7])
|
|
||||||
crop$SW_2000798 <- SW_DUM(SW_LIST[8])
|
|
||||||
crop$SW_2100521 <- SW_DUM(SW_LIST[9])
|
|
||||||
crop$SW_2200541 <- SW_DUM(SW_LIST[10])
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
wells <- read_rds("./Data/Input_Data/Well_Pumping.rds")
|
|
||||||
mt <- crop %>% select(PARCEL_ID,Year=Year,wdid=GW_ID1,all_of(SW_COL)) %>% distinct
|
|
||||||
m1 <- wells %>% inner_join(mt,multiple="all")
|
|
||||||
mt <- crop %>% select(PARCEL_ID,Year=Year,wdid=GW_ID2,all_of(SW_COL)) %>% distinct
|
|
||||||
m2 <- wells %>% inner_join(mt,multiple="all")
|
|
||||||
mt <- crop %>% select(PARCEL_ID,Year=Year,wdid=GW_ID3,all_of(SW_COL)) %>% distinct
|
|
||||||
m3 <- wells %>% inner_join(mt,multiple="all")
|
|
||||||
mt <- crop %>% select(PARCEL_ID,Year=Year,wdid=GW_ID4,all_of(SW_COL)) %>% distinct
|
|
||||||
m4 <- wells %>% inner_join(mt,multiple="all")
|
|
||||||
mt <- crop %>% select(PARCEL_ID,Year=Year,wdid=GW_ID5,all_of(SW_COL)) %>% distinct
|
|
||||||
m5 <- wells %>% inner_join(mt,multiple="all")
|
|
||||||
mt <- crop %>% select(PARCEL_ID,Year=Year,wdid=GW_ID6,all_of(SW_COL)) %>% distinct
|
|
||||||
m6 <- wells %>% inner_join(mt,multiple="all")
|
|
||||||
mt <- crop %>% select(PARCEL_ID,Year=Year,wdid=GW_ID7,all_of(SW_COL)) %>% distinct
|
|
||||||
m7 <- wells %>% inner_join(mt,multiple="all")
|
|
||||||
m <- rbind(m1,m2,m3,m4,m5,m6,m7) %>% rename(GW_wdid=wdid)
|
|
||||||
|
|
||||||
crop <- crop %>% select(PARCEL_ID,Year,CROP_TYPE,CROP_AREA,IRR_TY,POT,SG,ALF,GP,OT)
|
|
||||||
#Crep
|
|
||||||
|
|
||||||
CREP_PERM_2014 <- c(2013956,2005950,2005951,2005955,2014091,2006322,2006321,2014092, 2006327,2006328,2006325,2006326,2006332,2006331,2006684,2006685,2006686,2014274,2014107,2005512,2005448)
|
|
||||||
CREP_PERM_2015 <- c(2005098,2008177,2008178,2013955,2006005,2006656,2005171,2006655,2006323,2006324,2014088,2008223,2008224,2008225,2014054,2705248)
|
|
||||||
CREP_PERM_2016 <- c(2005476,2005537,2005538,2014266,2005769,2005770,2005771,2014270,2005766,2005767,2005768,2014267,2014268,2008439,2008440,2208441,2009992,2009197,2014045,2014046,2006003,2006004,2006653,2006654,2014311,2005952,2005953,2005954,2005121,2008772)
|
|
||||||
CREP_PERM_2018 <- c(2014309,2006334,2014080,2006333,2006337,2006338,2014081,2014082)
|
|
||||||
CREP_PERM_2020 <- c(2010499,2010500,2013906,2014178,2006528,2006529,2014189,2009110,2008239,2705472)
|
|
||||||
CREP_PERM_2021 <- c(2008146,2008147,2013953,2005665,2005664,2005666,2005662,2005663,2010786,2010787,2008389,2014023)
|
|
||||||
CREP_PERM_2014 <- cbind(CREP_PERM_2014,rep(2014,length(CREP_PERM_2014)),rep(1,length(CREP_PERM_2014)))
|
|
||||||
CREP_PERM_2015 <- cbind(CREP_PERM_2015,rep(2015,length(CREP_PERM_2015)),rep(1,length(CREP_PERM_2015)))
|
|
||||||
CREP_PERM_2016 <- cbind(CREP_PERM_2016,rep(2016,length(CREP_PERM_2016)),rep(1,length(CREP_PERM_2016)))
|
|
||||||
CREP_PERM_2018 <- cbind(CREP_PERM_2018,rep(2018,length(CREP_PERM_2018)),rep(1,length(CREP_PERM_2018)))
|
|
||||||
CREP_PERM_2020 <- cbind(CREP_PERM_2020,rep(2020,length(CREP_PERM_2020)),rep(1,length(CREP_PERM_2020)))
|
|
||||||
CREP_PERM_2021 <- cbind(CREP_PERM_2021,rep(2021,length(CREP_PERM_2021)),rep(1,length(CREP_PERM_2021)))
|
|
||||||
|
|
||||||
CREP_PERM <- rbind(CREP_PERM_2014,CREP_PERM_2015,CREP_PERM_2016,CREP_PERM_2018,CREP_PERM_2020,CREP_PERM_2021)
|
|
||||||
colnames(CREP_PERM) <- c("GW_wdid","CREP_Year","PERM_CREP")
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
CREP_TEMP_2014 <- c(2005642,2005643,2014474,2006153,2013962,2006478,2008677,2008678,2012887,2005857,2008391,2705126,2705519,2706148,2705342,2706196,2705341,2706195)
|
|
||||||
CREP_TEMP_2015 <- c(2008155,2008156,2008129,2008130,2014244,2005921,2005941,2006283,2006525,2006335,2006336,2014086,2014087,2705318,2012537,2014288,2706253,2705317,2705186,2705328,2705054)
|
|
||||||
CREP_TEMP_2016 <- c(2005133,2005533,2005886,2005868,2005595,2013377,2013618,2706014,2706246)
|
|
||||||
CREP_TEMP_2017 <- c(2009113,2705344,2705067,2705068,2705523,2705069,2705070)
|
|
||||||
CREP_TEMP_2018 <- c(2005774,2005775,2705293,2705290,2705224,2705225,2705225,2705224,2705197,2705359,2705246,2706237,2705006,2705790,2705184,2705185,2705356,2705327)
|
|
||||||
CREP_TEMP_2019 <- c(2006376,2006375,2005127,2005168,2013784,2705259,2705021,2705020,2706194)
|
|
||||||
CREP_TEMP_2020 <- c(2705347,2706258)
|
|
||||||
CREP_TEMP_2022 <- c(2006678,2006679,2005923,2005116)
|
|
||||||
CREP_TEMP_2023 <- c(2009084,2009082,2013887,2009940,2013577,2005038,2010590,2014490,2705247,2705080)
|
|
||||||
|
|
||||||
CREP_TEMP_2014 <- cbind(CREP_TEMP_2014,rep(2014,length(CREP_TEMP_2014)),rep(0,length(CREP_TEMP_2014)))
|
|
||||||
CREP_TEMP_2015 <- cbind(CREP_TEMP_2015,rep(2015,length(CREP_TEMP_2015)),rep(0,length(CREP_TEMP_2015)))
|
|
||||||
CREP_TEMP_2016 <- cbind(CREP_TEMP_2016,rep(2016,length(CREP_TEMP_2016)),rep(0,length(CREP_TEMP_2016)))
|
|
||||||
CREP_TEMP_2017 <- cbind(CREP_TEMP_2017,rep(2017,length(CREP_TEMP_2017)),rep(0,length(CREP_TEMP_2017)))
|
|
||||||
CREP_TEMP_2018 <- cbind(CREP_TEMP_2018,rep(2018,length(CREP_TEMP_2018)),rep(0,length(CREP_TEMP_2018)))
|
|
||||||
CREP_TEMP_2019 <- cbind(CREP_TEMP_2019,rep(2019,length(CREP_TEMP_2019)),rep(0,length(CREP_TEMP_2019)))
|
|
||||||
CREP_TEMP_2020 <- cbind(CREP_TEMP_2020,rep(2020,length(CREP_TEMP_2020)),rep(0,length(CREP_TEMP_2020)))
|
|
||||||
#CREP_TEMP_2022 <- cbind(CREP_TEMP_2022,rep(2022,length(CREP_TEMP_2022)),rep(0,length(CREP_TEMP_2022)))
|
|
||||||
#CREP_TEMP_2023 <- cbind(CREP_TEMP_2023,rep(2023,length(CREP_TEMP_2023)),rep(0,length(CREP_TEMP_2023)))
|
|
||||||
CREP_TEMP <- rbind(CREP_TEMP_2014,CREP_TEMP_2015,CREP_TEMP_2016,CREP_TEMP_2017,CREP_TEMP_2018,CREP_TEMP_2019,CREP_TEMP_2020)
|
|
||||||
colnames(CREP_TEMP) <- c("GW_wdid","CREP_Year","PERM_CREP")
|
|
||||||
IN_CREP <- rbind(CREP_TEMP,CREP_PERM) %>% as_tibble %>% mutate(GW_wdid=as.character(GW_wdid))
|
|
||||||
|
|
||||||
FALL_2020 <- c(2013693,2005731,2013884,2706159,2705471,2705395,2705517)
|
|
||||||
FALL_2020 <- cbind(FALL_2020,rep(2020,length(FALL_2020)),rep(1,length(FALL_2020)))
|
|
||||||
FALL_2021 <- c(2008226,2014273,2008591,2009461,2009462,2009114,2010568,2005035,2014173)
|
|
||||||
FALL_2021 <- cbind(FALL_2021,rep(2021,length(FALL_2021)),rep(1,length(FALL_2021)))
|
|
||||||
FALL_PROG <- rbind(FALL_2020,FALL_2021) %>% as_tibble
|
|
||||||
colnames(FALL_PROG) <- c("GW_wdid","FALL_PROG_YEAR","FALL_PROG")
|
|
||||||
|
|
||||||
#Legal Parcel
|
|
||||||
LP <- read_csv("./Data/Input_Data/LEGAL.csv") %>% rename(County=Layer) %>% select(-fid)
|
|
||||||
LP$County <- ifelse(is.na(LP$County),"Saguache",LP$County)
|
|
||||||
LP$County<- ifelse(LP$County=="Saguache",'SG',LP$County)
|
|
||||||
LP$County<- ifelse(LP$County=="Saguache Parcels",'SG',LP$County)
|
|
||||||
LP$County<- ifelse(LP$County=="Alamosa Parcels",'AL',LP$County)
|
|
||||||
LP$County <- ifelse(LP$County=="Rio Grande Parcels",'RG',LP$County)
|
|
||||||
LP$County <- ifelse(LP$County=="Conejos Parcels",'CN',LP$County)
|
|
||||||
#Crop to Legal Parcel
|
|
||||||
CL <- read_csv("./Data/Input_Data/CROP_LEGAL.csv",col_types=cols(PARCEL_ID=col_character())) %>% select(Name,PARCEL_ID,Year=CAL_YEAR)
|
|
||||||
|
|
||||||
|
|
||||||
SL <- read_csv("Data/Input_Data/SBD_LEGAL.csv")
|
|
||||||
SL$SBD1 <- ifelse(SL$SBD==1,1,0)
|
|
||||||
SL$SBD2 <- ifelse(SL$SBD==2,1,0)
|
|
||||||
SL$SBD3 <- ifelse(SL$SBD==3,1,0)
|
|
||||||
SL$SBD4 <- ifelse(SL$SBD==4,1,0)
|
|
||||||
SL$SBD5 <- ifelse(SL$SBD==5,1,0)
|
|
||||||
SL$SBD6 <- ifelse(SL$SBD==6,1,0)
|
|
||||||
SL <- SL %>% select(-SBD) %>% group_by(Name) %>% mutate(SBD1=max(SBD1),SBD2=max(SBD2),SBD3=max(SBD3),SBD4=max(SBD4),SBD5=max(SBD5),SBD6=max(SBD6)) %>% distinct
|
|
||||||
SL <- LP %>% select(Name) %>% distinct %>% left_join(SL) %>% mutate(across(everything(), ~replace_na(.x, 0)))
|
|
||||||
LP <- LP %>% left_join(SL)
|
|
||||||
|
|
||||||
CS <- read_csv("Data/Input_Data/SBD_CROP.csv",col_types=cols(PARCEL_ID=col_character())) %>% rename(Year=CAL_YEAR) %>% distinct
|
|
||||||
CS$SBD1 <- ifelse(CS$SBD==1,1,0)
|
|
||||||
CS$SBD2 <- ifelse(CS$SBD==2,1,0)
|
|
||||||
CS$SBD3 <- ifelse(CS$SBD==3,1,0)
|
|
||||||
CS$SBD4 <- ifelse(CS$SBD==4,1,0)
|
|
||||||
CS$SBD5 <- ifelse(CS$SBD==5,1,0)
|
|
||||||
CS$SBD6 <- ifelse(CS$SBD==6,1,0)
|
|
||||||
CS <- CS %>% select(-SBD) %>% group_by(PARCEL_ID,Year) %>% mutate(SBD1=max(SBD1),SBD2=max(SBD2),SBD3=max(SBD3),SBD4=max(SBD4),SBD5=max(SBD5),SBD6=max(SBD6)) %>% distinct
|
|
||||||
CS <- crop %>% select(PARCEL_ID,Year) %>% left_join(CS) %>% mutate(across(everything(), ~replace_na(.x, 0)))
|
|
||||||
m <- m %>% group_by(GW_wdid) %>% mutate(SW_2000812=max(SW_2000812),SW_2000623=max(SW_2000623),SW_2000631=max(SW_2000631),SW_2000753=max(SW_2000753),SW_2200593=max(SW_2200593),SW_3500570=max(SW_3500570),SW_2000829=max(SW_2000829),SW_2000798=max(SW_2000798),SW_2100521=max(SW_2100521),SW_2200541=max(SW_2200541)) %>% ungroup
|
|
||||||
WSW <- m %>% select(-Year,-AF,-PARCEL_ID) %>% unique
|
|
||||||
GW_CREP <- m %>% left_join(CL,multiple="all") %>% left_join(IN_CREP)
|
|
||||||
GW_CREP$IN_CREP <- ifelse(is.na(GW_CREP$CREP_Year),0,1)
|
|
||||||
|
|
||||||
#Well data set
|
|
||||||
well_df <- GW_CREP %>% left_join(m)
|
|
||||||
well_df <- well_df %>% full_join(crop)
|
|
||||||
well_df <- well_df %>% left_join(CS)
|
|
||||||
#well_df %>% filter(SBD1==0,SBD2==0,SBD3==0,SBD4==0,SBD5==0,SBD6==0)
|
|
||||||
well_df[which(is.na(well_df$GW_wdid)),1] <- "NONE"
|
|
||||||
well_df$AF<- ifelse(is.na(well_df$AF),0,well_df$AF)
|
|
||||||
#One point is -0.125 checked Hydrobase to confirm values. Either bad entry or augmentation
|
|
||||||
well_df[well_df$AF<0,]$AF <- 0
|
|
||||||
#well_df$IN_CREP<- ifelse(is.na(well_df$IN_CREP),0,well_df$IN_CREP)
|
|
||||||
well_df$IN_CREP <- well_df$GW_wdid %in% (IN_CREP %>% pull(GW_wdid))
|
|
||||||
|
|
||||||
well_df <- well_df %>% group_by_at(c(c("GW_wdid","Year","AF"),SW_COL)) %>% summarize(IN_CREP=max(IN_CREP),CREP_Year=min(CREP_Year,na.rm=TRUE),CROP_AREA=sum(CROP_AREA),POT=sum(POT),ALF=sum(ALF),GP=sum(GP),SG=sum(SG),OT=sum(OT),SBD1=max(SBD1),SBD2=max(SBD2),SBD3=max(SBD3),SBD4=max(SBD4),SBD5=max(SBD5),SBD6=max(SBD6))
|
|
||||||
well_df$CREP_Year[is.infinite(well_df$CREP_Year)] <- NA
|
|
||||||
temp <- well_df %>% group_by(GW_wdid) %>% mutate(ST_YEAR=min(Year))
|
|
||||||
well_df <- well_df %>% select(GW_wdid,IN_CREP,CREP_Year,SBD1,Year,AF,CROP_AREA,POT,ALF,SG,GP,OT,all_of(SW_COL),SBD2,SBD3,SBD4,SBD5,SBD6)
|
|
||||||
|
|
||||||
LIST2009 <- well_df %>% ungroup %>% filter(Year==2009) %>% pull(GW_wdid) %>% unique
|
|
||||||
MISSING2009 <- well_df[which(!(well_df$GW_wdid %in% LIST2009)),] %>% ungroup
|
|
||||||
MISSING2009 <- MISSING2009 %>% select(GW_wdid,IN_CREP,CREP_Year,SBD1,SBD2,SBD3,SBD4,SBD5,SBD6) %>% unique %>% mutate(Year=2009,AF=0,CROP_AREA=0,POT=0,ALF=0,SG=0,GP=0,OT=0) %>% left_join(WSW)
|
|
||||||
well_df <- rbind(MISSING2009,well_df)
|
|
||||||
|
|
||||||
for(x in 2009:2021){
|
|
||||||
S_YEAR <- x;
|
|
||||||
MISS <- well_df %>% group_by(GW_wdid,IN_CREP,CREP_Year,SBD1,SBD2,SBD3,SBD4,SBD5,SBD6) %>% filter(min(Year)<=S_YEAR,!any(Year==S_YEAR+1)) %>% select(GW_wdid,IN_CREP,CREP_Year,SBD1,SBD2,SBD3,SBD4,SBD5,SBD6) %>% ungroup %>% unique %>% mutate(Year=S_YEAR+1,AF=0,CROP_AREA=0,POT=0,ALF=0,SG=0,GP=0,OT=0) %>% left_join(WSW)
|
|
||||||
|
|
||||||
well_df <- rbind(well_df,MISS)
|
|
||||||
print("done")
|
|
||||||
}
|
|
||||||
well_df <- well_df %>% group_by(GW_wdid,Year) %>% mutate(AF=sum(AF),IN_CREP=max(IN_CREP),CREP_Year=min(CREP_Year),CROP_AREA=sum(CROP_AREA),BOTH=ifelse(n()>1,1,0),POT=sum(POT),ALF=sum(ALF),SG=sum(SG),GP=sum(GP),OT=sum(OT),SBD1=max(SBD1),SW_2000812=max(SW_2000812),SW_2000623=max(SW_2000623),SW_2000631=max(SW_2000631),SW_2000753=max(SW_2000753),SW_2200593=max(SW_2200593),SW_3500570=max(SW_3500570),SW_2000829=max(SW_2000829),SW_2000798=max(SW_2000798),SW_2100521=max(SW_2100521),SW_2200541=max(SW_2200541),SBD1=max(SBD1),SBD2=max(SBD2),SBD3=max(SBD3),SBD4=max(SBD4),SBD5=max(SBD5),SBD6=max(SBD6)) %>% unique %>% ungroup
|
|
||||||
|
|
||||||
well_df$Post_11 <- ifelse(well_df$Year>=2011,1,0)
|
|
||||||
well_df <- well_df %>% mutate(POST=ifelse(is.na(CREP_Year),0,ifelse(Year >=CREP_Year,1,0))) %>% select(GW_wdid,Year,POST,everything())
|
|
||||||
well_df <- well_df %>% group_by(GW_wdid) %>% mutate(M_AF=max(AF),M_CROP=max(CROP_AREA)) %>% ungroup
|
|
||||||
well_df <- well_df %>% filter(M_AF!=0)
|
|
||||||
#only 2 2005 entries
|
|
||||||
well_df <- well_df %>% filter(Year>2005)
|
|
||||||
|
|
||||||
##############Well Distances
|
|
||||||
AF_WELL <- well_df %>% group_by(GW_wdid) %>% summarize(AF=max(AF)) %>% arrange(GW_wdid)
|
|
||||||
well_list <- AF_WELL %>% filter(AF>0) %>% pull(GW_wdid)
|
|
||||||
WD <- read_csv("Data/Input_Data/Wells_Distance_Matrix.csv",col_types = cols(ID=col_character())) %>% rename(GW_wdid=ID)
|
|
||||||
##Keep only well records with pumping data, then arrange by well number for consistency
|
|
||||||
NM_SAVE <- WD[WD$GW_wdid %in% t(well_list),1]
|
|
||||||
###DISTANCE MATRIX
|
|
||||||
WD <- WD[WD$GW_wdid %in% well_list,colnames(WD) %in% well_list]
|
|
||||||
WD_FULL <- cbind(NM_SAVE,WD) %>% as_tibble
|
|
||||||
|
|
||||||
##Data Clean
|
|
||||||
well_df$Yearf <- as.factor(well_df$Year)
|
|
||||||
well_df$GW_wdid <- as.factor(well_df$GW_wdid)
|
|
||||||
well_df$LAF <- log(well_df$AF+0.00001)
|
|
||||||
well_df <- well_df %>% rename(CREP_YEAR=CREP_Year)
|
|
||||||
well_df <- well_df %>% filter(Year!=2022)
|
|
||||||
well_df <- well_df %>% mutate(CREP_rel_year=Year-CREP_YEAR,CREP_rel_year=replace_na(CREP_rel_year,Inf))
|
|
||||||
###Logit model of Fallowing
|
|
||||||
well_df$CREP_PRE <- ifelse(well_df$CREP_rel_year %in% c(-1,2),1,0)
|
|
||||||
well_df$CREP_PRE1 <- ifelse(well_df$CREP_rel_year %in% c(-1),1,0)
|
|
||||||
well_df$CREP_PRE2 <- ifelse(well_df$CREP_rel_year %in% c(-2),1,0)
|
|
||||||
well_df$CREP_PRE3 <- ifelse(well_df$CREP_rel_year %in% c(-3),1,0)
|
|
||||||
well_df$SUNAB_CREP <- ifelse(well_df$IN_CREP==0,100000,well_df$CREP_YEAR)
|
|
||||||
well_df <- well_df %>% left_join(IN_CREP %>% group_by(GW_wdid) %>% summarize(PERM_CREP=max(PERM_CREP),TEMP_CREP=as.numeric(min(PERM_CREP)==0))) %>% mutate(PERM_CREP=ifelse(is.na(PERM_CREP),0,PERM_CREP),TEMP_CREP=ifelse(is.na(TEMP_CREP),0,TEMP_CREP))
|
|
||||||
PERM_CREP <- IN_CREP %>% filter(PERM_CREP==1) %>% group_by(GW_wdid) %>% summarize(PERM_YEAR=min(CREP_Year))
|
|
||||||
TEMP_CREP <- IN_CREP %>% filter(PERM_CREP==0) %>% group_by(GW_wdid) %>% summarize(TEMP_YEAR=min(CREP_Year))
|
|
||||||
well_df <- well_df %>% left_join(TEMP_CREP ) %>% mutate(ifelse(is.na(TEMP_CREP),0,TEMP_CREP))
|
|
||||||
well_df <- well_df %>% left_join(PERM_CREP ) %>% mutate(ifelse(is.na(PERM_CREP),0,PERM_CREP))
|
|
||||||
well_df <- well_df %>% mutate(CREP_YEAR=ifelse(is.na(CREP_YEAR),Inf,CREP_YEAR),TEMP_YEAR=ifelse(is.na(TEMP_YEAR),Inf,TEMP_YEAR),PERM_YEAR=ifelse(is.na(PERM_YEAR),Inf,PERM_YEAR))
|
|
||||||
well_df$pumping_fee <- ifelse(well_df$Year==2011,45,NA)
|
|
||||||
well_df$pumping_fee <- ifelse(well_df$Year>2011 & well_df$Year<2018,75,well_df$pumping_fee)
|
|
||||||
well_df$pumping_fee <- ifelse(well_df$Year==2018 | well_df$Year==2019,90,well_df$pumping_fee)
|
|
||||||
well_df$pumping_fee <- ifelse(well_df$Year>2019 ,150,well_df$pumping_fee)
|
|
||||||
well_df$Post_16 <- ifelse(well_df$Year>=2016,1,0)
|
|
||||||
well_df$Post_11 <- ifelse(well_df$Year>=2011,1,0)
|
|
||||||
|
|
||||||
#df_half$SUNAB <- ifelse(df_half$CLOSE_CREP==0,100000,df_half$CREP_CLOSE_START_YEAR)
|
|
||||||
well_df$FALLOW <- ifelse(well_df$AF==0,1,0)
|
|
||||||
well_df$BETWEEN<- ifelse(well_df$IN_CREP==1 & well_df$Year<well_df$CREP_YEAR,1,0)
|
|
||||||
well_df <- well_df %>% left_join(FALL_PROG %>% mutate(GW_wdid=as.character(GW_wdid))) %>% rename(IN_FALL_PROG=FALL_PROG)%>% mutate(IN_FALL_PROG=ifelse(is.na(IN_FALL_PROG),0,1),FALL_PROG=ifelse(IN_FALL_PROG==1 & Year>=FALL_PROG_YEAR,1,0 ))
|
|
||||||
well_df$SBD1_Post <- ifelse(well_df$Post_11 & well_df$SBD1==1,1,0)
|
|
||||||
well_df$CREP_Post <- ifelse(well_df$Post_11 & well_df$IN_CREP==1,1,0)
|
|
||||||
well_df$SBD_ref_11 <- ifelse(well_df$SBD1==1,well_df$Year,Inf)
|
|
||||||
well_df$CREP_ref_11 <- ifelse(well_df$IN_CREP==1 & well_df$POST!=1,well_df$Year,Inf)
|
|
||||||
well_df$IND_CREP11 <- i(well_df$CREP_ref_11,ref=c(2009,2010,Inf))
|
|
||||||
well_df$IND_SBD11 <- i(well_df$SBD_ref_11,ref=c(2009,2010,Inf))
|
|
||||||
well_df <- well_df %>% select(-CREP_ref_11,-SBD_ref_11)
|
|
||||||
well_df$FALL_PROG_YEAR <- ifelse(is.na(well_df$FALL_PROG_YEAR),Inf,well_df$FALL_PROG_YEAR)
|
|
||||||
|
|
||||||
source("Scripts/Distance_Functions.r")
|
|
||||||
GET_DIS_DATA_SET <- function(DIS,WELL_DF=well_df){
|
|
||||||
DIS_DF <- WELL_DF %>% left_join(GET_CREP_DAT(DIS) )
|
|
||||||
DIS_DF$CLOSE_CREP <- ifelse(DIS_DF$CREP_CLOSE_YEAR<100000,1,0)
|
|
||||||
DIS_DF$CLOSE_BETWEEN <- ifelse(DIS_DF$Post_11 & DIS_DF$CLOSE_CREP==1 & DIS_DF$CREP_CLOSE_YEAR<DIS_DF$Year ,1,0)
|
|
||||||
DIS_DF$POST_CLOSE <- ifelse(DIS_DF$Post_11 & DIS_DF$CLOSE_CREP==1 & DIS_DF$CREP_CLOSE_YEAR>=DIS_DF$Year ,1,0)
|
|
||||||
#All Fallow plots
|
|
||||||
DIS_DF <- DIS_DF %>% left_join(DF_CLOSE_FALL(DIS))
|
|
||||||
#Data from 4 year Fallow program of SBD1
|
|
||||||
DIS_DF <- DIS_DF %>% left_join(GET_FALLOW_PROG_DAT(DIS))
|
|
||||||
DIS_DF <- DIS_DF %>% left_join(GET_FALLOW_PROG_DAT(DIS))
|
|
||||||
DIS_DF$FALL_PROG_CLOSE_YEAR <- ifelse(is.na(DIS_DF$FALL_PROG_CLOSE_YEAR),Inf,DIS_DF$FALL_PROG_CLOSE_YEAR)
|
|
||||||
DIS_DF$FALL_PROG_CLOSE_POST <- ifelse(DIS_DF$FALL_PROG==1 & DIS_DF$FALL_PROG_CLOSE_YEAR>=DIS_DF$Year,1,0)
|
|
||||||
return(DIS_DF)
|
|
||||||
}
|
|
||||||
df_quart <- GET_DIS_DATA_SET(5280/4)
|
|
||||||
df_half <- GET_DIS_DATA_SET(5280/2)
|
|
||||||
df_mile <- GET_DIS_DATA_SET(5280)
|
|
||||||
df_two <- GET_DIS_DATA_SET(2*5280)
|
|
||||||
#########################ADDING IN PROBIT MODEL OF ENTERING CREP DUE TO FEE
|
|
||||||
PRE_DF <- df_half %>% group_by(GW_wdid,IN_CREP,CLOSE_CREP)%>% filter(Year<2011,SBD1==1) %>% summarize(M_AF=max(AF),PRE_AF=mean(AF),PRE_CROP=mean(POT+ALF+SG+OT),PRE_POT=mean(POT)/PRE_CROP,PRE_ALF=mean(ALF)/PRE_CROP,PRE_SG=mean(SG)/PRE_CROP,PRE_OT=mean(OT)/PRE_CROP) %>% filter(PRE_CROP>0)
|
|
||||||
POST_DF <- df_half %>% group_by(GW_wdid,IN_CREP,CLOSE_CREP)%>% filter(Year>=2011,Year<2014,SBD1==1) %>% summarize(POST_AF=mean(AF),POST_CROP=mean(POT+ALF+SG+OT,na.rm=TRUE),POST_POT=mean(POT,na.rm=TRUE)/POST_CROP,POST_ALF=mean(ALF,na.rm=TRUE)/POST_CROP,POST_SG=mean(SG,na.rm=TRUE)/POST_CROP,POST_OT=mean(OT,na.rm=TRUE)/POST_CROP)
|
|
||||||
SW_DF <- df_half[,c(1,19:28)] %>% unique
|
|
||||||
logit_df <- PRE_DF %>% left_join(POST_DF) %>% mutate(DIFF_AF=POST_AF-PRE_AF,DIFF_CROP=PRE_CROP-POST_CROP) %>% left_join(SW_DF)
|
|
||||||
137
2_Create_CREP_Data.r
Normal file
137
2_Create_CREP_Data.r
Normal file
@ -0,0 +1,137 @@
|
|||||||
|
library(tidyverse)
|
||||||
|
library(janitor)
|
||||||
|
################Perm CREP contract
|
||||||
|
CONTRACT_NUMBER <- c('ALA#3','ALA#6','ALA#7','ALA#8','ALA#9','ALA#10','ALA#12','ALA#15','SAG#6','ALA#17','ALA#18','ALA#22','ALA#23','ALA#25','RG#4','ALA#26','ALA#27','ALA#28','ALA#29','ALA#30','ALA#31','ALA#32','ALA#33','ALA#34','ALA#38','ALA#39','SAG#33','SAG#34','ALA#40','ALA#41','ALA#42','ALA#43','ALA#44','ALA#45','ALA#47','SAG#39')
|
||||||
|
FIRST_FALLOW_YEAR <- c(2014,2014,2014,2014,2014,2014,2014,2014,2015,2015,2015,2015,2015,2015,2016,2016,2016,2016,2016,2016,2016,2016,2016,2016,2018,2018,2020,2020,2020,2020,2020,2021,2021,2021,2021,2024)
|
||||||
|
ACRES <- c(124.9,126,119.5,119.2,121.1,118.1,122.8,67,114.1,118.6,122,121,124.66,80,149.8,110,110,110,92.9,122.3,94,123,126,126,121.28,120.5,122.8,122,118,121.84,120,120,120.01,120.1,120.11,122.94)
|
||||||
|
CREP_PERM <- cbind(CONTRACT_NUMBER,FIRST_FALLOW_YEAR,ACRES,read_csv("./Data/CREP_and_Fallow/CREP_Perm.csv")) %>% as_tibble %>% mutate(program='CREP_perm',RETURN_YEAR=Inf,contract_type='Perm')
|
||||||
|
###############################Temp CREP contract
|
||||||
|
CONTRACT_NUMBER <- c('SAG#1','SAG#2','SAG#3','SAG#4','RG#1','RG#2','ALA#2','ALA#11','SAG#7','SAG#8','SAG#9','SAG#10','SAG#11','ALA#16','ALA#19','ALA#21','ALA#24','SAG#12','SAG#13','RG#3','RG#7','RG#8','ALA#35','SAG#14','SAG#15','SAG#16','ALA#36','SAG#17','SAG#18','SAG#19','SAG#20','SAG#21','SAG#22','SAG#23','SAG#24','SAG#25','SAG#26','SAG#27','SAG#28','ALA#37','SAG#29','SAG#30','SAG#31','RG#9','RG#10','SAG#32','RG#11','SAG#35','SAG#36','SAG#37','SAG#38','RG#12','RG#13')
|
||||||
|
FIRST_FALLOW_YEAR <- c(2014,2014,2014,2014,2014,2014,2014,2014,2015,2015,2015,2015,2015,2015,2015,2015,2015,2016,2016,2016,2016,2016,2016,2017,2017,2017,2017,2018,2018,2018,2018,2018,2018,2018,2018,2018,2018,2018,2018,2018,2019,2019,2019,2019,2019,2020,2022,2023,2023,2023,2023,2024,2024)
|
||||||
|
|
||||||
|
RETURN_YEAR <- c(2029,2029,2029,2029,2029,2029,2029,2029,2030,2030,2030,2030,2030,2030,2030,2030,2030,2031,2031,2031,2031,2031,2031,2032,2032,2032,2032,2033,2033,2033,2033,2033,2033,2033,2033,2033,2033,2033,2033,2033,2034,2034,2034,2034,2034,2035,2037,2038,2038,2038,2038,2038,2038)
|
||||||
|
ACRES <- c(144,144,210,60,130,120.4,120,121.5,172.09,113,191,116.5,120,124,120,129,120.97,120,124,139.9,122,123.32,122,120,122.4,123.4,113.92,120,120.35,114.32,124.78,125.58,119.3,123,125.15,126.1,126.3,125.5,53.6,106,112.81,126.95,118.9,118.36,120,120,100,120,130.02,114.54,120,121.92,126.15)
|
||||||
|
CREP_TEMP <- cbind(CONTRACT_NUMBER,FIRST_FALLOW_YEAR,RETURN_YEAR,ACRES,read_csv("./Data/CREP_and_Fallow/CREP_Temp.csv")) %>% as_tibble %>% mutate(program='CREP',contract_type='Temp')
|
||||||
|
######SBD1 Fallow Program
|
||||||
|
CONTRACT_NUMBER <- c(paste("Fallow Parcel ",1:23),paste("Fallow Parcel ",1:27),c(paste("Fallow Parcel ",1:9),paste("Fallow Parcel ",11:33)))
|
||||||
|
|
||||||
|
CONTRACT_TERM <- c(
|
||||||
|
c(rep(4,10),rep(1,4),rep(4,4),rep(2,2),4,rep(2,2)),
|
||||||
|
c(rep(4,14),rep(2,2),4,rep(2,2),rep(4,8)),
|
||||||
|
c(rep(4,19),2,4,rep(2,6),rep(1,2),rep(4,3))
|
||||||
|
)
|
||||||
|
length(CONTRACT_TERM )
|
||||||
|
length(c(rep(4,17),rep(2,6),rep(1,2),rep(4,3)))
|
||||||
|
|
||||||
|
|
||||||
|
FIRST_FALLOW_YEAR <- c(
|
||||||
|
c(rep(2018,9),rep(2019,3),2018,rep(2019,10)),
|
||||||
|
c(rep(2018,9),rep(2019,13),rep(2020,5)),
|
||||||
|
c(rep(2018,9),2020,rep(2019,4),2020,rep(2019,5),rep(2020,3),rep(2021,9))
|
||||||
|
)
|
||||||
|
length(c(rep(2018,9),2020,rep(2019,4),2020,rep(2019,5),rep(2020,3),rep(2021,9)))
|
||||||
|
|
||||||
|
RETURN_YEAR <- CONTRACT_TERM +FIRST_FALLOW_YEAR
|
||||||
|
|
||||||
|
ACRES <- c(
|
||||||
|
c(115,126,126,120,130,120,84.2,120,126,120,120,120,123,122.78,106,120,115,45,120,120,120,120,140),
|
||||||
|
c(145,126,126,120,130,120,84.2,120,126,120,106,120,115,45,rep(120,4),140,rep(120,3),121,120,125,38,124),
|
||||||
|
c(126,120,120,115,130,120,126,126,84.2,125,120,115,120,45,106,120,120,38,126,121,120,116,116,120,113,115,122,480,480,118,120,75)
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
SBD1_TEMP_FALLOW <- cbind(CONTRACT_NUMBER,FIRST_FALLOW_YEAR,RETURN_YEAR,ACRES,read_csv("./Data/CREP_and_Fallow/SBD1_Temp_Fallow.csv")) %>% as_tibble %>% mutate(program='SBD1_temp_fallow',contract_type='Temp',wdid1=as.character(wdid1),wdid2=as.character(wdid2),wdid3=as.character(wdid3),wdid4=as.character(wdid4),wdid5=as.character(wdid5),wdid6=as.character(wdid6),wdid7=as.character(wdid7),wdid8=as.character(wdid8))
|
||||||
|
SBD1_TEMP_FALLOW
|
||||||
|
nrow(SBD1_TEMP_FALLOW )
|
||||||
|
(SBD1_TEMP_FALLOW %>% filter(ACRES==125))[,-1:-1]
|
||||||
|
#Little changes so manually add 2022 data
|
||||||
|
ADDITIONS_2022 <- rbind(SBD1_TEMP_FALLOW[6,]%>% mutate(wdid1='2705334',CONTRACT_NUMBER='Fallow Parcel 34',ACRES=119,FIRST_FALLOW_YEAR=2022,RETURN_YEAR=2023,Data_Year=2022),SBD1_TEMP_FALLOW[6,]%>% mutate(wdid1='2008616',CONTRACT_NUMBER='Fallow Parcel 34',wdid2='20131888',ACRES=125,FIRST_FALLOW_YEAR=2022,RETURN_YEAR=2023,Data_Year=2022))
|
||||||
|
SBD1_TEMP_FALLOW <- rbind(SBD1_TEMP_FALLOW,ADDITIONS_2022)
|
||||||
|
#####2023 data
|
||||||
|
CONTRACT_NUMBER <- as.character(1:11 )
|
||||||
|
FIRST_FALLOW_YEAR <- c(rep(2020,4),rep(2021,7))
|
||||||
|
RETURN_YEAR <- c(rep(2024,6),rep(2025,5))
|
||||||
|
ACRES <- c(38.09,125,121,120,120,110,73.46,50,119,120,118)
|
||||||
|
wdid1 <- c(2013693,2005731,2013884,2706159,2705471,2705395,2008226,2008591,2009461,2009114,2010568)
|
||||||
|
wdid2 <- c(rep(NA,5),2705517,2014273,NA,2009462,NA,2005035)
|
||||||
|
wdid3 <- c(rep(NA,10),2014173)
|
||||||
|
|
||||||
|
SBD1_TEMP_FALLOW
|
||||||
|
DATA_2023 <-cbind(CONTRACT_NUMBER,FIRST_FALLOW_YEAR,RETURN_YEAR,ACRES)%>% as_tibble %>% mutate(Data_Year=2023) %>% cbind(wdid1,wdid2,wdid3) %>% as_tibble %>% mutate(CONTRACT_NUMBER=as.character(CONTRACT_NUMBER),FIRST_FALLOW_YEAR=as.numeric(FIRST_FALLOW_YEAR),RETURN_YEAR=as.numeric(RETURN_YEAR),ACRES=as.numeric(ACRES),wdid1=as.character(wdid1),wdid2=as.character(wdid2),wdid3=as.character(wdid3),wdid4=NA,wdid5=NA,wdid6=NA,wdid7=NA,wdid8=NA,program='SBD1_temp_fallow',contract_type='Temp')
|
||||||
|
SBD1_TEMP_FALLOW <- SBD1_TEMP_FALLOW %>% full_join(DATA_2023 )
|
||||||
|
#####2024 data
|
||||||
|
CONTRACT_NUMBER <- c('#1','#2','#3','#4','24_Fallow_2','24_Fallow_3','24_Fallow_4','24_Fallow_6','24_Fallow_7','24_Fallow_8','24_Fallow_9','24_Fallow_10','24_Fallow_11','24_Fallow_13','24_Fallow_14','24_Fallow_15','24_Fallow_16','24_Fallow_18','24_Fallow_19','24_Fallow_20','24_Fallow_21','24_Fallow_22','24_Fallow_23','24_Fallow_24','24_Fallow_25','24_Fallow_26','24_Fallow_29','24_Fallow_30','24_Fallow_31','24_Fallow_32','24_Fallow_33','24_Fallow_34','24_Fallow_35','24_Fallow_36','24_Fallow_37','24_Fallow_38','24_Fallow_39','24_Fallow_40','24_Fallow_41','24_Fallow_42','24_Fallow_43','24_Fallow_44','24_Fallow_46','24_Fallow_47','24_Fallow_48','24_Fallow_50')
|
||||||
|
FIRST_FALLOW_YEAR <- c(rep(2021,4),rep(2024,42))
|
||||||
|
RETURN_YEAR <- rep(2025,46)
|
||||||
|
ACRES <- c(73.46,50,119,118,122.01,126,126,120,198,122,123,116,126,126,120,64,124,116,126,126,126,126,120,120,126,126,100,126,126,118.62,139.62,101.4,120,118.8,118.32,118,117,136,120,114.68,114.67,49,126.74,120,126,120)
|
||||||
|
|
||||||
|
DATA_2024 <- cbind(CONTRACT_NUMBER,FIRST_FALLOW_YEAR,RETURN_YEAR,ACRES,read_csv("./Data/CREP_and_Fallow/SBD1_Temp_Fallow_2024.csv")) %>% as_tibble %>% mutate(program='SBD1_temp_fallow',contract_type='Temp',wdid1=as.character(wdid1),wdid2=as.character(wdid2),wdid3=as.character(wdid3),wdid4=as.character(wdid4),wdid5=as.character(wdid5),wdid6=as.character(wdid6))
|
||||||
|
SBD1_TEMP_FALLOW <- SBD1_TEMP_FALLOW %>% full_join(DATA_2024)
|
||||||
|
####SBD1 Permanent well Retirement
|
||||||
|
CONTRACT_NUMBER <- c('2021-01','2021-02','2021-03','2021-04','2021-05','2021-06','2021-07','2021-08','2021-09','2021-10','2021-11','2022-1-01','2022-1-02','2022-1-03','2022-1-04','2022-1-05','2022-1-06','2022-1-07','2022-1-08','2022-2-01','2023-01','2023-02','2023-03','2023-05','2023-06','2023-07','2023-08','2023-09')
|
||||||
|
FIRST_FALLOW_YEAR <- c(2022,2022,2022,2022,2022,2022,2022,2022,2022,2022,2022,2023,2023,2023,2023,2023,2023,2023,2023,2023,2024,2024,2024,2024,2024,2024,2024,2024)
|
||||||
|
ACRES <- c(125,135,123,130,117,122,97,121,125,125,128,130,128,119,124,121,124,121,124,123,124,130,129,123,120,240,123,118)
|
||||||
|
SBD1_WELL_PURCHASE <- cbind(CONTRACT_NUMBER,FIRST_FALLOW_YEAR,ACRES,read_csv("./Data/CREP_and_Fallow/SBD1_Well_Purchase.csv")) %>% as_tibble %>% mutate(program='SBD1_purchase',RETURN_YEAR=Inf,contract_type='Perm',Data_Year=2025)
|
||||||
|
SBD1_WELL_PURCHASE
|
||||||
|
######Groundwater Compact Compliance and Sustainability Fund (SB22-028)
|
||||||
|
CONTRACT_NUMBER <- c('004','008','009','009','011','011','117','118','119','120','121','121','121','121','122','123','125','126','231','231','231','233','235','239','340','340','342')
|
||||||
|
FIRST_FALLOW_YEAR <- c(2024,2024,2024,2024,2024,2024,2024,2024,2024,2024,2024,2024,2024,2024,2024,2024,2024,2024,2024,2024,2024,2024,2024,2025,2025,2025,2025)
|
||||||
|
ACRES <- c(125,118,121,131,119,119,125,125,123,122,120,130,123,126,125,120,124,117,126,120,125,122,124,120,119,125,122)
|
||||||
|
SB22_DATA <- cbind(CONTRACT_NUMBER,FIRST_FALLOW_YEAR,ACRES,read_csv("./Data/CREP_and_Fallow/SB22_Data.csv")) %>% as_tibble %>% mutate(program='SB22_028',RETURN_YEAR=Inf,contract_type='Perm',Data_Year=2025)
|
||||||
|
|
||||||
|
###########Half Fallow Program
|
||||||
|
CONTRACT_NUMBER <- paste("Half Usage",1:38)
|
||||||
|
FIRST_FALLOW_YEAR <- rep(2020,38)
|
||||||
|
RETURN_YEAR <- rep(2021,38)
|
||||||
|
LIMIT <- c(90.6,91.5,83.4,85.2,89.8,82.4,81.0,72.0,98.8,97.8,92.2,94.0,111.7,118.0,102.0,92.1,117.0,99.4,95.7,149.0,54.6,22.6,102.4,97.5,211.6,104.5,47.5,76.2,34.5,74.1,53.0,85.7,130.7,97.4,115.0,56.0,33.4,45.9)
|
||||||
|
ACRES <- c(111.92,119.22,116.82,117.26,119.1,123,118.03,106.98,109.15,120,117,128,126,126,125,121,121,126,121,120,43,24,138,137,117,121.5,142,126,174.22,118,118,119,126,126,120,114,126,63)
|
||||||
|
HALF_FALLOW <- cbind(CONTRACT_NUMBER,FIRST_FALLOW_YEAR,RETURN_YEAR,ACRES,LIMIT,read_csv("./Data/CREP_and_Fallow/SBD1_Half_Fallow.csv")) %>% as_tibble %>% mutate(program='SBD_half_fallow',contract_type='Temp')
|
||||||
|
#######################Combine
|
||||||
|
SBD1_TEMP_FALLOW$CONTRACT_NUMBER <- paste0(SBD1_TEMP_FALLOW$Data_Year,"_",SBD1_TEMP_FALLOW$CONTRACT_NUMBER)
|
||||||
|
SBD1_TEMP_FALLOW <- SBD1_TEMP_FALLOW %>% pivot_longer(c(wdid1,wdid2,wdid3,wdid4,wdid5,wdid6,wdid7,wdid8),values_to='wdid') %>% select(-name) %>% filter(!is.na(wdid))%>% clean_names
|
||||||
|
|
||||||
|
HALF_FALLOW <- HALF_FALLOW %>% pivot_longer(c(wdid1,wdid2,wdid3,wdid4),values_to='wdid') %>% select(-name) %>% filter(!is.na(wdid))%>% clean_names
|
||||||
|
|
||||||
|
SB22_DATA <- SB22_DATA %>% pivot_longer(c(wdid1,wdid2,wdid3),values_to='wdid') %>% select(-name) %>% filter(!is.na(wdid))%>% clean_names
|
||||||
|
|
||||||
|
SBD1_WELL_PURCHASE <- SBD1_WELL_PURCHASE %>% pivot_longer(c(wdid1,wdid2,wdid3,wdid4),values_to='wdid') %>% select(-name) %>% filter(!is.na(wdid))%>% clean_names
|
||||||
|
|
||||||
|
CREP_PERM <- CREP_PERM %>% pivot_longer(c(wdid1,wdid2,wdid3,wdid4,wdid5),values_to='wdid') %>% select(-name) %>% filter(!is.na(wdid))%>% clean_names
|
||||||
|
CREP_TEMP <- CREP_TEMP %>% pivot_longer(c(wdid1,wdid2,wdid3,wdid4,wdid5),values_to='wdid') %>% select(-name) %>% filter(!is.na(wdid))%>% clean_names
|
||||||
|
CREP <- full_join(CREP_TEMP,CREP_PERM)
|
||||||
|
SBD1_TEMP_FALLOW %>% select(wdid,first_fallow_year,return_year) %>% unique %>% group_by(wdid) %>% filter(n()>1) %>% arrange(wdid) %>% print(n=100)
|
||||||
|
SBD1_TEMP_FALLOW %>% select(-contract_number,-acres,-data_year) %>% group_by(wdid,program,contract_type) %>% summarize(first_fallow_year=min(first_fallow_year),)
|
||||||
|
WELL <- 2008026
|
||||||
|
DATA <- HALF_FALLOW
|
||||||
|
DATA %>% filter(wdid=='2008026' )
|
||||||
|
IN_PROGRAM <- function(WELL,DATA){
|
||||||
|
RES <- c()
|
||||||
|
for(YEAR in 2009:2025){
|
||||||
|
C <- DATA %>% filter(wdid==WELL)
|
||||||
|
STARTED <- C$first_fallow_year <=YEAR
|
||||||
|
ENDED <- C$return_year >YEAR
|
||||||
|
RES[YEAR-2008] <-as.numeric( any(STARTED & ENDED ))
|
||||||
|
}
|
||||||
|
RES <- cbind(rep(WELL,17),2009:2025,rep(C$program[1],17),RES) %>% as_tibble
|
||||||
|
colnames(RES) <- c("wdid","year","program","active")
|
||||||
|
return(RES)
|
||||||
|
}
|
||||||
|
CREP_PERM
|
||||||
|
CREP_TEMP
|
||||||
|
for(i in SBD1_TEMP_FALLOW %>% pull(wdid) %>% unique){
|
||||||
|
|
||||||
|
CURRENT <- IN_PROGRAM(i,SBD1_TEMP_FALLOW)
|
||||||
|
|
||||||
|
if(exists("ALL_PROGRAM_WELL_DATA")){ALL_PROGRAM_WELL_DATA <- rbind(ALL_PROGRAM_WELL_DATA,CURRENT)} else{ALL_PROGRAM_WELL_DATA <- CURRENT}
|
||||||
|
}
|
||||||
|
PROGRAM_ALL <- function(DATA_SET){do.call(rbind,lapply(DATA_SET$wdid,function(x){IN_PROGRAM(x,DATA_SET)})) }
|
||||||
|
ALL_PROGRAMS <- rbind(PROGRAM_ALL(CREP_PERM),
|
||||||
|
PROGRAM_ALL(CREP_TEMP) %>% mutate(program='CREP_temp'),
|
||||||
|
PROGRAM_ALL(HALF_FALLOW),
|
||||||
|
PROGRAM_ALL(SBD1_WELL_PURCHASE),
|
||||||
|
PROGRAM_ALL(SBD1_TEMP_FALLOW),
|
||||||
|
PROGRAM_ALL(SB22_DATA)) %>% unique %>% mutate(active=as.numeric(active))
|
||||||
|
ALL_PROGRAMS <- ALL_PROGRAMS%>% pivot_wider(values_from=active,names_from=program)%>% replace(is.na(.), 0)
|
||||||
|
ALL_PROGRAMS <- ALL_PROGRAMS %>% mutate(CREP_any=ifelse(CREP_perm+CREP_temp>0,1,0)) %>% select(wdid,year,CREP_any,everything())
|
||||||
|
|
||||||
|
write_csv(ALL_PROGRAMS,"Data/Output_Data/Fallow_Program_Data.csv")
|
||||||
@ -1,28 +0,0 @@
|
|||||||
#install.packages("devtools")
|
|
||||||
#devtools::install_github("anguswg-ucsb/cdssr")
|
|
||||||
#library(cdssr)
|
|
||||||
library(tidyverse)
|
|
||||||
library(janitor)
|
|
||||||
#install.packages("janitor")
|
|
||||||
#API <- 'PwevUQJCStcYZfqrOYbuyztmNPlUJWby'
|
|
||||||
read_csv("Data/SBD_Data/StructureList_SBD2.csv")
|
|
||||||
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))
|
|
||||||
#################
|
|
||||||
STRUCTURES <- 'https://dwr.state.co.us/Rest/GET/api/v2/structures/?format=csv&fields=wdid%2CciuCode%2CstructureType&division=3&pageSize=500000&apiKey=PwevUQJCStcYZfqrOYbuyztmNPlUJWby'
|
|
||||||
STRUCTURES<- read_csv(STRUCTURES,skip=2 )
|
|
||||||
WELLS <- STRUCTURES %>% filter(structureType=='WELL')
|
|
||||||
|
|
||||||
LIST <- WELLS %>% pull(wdid) %>% unique
|
|
||||||
|
|
||||||
if(file.exists("./Data/Div3_Pumping_Data.csv")){LIST <-LIST[-which(LIST %in% t(read.csv("./Data/Div3_Pumping_Data.csv")[,1] %>% unique))]}
|
|
||||||
for(C_WELL in LIST ){
|
|
||||||
try(C_DAT <- read_csv(paste0('https://dwr.state.co.us/Rest/GET/api/v2/structures/divrec/divrecyear/?format=csv&wdid=',C_WELL,'&apiKey=PwevUQJCStcYZfqrOYbuyztmNPlUJWby'),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/Div3_Pumping_Data.csv")}}
|
|
||||||
closeAllConnections()
|
|
||||||
}
|
|
||||||
|
|
||||||
63
3_Hydrobase.r
Normal file
63
3_Hydrobase.r
Normal file
@ -0,0 +1,63 @@
|
|||||||
|
#install.packages("devtools")
|
||||||
|
#devtools::install_github("anguswg-ucsb/cdssr")
|
||||||
|
#library(cdssr)
|
||||||
|
library(tidyverse)
|
||||||
|
library(janitor)
|
||||||
|
#install.packages("janitor")
|
||||||
|
#API <- 'PwevUQJCStcYZfqrOYbuyztmNPlUJWby'
|
||||||
|
read_csv("Data/SBD_Data/StructureList_SBD2.csv")
|
||||||
|
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
|
||||||
|
|
||||||
|
#################
|
||||||
|
#STRUCTURES <- 'https://dwr.state.co.us/Rest/GET/api/v2/structures/?format=csv&fields=wdid%2CciuCode%2CstructureType&division=3&pageSize=500000&apiKey=PwevUQJCStcYZfqrOYbuyztmNPlUJWby'
|
||||||
|
#STRUCTURES<- read_csv(STRUCTURES,skip=2 )
|
||||||
|
#WELLS <- STRUCTURES %>% filter(structuretype=='WELL')
|
||||||
|
|
||||||
|
WELL_DATA <- read_csv("Data/Structure_Data/Structures_with_Diversions.csv")%>% clean_names() %>% mutate(wdid=as.character(wdid)) %>% select(wdid,contacts) #Start with well data
|
||||||
|
STATIC_DATA <- WELL_DATA %>% left_join(SBD_LINK) %>% replace(is.na(.), 0) #Include subdistrict indicators
|
||||||
|
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)
|
||||||
|
|
||||||
|
write_csv(STATIC_DATA,"Data/Output_Data/Well_Level_Static_Data.csv")
|
||||||
|
|
||||||
|
|
||||||
|
###########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 )
|
||||||
|
ALL
|
||||||
|
CURRENT
|
||||||
|
|
||||||
|
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 %>% group_by(wdid,year) %>% filter(n()>1) %>% arrange(wdid,year)
|
||||||
|
POST_LIST[1]
|
||||||
|
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")
|
||||||
|
|
||||||
|
|
||||||
14
4_Analysis.r
Normal file
14
4_Analysis.r
Normal file
@ -0,0 +1,14 @@
|
|||||||
|
library(tidyverse)
|
||||||
|
library(fixest)
|
||||||
|
WELLS <- read_csv("Data/Output_Data/Full_Data_Set.csv")
|
||||||
|
WELLS$post <- WELLS$year>=2011
|
||||||
|
WELLS$I <- WELLS$year-2011
|
||||||
|
feols(af~sbd1*post|ditch_2000812+ ditch_2000631+ditch_other+ditch_2000829+ditch_2000798+ditch_2000816+ditch_2000753+ditch_2000623+ditch_2200627+contacts+year+sbd2+sbd3+sbd4+sbd5+sbd6,data=WELLS)
|
||||||
|
iplot(feols(log(af+0.0001)~i(I,sbd1)|ditch_2000812+ ditch_2000631+ditch_other+ditch_2000829+ditch_2000798+ditch_2000816+ditch_2000753+ditch_2000623+ditch_2200627+contacts+year+sbd2+sbd3+sbd4+sbd5+sbd6,data=WELLS))
|
||||||
|
iplot(feols(af~i(year,sbd1,2010)+per_alfalfa+per_potatoes+per_alfalfa|year+sbd2+sbd3+sbd4+sbd5+sbd6+ditch_2000812^year+ditch_2000631^year+ditch_2000829^year+ditch_2000798^year+ditch_2000816^year+ditch_2000753^year+ditch_2000623^year+ditch_2200627^year,data=WELLS))
|
||||||
|
?i
|
||||||
|
|
||||||
|
|
||||||
|
WELLS <-WELLS %>% group_by(year,sbd1) %>% summarize(af=sum(af)) %>% ungroup
|
||||||
|
ggplot(WELLS,aes(x=year,y=af,group=sbd1,color=(sbd1)))+geom_point()+geom_line()
|
||||||
|
|
||||||
@ -1,39 +1,39 @@
|
|||||||
Data_Year,wdid1,wdid2,wdid3,wdid4
|
Data_Year,wdid1,wdid2,wdid3,wdid4
|
||||||
2024,'2008026'
|
2024,"2008026"
|
||||||
2024,'2006428','2005137'
|
2024,"2006428","2005137"
|
||||||
2024,'2013801','2998539'
|
2024,"2013801","2998539"
|
||||||
2024,'20138584','2008504'
|
2024,"20138584","2008504"
|
||||||
2024,'2013375','2005155'
|
2024,"2013375","2005155"
|
||||||
2024,'2005876','2009550','2013330'
|
2024,"2005876","2009550","2013330"
|
||||||
2024,'2006502','2009205'
|
2024,"2006502","2009205"
|
||||||
2024,'2006504','2009147'
|
2024,"2006504","2009147"
|
||||||
2024,'2006474','2008502'
|
2024,"2006474","2008502"
|
||||||
2024,'2012166','2012163'
|
2024,"2012166","2012163"
|
||||||
2024,'2005340','2005049'
|
2024,"2005340","2005049"
|
||||||
2024,'2008962','2008963'
|
2024,"2008962","2008963"
|
||||||
2024,'2013506','2008965'
|
2024,"2013506","2008965"
|
||||||
2024,'2005046','2005410'
|
2024,"2005046","2005410"
|
||||||
2024,'2008457','2008452'
|
2024,"2008457","2008452"
|
||||||
2024,'2009305','2013915'
|
2024,"2009305","2013915"
|
||||||
2024,'2005207','2014155'
|
2024,"2005207","2014155"
|
||||||
2024,'2705247'
|
2024,"2705247"
|
||||||
2024,'2005176','2006011'
|
2024,"2005176","2006011"
|
||||||
2024,'2005645'
|
2024,"2005645"
|
||||||
2024,'2005033'
|
2024,"2005033"
|
||||||
2024,'2010719'
|
2024,"2010719"
|
||||||
2024,'2008235','2011333'
|
2024,"2008235","2011333"
|
||||||
2024,'2008397','2008406'
|
2024,"2008397","2008406"
|
||||||
2024,'2005527','2012676'
|
2024,"2005527","2012676"
|
||||||
2024,'2008197','2013969'
|
2024,"2008197","2013969"
|
||||||
2024,'2008040','2010723'
|
2024,"2008040","2010723"
|
||||||
2024,'2705050','2705058'
|
2024,"2705050","2705058"
|
||||||
2024,'2009609'
|
2024,"2009609"
|
||||||
2024,'2706270'
|
2024,"2706270"
|
||||||
2024,'2705797'
|
2024,"2705797"
|
||||||
2024,'2705436','2705437','2705644','2706071'
|
2024,"2705436","2705437","2705644","2706071"
|
||||||
2024,'2012450'
|
2024,"2012450"
|
||||||
2024,'2012668'
|
2024,"2012668"
|
||||||
2024,'2705235'
|
2024,"2705235"
|
||||||
2024,'2006567'
|
2024,"2006567"
|
||||||
2024,'2013548'
|
2024,"2013548"
|
||||||
2024,'2013563'
|
2024,"2013563"
|
||||||
|
|||||||
|
Can't render this file because it has a wrong number of fields in line 2.
|
Loading…
x
Reference in New Issue
Block a user