inst/shiny/quant/server.R

## Server.R

shiny::shinyServer(function(input, output, session) {

  #################################
  ## TAB 1: Reference library builder
  #################################
    shiny::observe({
      #Load the xrd.csv file
      xrddata <- shiny::reactive({
        infile1 <- input$uploadXRD
        if (is.null(infile1)) {
          # User has not uploaded a file yet
          return(NULL)
          }
        read.csv(infile1$datapath, header = TRUE, stringsAsFactors = FALSE)
        })

      #Load the phase.csv file
      phasedata <- shiny::reactive({
        infile2 <- input$uploadPHASE
        if (is.null(infile2)) {
          #User has not uploaded a file yet
          return(NULL)
          }
        read.csv(infile2$datapath, header = TRUE, stringsAsFactors = FALSE)
        })

      #Create a powdRlib object
      Dataset <- shiny::eventReactive(input$BuildLibButton, {
        Dataset <- powdR::powdRlib(xrd_table = xrddata(),
                                   phases_table = phasedata())
        })

      #Download the library
      output$download_lib <- shiny::downloadHandler(
        filename = "my_powdRlib.Rdata",
        content = function(con) {
          assign(input$name, Dataset())
          save(list=input$name, file=con)
          }
        )

      #Tabulate the minerals in the library
      output$minerals_table <- DT::renderDataTable({
        Dataset()[[3]]
        }, options = list(lengthMenu = c(10, 25, 50), pageLength = 10))
      })

    shiny::observe({
      minerals_xrd <- powdR::minerals_xrd

      #Downloads of example data
      output$download_xrd_eg <- shiny::downloadHandler(
        filename = function() {
          paste("xrd_example_", Sys.Date(), ".csv", sep="")
          },
        content = function(file) {
          write.table(minerals_xrd, file, sep = ",", col.names = TRUE, row.names = FALSE)
          }
        )
      })

    shiny::observe({
      minerals_phases <- powdR::minerals_phases
      output$download_phases_eg <- shiny::downloadHandler(
        filename = function() {
          paste("phase_info_example_", Sys.Date(), ".csv", sep="")
          },
        content = function(file) {
          write.table(minerals_phases, file, sep = ",", col.names = TRUE, row.names = FALSE)
          }
        )
      })


  #################################
  ## TAB 2: Reference library plotter
  #################################

  shiny::observe({

  #Load library
  lib_plotter_load <- shiny::reactive({
    infile_lib_plotter <- input$loadLIB_plotter
    if (is.null(infile_lib_plotter)) {
      # User has not uploaded a file yet
      return(NULL)
    }
    bar <- load(infile_lib_plotter$datapath)
    lpl <- get(bar)
    return(lpl)
  })

  #Make sure the class of the uploaded data is correct and
  #if it is, update the selectInput
  if(class(lib_plotter_load()) == "powdRlib") {
    shiny::updateSelectInput(session, "selectPHASES_plotter",
                             label = NULL,
                             choices = paste0(lib_plotter_load()[[3]][[2]], ": ",
                                              lib_plotter_load()[[3]][[1]]),
                             selected = head(paste0(lib_plotter_load()[[3]][[2]], ": ",
                                                    lib_plotter_load()[[3]][[1]]), 1))
    }

  #Tabulate the minerals in the library
  output$lib_table <- DT::renderDataTable({
    lib_plotter_load()[[3]]
    }, options = list(lengthMenu = c(5, 10, 25, 50), pageLength = 5))

  #Plot phases in the library
  output$lib_plot <- plotly::renderPlotly({

    #Subset the library based on the selection
    lib_sub <- lib_plotter_load()

    if (length(which(gsub(".*: ", "", input$selectPHASES_plotter) %in% lib_sub$phases$phase_id)) < 1) {
      return(NULL)
    }

    if (length(input$selectPHASES_plotter > 0)) {
      lib_sub$xrd <- lib_sub$xrd[which(names(lib_sub$xrd) %in% gsub(".*: ", "", input$selectPHASES_plotter))]
      lib_sub$phases <- lib_sub$phases[which(lib_sub$phases$phase_id %in% gsub(".*: ", "", input$selectPHASES_plotter)),]
      }

    if(class(lib_sub) == "powdRlib" & length(input$selectPHASES_plotter > 0)) {
      plot(lib_sub, wavelength = input$selectWAVELENGTH, interactive = TRUE)
      } else {
        return(NULL)
        }
    })
  })
    #################################
    ## TAB 3: Reference library Editor
    #################################

    shiny::observe({

      #Load library
      lib_editor_load <- shiny::reactive({
        infile_lib_editor <- input$loadLIB_editor
        if (is.null(infile_lib_editor)) {
          # User has not uploaded a file yet
          return(NULL)
          }
        bar <- load(infile_lib_editor$datapath)
        lpl <- get(bar)
        return(lpl)
        })

      #Make sure the class of the uploaded data is correct and
      #if it is, update the selectInput
      if(class(lib_editor_load()) == "powdRlib") {
        shiny::updateSelectInput(session, "selectPHASES_editor",
                                 label = NULL,
                                 choices = paste0(lib_editor_load()[[3]][[2]], ": ",
                                                  lib_editor_load()[[3]][[1]]),
                                 selected = NULL)
        }

      #Create a powdRlib object
      subset_lib <- shiny::eventReactive(input$SubsetLibButton, {
        subset_lib <- subset(lib_editor_load(),
                             refs = gsub(".*: ", "", input$selectPHASES_editor),
                             mode = input$selectMODE_editor)
        })

      #Download the library
      output$download_subset_lib <- shiny::downloadHandler(
        filename = "my_powdRlib.Rdata",
        content = function(con) {
          assign(input$name_editor, subset_lib())
          save(list=input$name_editor, file=con)
          }
        )

      #Tabulate the minerals in the library
      output$minerals_subset_table <- DT::renderDataTable({
        subset_lib()[[3]]
        }, options = list(lengthMenu = c(10, 25, 50), pageLength = 10))
      })

    ##################################
    # TAB 4: Full pattern fitting
    ##################################

    #-------------------------------
    #Examples
    #-------------------------------

    shiny::observe({
      output$download_sandstone <- shiny::downloadHandler(
        filename = function() {
          paste("sandstone", Sys.Date(), ".xy", sep="")
        },
        content = function(file) {
          write.table(soils$sandstone, file, sep = " ", col.names = FALSE, row.names = FALSE)
        }
      )

      output$download_limestone <- shiny::downloadHandler(
        filename = function() {
          paste("limestone", Sys.Date(), ".xy", sep="")
        },
        content = function(file) {
          write.table(soils$limestone, file, sep = " ", col.names = FALSE, row.names = FALSE)
        }
      )

      output$download_granite <- shiny::downloadHandler(
        filename = function() {
          paste("granite", Sys.Date(), ".xy", sep="")
        },
        content = function(file) {
          write.table(soils$granite, file, sep = " ", col.names = FALSE, row.names = FALSE)
        }
      )

    })

    #Download an example reference library
    shiny::observe({

      output$download_rockjock <- shiny::downloadHandler(
        filename = "rockjock_powdRlib.Rdata",
        content = function(con) {
          assign("rockjock_powdRlib", rockjock)
          save(list="rockjock_powdRlib", file=con)
        }
      )

      output$download_mineral_library <- shiny::downloadHandler(
        filename = "example_powdRlib.Rdata",
        content = function(con) {
          assign("example_powdRlib", minerals)
          save(list="example_powdRlib", file=con)
        }
      )

    })


    #---------------------------------------------------
    #Uploading data
    #---------------------------------------------------

    #Load the .xy sample file

    filedata2 <- shiny::reactive({
      infile2 <- input$loadXY
      if (is.null(infile2)) {
        #User has not uploaded a file yet
        return(NULL)
      }

      csv1 <- lapply(infile2$datapath, read.csv, sep = " ", header = FALSE)
      names(csv1) <- substr(infile2$name, 1, nchar(infile2$name)-3)
      return(csv1)
    })

    shiny::observe({
      shiny::updateSelectInput(session, "selectOUTPUT_fps",
                               label = NULL,
                               choices = names(filedata2()))
    })



    #If a library has been uploaded, then create a reactive library
    filedata3 <- shiny::reactive({
      infile3 <- input$loadLIB
      if (is.null(infile3)) {
        #User has not uploaded a file yet
        return(NULL)
      }
      bar <- load(infile3$datapath)
      fd3 <- get(bar)
      return(fd3)
    })

    shiny::observe({

      #If automated mode is selected then update the selection box
      if (input$selectMode_fps == "Automated") {
        return(shiny::updateSelectInput(session, "selectSolver_fps",
                                        label = NULL,
                                        choices = c("BFGS", "Nelder-Mead", "CG"),
                                        selected = "BFGS"))
      }

      if (input$selectMode_fps == "Manual") {
        return(shiny::updateSelectInput(session, "selectSolver_fps",
                                        label = NULL,
                                        choices = c("BFGS", "Nelder-Mead", "CG", "NNLS"),
                                        selected = "BFGS"))
      }
    })


    output$amorph_help_ui <- shiny::renderUI({
      if (input$selectMode_fps == "Manual") return(NULL)
      return(shiny::helpText("Select which phases (if any) should be treated as amorphous"))
    })

    output$selectAMORPH_ui <- shiny::renderUI({
      if (input$selectMode_fps == "Manual") return(NULL)
      return(shiny::selectInput(inputId = "selectAMORPH",
                                label = NULL,
                                choices = c(),
                                multiple = TRUE,
                                selectize = TRUE))
    })

    output$force_help_ui <- shiny::renderUI({
      if (input$selectMode_fps == "Manual" | !class(filedata3()) == "powdRlib") return(NULL)

      return(shiny::helpText("Select the phases (if any) that should be forced to remain in the output"))
    })

    output$selectFORCE_ui <- shiny::renderUI({
      if (input$selectMode_fps == "Manual" | !class(filedata3()) == "powdRlib") return(NULL)
      refs_force <- list("PHASE_NAMES" = as.list(paste0(filedata3()[[3]][[2]])),
                         "PHASE IDs" = as.list(paste0(filedata3()[[3]][[2]], ": ", filedata3()[[3]][[1]])))

      #Order alphabetically
      #refs_force[[1]] <- refs_force[[1]][order(unlist(refs_force[[1]]))]
      #refs_force[[2]] <- refs_force[[2]][order(unlist(refs_force[[2]]))]

      return(shiny::selectInput("selectFORCE",
                                label = NULL,
                                choices = refs_force,
                                selected = NULL,
                                multiple = TRUE,
                                selectize = TRUE))
    })

    #Update the selectINPUT boxes in the full pattern fitting tab
    shiny::observe({
      if (class(filedata3()) == "powdRlib") {
        refs_choices <- list("SELECT ALL" = as.list("Select all"),
                             "PHASE_NAMES" = as.list(paste0(filedata3()[[3]][[2]])),
                             "PHASE IDs" = as.list(paste0(filedata3()[[3]][[2]], ": ", filedata3()[[3]][[1]])))
        #Order alphabetically
        #refs_choices[[1]] <- refs_choices[[1]][order(unlist(refs_choices[[1]]))]
        #refs_choices[[2]] <- refs_choices[[2]][order(unlist(refs_choices[[2]]))]

        return(shiny::updateSelectInput(session, "selectPHASES_fps",
                                        choices = refs_choices,
                                        selected = NULL))
      }
    })

    observe({
      if ("Select all" %in% input$selectPHASES_fps) {
        # choose all the choices _except_ "Select All"
        selected_choices <- setdiff(paste0(filedata3()[[3]][[2]]), "Select all")
        updateSelectInput(session, "selectPHASES_fps", selected = selected_choices)
      }
    })


    shiny::observe({
      if (class(filedata3()) == "powdRlib") {

        int_choices <- paste0(filedata3()[[3]][[2]], ": ", filedata3()[[3]][[1]])


        return(shiny::updateSelectInput(session, "selectINT_fps",
                                        choices = int_choices,
                                        selected = int_choices[1]))
      }
    })


    shiny::observe({

      amorph_choices <- paste0(filedata3()[[3]][[2]], ": ", filedata3()[[3]][[1]])

      if (input$selectMode_fps == "Automated") {
        return(shiny::updateSelectInput(session, "selectAMORPH",
                                        label = NULL,
                                        choices = amorph_choices,
                                        selected = NULL))
      }
    })

    shiny::observe({

      output$std_conc_help_ui <- shiny::renderUI({

        if (input$std_conc_check_fps == FALSE) return(NULL)

        return(shiny::helpText("Define the internal standard concentration"))
      })

    })

    shiny::observe({

      output$std_conc_box_fps_ui <- shiny::renderUI({

        if (input$std_conc_check_fps == FALSE) return(NULL)

        return(shiny::numericInput("std_conc_box_fps", label = NULL,
                                   min = 0.01,
                                   max = 99.99,
                                   value = 20,
                                   step = 0.01))
      })

    })

    #Use the selected library to adjust the 2theta slider
    shiny::observe({

      if (!is.null(input$loadLIB)) {
        return(shiny::updateSliderInput(session = session, inputId = "tth_fps_slide",
                                        min = round(min(as.numeric(filedata3()[[2]])) + abs(input$align_fps), 2),
                                        max = round(max(as.numeric(filedata3()[[2]])) - abs(input$align_fps), 2),
                                        value = c(round(min(as.numeric(filedata3()[[2]])) + abs(input$align_fps), 2),
                                                  round(max(as.numeric(filedata3()[[2]])) - abs(input$align_fps), 2))))
      }
    })

    #Modify the lod slider for manual and automated fitting
    shiny::observe({
      if (input$selectMode_fps == "Manual") {

        output$slide_help_ui <- shiny::renderUI({

          return(shiny::helpText("Adjust the slider to remove any trace phases from the output (%)."))

        })

      }

      if (input$selectMode_fps == "Automated") {

        output$slide_help_ui <- shiny::renderUI({

          return(shiny::helpText("Adjust the slider to represent the LOD of the internal standard (%)."))

        })

      }
    })

    #Use the tickbox to adjust the alignment slider
    shiny::observe({
      if (input$align_man_fps == TRUE) {
        return(shiny::updateSliderInput(session = session, inputId = "align_fps",
                                        min = -0.5,
                                        max = 0.5,
                                        value = 0))
      }

      if (input$align_man_fps == FALSE) {
        return(shiny::updateSliderInput(session = session, inputId = "align_fps",
                                        min = 0,
                                        max = 0.5,
                                        value = 0.1))
      }
    })

    #FULL PATTERN FITTING

    shiny::observe({



      fps_reactive <- shiny::eventReactive(input$goButton_fps, {

        shiny::withProgress(message = "Computing...", value = 1,{

        if (input$std_conc_check_fps == FALSE) {
          std_conc_fps <- NA
        }

        if (input$std_conc_check_fps == TRUE) {
          std_conc_fps <- input$std_conc_box_fps
        }


        if (input$selectMode_fps == "Manual") {
          fps_out <- lapply(filedata2(),
                            powdR::fps,
                            lib = filedata3(),
                            std = sub(".*: ", "", input$selectINT_fps),
                            std_conc = std_conc_fps,
                            refs = c(sub(".*: ", "", input$selectPHASES_fps),
                                     sub(".*: ", "", input$selectINT_fps)),
                            align = input$align_fps,
                            tth_fps = input$tth_fps_slide,
                            manual_align = input$align_man_fps,
                            shift = input$shift_fps,
                            obj = input$selectOBJ_fps,
                            solver = input$selectSolver_fps,
                            remove_trace = input$lod_slide)
          return(fps_out)
        }
        if (input$selectMode_fps == "Automated") {
          afps_out <- lapply(filedata2(),
                             powdR::afps,
                             lib = filedata3(),
                             std = sub(".*: ", "", input$selectINT_fps),
                             std_conc = std_conc_fps,
                             refs = c(sub(".*: ", "", input$selectPHASES_fps),
                                      sub(".*: ", "", input$selectINT_fps),
                                      sub(".*: ", "", input$selectAMORPH)),
                             force = sub(".*: ", "", input$selectFORCE),
                             align = input$align_fps,
                             tth_fps = input$tth_fps_slide,
                             manual_align = input$align_man_fps,
                             shift = input$shift_fps,
                             obj = input$selectOBJ_fps,
                             solver = input$selectSolver_fps,
                             lod = input$lod_slide,
                             amorphous = sub(".*: ", "", input$selectAMORPH))
          return(afps_out)
        }

        }) #end with progress
      })

      observe({

        #fps_out <- fps_reactive()

        output$contents_fps <- DT::renderDataTable({

          fps_table <- data.frame(fps_reactive()[[1]]$phases)
          fps_table$phase_percent <- round(fps_table$phase_percent, 2)
          return(fps_table)
        }, options = list(lengthMenu = c(5, 10, 15), pageLength = 10))

        output$line_fps <- plotly::renderPlotly({

          return(plot(fps_reactive()[[1]], wavelength = input$selectWAVELENGTHfps, interactive = TRUE))

        })

        output$download_meas <- shiny::downloadHandler(
          filename = function() {
            paste("measured_", Sys.Date(), ".xy", sep="")
          },
          content = function(file) {
            write.table(data.frame("X" = fps_reactive()[[1]]$tth,
                                   "Y" = fps_reactive()[[1]]$measured), file,
                        sep = " ", col.names = FALSE, row.names = FALSE)
          }
        )

        output$download_calc <- shiny::downloadHandler(
          filename = function() {
            paste("fitted_", Sys.Date(), ".xy", sep="")
          },
          content = function(file) {
            write.table(data.frame("X" = fps_reactive()[[1]]$tth,
                                   "Y" = fps_reactive()[[1]]$fitted), file,
                        sep = " ", col.names = FALSE, row.names = FALSE)
          }
        )


        output$download_concs <- shiny::downloadHandler(
          filename = function() {
            paste("concs_", Sys.Date(), ".csv", sep="")
          },
          content = function(file) {
            write.table(fps_reactive()[[1]]$phases, file, sep = ",", col.names = TRUE, row.names = FALSE)
          }
        )

        #Download the whole fps output as .Rdata format
        output$download_fps <- shiny::downloadHandler(
          filename = "fps_output.Rdata",
          content = function(con) {
            assign("fps_output", fps_reactive()[[1]])
            save(list="fps_output", file=con)
          }
        )


      })

    })

    #######################
    #TAB 5: Results editor
    #######################

    #Create a recompute button in new results is selected

    #Load the results
    results_editor_load <- shiny::reactive({
      infile_results_editor <- input$loadResults_editor
      if (is.null(infile_results_editor)) {
        #User has not uploaded a file yet
        return(NULL)
        }
      bar <- load(infile_results_editor$datapath)
      rpl <- get(bar)
      return(rpl)
      })

    shiny::observe({

      if(input$selectPLOTeditor == "Original results") {

        if (!class(results_editor_load()) %in% c("powdRafps", "powdRfps")) {

          return(NULL)

          } else {

            output$contents_editor <- DT::renderDataTable({

              table_to_view <- results_editor_load()$phases
              table_to_view$phase_percent <- round(table_to_view$phase_percent, 2)
              table_to_view

              }, options = list(lengthMenu = c(10, 25, 50), pageLength = 10))

            output$line_editor <- plotly::renderPlotly({

              if(class(results_editor_load()) %in% c("powdRfps", "powdRafps")) {

                plot(results_editor_load(), wavelength = input$selectWAVELENGTHeditor, interactive = TRUE)

                } else {

                  return(NULL)

                  }
            })
          }
        }
      })

    shiny::observe({
      #If the thing uploaded is a powdRfps or powdRafps object then update the selection box
      if(class(results_editor_load()) %in% c("powdRfps", "powdRafps")) {
        shiny::updateSelectInput(session, "selectREMOVE_editor",
                                 label = NULL,
                                 choices = paste0(results_editor_load()[[5]][[2]], ": ", results_editor_load()[[5]][[1]]),
                                 selected = NULL)
        }
      })

    shiny::observe({
      if(class(results_editor_load()) %in% c("powdRfps", "powdRafps")) {
        shiny::updateSliderInput(session = session, inputId = "tth_editor",
                                 min = round(min(results_editor_load()$tth) + abs(input$align_editor), 2),
                                 max = round(max(results_editor_load()$tth) - abs(input$align_editor), 2),
                                 value = c(round(min(results_editor_load()$tth) + abs(input$align_editor), 2),
                                           round(max(results_editor_load()$tth) - abs(input$align_editor), 2)))
        }
      })

    #Load the results
    results_editor_load_lib <- shiny::reactive({
      infile_results_editor2 <- input$loadLIB_fps_editor
      if (is.null(infile_results_editor2)) {
        #User has not uploaded a file yet
        return(NULL)
        }
      bar2 <- load(infile_results_editor2$datapath)
      rpl2 <- get(bar2)
      return(rpl2)
      })

    shiny::observe({
      #If both items have been loaded correctly then update the selectADD box
      if(class(results_editor_load_lib()) == "powdRlib" &
         class(results_editor_load()) %in% c("powdRfps", "powdRafps")) {

        #The selection needs to include all of the phases in the library that are not already in the results
        phase_options <- results_editor_load_lib()[[3]][-which(results_editor_load_lib()[[3]][[1]] %in%
                                                                 results_editor_load()[[5]][[1]]),]

        shiny::updateSelectInput(session, "selectADD_editor",
                                 label = NULL,
                                 choices = paste0(phase_options[[2]], ": ", phase_options[[1]]),
                                 selected = NULL)
      }

    })


#Update the standard selector based on the phases in the library
      shiny::observe({
        if (class(results_editor_load_lib()) == "powdRlib") {

          int_choices_editor <- paste0(results_editor_load_lib()[[3]][[2]], ": ", results_editor_load_lib()[[3]][[1]])


          return(shiny::updateSelectInput(session, "selectSTD_editor",
                                          choices = int_choices_editor,
                                          selected = int_choices_editor[1]))
        }
      })


    #Add the uioutput if standard concentration is known
    output$std_conc_box_editor_ui <- shiny::renderUI({
      if (input$std_conc_check_editor == FALSE) return(NULL)
      shiny::numericInput("std_conc_box_editor", label = "Define the internal standard concentration",
                          min = 0.01,
                          max = 99.99,
                          value = 20,
                          step = 0.01)
      })

    shiny::observeEvent(input$align_man_editor,{
      output$align_editor_ui <- shiny::renderUI({
        if (input$align_man_editor == FALSE) return(shiny::sliderInput("align_editor", label = NULL, min = 0,
                                                                       max = 0.5,
                                                                       value = c(0.1)))
        shiny::sliderInput("align_editor", label = NULL, min = -0.5,
                           max = 0.5,
                           value = c(0))
        })
      })

    #FULL PATTERN FITTING

    shiny::observe({
      fps_reactive_editor <- shiny::eventReactive(input$goButton_editor, {

        shiny::withProgress(message = "Computing...", value = 1,{

        if(input$std_conc_check_editor == FALSE) {
          std_conc_editor <- NA
          } else {
            std_conc_editor <- input$std_conc_box_editor
            }
        added_phases2 <- as.character(input$selectADD_editor)
        removed_phases2 <- as.character(input$selectREMOVE_editor)

        #The selection needs to include all of the phases in the library that are not already in the results
        phases2 <- c(paste0(results_editor_load()[[5]][[2]], ": ",
                            results_editor_load()[[5]][[1]]),
                     added_phases2)

        if(length(removed_phases2) > 0) {
          phases2 <- phases2[-which(phases2 %in% removed_phases2)]
          }

        smpl_editor <- data.frame("tth" = results_editor_load()[[1]],
                            "counts" = results_editor_load()[[3]])

        xrdlib_editor <- results_editor_load_lib()

        fps_out <- powdR::fps(smpl = smpl_editor, lib = xrdlib_editor,
                              harmonise = TRUE,
                              std = gsub(".*: ", "", input$selectSTD_editor),
                              std_conc = std_conc_editor,
                              refs = c(gsub(".*: ", "", phases2),
                                       gsub(".*: ", "", input$selectSTD_editor)),
                              align = input$align_editor,
                              tth_fps = input$tth_editor,
                              manual_align = input$align_man_editor,
                              shift = input$shift_editor,
                              obj = input$selectOBJ_editor,
                              solver = input$selectSolver_editor)

        }) #end withProgress

        })

      shiny::observe({
        fps_out_editor <- fps_reactive_editor()
        if (!input$selectPLOTeditor == "Original results") {
          output$contents_editor <- DT::renderDataTable({
            fps_table_editor <- data.frame(fps_out_editor$phases)
            fps_table_editor$phase_percent <- round(fps_table_editor$phase_percent, 2)
            fps_table_editor
            }, options = list(lengthMenu = c(5, 10, 15), pageLength = 10))

          output$line_editor <- plotly::renderPlotly({
            plot(fps_out_editor, wavelength = input$selectWAVELENGTHeditor, interactive = TRUE)
          })
          }
        })

      shiny::observe({
        #Export the mineral concentrations to a .csv file
        #minout_editor <- fps_reactive_editor()
        #minout_editor <- data.frame(minout_editor[["phases"]])

        output$download_mins_editor <- shiny::downloadHandler(
          filename = function() {
            paste("minerals_", Sys.Date(), ".csv", sep="")
            },
          content = function(file) {
            write.table(fps_reactive_editor()$phases, file, sep = ",", col.names = TRUE, row.names = FALSE)
            }
          )

        #Export the weighted patterns
        #fitout_editor <- fps_reactive_editor()
        #fitout_editor <- data.frame("TTH" = fitout_editor[["tth"]],
        #                            "MEASURED" = fitout_editor[["measured"]],
        #                            "FITTED" = fitout_editor[["fitted"]],
        #                            fitout_editor[["weighted_pure_patterns"]])

        output$download_meas_editor <- shiny::downloadHandler(
          filename = function() {
            paste("measured_", Sys.Date(), ".xy", sep="")
          },
          content = function(file) {
            write.table(data.frame("X" = fps_reactive_editor()$tth,
                                   "Y" = fps_reactive_editor()$measured), file, sep = " ", col.names = FALSE, row.names = FALSE)
          }
        )

        output$download_calc_editor <- shiny::downloadHandler(
          filename = function() {
            paste("fitted_", Sys.Date(), ".xy", sep="")
          },
          content = function(file) {
            write.table(data.frame("X" = fps_reactive_editor()$tth,
                                   "Y" = fps_reactive_editor()$fitted), file, sep = " ", col.names = FALSE, row.names = FALSE)
          }
        )

        # output$download_fit_editor <- shiny::downloadHandler(
        #   filename = function() {
        #     paste("fit-", Sys.Date(), ".csv", sep="")
        #     },
        #   content = function(file) {
        #     write.table(fitout_editor, file, sep = ",", col.names = TRUE, row.names = FALSE)
        #     }
        #   )

        #Download the whole fps output as .Rdata format
        output$download_editor <- shiny::downloadHandler(
          filename = "fps_editor_output.Rdata",
          content = function(con) {
            assign("fps_editor_output", fps_reactive_editor())
            save(list="fps_editor_output", file=con)
            }
          )
        })
      })

    ############################
    #TAB 6: HELP
    ############################

      output$video <- shiny::renderUI({
        shiny::HTML(paste0('<iframe width="840" height="472.5" src="https://www.youtube.com/embed/', "dDd6cr8kpTc",
                           '" frameborder="0" allow="accelerometer; autoplay; encrypted-media; gyroscope; picture-in-picture" allowfullscreen></iframe>'))
        })

    session$onSessionEnded(function() {
      shiny::stopApp()
      })

    }) ## end  shinyServer

Try the powdR package in your browser

Any scripts or data that you put into this service are public.

powdR documentation built on Aug. 13, 2021, 5:08 p.m.