Browse Source

Fix some stuff with the shiny app so that it actually works

Petra Lamborn 5 years ago
parent
commit
998e897e66
2 changed files with 44 additions and 32 deletions
  1. 11
    11
      R/weathmod.R
  2. 33
    21
      shiny/app.R

+ 11
- 11
R/weathmod.R View File

@@ -37,36 +37,36 @@ tplot <- ggplot(fulltemp, aes(x = temp_timestamp, y = tmin_c)) + geom_line() +
37 37
     geom_line(aes(y = runmin), color = "blue") +
38 38
     geom_line(aes(y = runmax), color = "red")
39 39
 
40
-tplot
40
+# tplot
41 41
 
42
-tplot + coord_cartesian(xlim = c(as.POSIXct("2016-12-01"), as.POSIXct("2017-03-01")))
42
+# tplot + coord_cartesian(xlim = c(as.POSIXct("2016-12-01"), as.POSIXct("2017-03-01")))
43 43
 
44 44
 # Create a harmonic (sine wave) model for minimum temperature
45
-yharm <- harmonic(ts(1:nrow(fulltemp), frequency = floor(365.25 * 48)), 2)
45
+yharm <- harmonic(ts(1:nrow(fulltemp), frequency = floor(365.25 * 48)), 2) %>% as.data.frame()
46 46
 #dharm <- harmonic(ts(1:nrow(fulltemp), frequency = floor(48)), 1)
47
-hmod <- lm(fulltemp$runmin ~ yharm)
47
+hmod <- lm(fulltemp$runmin ~ ., data = yharm)
48 48
 summary(hmod)
49 49
 
50 50
 hmdf <- data.frame(x = fulltemp$temp_timestamp, y = fulltemp$runmin, f = fitted(hmod), r = resid(hmod))
51 51
 tmplot <- ggplot(hmdf, aes(x = x, y = y)) + geom_line(aes(y = f), color = "blue", size = 2) + geom_point() +
52 52
     geom_point(aes(y = r), color = "darkgreen")
53 53
 
54
-tmplot
54
+# tmplot
55 55
 
56
-tmplot + coord_cartesian(xlim = c(as.POSIXct("2017-05-01", tz = "UTC"), as.POSIXct("2017-06-01", tz = "UTC")))
56
+# tmplot + coord_cartesian(xlim = c(as.POSIXct("2017-05-01", tz = "UTC"), as.POSIXct("2017-06-01", tz = "UTC")))
57 57
 
58 58
 
59 59
 
60
-maxhmod <- lm(fulltemp$runmax ~ yharm)
60
+maxhmod <- lm(fulltemp$runmax ~ ., data = yharm)
61 61
 summary(maxhmod)
62 62
 mhmdf <- data.frame(x = fulltemp$temp_timestamp, y = fulltemp$runmax, f = fitted(maxhmod), r = resid(maxhmod))
63 63
 
64 64
 mtmplot <- ggplot(mhmdf, aes(x = x, y = y)) + geom_line(aes(y = f), color = "blue", size = 2) + geom_point() +
65 65
     geom_point(aes(y = r), color = "darkgreen")
66 66
 
67
-mtmplot
67
+# mtmplot
68 68
 
69
-mtmplot + coord_cartesian(xlim = c(as.POSIXct("2017-05-01", tz = "UTC"), as.POSIXct("2017-06-01", tz = "UTC")))
69
+# mtmplot + coord_cartesian(xlim = c(as.POSIXct("2017-05-01", tz = "UTC"), as.POSIXct("2017-06-01", tz = "UTC")))
70 70
 
71 71
 hmdf.comb <- left_join(hmdf, mhmdf, by = "x", suffix = c(".min", ".max"))
72 72
 
