alex/CREP_Policy_Interaction_Analysis
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Updating with new pumping data

Browse Source
This commit is contained in:
Alex Gebben Work 2026-04-21 17:11:24 -06:00
parent 6bd0ae9639
commit 317520250b
3 changed files with 121 additions and 85 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
2_Hydrobase.r
View File

@ -1,44 +1,28 @@
#install.packages("devtools") #install.packages("devtools")
#devtools::install_github("anguswg-ucsb/cdssr") #devtools::install_github("anguswg-ucsb/cdssr")
library(cdssr) #library(cdssr)
library(tidyverse) library(tidyverse)
library(janitor) library(janitor)
#install.packages("janitor") #install.packages("janitor")
#API <- 'PwevUQJCStcYZfqrOYbuyztmNPlUJWby' #API <- 'PwevUQJCStcYZfqrOYbuyztmNPlUJWby'
STR <- get_structures(div=3) %>% as_tibble %>% clean_names read_csv("Data/SBD_Data/StructureList_SBD2.csv")
SBD_LINK <- rbind(read_csv("Data/SBD_Data/StructureList_SBD1.csv") %>% mutate(SBD=1),
SBD_STR_DATA <- 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_SBD2.csv") %>% mutate(SBD=2),
read_csv("Data/SBD_Data/StructureList_SBD3.csv") %>% mutate(SBD=3), 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_SBD4.csv") %>% mutate(SBD=4),
read_csv("Data/SBD_Data/StructureList_SBD5.csv") %>% mutate(SBD=5), 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)) read_csv("Data/SBD_Data/StructureList_SBD6.csv") %>% mutate(SBD=6)) %>% clean_names %>% mutate(wdid=as.character(wdid))
SBD_LINK <- SBD_STR_DATA %>% select(wdid,sbd) #################
nrow(SBD_STR_DATA ) STRUCTURES <- 'https://dwr.state.co.us/Rest/GET/api/v2/structures/?format=csv&fields=wdid%2CciuCode%2CstructureType&division=3&pageSize=500000&apiKey=PwevUQJCStcYZfqrOYbuyztmNPlUJWby'
STR <- STR %>% left_join(SBD_LINK) %>% mutate(sbd=ifelse(is.na(sbd),"none",sbd)) STRUCTURES<- read_csv(STRUCTURES,skip=2 )
STR <- STR %>% select(wdid,sbd,ciu_code,county,water_district,sbd,structure_type,management_district_name,latdecdeg,longdecdeg) WELLS <- STRUCTURES %>% filter(structureType=='WELL')
STR
?get_structures_divrec_ts
get_structures_divrec_ts(wdid='2005007')
WDID <- 2005007
LINK <- paste0('https://dwr.state.co.us/Rest/GET/api/v2/structures/divrec/divrecyear/?format=tsv&dateFormat=dateOnly&fields=wdid%2CwaterClassNum%2CwcIdentifier%2CdataMeasDate%2CdataValue%2CmeasUnits%2CapprovalStatus&measInterval=Annual&wdid=',WDID,'&apiKey=PwevUQJCStcYZfqrOYbuyztmNPlUJWby')
TEMP <- read_tsv(LINK,skip=2 )
TEMP %>% print(n=20)
TOTAL_ROWS <- str_detect(TEMP$wcIdentifier,"Total")
Total_Values <- TEMP[TOTAL_ROWS,]
Total_Values %>% select(wdid,year=dataMeasDate,Volume=dataValue)
OTHER <- TEMP[!TOTAL_ROWS,]
OTHER$wcIdentifier
LIST <- WELLS %>% pull(wdid) %>% unique
TEMP %>% filter((wcIdentifier=='Total (Diversion)') if(file.exists("./Data/Div3_Pumping_Data.csv")){LIST <-LIST[-which(LIST %in% t(read.csv("./Data/Div3_Pumping_Data.csv")[,1] %>% unique))]}
%>% filter( 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")}}
STR %>% filter(structure_type=='WELL') closeAllConnections()
}
get_parceluse_ts(wdid='2005000')
STR <- as_tibble(STR)

84
Data/CREP_and_Fallow/Create_CREP_Data.r
View File

@ -5,7 +5,6 @@ CONTRACT_NUMBER <- c('ALA#3','ALA#6','ALA#7','ALA#8','ALA#9','ALA#10','ALA#12','
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) 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) 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("CREP_Perm.csv")) %>% as_tibble %>% mutate(program='CREP',RETURN_YEAR=Inf,contract_type='Perm') CREP_PERM <- cbind(CONTRACT_NUMBER,FIRST_FALLOW_YEAR,ACRES,read_csv("CREP_Perm.csv")) %>% as_tibble %>% mutate(program='CREP',RETURN_YEAR=Inf,contract_type='Perm')
CREP_PERM
###############################Temp CREP contract ###############################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') 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) 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)
@ -13,8 +12,6 @@ FIRST_FALLOW_YEAR <- c(2014,2014,2014,2014,2014,2014,2014,2014,2015,2015,2015,20
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) 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) 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("CREP_Temp.csv")) %>% as_tibble %>% mutate(program='CREP',contract_type='Temp') CREP_TEMP <- cbind(CONTRACT_NUMBER,FIRST_FALLOW_YEAR,RETURN_YEAR,ACRES,read_csv("CREP_Temp.csv")) %>% as_tibble %>% mutate(program='CREP',contract_type='Temp')
CREP_TEMP %>% full_join(CREP_PERM)
CREP_PERM
######SBD1 Fallow Program ######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_NUMBER <- c(paste("Fallow Parcel ",1:23),paste("Fallow Parcel ",1:27),c(paste("Fallow Parcel ",1:9),paste("Fallow Parcel ",11:33)))
@ -35,20 +32,13 @@ FIRST_FALLOW_YEAR <- c(
length(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 RETURN_YEAR <- CONTRACT_TERM +FIRST_FALLOW_YEAR
RETURN_YEAR
ACRES <- c( 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(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(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) 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)
) )
length( 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))
cbind(CONTRACT_NUMBER,FIRST_FALLOW_YEAR,RETURN_YEAR,ACRES)
length(CONTRACT_NUMBER)
length(FIRST_FALLOW_YEAR)
length(ACRES)
length(CONTRACT_TERM)
SBD1_TEMP_FALLOW <- cbind(CONTRACT_NUMBER,FIRST_FALLOW_YEAR,RETURN_YEAR,ACRES,read_csv("SBD1_Temp_Fallow.csv")) %>% as_tibble %>% mutate(program='SBD 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 <- cbind(CONTRACT_NUMBER,FIRST_FALLOW_YEAR,RETURN_YEAR,ACRES,read_csv("SBD1_Temp_Fallow.csv")) %>% as_tibble %>% mutate(program='SBD 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 SBD1_TEMP_FALLOW
@ -67,23 +57,85 @@ wdid2 <- c(rep(NA,5),2705517,2014273,NA,2009462,NA,2005035)
wdid3 <- c(rep(NA,10),2014173) wdid3 <- c(rep(NA,10),2014173)
SBD1_TEMP_FALLOW 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='SBD Temp Fallow',contract_ype='Temp') 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='SBD Temp Fallow',contract_type='Temp')
SBD1_TEMP_FALLOW <- SBD1_TEMP_FALLOW %>% full_join(DATA_2023 ) SBD1_TEMP_FALLOW <- SBD1_TEMP_FALLOW %>% full_join(DATA_2023 )
#####2024 data #####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("SBD1_Temp_Fallow_2024.csv")) %>% as_tibble %>% mutate(program='SBD 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("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("SB22_Data.csv")) %>% as_tibble %>% mutate(program='SB22-028',RETURN_YEAR=Inf,contract_type='Perm',Data_Year=2025)
###########Half Fallow Program ###########Half Fallow Program
CONTRACT_NUMBER <- paste("Half Usage",1:38) CONTRACT_NUMBER <- paste("Half Usage",1:38)
FIRST_FALLOW_YEAR <- rep(2020,38) FIRST_FALLOW_YEAR <- rep(2020,38)
RETURN_YEAR <- rep(2021,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) 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) 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("SBD1_Half_Fallow.csv")) %>% as_tibble %>% mutate(program='SBD Half Fallow',contract_type='Temp') HALF_FALLOW <- cbind(CONTRACT_NUMBER,FIRST_FALLOW_YEAR,RETURN_YEAR,ACRES,LIMIT,read_csv("SBD1_Half_Fallow.csv")) %>% as_tibble %>% mutate(program='SBD Half Fallow',contract_type='Temp')
HALF_FALLOW %>% tail #######################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
cbind(CONTRACT_NUMBER,ACRES,LIMIT) 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 <- 2005035
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}
}
ALL_PROGRAM_WELL_DATA %>% print(n=100)
IN_PROGRAM(2013956,CREP_PERM)
IN_PROGRAM(2705126,CREP_TEMP)
dir.create("./Cleaned",showWarnings=FALSE)
write_csv(SBD1_TEMP_FALLOW,"./Cleaned/SBD1_Temporary_Fallow_Payments.csv")
write_csv(SBD1_WELL_PURCHASE,"./Cleaned/SBD1_Well_Purchase_Program.csv")
write_csv(HALF_FALLOW,"./Cleaned/SBD1_Half_Fallow_Program.csv")
write_csv(SB22_Data,"./Cleaned/Bill_SB22_Fallow_Payments.csv")
write_csv(CREP,"./Cleaned/CREP.csv")

