wie versprochen der Lösungsansatz! Ist zwar nicht der eleganteste aber vielleicht für ein Shiny Anfänger der pragmatischste:
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)
Hauptsache es funktioniert erstmal. In Schönheit sterben kann ich auch ein anderes Mal.
So long,
PS: Vielleicht kann man diesen Thread schon in das Shiny Unterforum verschieben?????