@@ -75,9 +75,9 @@ ctmplot <- ggplot(hmdf.comb, aes(x = x, y = f.min)) + geom_line(color = "blue",
75 75
     geom_point(aes(y = y.max), color = "magenta") +
76 76
     geom_point(aes(y = y.min), color = "lightblue")
77 77
 
78
-ctmplot
78
+# ctmplot
79 79
 
80
-ctmplot + coord_cartesian(xlim = c(as.POSIXct("2017-05-01", tz = "UTC"), as.POSIXct("2017-06-01", tz = "UTC")))
80
+# ctmplot + coord_cartesian(xlim = c(as.POSIXct("2017-05-01", tz = "UTC"), as.POSIXct("2017-06-01", tz = "UTC")))
81 81
 
82 82
 write.csv(hmdf.comb, "../data/weatherharm.csv", row.names = FALSE)
83 83
 

+ 33
- 21
shiny/app.R View File

@@ -5,6 +5,7 @@ library(ggplot2)
5 5
 library(shinycssloaders)
6 6
 library(TSA)
7 7
 theme_set(theme_bw())
8
+use_virtualenv("../venv/")
8 9
 
9 10
 p <- import("pandas")
10 11
 aggdf <- p$read_pickle("../data/9-clusters.agg.pkl")
@@ -42,9 +43,9 @@ ui <- navbarPage("Counties Power demand modelling", collapsible = TRUE, selected
42 43
                )
43 44
                )),