78
Data/CREP_and_Fallow/SBD1_Half_Fallow.csv
View File

@ -1,39 +1,39 @@
wdid1,wdid2,wdid3,wdid4 Data_Year,wdid1,wdid2,wdid3,wdid4
2008026 2024,'2008026'
2006428, 2005137 2024,'2006428','2005137'
2013801, 2998539 2024,'2013801','2998539'
20138584, 2008504 2024,'20138584','2008504'
2013375, 2005155 2024,'2013375','2005155'
2005876, 2009550,2013330 2024,'2005876','2009550','2013330'
2006502, 2009205 2024,'2006502','2009205'
2006504, 2009147 2024,'2006504','2009147'
2006474, 2008502 2024,'2006474','2008502'
2012166, 2012163 2024,'2012166','2012163'
2005340, 2005049 2024,'2005340','2005049'
2008962, 2008963 2024,'2008962','2008963'
2013506, 2008965 2024,'2013506','2008965'
2005046, 2005410 2024,'2005046','2005410'
2008457, 2008452 2024,'2008457','2008452'
2009305, 2013915 2024,'2009305','2013915'
2005207, 2014155 2024,'2005207','2014155'
2705247 2024,'2705247'
2005176, 2006011 2024,'2005176','2006011'
2005645 2024,'2005645'
2005033 2024,'2005033'
2010719 2024,'2010719'
2008235, 2011333 2024,'2008235','2011333'
2008397, 2008406 2024,'2008397','2008406'
2005527, 2012676 2024,'2005527','2012676'
2008197, 2013969 2024,'2008197','2013969'
2008040, 2010723 2024,'2008040','2010723'
2705050, 2705058 2024,'2705050','2705058'
2009609 2024,'2009609'
2706270 2024,'2706270'
2705797 2024,'2705797'
2705436, 2705437,2705644, 2706071 2024,'2705436','2705437','2705644','2706071'
2012450 2024,'2012450'
2012668 2024,'2012668'
2705235 2024,'2705235'
2006567 2024,'2006567'
2013548 2024,'2013548'
2013563 2024,'2013563'

