Skip to content

Commit 552eeec

Browse files
nllongnllong
committed
reformat r files
1 parent eb0555c commit 552eeec

2 files changed

Lines changed: 111 additions & 95 deletions

File tree

‎bsyncr_server/lib/bsync_runner.r‎

Lines changed: 106 additions & 90 deletions
Original file line numberDiff line numberDiff line change
@@ -18,118 +18,134 @@ run_analysis <- function(bsync_filepath, model_type) {
1818

1919
baseline_xpath <- sprintf("//auc:Scenario[@ID = '%s']", baseline_scenario_id)
2020
sc_baseline <- xml2::xml_find_first(bsync_doc, baseline_xpath)
21-
not_used <- sc_baseline %>% bsyncr::bs_stub_derived_model(dm_id = "DerivedModel-bsyncr",
22-
dm_period = "Baseline")
21+
not_used <- sc_baseline %>% bsyncr::bs_stub_derived_model(
22+
dm_id = "DerivedModel-bsyncr",
23+
dm_period = "Baseline"
24+
)
2325

24-
b_df <- bsyncr::bs_parse_nmecr_df(bsync_doc, insert_weather_data=TRUE)
26+
b_df <- bsyncr::bs_parse_nmecr_df(bsync_doc, insert_weather_data = TRUE)
2527

2628
if (model_type == "SLR") {
27-
model <- nmecr::model_with_SLR(b_df,
28-
nmecr::assign_model_inputs(regression_type = "SLR"))
29+
model <- nmecr::model_with_SLR(
30+
b_df,
31+
nmecr::assign_model_inputs(regression_type = "SLR")
32+
)
2933
} else if (model_type == "3PC") {
30-
model <- nmecr::model_with_CP(b_df,
31-
nmecr::assign_model_inputs(regression_type = "3PC"))
34+
model <- nmecr::model_with_CP(
35+
b_df,
36+
nmecr::assign_model_inputs(regression_type = "3PC")
37+
)
3238
} else if (model_type == "3PH") {
33-
model <- nmecr::model_with_CP(b_df,
34-
nmecr::assign_model_inputs(regression_type = "3PH"))
39+
model <- nmecr::model_with_CP(
40+
b_df,
41+
nmecr::assign_model_inputs(regression_type = "3PH")
42+
)
3543
} else if (model_type == "4P") {
36-
model <- nmecr::model_with_CP(b_df,
37-
nmecr::assign_model_inputs(regression_type = "4P"))
44+
model <- nmecr::model_with_CP(
45+
b_df,
46+
nmecr::assign_model_inputs(regression_type = "4P")
47+
)
3848
} else {
39-
stop('Invalid model_type')
49+
stop("Invalid model_type")
4050
}
4151

4252
# add model to bsync tree
43-
bs_gen_dm_nmecr(nmecr_baseline_model = model,
44-
x = bsync_doc)
53+
bs_gen_dm_nmecr(
54+
nmecr_baseline_model = model,
55+
x = bsync_doc
56+
)
4557

46-
return(list("bsync_doc"=bsync_doc, "model"=model))
58+
return(list("bsync_doc" = bsync_doc, "model" = model))
4759
}
4860

4961
# setup
50-
args <- commandArgs(trailingOnly=TRUE)
62+
args <- commandArgs(trailingOnly = TRUE)
5163
if (length(args) != 3) {
52-
print('USAGE:')
53-
print('Rscript bsync_runner.r bsync_input model_type output_directory')
54-
print(' bsync_input: path to input file')
55-
print(' model_type: type of model to fit')
56-
print(' output_directory: directory to output files')
64+
print("USAGE:")
65+
print("Rscript bsync_runner.r bsync_input model_type output_directory")
66+
print(" bsync_input: path to input file")
67+
print(" model_type: type of model to fit")
68+
print(" output_directory: directory to output files")
5769
stop("Invalid arguments to script. See usage")
5870
}
5971
bsync_filepath <- args[1]
6072
model_type <- args[2]
6173
output_dir <- args[3]
62-
output_xml <- paste(output_dir, "result.xml", sep="/")
63-
output_plot <- paste(output_dir, "plot.png", sep="/")
64-
err_filename <- paste(output_dir, "error.json", sep="/")
74+
output_xml <- paste(output_dir, "result.xml", sep = "/")
75+
output_plot <- paste(output_dir, "plot.png", sep = "/")
76+
err_filename <- paste(output_dir, "error.json", sep = "/")
6577

