inst/mgmwm_gui/app.R

#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
#    http://shiny.rstudio.com/
#

library(shiny)
library(shinyjs)
library(imudata)
library(classimu)
library(wv)
library(gmwm)
library(simts)

data(KVH1750imu1kHzAcc)
data(KVH1750imu1kHzGyro)
data(MTIG710imu1kHz)
data(KVH1750imuAcc)
data(KVH1750imuGyro)
data(MTIG710imu50Hz)
data(ADIS16405imu100Hz)

const.RENDER_PLOT_WIDTH = 1000
const.RENDER_PLOT_HEIGHT = 600
const.RENDER_PLOT_RES = 100 # default is 72

const.FIGURE_PLOT_HEIGHT = "600px"
const.FIGURE_PLOT_HEIGHT_REDUCED = "400px"
const.FIGURE_PLOT_HEIGHT_LOGO = "100px"

const.nb_of_digits = 7

# convert degrees-per-second to radians-per-second
const.degps_2_radps = 1/360 * 2*pi

# constant default frequency for custom data
const.DEFAULT_FREQ = 1 # [Hz]
ui <- shinyUI(fluidPage(

  shinyjs::useShinyjs(),

  tags$style(HTML(".js-irs-0 .irs-single, .js-irs-0 .irs-bar-edge, .js-irs-0 .irs-bar {background: red}")),
  tags$style(HTML(".js-irs-1 .irs-single, .js-irs-1 .irs-bar-edge, .js-irs-1 .irs-bar {background: green}")),
  tags$style(type='text/css', '#summ {background-color: rgba(0,0,200,0.02); color: black; width: 500px; font-size: 14px;}'),


  title = "MGMWM GUI",
  tabsetPanel(id = "tabs",
              tabPanel("Model Data", plotOutput(outputId = "plot", height = const.FIGURE_PLOT_HEIGHT)),
              tabPanel("Selected Sensor", plotOutput(outputId = "plot2", height = const.FIGURE_PLOT_HEIGHT)),
              tabPanel("Summary", verbatimTextOutput(outputId = "summ", placeholder = FALSE)),
              tabPanel("Tutorial", htmlOutput("tuto")),
              tabPanel("Help",
                       # fluidPage("cluster"),
                       h4("Help Tab" ),
                       br(),
                       # actionButton("subClust", label = "Create Subcluster"),
                       #
                       uiOutput(outputId = "tabhelpurl"),
                       br(),br(),
                       fluidRow(
                         column(5,
                                plotOutput(outputId = "tabhelpplotlogo_pennstate", height = const.FIGURE_PLOT_HEIGHT_LOGO)
                         ),
                         column(5,
                                plotOutput(outputId = "tabhelpplotlogo_epfl", height = const.FIGURE_PLOT_HEIGHT_LOGO)
                         )
                       )
              )
  ),

  hr(),

  fluidRow(
    column(4,


             selectInput("imu_obj", "Select IMU file:",
                         c("KVH 1750 imu 1k Hz Accelerometers"="KVH1750imu1kHzAcc",
                           "KVH 1750 imu 1k Hz Gyroscopes"="KVH1750imu1kHzGyro",
                           "MTI-G-710 imu 1k Hz"="MTIG710imu1kHz",
                           "MTI-G-710 imu 50 Hz"="MTIG710imu50Hz",
                           "KVH 1750 imu 100 Hz Accelerometers"="KVH1750imuAcc",
                           "KVH 1750 imu 100 Hz Gyroscopes"="KVH1750imuGyro",
                           "ADIS 16405 imu 100Hz" = "ADIS16405imu100Hz"),
                         selected = 1),

            selectInput("sensors", "Select sensor", c("1"="1","2"="2", selected = 1)),



           actionButton("fit1", label = "Plot WV"),

           br(),

           uiOutput("choose_columns")
    ),

column(4,
       checkboxGroupInput("model", "Select Model",
                          c("Quantization Noise" = "QN",
                            "White Noise" = "WN",
                            "Random Walk" = "RW",
                            "Drift" = "DR",
                            "Auto-Regressive" = "AR"),
                          selected = "WN"),
       conditionalPanel(
         condition = "input.model.indexOf('AR')>-1",
         sliderInput("gm_nb", "Number of Gauss-Markov Processes", 1, 5, 2)
       ),

       actionButton("fit3", label = "Fit Model"),

       br(),
       br(),
       br(),
       br(),

       actionButton("fit2", label = "Reduce Model Automatically")

),

column(4,

       checkboxInput("process_decomp", "Show latent processes", TRUE),
       checkboxInput("fast", "Fast computation", FALSE),
       checkboxInput("test", "Near-stationarity test", FALSE),
       checkboxInput("test_pval", "Paired test Selection", FALSE),

       br(),

       checkboxGroupInput("summary_plot", label = "Summary options:",
                          c("Show test result" = "test_result"),
                          selected = c("sum")),

       conditionalPanel(
         condition = "input.edit_intern == 1",
         numericInput("num", label = "Number of Simu. for Starting Values", value = 10^5),
         numericInput("seed", label = "Simulation seed", value = 1982)
       )

)
)
))

