SCI/workflow.R at master · LimnoTech/SCI · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159

library(readxl)
library(usethis)

devtools::load_all(".")


# Input Variables ---------------------------------------------------------

# Excel spreadsheet with Ambient Water Quality Data
df_wq <- readxl::read_excel("data/ARII_Xtab_AmbWQ_SCI_downloaded_20250102.xlsx",
                            col_types = c("text","text","date","text","text","date", "text","text","text","text"))

# Excel spreadsheet with Rapid Stream Assessment (RSA) reach and point data
df_reach <- readxl::read_excel("data/StreamReaches_20241105.xlsx")
df_point <- readxl::read_excel("data/StreamPoints_20241105_INT.xlsx")

# Date ranges used for filtering water quality data
start_date <- "2017-01-01"
end_date <- "2024-12-31"

# Field name prefixes for RSA dataset
# Prefixes change depending on layer and table names pulled from geodatabase
reach_prefix_from_table <- "StreamReachAttributes"  # Should match name of stream reach attribute table from RSA .gdb
reach_prefix_from_layer <- "StreamReaches"          # Should match name of stream reach polyline layer from RSA .gdb

point_prefix_from_table <- "StreamPointAttributes"  # Should match name of stream point attribute table from RSA .gdb
point_prefix_from_layer <- "StreamPoints_Nov2024_Intersect" # Should match name of intersected stream point layer from RSA .gdb


# Output filepaths
all_scores_path <- "output/all_scores.csv"
index_grades_path <- "output/index_grades.csv"
overall_grades_path <- "output/overall_grades.csv"
graphics_ppt_path <- "output/SCI_graphics.pptx"


# Lookup Tables -----------------------------------------------------------


# If data in lookup_tables.xlsx is modified, run the corresponding lines of code
#    below to update the relevant lookup table. Otherwise, keep code as comments

    # location_id <- readxl::read_excel("data/lookup_tables.xlsx", sheet = "location_id")
    # usethis::use_data(location_id, overwrite = TRUE)
    #
    # location_name <- readxl::read_excel("data/lookup_tables.xlsx", sheet = "location_name")
    # usethis::use_data(location_name, overwrite = TRUE)
    #
    # dumpsite_score <- readxl::read_excel("data/lookup_tables.xlsx", sheet = "dumpsite_score")
    # usethis::use_data(dumpsite_score, overwrite = TRUE)
    #
    # dumpsite_weight <- readxl::read_excel("data/lookup_tables.xlsx", sheet = "dumpsite_weight")
    # usethis::use_data(dumpsite_weight, overwrite = TRUE)
    #
    # trash_score <- readxl::read_excel("data/lookup_tables.xlsx", sheet = "trash_score")
    # usethis::use_data(trash_score, overwrite = TRUE)
    #
    # connectivity_summary <- readxl::read_excel("data/lookup_tables.xlsx", sheet = "connectivity_summary")
    # usethis::use_data(connectivity_summary, overwrite = TRUE)
    #
    # fish_summary <- readxl::read_excel("data/lookup_tables.xlsx", sheet = "fish_summary")
    # usethis::use_data(fish_summary, overwrite = TRUE)
    #
    # habitat_summary <- readxl::read_excel("data/lookup_tables.xlsx", sheet = "habitat_summary")
    # usethis::use_data(habitat_summary, overwrite = TRUE)
    #
    # macroinvertebrate_summary <- readxl::read_excel("data/lookup_tables.xlsx", sheet = "macroinvertebrate_summary")
    # usethis::use_data(macroinvertebrate_summary, overwrite = TRUE)
    #
    # eia_subsheds <- readxl::read_excel("data/lookup_tables.xlsx", sheet = "eia_subsheds")
    # usethis::use_data(eia_subsheds, overwrite = TRUE)
    #
    # eia_rock_creek <- readxl::read_excel("data/lookup_tables.xlsx", sheet = "eia_rock_creek")
    # usethis::use_data(eia_rock_creek, overwrite = TRUE)
    #
    # eia_score <- readxl::read_excel("data/lookup_tables.xlsx", sheet = "eia_score")
    # usethis::use_data(eia_score, overwrite = TRUE)


