Calculator: \(t\)-testing
Summary
Calculators to provide facilit for all types of \(t\)-testing.
\(t\)-statistic and degrees of freedom calculator
#| '!! shinylive warning !!': |
#| shinylive does not work in self-contained HTML documents.
#| Please set `embed-resources: false` in your metadata.
#| standalone: true
#| viewerHeight: 820
library(shiny)
library(bslib)
ui <- page_fluid(
title = "t-statistic Calculator",
# Navigation buttons
layout_columns(
col_widths = 12,
card(
card_body(
div(
style = "text-align: center; margin-bottom: 20px;",
actionButton("show_one_sample", "One sample t-test",
class = "btn-primary", style = "margin-right: 10px;"),
actionButton("show_two_sample", "Two-sample t-test",
class = "btn-outline-primary")
)
)
)
),
# One-sample t-test panel
conditionalPanel(
condition = "input.current_tab == 'one_sample'",
layout_columns(
col_widths = c(6, 6),
card(
card_header("Sample Data"),
card_body(
numericInput("n1", "Sample size (n)", value = 30, min = 1, step = 1),
numericInput("xbar1", "Sample mean", value = 50, step = 0.01),
numericInput("s1", "Sample standard deviation", value = 10, min = 0.001, step = 0.01),
numericInput("mu0", "Population mean (μ₀)", value = 45, step = 0.01),
hr(),
helpText("Calculate t-statistic for testing whether sample mean differs from population mean.")
)
),
card(
card_header("Results"),
card_body(
verbatimTextOutput("one_sample_results")
)
)
)
),
# Two-sample t-test panel
conditionalPanel(
condition = "input.current_tab == 'two_sample'",
layout_columns(
col_widths = c(4, 4, 4),
card(
card_header("Sample 1"),
card_body(
numericInput("n1_two", "Sample Size (n₁)", value = 25, min = 1, step = 1),
numericInput("xbar1_two", "Sample Mean (x̄₁)", value = 52, step = 0.01),
numericInput("s1_two", "Sample Standard Deviation (s₁)", value = 8, min = 0.001, step = 0.01)
)
),
card(
card_header("Sample 2"),
card_body(
numericInput("n2_two", "Sample Size (n₂)", value = 30, min = 1, step = 1),
numericInput("xbar2_two", "Sample Mean (x̄₂)", value = 48, step = 0.01),
numericInput("s2_two", "Sample Standard Deviation (s₂)", value = 10, min = 0.001, step = 0.01)
)
),
card(
card_header("Test Settings"),
card_body(
radioButtons("test_type", "Test type:",
choices = list("Independent Samples (Equal variances)" = "independent",
"Independent Samples (Welch's t-test)" = "welch",
"Paired Samples" = "paired"),
selected = "independent"),
hr(),
helpText("Choose between pooled t-test, Welch's t-test, or paired samples t-test.")
)
)
),
layout_columns(
col_widths = 12,
card(
card_header("Results"),
card_body(
verbatimTextOutput("two_sample_results")
)
)
)
),
# Hidden input to track current tab
textInput("current_tab", "", value = "one_sample", width = "0px"),
tags$style("#current_tab { display: none; }"),
uiOutput("button_css")
)
server <- function(input, output, session) {
# Switch tab logic
observeEvent(input$show_one_sample, {
updateTextInput(session, "current_tab", value = "one_sample")
})
observeEvent(input$show_two_sample, {
updateTextInput(session, "current_tab", value = "two_sample")
})
# Dynamic CSS
output$button_css <- renderUI({
if (input$current_tab == "one_sample") {
tags$style("
#show_one_sample {
background-color: #3F6BB6 !important;
border-color: #3F6BB6 !important;
color: white !important;
}
#show_two_sample {
background-color: transparent !important;
border-color: #3F6BB6 !important;
color: #3F6BB6 !important;
}
")
} else {
tags$style("
#show_one_sample {
background-color: transparent !important;
border-color: #3F6BB6 !important;
color: #3F6BB6 !important;
}
#show_two_sample {
background-color: #3F6BB6 !important;
border-color: #3F6BB6 !important;
color: white !important;
}
")
}
})
# One-sample t-test logic
output$one_sample_results <- renderText({
n <- input$n1
xbar <- input$xbar1
s <- input$s1
mu0 <- input$mu0
t_stat <- (xbar - mu0) / (s / sqrt(n))
df <- n - 1
se <- s / sqrt(n)
paste0(
"T-statistic: ", round(t_stat, 6), "\n",
"Degrees of freedom: ", df, "\n",
"Standard error: ", round(se, 6), "\n\n",
"Formula: t = (x̄ - μ₀) / (s / √n)\n",
"x̄ = ", xbar, ", μ₀ = ", mu0, ", s = ", s, ", n = ", n
)
})
# Two-sample t-test logic
output$two_sample_results <- renderText({
n1 <- input$n1_two
xbar1 <- input$xbar1_two
s1 <- input$s1_two
n2 <- input$n2_two
xbar2 <- input$xbar2_two
s2 <- input$s2_two
test_type <- input$test_type
if (test_type == "independent") {
# Pooled t-test
sp <- sqrt(((n1 - 1) * s1^2 + (n2 - 1) * s2^2) / (n1 + n2 - 2))
se <- sp * sqrt(1/n1 + 1/n2)
t_stat <- (xbar1 - xbar2) / se
df <- n1 + n2 - 2
result <- paste0(
"Independent samples t-test (Equal variances assumed)\n",
"T-statistic: ", round(t_stat, 6), "\n",
"Degrees of freedom: ", df, "\n",
"Pooled standard deviation: ", round(sp, 6), "\n",
"Standard error: ", round(se, 6), "\n\n",
"Formula: t = (x̄₁ - x̄₂) / (sp × √(1/n₁ + 1/n₂))"
)
} else if (test_type == "welch") {
# Welch's t-test
se <- sqrt((s1^2 / n1) + (s2^2 / n2))
t_stat <- (xbar1 - xbar2) / se
df_num <- (s1^2 / n1 + s2^2 / n2)^2
df_den <- ((s1^2 / n1)^2 / (n1 - 1)) + ((s2^2 / n2)^2 / (n2 - 1))
df <- df_num / df_den
result <- paste0(
"Welch's t-test (Unequal variances)\n",
"T-statistic: ", round(t_stat, 6), "\n",
"Degrees of freedom (Welch): ", round(df, 2), "\n",
"Standard error: ", round(se, 6), "\n\n",
"Formula: t = (x̄₁ - x̄₂) / √(s₁²/n₁ + s₂²/n₂)\n",
"df = [(s₁²/n₁ + s₂²/n₂)²] / [ (s₁²/n₁)²/(n₁−1) + (s₂²/n₂)²/(n₂−1) ]"
)
} else {
# Paired t-test approximation
n <- min(n1, n2)
s_diff <- sqrt(s1^2 + s2^2)
se <- s_diff / sqrt(n)
t_stat <- (xbar1 - xbar2) / se
df <- n - 1
result <- paste0(
"Paired samples t-test (approximation)\n",
"T-statistic: ", round(t_stat, 6), "\n",
"Degrees of freedom: ", df, "\n",
"Standard error of differences: ", round(se, 6), "\n\n",
"Formula: t = (x̄₁ - x̄₂) / (s_diff / √n)\n",
"s_diff ≈ √(s₁² + s₂²) = ", round(s_diff, 6)
)
}
return(result)
})
}
shinyApp(ui, server)
\(p\)-value calculator
Using your \(t\)-statistic and degrees of freedom from the above calculator, use the below calculator to work out your \(p\)-value.
#| '!! shinylive warning !!': |
#| shinylive does not work in self-contained HTML documents.
#| Please set `embed-resources: false` in your metadata.
#| standalone: true
#| viewerHeight: 730
library(shiny)
library(bslib)
library(ggplot2)
ui <- page_fluid(
title = "T-test calculator",
layout_columns(
col_widths = c(4, 8),
# Left column - Input parameters
card(
card_header("Input parameters"),
card_body(
numericInput("tscore", "T-statistic", value = 2.0, step = 0.01),
numericInput("df", "Degrees of freedom", value = 20, min = 1, step = 1),
radioButtons("test_type", "Test type",
choices = list("Two-tailed" = "two",
"One-tailed (upper)" = "upper",
"One-tailed (lower)" = "lower"),
selected = "two"),
hr(),
helpText("This app calculates p-values for t-tests based on the t-distribution with specified degrees of freedom.")
)
),
# Right column - Graphical representation
card(
card_header("Graphical representation"),
card_body(
plotOutput("density_plot", height = "300px")
)
)
),
# Results at the bottom
card(
card_header("T-test results"),
card_body(
verbatimTextOutput("pvalue_result")
)
)
)
server <- function(input, output, session) {
# Calculate p-value based on test type
p_value <- reactive({
t <- input$tscore
df <- input$df
test <- input$test_type
if (test == "two") {
p <- 2 * pt(-abs(t), df = df)
result <- paste0("Two-tailed p-value: ", round(p, 4))
} else if (test == "upper") {
p <- pt(t, df = df, lower.tail = FALSE)
result <- paste0("Upper-tailed p-value: ", round(p, 4))
} else if (test == "lower") {
p <- pt(t, df = df, lower.tail = TRUE)
result <- paste0("Lower-tailed p-value: ", round(p, 4))
}
return(list(p = p, result = result, test = test))
})
# Display p-value
output$pvalue_result <- renderText({
p_value()$result
})
# Create density plot
output$density_plot <- renderPlot({
t <- input$tscore
df <- input$df
test <- p_value()$test
# Generate x values for t-distribution
x <- seq(-4, 4, length.out = 1000)
y <- dt(x, df = df)
df_data <- data.frame(x = x, y = y)
# Base plot
p <- ggplot(df_data, aes(x = x, y = y)) +
geom_line() +
labs(x = "T-statistic", y = "Density",
title = paste("T-distribution (df =", df, ")")) +
theme_minimal() +
theme(panel.grid.minor = element_blank()) +
geom_vline(xintercept = 0, linetype = "dashed", alpha = 0.5)
# Add shaded area based on test type, using #3F6BB6 as the color
if (test == "two") {
# Two-tailed test: shade both tails
if (t > 0) {
p <- p +
geom_area(data = subset(df_data, x >= t), aes(x = x, y = y), fill = "#3F6BB6", alpha = 0.5) +
geom_area(data = subset(df_data, x <= -t), aes(x = x, y = y), fill = "#3F6BB6", alpha = 0.5) +
geom_vline(xintercept = t, color = "#3F6BB6") +
geom_vline(xintercept = -t, color = "#3F6BB6")
} else {
p <- p +
geom_area(data = subset(df_data, x <= t), aes(x = x, y = y), fill = "#3F6BB6", alpha = 0.5) +
geom_area(data = subset(df_data, x >= -t), aes(x = x, y = y), fill = "#3F6BB6", alpha = 0.5) +
geom_vline(xintercept = t, color = "#3F6BB6") +
geom_vline(xintercept = -t, color = "#3F6BB6")
}
} else if (test == "upper") {
# Upper-tailed test: shade area above t
p <- p +
geom_area(data = subset(df_data, x >= t), aes(x = x, y = y), fill = "#3F6BB6", alpha = 0.5) +
geom_vline(xintercept = t, color = "#3F6BB6")
} else if (test == "lower") {
# Lower-tailed test: shade area below t
p <- p +
geom_area(data = subset(df_data, x <= t), aes(x = x, y = y), fill = "#3F6BB6", alpha = 0.5) +
geom_vline(xintercept = t, color = "#3F6BB6")
}
return(p)
})
}
shinyApp(ui, server)
Version history
v1.0: created by tdhc 08/25.