# Define server logic required to draw a histogram
server <- function(input, output, session) {

  # library or custom dataset
  v <- reactiveValues(plot = FALSE,
                      fit = FALSE,
                      gmwm = NULL,
                      form = NULL,
                      freq = 100,
                      first_gmwm = NULL,
                      n = NULL,
                      sensor_name = NULL,
                      sensor_column = NULL,
                      overlap_datasheet = FALSE,
                      y_label_with_dataunits = NA,


                      first_time_plotting_6_pack = TRUE,

                      custom_data = FALSE,
                      custom_data_name = NULL,
                      custom_data_type = NULL,
                      custom_data_size = NULL,
                      custom_data_tot_colums = NULL,
                      datasheet_noise_model = NULL,
                      datasheet_values_make_sense = FALSE)


  dsnames <- c()

  data_set <- reactive({
    inFile <- input$imu_obj

    if (is.null(inFile))
      return(kvh)

    data_set <- get(input$imu_obj)
  })

  observe({
    dsnames <- names(data_set())
    cb_options <- list()
    cb_options[ dsnames] <- dsnames
    data_set <- get(input$imu_obj)
    v$all = data_set
    updateSelectInput(session, "sensors",
                      label = "Selected sensor",
                      choices = cb_options,
                      selected = "")
  })


  # PUSHING ON BUTTON "Plot WV"
  observeEvent(input$fit1, {

    withProgress(message = 'Calculating empirical WV...', value = 0, {

      v$plot = TRUE
      v$fit = FALSE

      my_data = get(input$imu_obj)
      Xt = my_data[input$sensors][[1]]

      v$sensor_name = input$imu_obj
      v$sensor_column = input$sensors
      v$freq = attr(my_data, 'freq')
      v$custom_data = FALSE
      if (input$sensors == "Gyro. X" || input$sensors == "Gyro. Y" || input$sensors == "Gyro. Z"){
        v$y_label_with_dataunits = expression(paste("Wavelet Variance ", nu, " [", rad^2/s^2, "]"))
      } else if (input$sensors == "Acc.X" || input$sensors == "Acc.Y" || input$sensors == "Acc.Z"){
        v$y_label_with_dataunits = expression(paste("Wavelet Variance ", nu, " [", m^2/s^4, "]"))
      }


      v$form = Xt

      updateNavbarPage(session, "tabs", selected = "Selected Sensor")
    })
  })


  observeEvent(input$fit3, {

    withProgress(message = 'Fitting desired model...', value = 0, {

      if (is.null(v$first_gmwm)){
        v$first_gmwm = TRUE
      }
      v$fit = TRUE
      v$plot = FALSE

      my_data = get(input$imu_obj)
      Xt = my_data[input$sensors][[1]]

      first = TRUE
      counter_model_size = 0

      if ("AR" %in% input$model){
        for (i in 1:input$gm_nb){
          counter_model_size = counter_model_size + 1
          if (first == TRUE){
            model = AR1()
            first = FALSE
          }else{
            model = model + AR1()
          }
        }
      }

      if ("WN" %in% input$model){
        counter_model_size = counter_model_size + 1
        if (first == TRUE){
          model = WN()
          first = FALSE
        }else{
          model = model + WN()
        }
      }

      if ("QN" %in% input$model){
        counter_model_size = counter_model_size + 1
        if (first == TRUE){
          model = QN()
          first = FALSE
        }else{
          model = model + QN()
        }
      }


      if ("RW" %in% input$model){
        counter_model_size = counter_model_size + 1
        if (first == TRUE){
          model = RW()
          first = FALSE
        }else{
          model = model + RW()
        }
      }

      if ("DR" %in% input$model){
        counter_model_size = counter_model_size + 1
        if (first == TRUE){
          model = DR()
          first = FALSE
        }else{
          model = model + DR()
        }
      }

      if (is.null(model)){
        model = 3*AR1()
      }

      if (is.null(input$seed)){
        input$seed = 1982
      }

      if (is.null(input$num)){
        input$num = 10^5
      }
      v$gmwm = mgmwm(model = model, mimu = Xt, stationarity_test = input$test, B = 100, fast = input$fast)
      v$form = v$gmwm
      v$first_gmwm = FALSE

      updateNavbarPage(session, "tabs", selected = "Selected Sensor")

    })

  })

  # BUTTON REDUCE MODEL WHICH WILL USE THE model_selection FUNCTION
  observeEvent(input$fit2, {

    withProgress(message = 'Reducing model automatically...', value = 0, {

      if (is.null(v$first_gmwm)){
        v$first_gmwm = TRUE
      }
      v$fit = TRUE
      v$plot = FALSE

      my_data = get(input$imu_obj)
      Xt = my_data[input$sensors][[1]]

      first = TRUE
      counter_model_size = 0

      if ("AR" %in% input$model){
        for (i in 1:input$gm_nb){
          counter_model_size = counter_model_size + 1
          if (first == TRUE){
            model = AR1()
            first = FALSE
          }else{
            model = model + AR1()
          }
        }
      }

      if ("WN" %in% input$model){
        counter_model_size = counter_model_size + 1
        if (first == TRUE){
          model = WN()
          first = FALSE
        }else{
          model = model + WN()
        }
      }

      if ("QN" %in% input$model){
        counter_model_size = counter_model_size + 1
        if (first == TRUE){
          model = QN()
          first = FALSE
        }else{
          model = model + QN()
        }
      }


      if ("RW" %in% input$model){
        counter_model_size = counter_model_size + 1
        if (first == TRUE){
          model = RW()
          first = FALSE
        }else{
          model = model + RW()
        }
      }

      if ("DR" %in% input$model){
        counter_model_size = counter_model_size + 1
        if (first == TRUE){
          model = DR()
          first = FALSE
        }else{
          model = model + DR()
        }
      }

      if (is.null(model)){
        model = 3*AR1()
      }

      a = model_selection( Xt, model ,s_test = 2, test_pval = input$test_pval)
      v$form = a


      updateNavbarPage(session, "tabs", selected = "Selected Sensor")
    })
  })


  output$plot2 <- renderPlot({
    if (class(v$form) == "mgmwm"){
      plot(v$form, process.decomp = input$process_decomp)
    }else{
      plot(v$form)
    }
  })

  output$plot <- renderPlot({
    N = length(v$all)

    if (N > 3){
      par(mfrow = c(2,3))
    }else{
     par(mfrow = c(1,3))
    }


    for (i in 1:N){
      if (i == 1){
        plot(v$all[[i]])
      }else{
        plot(v$all[[i]], legend = FALSE)
      }

    }
  })

  output$summ <- renderPrint({
    if (v$fit){

      summmary_of_gmwm = list(v$form$estimate, v$form$obj.value, v$form$p_value, v$form$test_res)

      if("test_result" %in% input$summary_plot){
        # summmary_of_gmwm
        cat("Objective Function: ", v$form$obj.value, "\n")
        cat("P-value: ", v$form$p_value, "\n\n")
        cat("Test Result: ", v$form$test.result, "\n\n\n")
        v$form$estimate
      } else {
        cat("Objective Function: ", v$form$obj.value, "\n")
        v$form$obj.value
        v$form$estimate
      }
    }
  })


  output$tuto <- renderUI({
    tags$iframe(src = "https://www.youtube.com/embed/HPPj6viIBmU", height=400, width=600)
  })
}



# Run the application
shinyApp(ui = ui, server = server)
SMAC-Group/classimu documentation built on May 6, 2019, 12:23 p.m.