# Run Calculations --------------------------------------------------------

df_wq_formatted <- format_wq(df_wq)
df_wq_processed <- process_wq(df_wq_formatted, start_date, end_date)

# Water Quality - Nutrients
## Units for criteria are in mg/L. Original dataset does not include units for non-detects. Function does not filter for units so ND results get included
tp <- assess_wq_nutrients(df_wq_processed, parameter_name = "Phosphorus, Total (as P)", piedmont_criteria = 0.04, coastal_plain_criteria = 0.0225)
tn <- assess_wq_nutrients(df_wq_processed, parameter_name = "Nitrogen", piedmont_criteria = 1.295, coastal_plain_criteria = 0.395)


# Water Quality - Non-nutrient parameters
temp <- assess_wq(df_wq_processed, parameter_name = "Temperature, water", unit = "deg C", max_criteria = 24)
ph <- assess_wq(df_wq_processed, parameter_name = "pH",  unit = "none", max_criteria = 8.5, min_criteria = 6.0)
do <- assess_wq(df_wq_processed, parameter_name = "Dissolved oxygen (DO)", unit = "mg/L", min_criteria = 5.0)
ecoli <- assess_wq(df_wq_processed, parameter_name = "Escherichia coli", unit = "MPN/100mL", max_criteria = 410)
turb <- assess_wq(df_wq_processed, parameter_name = "Turbidity", unit = "NTU", max_criteria = 20.9)
cond <- assess_wq(df_wq_processed, parameter_name = "Conductivity", unit = "uS/cm", max_criteria = 300)


# Aquatic Biology - Pull static results from lookup table
conn <- connectivity_summary %>% dplyr::select(sci_subshed,
                                               Connectivity = score)
fish <- fish_summary %>% dplyr::select(sci_subshed,
                                       Fish = score)
hab <- habitat_summary %>% dplyr::select(sci_subshed,
                                         Habitat = score)
macro <- macroinvertebrate_summary %>% dplyr::select(sci_subshed,
                                                     Macroinvertebrates = score)


# Assess RSA Data
trash <- assess_trash(df_reach, reach_prefix_from_table, reach_prefix_from_layer)
dumpsite <- assess_dumpsites(df_point, df_reach,
                             reach_prefix_from_table, reach_prefix_from_layer,
                             point_prefix_from_table, point_prefix_from_layer)

# EIA
eia <- assess_eia()

# Compile scores
all_scores <-
  trash[["score"]] %>%
  dplyr::full_join(dumpsite[["score"]]) %>%
  dplyr::full_join(eia[["score"]]) %>%
  dplyr::full_join(temp[["score"]]) %>%
  dplyr::full_join(ph[["score"]]) %>%
  dplyr::full_join(do[["score"]]) %>%
  dplyr::full_join(ecoli[["score"]]) %>%
  dplyr::full_join(turb[["score"]]) %>%
  dplyr::full_join(cond[["score"]]) %>%
  dplyr::full_join(tn[["score"]]) %>%
  dplyr::full_join(tp[["score"]]) %>%
  dplyr::full_join(conn) %>%
  dplyr::full_join(fish) %>%
  dplyr::full_join(hab) %>%
  dplyr::full_join(macro)

# Write results file
write.csv(all_scores, file = all_scores_path)


# Create Graphics ---------------------------------------------------------

# Calculate grades to be represented in each graphic
grades <- calculate_grades(all_scores)

grade_graphics <- grades[["graphics"]]

# Write grades file
write.csv(grades[["index_grades"]], index_grades_path)
write.csv(grades[["overall_grades"]], overall_grades_path)

# Generate graphics
create_graphics(grade_graphics, graphics_ppt_path)