Deutsches R-Forum

Code: Alles auswählen

library(shiny)
library(shinyWidgets)
library(tidyverse) 
library(plotly)

set.seed(1234)
A <-  tibble (
  Horizon = ("Horizon A"),
  Depth     = seq(0, 2.6, 0.2),
  Element_1 =  abs(round(rnorm(14), 2)),
  Element_2 =  abs(round(rnorm(14), 2)),
  Element_3 =  abs(round(rnorm(14), 2))
)

B <-  tibble (
  Horizon = ("Horizon B"),
  Depth     = seq(2.8, 43.8, 0.33),
  Element_1 =  abs(round(rnorm(125), 2)),
  Element_2 =  abs(round(rnorm(125), 2)),
  Element_3 =  abs(round(rnorm(125), 2))
)

C <-  tibble (
  Horizon = ("Horizon C"),
  Depth     = seq(44, 50, 0.6),
  Element_1 =  abs(round(rnorm(11), 2)),
  Element_2 =  abs(round(rnorm(11), 2)),
  Element_3 =  abs(round(rnorm(11), 2))
)

Analyse = rbind (A, B, C)
Analyse.L = Analyse%>%
  pivot_longer(
    cols = Element_1: Element_3,
    names_to = "Element",
    values_to = "Values")

# Scatter Plot
ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      pickerInput(
        inputId = "lith",
        label = "Lithology",
        choices = unique(Analyse$Horizon),
        selected = Analyse$Horizon [1],
        multiple = TRUE,
        options =  list("max-options" = 3,
                        "max-options-text" = "No more!")),
      br(),
      selectInput("x", "X variable for scatter plot", selected = NULL,
                  choices = colnames(Analyse)[3:5], multiple = FALSE), 
      br(),
      selectInput("y", "Y variable for scatter plot", selected = NULL,
                  choices = colnames(Analyse)[3:5], multiple = FALSE), 
      br(),
      pickerInput(
        inputId = "litho",
        label = "Select Lithology",
        choices = unique(Analyse$Horizon),
        selected = Analyse$Horizon [1],
        multiple = TRUE,
        options =  list("max-options" = 3,
                        "max-options-text" = "No more!")),
      br(),
      pickerInput(
        inputId = "data",
        label = "Select a quantitative variable for Boxplot & Histogram",
        choices = list(
          Element =  colnames(Analyse) [c(3:5)]),
        multiple = TRUE,
        options = pickerOptions(
          actionsBox = TRUE,
          title = "Please select a item",
          header = "Main & Minor Elements")),
      
    ),  
  
# end sidebar panel
    
    mainPanel(
      tabsetPanel(type = "tab",
                  tabPanel("Scatterplot", plotlyOutput("plot")),
                  tabPanel("Boxplot", plotlyOutput("box")),
                  tabPanel("Histogram", plotlyOutput("hist"))
      
    ))

))



# end main panel
server <- function(input, output, session) { 
  
  # make reactive
  reactivescatter <- reactive({
    Analyse%>%
      filter(Horizon %in% input$lith)
  })
  
  output$plot <- renderPlotly({
    plot <- plot_ly(reactivescatter (), x = ~ .data[[input$x]], y = ~ .data[[input$y]],
                    color = ~ input$lith,
                    type = "scatter")  %>%
      layout(title = input$lith,
             xaxis = list(title=input$x),
             yaxis = list(title = input$y))
    
  })
  
  # Boxplot
  
  DF <- reactive({
    Analyse.L %>% 
      filter  (Element%in% input$data& 
                 Horizon%in% input$litho)
  })
  
  output$box <- renderPlotly({
    box <- plot_ly(DF(), y = ~ Values,
                   color = ~ Horizon,
                   type = "box")  %>%
      layout(title = input$litho,
             xaxis = list(title=input$data))
    
  })
  
  # Histogram
  
  output$hist <- renderPlotly({
    hist <- plot_ly(DF(), x = ~ Values,
                    alpha = 0.8, 
                    color = ~ Horizon,
                    type = "histogram")  %>%
      layout(title = input$litho,
             barmode = "overlay",
             xaxis = list(title=input$data))
    
  })
  
}

shinyApp(ui, server)