library(tikzDevice)
library(tools)
# 1. Define filenames
tex_file <- "fig_expected_loglik.tex"
pdf_file <- "fig_expected_loglik.pdf"
options(tikzDocumentDeclaration = "\\documentclass[12pt]{extarticle}")
# 2. Now open the device, matching the pointsize
tikz(tex_file, width = 7, height = 7, standAlone = TRUE, pointsize = 16)
# --- START OF PLOT CODE ---
theta_0 <- 2
sigma <- 10
n <- 100
se <- sigma / sqrt(n)
x_vals <- seq(theta_0 - 4*se, theta_0 + 4*se, length.out = 500)
expected_log_lik <- dnorm(x_vals, mean = theta_0, sd = se, log = TRUE) - 0.5
y_min <- min(expected_log_lik)
y_max <- dnorm(0, sd = se, log = TRUE) + 2.5
set.seed(123)
x_bar_samples <- rnorm(10, mean = theta_0, sd = se)
idx_max <- which.max(x_bar_samples)
x_bar_max <- x_bar_samples[idx_max]
grey_color <- "grey70"
highlight_color <- "black" # Swapped from blue
expected_color <- "blue" # Swapped from black
score_color <- "green"
null_color <- "red"
exp_color <- "darkorange"
par(mar = c(5, 4, 4, 4) + 0.3, cex.axis = 1.2, cex.lab = 1.4)
plot(x_vals, expected_log_lik, type = "n",
ylim = c(y_min, y_max),
xlab = "$\\theta$",
ylab = "Log-Value",
main = "Expected vs. Realized $\\ell^*(\\theta)$, Deviance, and Score",
frame.plot = TRUE)
lines(x_vals, expected_log_lik, lwd = 3, col = expected_color)
abline(v = theta_0, col = null_color, lty = 1, lwd = 2)
for (i in 1:10) {
log_lik_vals <- dnorm(x_bar_samples[i], mean = x_vals, sd = se, log = TRUE)
l_width <- ifelse(i == idx_max, 2, 1)
current_col <- ifelse(i == idx_max, highlight_color, grey_color)
lines(x_vals, log_lik_vals, col = current_col, lty = 2, lwd = l_width)
}
# 3. Draw Empirical Deviance segments for the largest x_bar
peak_y <- dnorm(x_bar_max, mean = x_bar_max, sd = se, log = TRUE)
null_y <- dnorm(x_bar_max, mean = theta_0, sd = se, log = TRUE)
segments(x0 = theta_0, y0 = null_y, x1 = x_bar_max, y1 = null_y, col = highlight_color, lwd = 2, lty = 1)
# Increased vertical lwd to 4
segments(x0 = x_bar_max, y0 = null_y, x1 = x_bar_max, y1 = peak_y, col = highlight_color, lwd = 4, lty = 1)
# Label updated and moved to the right (pos = 4)
text(x_bar_max, (null_y + peak_y)/2, labels = "$\\frac{1}{2}D(\\hat{\\theta})$", pos = 4, col = highlight_color, font = 2, cex = 1)
points(theta_0, null_y, pch = 16, col = highlight_color, cex = 1.5)
# 4. Draw Expected Drop on the expected curve
exp_max_y <- dnorm(theta_0, mean = theta_0, sd = se, log = TRUE) - 0.5
exp_hat_y <- dnorm(x_bar_max, mean = theta_0, sd = se, log = TRUE) - 0.5
# Dynamically shift slightly LEFT to avoid the blue line and text collision
x_shift <- x_bar_max - 0.06 * se
# Horizontal line at expected max
segments(x0 = theta_0, y0 = exp_max_y, x1 = x_shift, y1 = exp_max_y, col = exp_color, lwd = 2, lty = 1)
# Increased vertical lwd to 4
segments(x0 = x_shift, y0 = exp_max_y, x1 = x_shift, y1 = exp_hat_y, col = exp_color, lwd = 4, lty = 1)
# Short dotted connector back to the actual point on the curve
segments(x0 = x_bar_max, y0 = exp_hat_y, x1 = x_shift, y1 = exp_hat_y, col = exp_color, lwd = 1, lty = 3)
# Label expected drop, placed on the left (pos = 2)
text(x_shift, (exp_max_y + exp_hat_y)/2, labels = "$\\frac{1}{2}D^*(\\hat{\\theta})$", pos = 2, col = exp_color, font = 2, cex = 1)
# Mark the points on the expected curve
points(x_bar_max, exp_hat_y, pch = 16, col = exp_color, cex = 1.5)
points(theta_0, exp_max_y, pch = 16, col = exp_color, cex = 1.5)
# 5. Add Score Function using a 2nd y-axis
par(new = TRUE)
score_vals <- x_bar_max - x_vals
plot(x_vals, score_vals, type = "n", axes = FALSE, xlab = "", ylab = "", ylim = c(-5, 9))
abline(h = 0, col = "gray", lty = 3, lwd = 2)
lines(x_vals, score_vals, col = score_color, lwd = 3, lty = 1)
for (i in 1:10) {
p_size <- ifelse(i == idx_max, 1.5, 1.2)
p_col <- ifelse(i == idx_max, highlight_color, grey_color)
points(x_bar_samples[i], 0, col = p_col, pch = 16, cex = p_size)
}
axis(4, col = score_color, col.axis = score_color, lwd = 2)
mtext("Score Function $U(\\theta)$", side = 4, line = 2.5, col = score_color, font = 2)
# 6. Updated Legend
legend("topleft",
legend = c(
"Expected (Test) $\\ell^*(\\theta)$",
"Expected (Test) D-gap $\\frac{1}{2}D^*(\\hat\\theta)$",
"Training $\\ell(\\theta; y_{\\mathrm{train}})$",
"Training D-gap $\\frac{1}{2}D(\\hat{\\theta})$",
"True Null $\\theta_0$",
"Score $U_n(\\theta)$"
),
col = c(
expected_color, # Swapped to use expected_color (blue)
exp_color,
highlight_color, # Swapped to use highlight_color (black)
highlight_color,
null_color,
score_color
),
lty = c(1, 1, 2, 1, 1, 1),
lwd = c(3, 4, 2, 4, 2, 3),
bg = "white",
cex = 0.85)
# --- END OF PLOT CODE ---
# 3. Close the device silently
invisible(dev.off())
# 4. Compile the .tex file to a permanent .pdf
invisible(tools::texi2pdf(tex_file, clean = TRUE))
# 5. Convert the PDF to a high-res PNG unconditionally
if (!requireNamespace("pdftools", quietly = TRUE)) install.packages("pdftools")
png_file <- "fig_expected_loglik.png"
invisible(pdftools::pdf_convert(pdf_file, format = "png", dpi = 600, filenames = png_file))