44 45
       tabPanel("Prediction",
45
-               plotOutput("predPlot") %>% withSpinner(type = 5),
46
+               plotOutput("predPlot"),
46 47
                fluidRow(
47
-                        column(8,
48
+                        column(6,
48 49
                sliderInput("temprange", "Temperature range", min = 0, max = 30, value = c(10, 18), width = "100%", post = " °C",
49 50
                            step = 0.5, dragRange = TRUE)),
50 51
                column(2,
@@ -52,20 +53,23 @@ ui <- navbarPage("Counties Power demand modelling", collapsible = TRUE, selected
52 53
                       ),
53 54
                column(2,
54 55
                       selectInput("predday", "Day of week", weekdaychoices, selected = 2, width = "100%")
56
+                      ),
57
+               column(2,
58
+                      numericInput("prl", "Reference line (kwh)", value = 2, width = "100%")
55 59
                       )
56 60
                ),
57 61
 
58 62
                h5("Number of ICPs of each cluster serviced by node:"),
59 63
                fluidRow(
60 64
                     column(1, numericInput("c1v", "1:", value = 1, min = 0, step = 1, width = "100%"), offset = 0),
61
-                    column(1, numericInput("c2v", "2:", value = 1, min = 0, step = 1, width = "100%")),
62
-                    column(1, numericInput("c3v", "3:", value = 1, min = 0, step = 1, width = "100%")),
63
-                    column(1, numericInput("c4v", "4:", value = 1, min = 0, step = 1, width = "100%")),
64
-                    column(1, numericInput("c5v", "5:", value = 1, min = 0, step = 1, width = "100%")),
65
-                    column(1, numericInput("c6v", "6:", value = 1, min = 0, step = 1, width = "100%")),
66
-                    column(1, numericInput("c7v", "7:", value = 1, min = 0, step = 1, width = "100%")),
67
-                    column(1, numericInput("c8v", "8:", value = 1, min = 0, step = 1, width = "100%")),
68
-                    column(1, numericInput("c9v", "9:", value = 1, min = 0, step = 1, width = "100%"))
65
+                    column(1, numericInput("c2v", "2:", value = 0, min = 0, step = 1, width = "100%")),
66
+                    column(1, numericInput("c3v", "3:", value = 0, min = 0, step = 1, width = "100%")),
67
+                    column(1, numericInput("c4v", "4:", value = 0, min = 0, step = 1, width = "100%")),
68
+                    column(1, numericInput("c5v", "5:", value = 0, min = 0, step = 1, width = "100%")),
69
+                    column(1, numericInput("c6v", "6:", value = 0, min = 0, step = 1, width = "100%")),
70
+                    column(1, numericInput("c7v", "7:", value = 0, min = 0, step = 1, width = "100%")),
71
+                    column(1, numericInput("c8v", "8:", value = 0, min = 0, step = 1, width = "100%")),
72
+                    column(1, numericInput("c9v", "9:", value = 0, min = 0, step = 1, width = "100%"))
69 73
                 )
70 74
                
71 75
                )
@@ -99,34 +103,42 @@ server <- function(input, output) {
99 103
         return(dplot)
100 104
     })
101 105
 
102
-    prediction <- reactive({
106
+    prediction <- function() {
103 107
         numeclus <- c(input$c1v,input$c2v,input$c3v,input$c4v,input$c5v,input$c6v,input$c7v,input$c8v,input$c9v)
104 108
         numeclus[is.na(numeclus)] <- 0
105 109
         ystart <- floor((as.numeric(input$predmon) - 0.5) / 12 * 365.25 * 48)
106 110
         harm.y <- ts(1:48, frequency = 365.25 * 48, start = c(1, ystart)) %>% harmonic(2)
107
-        harm.w <- ts(1:48, frequency = 7 * 48, start = c(1, 48 * as.numeric(input$predday))) %>% harmonic(3)
111
+        harm.w <- ts(1:48, frequency = 7 * 48, start = c(1, 48 * (-1 + as.numeric(input$predday)))) %>% harmonic(3)
108 112
         harm.d <- ts(1:48, frequency = 48, start = c(1, 1)) %>% harmonic(3)
109 113
         colnames(harm.y) <- sprintf("%s.%s.%s", "year", rep(c("cos", "sin"), each = ncol(harm.y)/2), rep(1:(ncol(harm.y)/2), times = 2))
110 114
         colnames(harm.w) <- sprintf("%s.%s.%s", "week", rep(c("cos", "sin"), each = ncol(harm.w)/2), rep(1:(ncol(harm.w)/2), times = 2))
111 115
         colnames(harm.d) <- sprintf("%s.%s.%s", "day",  rep(c("cos", "sin"), each = ncol(harm.d)/2), rep(1:(ncol(harm.d)/2), times = 2))
112
-        yharm <- harmonic(ts(1:48, frequency = floor(365.25 * 48), start = c(1, ystart)), 2)
113
-        harnames <- paste0("yharm", colnames(yharm))
114
-        # yharm <- as.data.frame(yharm)
115
-        colnames(yharm) <- harnames
116
-        wmmin <- input$temprange[1] - predict(minhwm, as.data.frame(yharm))
117
-        wmmax <- input$temprange[2] - predict(maxhwm, as.data.frame(yharm))
116
+        qharm <- harmonic(ts(1:48, frequency = floor(365.25 * 48), start = c(1, ystart)), 2)
117
+        # harnames <- paste0("yharm", colnames(qharm))
118
+        qharm <- as.data.frame(qharm)
119
+        # names(qharm) <- harnames
120
+        wmmin <- input$temprange[1] - predict(minhwm, newdata = qharm, type = 'response')
121
+        wmmax <- input$temprange[2] - predict(maxhwm, newdata = qharm, type = 'response')
118 122
         predinp <- data.frame(resmin = wmmin, resmax = wmmax)
119 123
         predinp <- cbind(predinp, harm.y, harm.w, harm.d)
120 124
         predvec = rep(0, 48)
121 125
         for (c in 1:length(clusters)) {
122
-            predvec <- predvec + numeclus[c] * predict(models[[c]], predinp)
126
+            predvec <- predvec + numeclus[c] * predict(models[[c]], newdata = predinp, type = 'response')
123 127
         }
124 128
         return(data.frame(x = 1:48, y = predvec))
125
-    })
129
+    }
126 130
 
127 131
     output$predPlot <- renderPlot({
128 132
         predf <- prediction()
129
-        ggplot(predf, aes(x, y)) + geom_line()
133
+        predp <- ggplot(predf, aes(x, y)) + geom_line()
134
+        predp <- predp + scale_y_continuous("Predicted kwh", limits = c(0, NA))
135
+        predp <- predp + scale_x_continuous("Time", labels = function(x) {
136
+                                                sprintf("%02d:%02d", (x %/% 2) %% 24, x %% 2 * 30)
137
+                                         }, breaks = 0:12 * 4)
138
+        if (!is.na(input$prl)) {
139
+            predp <- predp + geom_hline(yintercept = input$prl, linetype = "dashed")
140
+        }
141
+        predp
130 142
     })
131 143
 
132 144
 }