CREP_Policy_Interaction_Ana.../2_Create_Fallow_Program_Data.r
2026-07-22 16:25:13 -06:00

147 lines
13 KiB
R

library(tidyverse)
library(janitor)
#Data manually copied from tables in the yearly reports, and combined here. The original PDF files are very large but can be reviewed for accuracy by going to the public P-drive link to the data.
#The link to this raw data is https://u.pcloud.link/publink/show?code=kZ0vRc5Zv5LhTm5PoBbj5lyoSDgwwfX0DUCy or it can be found in the Annual Reports on the Subdistrict website.
#As an example the file "ARP 2023- ALL for Website.pdf" in the drive has a table in Appendix L- Crep and Fallow Programs starting at page 314. Each column was manually copied into the vectors in this file before being converted into a data frame and saved for later use in the data collation, and final analysis.
###########Some data was copied into rough csv files from the pdf's to make data maniputlation easier. This is the location of those files
ROOT_DIR <- "./Data/CREP_and_Fallow/"
dir.create(ROOT_DIR,showWarnings=FALSE)
RAW_DATA_DIR <- paste0(ROOT_DIR,"Raw_CSV_Data_Made_from_Files/")
################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(paste0(RAW_DATA_DIR,"CREP_Perm.csv"))) %>% as_tibble %>% mutate(program='CREP',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(paste0(RAW_DATA_DIR,"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(paste0(RAW_DATA_DIR,"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
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='SBD 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(paste0(RAW_DATA_DIR,"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(paste0(RAW_DATA_DIR,"SBD1_Well_Purchase.csv"))) %>% as_tibble %>% mutate(program='SBD1 Purchase',RETURN_YEAR=Inf,contract_type='Perm',Data_Year=2025)
######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(paste0(RAW_DATA_DIR,"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(paste0(RAW_DATA_DIR,"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 <- 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)
write_csv(SBD1_TEMP_FALLOW,paste0(ROOT_DIR,"SBD1_Temporary_Fallow_Payments.csv"))
write_csv(SBD1_WELL_PURCHASE,paste0(ROOT_DIR,"SBD1_Well_Purchase_Program.csv"))
write_csv(HALF_FALLOW,paste0(ROOT_DIR,"SBD1_Half_Fallow_Program.csv"))
write_csv(SB22_Data,paste0(ROOT_DIR,"Bill_SB22_Fallow_Payments.csv"))
write_csv(CREP,paste0(ROOT_DIR,"CREP.csv"))