#| '!! shinylive warning !!': |
#| shinylive does not work in self-contained HTML documents.
#| Please set `embed-resources: false` in your metadata.
#| standalone: true
#| viewerHeight: 800
library(shiny)
ui <- fluidPage(
titlePanel("Confronto Distribuzioni"),
sidebarLayout(
sidebarPanel(
radioButtons("mode", "Modalità Input:",
choices = c("Parametri Liberi" = "free", "Cohen's d" = "d_score")),
hr(),
conditionalPanel(
condition = "input.mode == 'free'",
fluidRow(
column(6, h5(strong("Popolazione 1")),
numericInput("m1", "Media:", 0),
numericInput("sd1", "Dev. Std:", 1, min = 0.001, step = 0.1)),
column(6, h5(strong("Popolazione 2")),
numericInput("m2", "Media:", 100),
numericInput("sd2", "Dev. Std:", 15, min = 0.001, step = 0.1))
)
),
conditionalPanel(
condition = "input.mode == 'd_score'",
sliderInput("d_val", "Cohen's d:", 0, 10, 0.8, 0.1),
numericInput("sd2_d", "Dev. Std (Pop 2):", 1, min = 0.001)
)
),
mainPanel(
plotOutput("distPlot"),
tableOutput("summaryTable")
)
)
)
server <- function(input, output) {
params <- reactive({
if (input$mode == "free") {
m1 <- if(is.na(input$m1)) 0 else input$m1
s1 <- if(is.na(input$sd1) || input$sd1 <= 0) 0.1 else input$sd1
m2 <- if(is.na(input$m2)) 0 else input$m2
s2 <- if(is.na(input$sd2) || input$sd2 <= 0) 0.1 else input$sd2
list(m1=m1, s1=s1, m2=m2, s2=s2)
} else {
s1 <- 1; m1 <- 0
s2 <- if(is.na(input$sd2_d) || input$sd2_d <= 0) 0.1 else input$sd2_d
d <- if(is.na(input$d_val)) 0 else input$d_val
# m2 calcolata per mantenere d costante con le diverse SD
m2 <- d * sqrt((s1^2 + s2^2)/2) + m1
list(m1=m1, s1=s1, m2=m2, s2=s2)
}
})
output$distPlot <- renderPlot({
p <- params()
# CALCOLO RANGE DINAMICO (Asse X)
# Prendiamo il minimo e il massimo considerando 4 deviazioni standard da ogni media
x_min <- min(p$m1 - 4*p$s1, p$m2 - 4*p$s2)
x_max <- max(p$m1 + 4*p$s1, p$m2 + 4*p$s2)
x_seq <- seq(x_min, x_max, length.out = 500)
y1 <- dnorm(x_seq, p$m1, p$s1)
y2 <- dnorm(x_seq, p$m2, p$s2)
# Grafico Base R (più leggero per Shinylive)
par(mar = c(5, 4, 4, 2) + 0.1)
plot(x_seq, y1, type="l", col="#3498db", lwd=3,
xlab="Valore", ylab="Densità",
ylim=c(0, max(y1, y2) * 1.1), xlim=c(x_min, x_max), xaxs="i")
lines(x_seq, y2, col="#e74c3c", lwd=3)
# Aggiunta aree colorate
polygon(c(x_seq, rev(x_seq)), c(y1, rep(0, length(y1))), col=rgb(52/255, 152/255, 219/255, 0.3), border=NA)
polygon(c(x_seq, rev(x_seq)), c(y2, rep(0, length(y2))), col=rgb(231/255, 76/255, 60/255, 0.3), border=NA)
legend("topright", legend=c("Popolazione 1", "Popolazione 2"),
col=c("#3498db", "#e74c3c"), lwd=3, bty="n")
})
output$summaryTable <- renderTable({
p <- params()
sd_p <- sqrt((p$s1^2 + p$s2^2)/2)
d_eff <- abs(p$m1 - p$m2) / sd_p
data.frame(
Parametro = c("Media (μ)", "Deviazione Standard (σ)", "Differenza tra medie", "Cohen's d"),
`Popolazione 1` = c(p$m1, p$s1, "-", "-"),
`Popolazione 2` = c(round(p$m2, 2), p$s2, "-", "-"),
`Risultato` = c("-", "-", round(abs(p$m1-p$m2), 2), round(d_eff, 3)),
check.names = FALSE
)
}, striped = TRUE, bordered = TRUE, align = 'c')
}
shinyApp(ui, server)