1 wdid1,wdid2,wdid3,wdid4 Data_Year,wdid1,wdid2,wdid3,wdid4
2 2008026 2024,'2008026'
3 2006428, 2005137 2024,'2006428','2005137'
4 2013801, 2998539 2024,'2013801','2998539'
5 20138584, 2008504 2024,'20138584','2008504'
6 2013375, 2005155 2024,'2013375','2005155'
7 2005876, 2009550,2013330 2024,'2005876','2009550','2013330'
8 2006502, 2009205 2024,'2006502','2009205'
9 2006504, 2009147 2024,'2006504','2009147'
10 2006474, 2008502 2024,'2006474','2008502'
11 2012166, 2012163 2024,'2012166','2012163'
12 2005340, 2005049 2024,'2005340','2005049'
13 2008962, 2008963 2024,'2008962','2008963'
14 2013506, 2008965 2024,'2013506','2008965'
15 2005046, 2005410 2024,'2005046','2005410'
16 2008457, 2008452 2024,'2008457','2008452'
17 2009305, 2013915 2024,'2009305','2013915'
18 2005207, 2014155 2024,'2005207','2014155'
19 2705247 2024,'2705247'
20 2005176, 2006011 2024,'2005176','2006011'
21 2005645 2024,'2005645'
22 2005033 2024,'2005033'
23 2010719 2024,'2010719'
24 2008235, 2011333 2024,'2008235','2011333'
25 2008397, 2008406 2024,'2008397','2008406'
26 2005527, 2012676 2024,'2005527','2012676'
27 2008197, 2013969 2024,'2008197','2013969'
28 2008040, 2010723 2024,'2008040','2010723'
29 2705050, 2705058 2024,'2705050','2705058'
30 2009609 2024,'2009609'
31 2706270 2024,'2706270'
32 2705797 2024,'2705797'
33 2705436, 2705437,2705644, 2706071 2024,'2705436','2705437','2705644','2706071'
34 2012450 2024,'2012450'
35 2012668 2024,'2012668'
36 2705235 2024,'2705235'
37 2006567 2024,'2006567'
38 2013548 2024,'2013548'
39 2013563 2024,'2013563'