diff --git a/script_datos.R b/script_datos.R
deleted file mode 100644
index 5f7aafa..0000000
--- a/script_datos.R
+++ /dev/null
@@ -1,82 +0,0 @@
-library(zoo)
-
-#####
-####Still in development
-#####
-#Load to Enviroment "knn_optim", "knn_past" and "knn_elements"
-
-y <- sunspot.month
-
-n <- NROW(y)
-train_init <- floor(n * 0.7)
-test_init <- floor(n * 0.9)
-y_train <- y[1:test_init]
-distance <- "euclidean"
-error_metric <- "RMSE"
-weight <- "proximity"
-n_threads <- 7
-ks <- 1:60
-ds <- 1:30
-dates <- as.Date(time(y))
-min_y <- min(y)
-max_y <- max(y)
-
-# Get errors matrix, and best k and d
-res <- knn_optim(y = y_train, k = ks, d = ds, init = train_init, distance_metric = distance,
- error_metric = error_metric, weight = weight, threads = n_threads)
-
-optimal_train <- knn_past(y = y_train, k = res$k, d = res$d, init = train_init,
- distance_metric = distance, weight = weight, threads = n_threads)
-optimal_test <- knn_past(y = y, k = res$k, d = res$d, init = test_init,
- distance_metric = distance, weight = weight, threads = n_threads)
-optimal <- c(optimal_train, optimal_test)
-
-y_err <- ts(y[(train_init + 1):n])
-y_train_err <- ts(y[(train_init + 1):test_init])
-y_test_err <- ts(y[(test_init + 1):n])
-sub_dates <- tail(dates, length(y) - train_init)
-naive <- ts(y[train_init:(n - 1)])
-cont_min <- min(res$errors)
-cont_max_fix <- (max(res$errors) - (max(res$errors) - cont_min) * 0.4)
-num_contours <- 12
-
-minimums <- head(sort.int(res$errors, index.return = TRUE)$ix , 5)
-
-x_minims <- ((minimums - 1) %% max(ks)) + 1
-y_minims <- ceiling(minimums/max(ks))
-
-
-# Data for residuals
-residuals_matrix <- matrix(nrow = 5, ncol = length(y_err))
-residuals_matrix[1, ] <- y_err - optimal
-residuals_matrix[2, ] <- y_err - naive
-
-# Data for errors table
-names_col <- c("Optimal", "Naive", "Seasonal Naive", "", "", "")
-optimal_train_error <- accuracy(ts(optimal_train), y_train_err)
-optimal_test_error <- accuracy(ts(optimal_test), y_test_err)
-naive_train_error <- accuracy(naive[1:length(y_train_err)], y_train_err)
-naive_test_error <- accuracy(naive[(length(y_train_err) + 1):length(naive)], y_test_err)
-
-errors_matrix <- matrix(nrow = 5, ncol = 14)
-errors_matrix[1, ] <- c(optimal_train_error, optimal_test_error)
-errors_matrix[2, ] <- c(naive_train_error, naive_test_error)
-
-errors_matrix_tab1 <- errors_matrix
-errors_matrix_tab2 <- errors_matrix
-
-# Data for selected methods
-selected_methods <- rep(FALSE, 5)
-
-# Data for selected points in contour
-selected_points <- matrix(rep(FALSE, NROW(res$errors) * NCOL(res$errors)), nrow = NROW(res$errors), ncol = NCOL(res$errors))
-selected_points_aux <<- selected_points
-previous_countour <<- "default"
-
-# Index of error type
-# error_type <- switch(error_metric,
-# ME = 1,
-# RMSE = 2,
-# MAE = 3,
-# MPE = 4,
-# MAPE = 5)
\ No newline at end of file
diff --git a/script_graficas.R b/script_graficas.R
deleted file mode 100644
index 2ae8fb5..0000000
--- a/script_graficas.R
+++ /dev/null
@@ -1,76 +0,0 @@
-library(plotly)
-library(shiny)
-library(shinyWidgets)
-library(DT)
-
-# Plots for main tab
-pMain <- plot_ly(x = dates, y = y, type = "scatter", name = "Real Time Series", mode = "lines", legendgroup = "real", hoverinfo = "x+y")
-pMain <- add_trace(pMain, x = sub_dates, y = optimal, name = paste0("Optimal (k = ", res$k, ", d = ", res$d, ")"), legendgroup = "optim")
-# pMain <- add_trace(pMain, x = sub_dates, y = naive, name = "Naive", legendgroup = "naive")
-# Separation lines for train and test
-pMain <- add_segments(pMain, x = dates[train_init], xend = dates[train_init], y = min_y - 0.05 * (max_y - min_y),
- yend = max_y + 0.05 * (max_y - min_y), name = "Train", showlegend = FALSE, text = "Train",
- hoverinfo = "text", legendgroup = "lines", line = list(color = "gray", width = 1.5, dash = "dash"))
-pMain <- add_segments(pMain, x = dates[test_init], xend = dates[test_init], y = min_y - 0.05 * (max_y - min_y),
- yend = max_y + 0.05 * (max_y - min_y), name = "Test", showlegend = FALSE, text = "Test",
- hoverinfo = "text", legendgroup = "lines", line = list(color = "gray", width = 1.5, dash = "dash"))
-pMain <- layout(pMain, xaxis = list(rangeslider = list(type = "date")))
-pMainBase <- pMain
-
-#Errors
-pErrMain <- plot_ly(x = sub_dates, y = residuals_matrix[1, ], name = "Optimal error", type = "scatter", mode = "markers", legendgroup = "optim", hoverinfo = "x+y")
-#pErrMain <- add_trace(pErrMain, x = sub_dates, y = residuals_matrix[2, ], name = "Naive error", legendgroup = "naive")
-
-combPlotMain <- subplot(pMain, pErrMain, nrows = 2, shareX = TRUE)
-
-
-
-
-# Plots for optimization tab
-pOpt <- plot_ly(x = dates, y = y, type = "scatter", name = "Real Time Series", mode = "lines", legendgroup = "real", hoverinfo = "x+y")
-pOpt <- add_trace(pOpt, x = sub_dates, y = optimal, name = paste0("Optimal (k = ", res$k, ", d = ", res$d, ")"), legendgroup = "optim")
-pOpt <- add_segments(pOpt, x = dates[train_init], xend = dates[train_init], y = min_y - 0.05 * (max_y - min_y),
- yend = max_y + 0.05 * (max_y - min_y), name = "Train", showlegend = FALSE, text = "Train",
- hoverinfo = "text", legendgroup = "lines", line = list(color = "gray", width = 1.5, dash = "dash"))
-pOpt <- add_segments(pOpt, x = dates[test_init], xend = dates[test_init], y = min_y - 0.05 * (max_y - min_y),
- yend = max_y + 0.05 * (max_y - min_y), name = "Test", showlegend = FALSE, text = "Test",
- hoverinfo = "text", legendgroup = "lines", line = list(color = "gray", width = 1.5, dash = "dash"))
-pOpt <- layout(pOpt, xaxis = list(rangeslider = list(type = "date")))
-
-pOptBase <- pOpt
-
-# Error bars
-pBarsOpt <- plot_ly(type = "scatter", mode = "markers", hoverinfo = "x+y")
-#pBarsOpt <- add_trace(pBarsOpt, x = sub_dates, y = residuals_matrix[1, ], name = "Optimal error", type = "scatter", mode = "markers", legendgroup = "optim", hoverinfo = "x+y")
-pBarsOptBase <- pBarsOpt
-pBarsOpt <- add_trace(pBarsOpt, x = sub_dates, y = residuals_matrix[1, ], name = "Optimal error",
- type = "scatter", mode = "markers", legendgroup = "optim", hoverinfo = "x+y")
-
-combPlotOpt <- subplot(pOpt, pBarsOpt, nrows = 2, shareX = TRUE)
-
-
-# Contour
-#Default
-pContourBase <- plot_ly(x = ks , y = ds, z = res$errors, transpose = TRUE, type = "contour", source = "contour",
- autocontour = TRUE, contours = list(showlabels = TRUE, coloring = "heatmap"), colorscale = "Jet",
- ncontours = 4*num_contours, hoverinfo = "x+y+z")
-pContourBase <- layout(pContourBase, xaxis = list(title = "k"), yaxis = list(title = "d") )
-pContourBase <- add_trace(pContourBase, type = "scatter", mode = "markers", x = x_minims[1], y = y_minims[1],
- text = as.character(res$errors[x_minims[1], y_minims[1] ]),
- marker = list(color = "green"), hoverinfo = "x+y+text", showlegend = FALSE)
-pContourBase <- add_trace(pContourBase, type = "scatter", mode = "markers", x = x_minims[2:5], y = y_minims[2:5],
- text = as.character(res$errors[x_minims[2:5], y_minims[2:5] ][,1]),
- marker = list(color = "orange"), hoverinfo = "x+y+text", showlegend = FALSE)
-
-#Top-values trimmed
-pContourTrim <- plot_ly(x = ks , y = ds, z = res$errors, transpose = TRUE, type = "contour", source = "contour",
- colorscale = "Jet", contours = list(showlabels = TRUE, coloring = "heatmap",
- start = cont_min, end = (cont_max_fix + cont_min)/2,
- size = (((cont_max_fix+cont_min)/2)-cont_min)/num_contours),
- zmin = cont_min, zmax = cont_max_fix, hoverinfo = "x+y+z")
-pContourTrim <- layout(pContourTrim, xaxis = list(title = "k"), yaxis = list(title = "d") )
-pContourTrim <- add_trace(pContourTrim, type = "scatter", mode = "markers", x = x_minims[1], y = y_minims[1], text = as.character(res$errors[x_minims[1], y_minims[1] ]), marker = list(color = "green"), hoverinfo = "x+y+text", showlegend = FALSE)
-pContourTrim <- add_trace(pContourTrim, type = "scatter", mode = "markers", x = x_minims[2:5], y = y_minims[2:5], text = as.character(res$errors[x_minims[2:5], y_minims[2:5] ][,1]), marker = list(color = "orange"), hoverinfo = "x+y+text", showlegend = FALSE)
-
-pContour <- pContourBase
-
diff --git a/script_shiny.R b/script_shiny.R
deleted file mode 100644
index d9f6ee9..0000000
--- a/script_shiny.R
+++ /dev/null
@@ -1,395 +0,0 @@
-server <- function(input, output, session) {
- output$optimization <- renderPlotly({
- #pContour
- click <- event_data("plotly_click", source = "contour")
- #if (is.null(click))
- #return(pContour)
- if (!is.null(click) ) {
- k = click[[3]]
- d = click[[4]]
- if (x_minims[1] != k || y_minims[1] != d) {
- selected_points[k, d] <<- !selected_points[k, d]
- }
- }
-
- # Selected points that are related to minimuns can't be taken out
- #for (i in 1:5) {
- #if (any(x_minims == k && y_minims == d) ) {
- #if (x_minims[i] == k && y_minims[i] == d) {
- #return(pContour)
- #}
- #}
-
-
-
- #if (selected_points[k,d]) { #it wasn't selected, so just have to add that dot
- #pContour <<- add_trace(pContour, type = "scatter", mode = "markers", x = k, y = d,
- # text = as.character(res$errors[k, d]), marker = list(color = "red"),
- # hoverinfo = "x+y+text", showlegend = FALSE)
- #return(pContour)
- #}
- #it was selected, so we have to add all the dots again
- if (input$contourType != previous_countour) {
- selected_points <<- selected_points_aux
- }
-
- if (input$contourType == "trim") {
- pContour <<- pContourTrim
- previous_countour <<- "trim"
- selected_points_aux <<- selected_points
- }
- else if (input$contourType == "naive") {
- #falta crear en script_gráficas otra más
- pContour <<- pContourBase
- previous_countour <<- "naive"
- selected_points_aux <<- selected_points
- }
- else {
- pContour <<- pContourBase
- previous_countour <<- "default"
- selected_points_aux <<- selected_points
- }
-
- for (i in 1:NROW(selected_points)) {
- for (j in 1:NCOL(selected_points)) {
- if (selected_points[i, j])
- pContour <<- add_trace(pContour, type = "scatter", mode = "markers", x = i, y = j,
- text = as.character(res$errors[i, j]), marker = list(color = "red"),
- hoverinfo = "x+y+text", showlegend = FALSE)
- }
- }
- pContour
- })
-
- output$optPlot <- renderPlotly({
- #combPlotOpt
- # if ( (!exists("lastChbAbs2val")) || lastChbAbs2val != input$chbabs_tab2 ) {
- # lastChbAbs2val <<- input$chbabs_tab2
- # print(paste0("Se ha quedado a ",lastChbAbs2val))
- # pOpt <<- pOptBase
- # pBarsOpt <<- pBarsOptBase
- #
- # if (input$chbabs_tab2 == TRUE) {
- # pBarsOpt <<- add_trace(pBarsOpt, x = sub_dates, y = abs(residuals_matrix[1, ]),
- # name = "Optimal Error", legendgroup = "optim")
- # }
- # else {
- # pBarsOpt <<- add_trace(pBarsOpt, x = sub_dates, y = residuals_matrix[1, ],
- # name = "Optimal Error", legendgroup = "optim")
- # }
- #
- # for (i in 1:NROW(selected_points)) {
- # for (j in 1:NCOL(selected_points)) {
- # if (selected_points[i, j] && i != res$k && j != res$d) {
- # preds <- knn_past(y = y, k = i, d = j, init = train_init, distance_metric = distance,
- # weight = weight, threads = n_threads)
- # pOpt <<- add_trace(pOpt, x = sub_dates, y = preds, name = paste("k =" , i, "d =" , j),
- # legendgroup = paste("k", i, "d", j))
- # #comprobar valor absoluto en el error
- # if (input$chbabs_tab2 == 1) {
- # pBarsOpt <<- add_trace(pBarsOpt, x = sub_dates, y = abs(y_err - preds),
- # name = paste("k", i, "d", j, "Error"), legendgroup = paste("k", i, "d", j))
- # }
- # else {
- # pBarsOpt <<- add_trace(pBarsOpt, x = sub_dates, y = y_err - preds,
- # name = paste("k", i, "d", j, "Error"), legendgroup = paste("k", i, "d", j))
- # }
- # }
- # }
- # }
- #
- # combPlotOpt <<- subplot(pOpt, pBarsOpt, nrows = 2, shareX = TRUE)
- # return(combPlotOpt)
- # }
-
- click <- event_data("plotly_click", source = "contour")
- if (!is.null(click)) {
- #print("Procesando click")
- #print(click)
- k = click[[3]]
- d = click[[4]]
-
- # The best combination is always plotted
- if (x_minims[1] == k && y_minims[1] == d)
- return(combPlotOpt)
- }
-
- if (input$contourType != previous_countour) {
- selected_points <<- selected_points_aux
- }
-
- # It wasn't selected, so just have to add that line
- # if (selected_points[k,d]) {
- # auxPred <- knn_past(y = y, k = k, d = d, init = train_init,
- # distance_metric = distance, weight = weight, threads = n_threads)
- # pOpt <<- add_trace(pOpt, x = sub_dates, y = auxPred, name = paste("k =", k, "d =", d),
- # legendgroup = paste("k", k, "d", d))
- # #comprobar valor absoluto en el error
- # if (input$chbabs_tab2 == 1) {
- # pBarsOpt <<- add_trace(pBarsOpt, x = sub_dates, y = abs(y_err - auxPred),
- # name = paste("k" , k, "d" , d, "Error"), legendgroup = paste("k", k, "d", d))
- # }
- # else {
- # pBarsOpt <<- add_trace(pBarsOpt, x = sub_dates, y = y_err - auxPred,
- # name = paste("k" , k, "d" , d, "Error"), legendgroup = paste("k", k, "d", d))
- # }
- # combPlotOpt <<- subplot(pOpt, pBarsOpt, nrows = 2, shareX = TRUE)
- # return( combPlotOpt )
- # }
-
- # Erased one point, so we have to replot everything
- pOpt <<- pOptBase
- pBarsOpt <<- pBarsOptBase
- if (input$chbabs_tab2 == 1) {
- pBarsOpt <<- add_trace(pBarsOpt, x = sub_dates, y = abs(residuals_matrix[1, ]),
- name = "Optimal Error", legendgroup = "optim")
- }
- else {
- pBarsOpt <<- add_trace(pBarsOpt, x = sub_dates, y = residuals_matrix[1, ],
- name = "Optimal Error", legendgroup = "optim")
- }
-
- for (i in 1:NROW(selected_points)) {
- for (j in 1:NCOL(selected_points)) {
- if (selected_points[i, j]) {
- preds <- knn_past(y = y, k = i, d = j, init = train_init, distance_metric = distance,
- weight = weight, threads = n_threads)
- pOpt <<- add_trace(pOpt, x = sub_dates, y = preds, name = paste0("k = " , i, ", d = " , j, ""),
- legendgroup = paste("k", i, "d", j))
- #comprobar valor absoluto en el error
- if (input$chbabs_tab2 == 1) {
- pBarsOpt <<- add_trace(pBarsOpt, x = sub_dates, y = abs(y_err - preds),
- name = paste0("k = " , i, ", d = " , j, "", " Error"), legendgroup = paste("k", i, "d", j))
- }
- else {
- pBarsOpt <<- add_trace(pBarsOpt, x = sub_dates, y = y_err - preds,
- name = paste0("k = " , i, ", d = " , j, "", " Error"), legendgroup = paste("k", i, "d", j))
- }
- }
- }
- }
- combPlotOpt <<- subplot(pOpt, pBarsOpt, nrows = 2, shareX = TRUE)
- combPlotOpt
-
- })
-
- output$table_tab2 <- renderDataTable({
- click <- event_data("plotly_click", source = "contour")
- if (!is.null(click)) {
- #print("Procesando click")
- #print(click)
- k = click[[3]]
- d = click[[4]]
- }
-
- if (input$contourType != previous_countour) {
- selected_points <<- selected_points_aux
- }
-
- names_col_local <- c(names_col[1])
- errors_matrix_local <- matrix(errors_matrix_tab2[1, ], nrow = 1)
- # names_col_local <- c(names_col_local, names_col[2])
- # errors_matrix_local <- rbind(errors_matrix_local, errors_matrix_tab2[2, ])
-
- for (i in 1:NROW(selected_points)) {
- for (j in 1:NCOL(selected_points)) {
- if (selected_points[i, j]){
- names_col_local <- c(names_col_local, paste0("k = " , i, ", d = " , j, ""))
- preds <- knn_past(y = y, k = i, d = j, init = train_init, distance_metric = distance,
- weight = weight, threads = n_threads)
- train_error <- accuracy(ts(preds[1:length(y_train_err)]), y_train_err)
- test_error <- accuracy(ts(preds[(length(y_train_err) + 1):length(preds)]), y_test_err)
- errors_aux <- c(train_error, test_error)
- errors_matrix_local <- rbind(errors_matrix_local, errors_aux)
- }
- }
- }
-
- DT::datatable(data.frame(
- Name = names_col_local, trainME = round(errors_matrix_local[, 1], digits = 2), trainRMSE = round(errors_matrix_local[, 2], 2),
- trainMAE = round(errors_matrix_local[, 3], digits = 2), testME = round(errors_matrix_local[, 8], digits = 2),
- testRMSE = round(errors_matrix_local[, 9], 2), testMAE = round(errors_matrix_local[, 10], digits = 2)
- ), colnames = c("Name", "ME (train)", "RMSE (train)", "MAE (train)", "ME (test)", "RMSE (test)", "MAE (test)"))
-
- })
-
- output$mainPlot <- renderPlotly({
- # This traces are always in the graphic
- #pMain <- plot_ly(x = dates, y = y, type = "scatter", name = "Real", mode = "lines", legendgroup = "real", hoverinfo = "x+y")
- #pMain <- add_trace(pMain, x = sub_dates, y = optimal, name = paste("Optimal k =", res$k, "d =", res$d), legendgroup = "optim")
- #pMain <- add_segments(pMain, x = dates[train_init], xend = dates[train_init], y = min_x - 0.10 * (max_x - min_x),
- # yend = max_x + 0.10 * (max_x - min_x), name = "Train", showlegend = FALSE, text = "Train",
- # hoverinfo = "text", line = list(color = "gray", width = 1.5, dash = "dash"))
- #pMain <- add_segments(pMain, x = dates[test_init], xend = dates[test_init], y = min_x - 0.10 * (max_x - min_x),
- # yend = max_x + 0.10 * (max_x - min_x), name = "Test", showlegend = FALSE, text = "Test",
- # hoverinfo = "text", line = list(color = "gray", width = 1.5, dash = "dash"))
- #pMain <- layout(pMain, xaxis = list(rangeslider = list(type = "date")))
- pMain <- pMainBase
-
- if (input$chbabs == 1) {
- pErrMain <- plot_ly(x = sub_dates, y = abs(residuals_matrix[1, ]), name = "Optimal Error",
- type = "scatter", mode = "markers", legendgroup = "optim", hoverinfo = "x+y")
- }
- else {
- pErrMain <- plot_ly(x = sub_dates, y = residuals_matrix[1, ], name = "Optimal Error",
- type = "scatter", mode = "markers", legendgroup = "optim", hoverinfo = "x+y")
- }
-
- # Naive activated with checkbox
- if (input$chbnaive == 1) {
- pMain <- add_trace(pMain, x = sub_dates, y = naive, name = "Naive", legendgroup = "naive")
- if (input$chbabs == 1) {
- pErrMain <- add_trace(pErrMain, x = sub_dates, y = abs(residuals_matrix[2, ]),
- name = "Naive Error", legendgroup = "naive")
- }
- else {
- pErrMain <- add_trace(pErrMain, x = sub_dates, y = residuals_matrix[2, ],
- name = "Naive Error", legendgroup = "naive")
- }
- }
-
- if (input$chbsnaive == 1) {
- isolate({
- snaive <- ts(y[(train_init - as.numeric(input$s) + 1):(n - as.numeric(input$s))])
- })
- residuals_matrix[3, ] <- y_err - snaive
- pMain <- add_trace(pMain, x = sub_dates, y = snaive, name = "S. Naive", legendgroup = "snaive")
- if (input$chbabs == 1) {
- pErrMain <- add_trace(pErrMain, x = sub_dates, y = abs(residuals_matrix[3, ]),
- name = "S. Naive Error", legendgroup = "snaive")
- }
- else {
- pErrMain <- add_trace(pErrMain, x = sub_dates, y = residuals_matrix[3, ],
- name = "S. Naive Error", legendgroup = "snaive")
- }
- }
-
- # Load data activated with checkbox
- if (input$chbsload == 1) {
- isolate({
- new_ts <- readRDS(input$path)
- name <- basename(input$path)
- })
- pMain <- add_trace(pMain, x = sub_dates, y = new_ts, name = name, legendgroup = name)
- residuals_matrix[5, ] <- y_err - new_ts
- if (input$chbabs == 1) {
- pErrMain <- add_trace(pErrMain, x = sub_dates, y = abs(residuals_matrix[5, ]),
- name = paste(name, "Error"), legendgroup = name)
- }
- else {
- pErrMain <- add_trace(pErrMain, x = sub_dates, y = residuals_matrix[5, ],
- name = paste(name, "Error"), legendgroup = name)
-
- }
- }
- combPlotMain <- subplot(pMain, pErrMain, nrows = 2, shareX = TRUE)
- combPlotMain
- })
-
-
- output$table_tab1 <- renderDataTable({
- names_col_local <- c(names_col[1])
- errors_matrix_local <- matrix(errors_matrix_tab1[1, ], nrow = 1)
-
- # Naive activated with checkbox
- if (input$chbnaive == 1) {
- names_col_local <- c(names_col_local, names_col[2])
- errors_matrix_local <- rbind(errors_matrix_local, errors_matrix_tab1[2, ])
- }
-
- if (input$chbsnaive == 1) {
- names_col_local <- c(names_col_local, names_col[3])
- isolate({
- snaive <- ts(y[(train_init - as.numeric(input$s) + 1):(n - as.numeric(input$s))])
- })
- train_error <- accuracy(snaive[1:length(y_train_err)], y_train_err)
- test_error <- accuracy(snaive[(length(y_train_err) + 1):length(snaive)], y_test_err)
- errors_matrix_tab1[3, ] <- c(train_error, test_error)
- errors_matrix_local <- rbind(errors_matrix_local, errors_matrix_tab1[3, ])
- }
-
- if (input$chbsload == 1) {
- isolate({
- new_ts <- readRDS(input$path)
- name <- basename(input$path)
- })
- names_col_local <- c(names_col_local, name)
- train_error <- accuracy(ts(new_ts[1:length(y_train_err)]), y_train_err)
- test_error <- accuracy(ts(new_ts[(length(y_train_err) + 1):length(new_ts)]), y_test_err)
- errors_matrix_tab1[5, ] <- c(train_error, test_error)
- errors_matrix_local <- rbind(errors_matrix_local, errors_matrix_tab1[5, ])
- }
-
- DT::datatable(data.frame(
- Name = names_col_local, trainME = round(errors_matrix_local[, 1], digits = 2), trainRMSE = round(errors_matrix_local[, 2], 2),
- trainMAE = round(errors_matrix_local[, 3], digits = 2), testME = round(errors_matrix_local[, 8], digits = 2),
- testRMSE = round(errors_matrix_local[, 9], 2), testMAE = round(errors_matrix_local[, 10], digits = 2)
- ), colnames = c("Name", "ME (train)", "RMSE (train)", "MAE (train)", "ME (test)", "RMSE (test)", "MAE (test)"))
-
- })
-
-}
-
-ui <- navbarPage("",
-
- tabPanel("Vs",
- fluidPage(
- headerPanel("Time Series and Predictions"),
- mainPanel(
- plotlyOutput("mainPlot")
- ),
- sidebarPanel(
- tags$head(
- tags$style(HTML("hr {border-top: 1px solid #cbcbcb;}"))
- ),
- checkboxInput("chbnaive", label = "Naive", value = TRUE),
- hr(),
- checkboxInput("chbsnaive", label = "Seasonal Naive", value = FALSE),
- textInput("s", "Lag:"),
- hr(),
- checkboxInput("chbsload", label = "Custom", value = FALSE),
- textInput("path", "File:"),
- actionButton("browse", "Browse"),
- hr(),
- materialSwitch(inputId = "chbabs", label = "Absolute Error", value = FALSE, status = "primary")
- #prettyCheckbox("chbabs", label = "Absolute Error", value = FALSE, thick = TRUE, shape = "curve", bigger = TRUE)
-
- ),
-
- headerPanel("Errors Table"),
- sidebarPanel(
- DT::dataTableOutput("table_tab1"),
- width = 10
- )
- )
-
- ),
-
-
- tabPanel("Optimization",
- headerPanel(HTML(paste0("Errors for each k and d (", error_metric, ")"))),
- mainPanel(
- plotlyOutput("optimization")
- ),
- sidebarPanel(
- radioButtons("contourType", label = "Type of contour", selected = "default",
- choices = list("Default" = "default", "Contour lines under Naive" = "naive", "Top-values color trimmed" = "trim"))
- ),
- headerPanel("Time Series and Predictions"),
- mainPanel(
- plotlyOutput("optPlot")
- ),
- sidebarPanel(
- materialSwitch(inputId = "chbabs_tab2", label = "Absolute Error", value = FALSE, status = "primary")
- # checkboxInput("chbabs_tab2", label = "Absolute Error", value = FALSE)
- ),
- headerPanel("Errors Table"),
- sidebarPanel(
- DT::dataTableOutput("table_tab2"),
- width = 10
- )
- )
-)
-
-# Now run the following:
-# shinyApp(server = server, ui = ui)
\ No newline at end of file