66-
NOAA_TOKEN <- Sys.getenv('NOAA_TOKEN')
78+
NOAA_TOKEN <- Sys.getenv("NOAA_TOKEN")
6779
if (NOAA_TOKEN == "") {
6880
stop("Missing NOAA token env var: NOAA_TOKEN")
6981
}
70-
options(noaakey=NOAA_TOKEN)
71-
72-
tryCatch({
73-
# run analysis
74-
analysis_result <- run_analysis(bsync_filepath, model_type)
75-
bsync_doc <- analysis_result$bsync_doc
76-
model <- analysis_result$model
77-
78-
# save the updated bsync doc
79-
xml2::write_xml(bsync_doc, output_xml)
80-
81-
# save the plot
82-
model_df <- model$training_data %>%
83-
tidyr::gather(key = "variable", value = "value", c("eload", "model_fit"))
84-
85-
if (model$model_input_options$regression_type != "SLR") {
86-
# Add a data point for the derived change point to make sure the line plot looks correct
87-
temp_change_point <- abs(model$model$psi[2]) # this is the estimated temperature for the change point - taking abs b/c it is incorrectly negative for some models
88-
predictions <- calculate_model_predictions(
89-
training_data=model$training_data,
90-
prediction_data=as.data.frame(list(time=c(2019-01-01), temp=c(temp_change_point))),
91-
modeled_object=model
92-
)
93-
load_change_point <- predictions$predictions[1]
94-
model_df <- model_df %>% add_row(
95-
temp=temp_change_point,
96-
variable="model_fit",
97-
value=load_change_point)
82+
options(noaakey = NOAA_TOKEN)
83+
84+
tryCatch(
85+
{
86+
# run analysis
87+
analysis_result <- run_analysis(bsync_filepath, model_type)
88+
bsync_doc <- analysis_result$bsync_doc
89+
model <- analysis_result$model
90+
91+
# save the updated bsync doc
92+
xml2::write_xml(bsync_doc, output_xml)
93+
94+
# save the plot
95+
model_df <- model$training_data %>%
96+
tidyr::gather(key = "variable", value = "value", c("eload", "model_fit"))
97+
98+
if (model$model_input_options$regression_type != "SLR") {
99+
# Add a data point for the derived change point to make sure the line plot looks correct
100+
temp_change_point <- abs(model$model$psi[2]) # this is the estimated temperature for the change point - taking abs b/c it is incorrectly negative for some models
101+
predictions <- calculate_model_predictions(
102+
training_data = model$training_data,
103+
prediction_data = as.data.frame(list(time = c(2019 - 01 - 01), temp = c(temp_change_point))),
104+
modeled_object = model
105+
)
106+
load_change_point <- predictions$predictions[1]
107+
model_df <- model_df %>% add_row(
108+
temp = temp_change_point,
109+
variable = "model_fit",
110+
value = load_change_point
111+
)
112+
}
113+
114+
# display the data
115+
print(model_df)
116+
117+
if (model$model_input_options$regression_type == "SLR") {
118+
# add in the linear regression line from the model results, need to
119+
# confirm, but it looks like model is in BTU and °C
120+
intercept <- model$model$coefficients[["(Intercept)"]] / 3.41214 # BTU to kwh
121+
slope <- model$model$coefficients[["temp"]] * 9 / 5 # °C to °F
122+
ggplot2::ggplot(model_df, aes(x = temp, y = value)) +
123+
geom_point(aes(color = variable), data = model_df[model_df$variable == "eload", ]) +
124+
geom_line(aes(color = variable), data = model_df[model_df$variable == "model_fit", ]) +
125+
geom_abline(intercept = intercept, slope = slope, color = "red", linetype = "dashed") +
126+
xlab("Temperature") +
127+
scale_y_continuous(name = "Energy Data & Model Fit (kWh)", labels = scales::comma) +
128+
theme_minimal() +
129+
theme(legend.position = "bottom") +
130+
theme(legend.title = element_blank())
131+
} else {
132+
ggplot2::ggplot(model_df, aes(x = temp, y = value)) +
133+
geom_point(aes(color = variable), data = model_df[model_df$variable == "eload", ]) +
134+
geom_line(aes(color = variable), data = model_df[model_df$variable == "model_fit", ]) +
135+
xlab("Temperature") +
136+
scale_y_continuous(name = "Energy Data & Model Fit (kWh)", labels = scales::comma) +
137+
theme_minimal() +
138+
theme(legend.position = "bottom") +
139+
theme(legend.title = element_blank())
140+
}
141+
142+
143+
ggsave(output_plot)
144+
},
145+
error = function(e) {
146+
print(e)
147+
err <- list(message = e$message)
148+
write(rjson::toJSON(err), err_filename)
149+
quit(status = 1)
98150
}
99-
100-
# display the data
101-
print(model_df)
102-
103-
if (model$model_input_options$regression_type == "SLR") {
104-
# add in the linear regression line from the model results, need to
105-
# confirm, but it looks like model is in BTU and °C
106-
intercept = model$model$coefficients[["(Intercept)"]] / 3.41214 # BTU to kwh
107-
slope = model$model$coefficients[["temp"]] * 9/5 # °C to °F
108-
ggplot2::ggplot(model_df, aes(x = temp, y = value)) +
109-
geom_point(aes(color = variable), data=model_df[model_df$variable == "eload",]) +
110-
geom_line(aes(color = variable), data=model_df[model_df$variable == "model_fit",]) +
111-
geom_abline(intercept = intercept, slope = slope, color = "red", linetype = "dashed") +
112-
xlab("Temperature") +
113-
scale_y_continuous(name = "Energy Data & Model Fit (kWh)", labels = scales::comma) +
114-
theme_minimal() +
115-
theme(legend.position = "bottom") +
116-
theme(legend.title = element_blank())
117-
} else {
118-
ggplot2::ggplot(model_df, aes(x = temp, y = value)) +
119-
geom_point(aes(color = variable), data=model_df[model_df$variable == "eload",]) +
120-
geom_line(aes(color = variable), data=model_df[model_df$variable == "model_fit",]) +
121-
xlab("Temperature") +
122-
scale_y_continuous(name = "Energy Data & Model Fit (kWh)", labels = scales::comma) +
123-
theme_minimal() +
124-
theme(legend.position = "bottom") +
125-
theme(legend.title = element_blank())
126-
}
127-
128-
129-
ggsave(output_plot)
130-
}, error = function(e) {
131-
print(e)
132-
err <- list(message=e$message)
133-
write(rjson::toJSON(err), err_filename)
134-
quit(status=1)
135-
})
151+
)

‎install_r_packages.R‎

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@
44

55
# Install required packages if not already installed
66
required_packages <- c(
7-
"remotes", "crayon", "dplyr", "tidyr", "crul", "xml2", "testthat", "anytime","lubridate", "segmented", "xts", "zoo", "ggplot2", "scales", "XML", "rappdirs", "gridExtra", "isdparser", "geonames", "hoardr", "data.table"
7+
"remotes", "crayon", "dplyr", "tidyr", "crul", "xml2", "testthat", "anytime", "lubridate", "segmented", "xts", "zoo", "ggplot2", "scales", "XML", "rappdirs", "gridExtra", "isdparser", "geonames", "hoardr", "data.table"
88
)
99

1010
cat("Checking and installing required packages...\n")
@@ -14,15 +14,15 @@ for (pkg in required_packages) {
1414
}
1515
}
1616

17-
library('remotes')
17+
library("remotes")
1818
# RNOAA for weather data
19-
remotes::install_github('ropensci/[email protected]', upgrade='never')
19+
remotes::install_github("ropensci/[email protected]", upgrade = "never")
2020

2121
# NMECR from kW Engineering
22-
remotes::install_github('kW-Labs/[email protected]', upgrade='never')
22+
remotes::install_github("kW-Labs/[email protected]", upgrade = "never")
2323

2424
# BSync package for reading/writing BuildingSync files for NMECR
25-
remotes::install_github('BuildingSync/[email protected]', upgrade='never')
25+
remotes::install_github("BuildingSync/[email protected]", upgrade = "never")
2626

2727
library(rnoaa)
2828
rnoaa::ghcnd_stations()

0 commit comments

Comments
 (0)