如何动态调整基本 R 图中的 ylim？

Question

我有一个数据列表（见下文），我使用此脚本以图形方式表示：

# Define plotting parameters
pch_values <- c(16, 17)  # Different symbols for beta_0 and beta_1
colors <- c("red", "blue", "gray60")  # Colors for different noise types
lty_values <- c(1, 2, 3)  # Line types for different noise types
quartile_titles <- c("Absolute Bias of First Quartile", "Absolute Bias of Second Quartile (Median)", "Absolute Bias of Third Quartile")

# Directory for saving plots
output_dir <- "Abs_Quartile_Bias_Plots"
if (!dir.exists(output_dir)) dir.create(output_dir)

# Compute unified y-axis limits for all quartile plots in test_data
y_values_all <- unlist(sapply(test_data, function(noise_data) {
  sapply(noise_data, function(T_data) T_data)
}), use.names = FALSE)

ylim_min <- min(y_values_all, na.rm = TRUE)
ylim_max <- max(y_values_all, na.rm = TRUE)
margin <- 0.05 * (ylim_max - ylim_min)  # Add 5% margin above and below
unified_ylim <- c(ylim_min - margin, ylim_max + margin)

# Set output file
png(file.path(output_dir, "Abs_Quartile_Bias_Case1.png"), 
    width = 1200, height = 400, res = 120)
par(mfrow = c(1, 3), mar = c(4, 4, 2, 1))  # 3 side-by-side subplots

# Plot each absolute quartile bias
for (quartile_idx in 1:3) {
  # Start a blank plot with unified y-axis limits
  plot(NULL, log = "x", xlim = range(sample_sizes), ylim = unified_ylim, 
       xlab = "Sample Size (T)", 
       ylab = quartile_titles[quartile_idx],
       main = quartile_titles[quartile_idx])
  
  # Add lines and points for beta_0 and beta_1 for each noise type
  for (noise_idx in seq_along(noise_types)) {
    noise <- noise_types[noise_idx]
    for (coef_name_idx in seq_along(pch_values)) {
      coef_name <- c("beta_0", "beta_1")[coef_name_idx]  # Explicitly specify coefficient names
      
      y_values <- sapply(test_data[[noise]][[coef_name]], function(T_data) T_data[[quartile_idx]])
      
      # Plot lines
      lines(sample_sizes, y_values, col = colors[noise_idx], lty = lty_values[noise_idx], lwd = 1)
      # Plot points
      points(sample_sizes, y_values, col = colors[noise_idx], pch = pch_values[coef_name_idx])
    }
  }
  
  # Add legends
  if (quartile_idx == 1) {  # Only add legends to the first plot
    legend("topright", 
           legend = c(expression(beta[0]), expression(beta[1])),
           pch = pch_values, 
           col = "black", bty = "n")
    legend("topright", 
           legend = str_to_title(noise_types), 
           col = colors, 
           lty = lty_values, 
           lwd = 1, bty = "n", inset = c(.18, 0))
  }
}

dev.off()

产生下图：

如您所见，问题在于

ylim

未针对每个子图进行调整，这会创建

ylim

的上端远离子图中线的最高值的图。

问题：

有人可以帮我修改代码，使

ylim

动态调整到手头数据的范围吗？

我很抱歉我的数据没有得到最佳安排。

这是有问题的数据：

> test_data
$gaussian
$gaussian$beta_0
$gaussian$beta_0$`50`
        25%         50%         75% 
0.243594615 0.002777537 0.245669686 

$gaussian$beta_0$`100`
         25%          50%          75% 
1.719185e-01 9.393732e-05 1.831527e-01 

$gaussian$beta_0$`200`
       25%        50%        75% 
0.11688113 0.00117105 0.12361028 

$gaussian$beta_0$`500`
        25%         50%         75% 
0.080452190 0.001030278 0.078410130 

$gaussian$beta_0$`1000`
       25%        50%        75% 
0.05410107 0.00294704 0.05319781 

$gaussian$beta_0$`2000`
        25%         50%         75% 
0.037754358 0.003339657 0.041307901 

$gaussian$beta_0$`5000`
         25%          50%          75% 
0.0217425538 0.0004601096 0.0257457441 


$gaussian$beta_1
$gaussian$beta_1$`50`
        25%         50%         75% 
0.008825068 0.000371505 0.007650828 

$gaussian$beta_1$`100`
         25%          50%          75% 
2.902638e-03 6.824981e-05 2.865865e-03 

$gaussian$beta_1$`200`
         25%          50%          75% 
1.090956e-03 5.224608e-05 1.094486e-03 

$gaussian$beta_1$`500`
         25%          50%          75% 
2.657166e-04 8.856132e-07 2.592028e-04 

$gaussian$beta_1$`1000`
         25%          50%          75% 
9.217006e-05 7.248598e-07 9.598419e-05 

$gaussian$beta_1$`2000`
         25%          50%          75% 
3.417757e-05 3.301637e-06 2.860609e-05 

$gaussian$beta_1$`5000`
         25%          50%          75% 
8.289284e-06 4.182673e-07 8.432296e-06 



$laplace
$laplace$beta_0
$laplace$beta_0$`50`
        25%         50%         75% 
0.198717632 0.008131017 0.210213471 

$laplace$beta_0$`100`
        25%         50%         75% 
0.130486991 0.005130119 0.151674765 

$laplace$beta_0$`200`
        25%         50%         75% 
0.111212424 0.007347042 0.098152012 

$laplace$beta_0$`500`
       25%        50%        75% 
0.06304653 0.00897076 0.06838179 

$laplace$beta_0$`1000`
        25%         50%         75% 
0.042034483 0.001328558 0.042583742 

$laplace$beta_0$`2000`
        25%         50%         75% 
0.033912931 0.003455312 0.028014372 

$laplace$beta_0$`5000`
         25%          50%          75% 
0.0198791808 0.0004795659 0.0194025102 


$laplace$beta_1
$laplace$beta_1$`50`
         25%          50%          75% 
0.0074049435 0.0005828648 0.0074100951 

$laplace$beta_1$`100`
         25%          50%          75% 
0.0024418420 0.0001347468 0.0024451187 

$laplace$beta_1$`200`
         25%          50%          75% 
8.666330e-04 8.767849e-05 1.057392e-03 

$laplace$beta_1$`500`
         25%          50%          75% 
2.350068e-04 9.755442e-06 2.124413e-04 

$laplace$beta_1$`1000`
         25%          50%          75% 
8.003015e-05 1.073205e-06 7.296090e-05 

$laplace$beta_1$`2000`
         25%          50%          75% 
2.544721e-05 1.468161e-06 2.844473e-05 

$laplace$beta_1$`5000`
         25%          50%          75% 
6.162208e-06 1.482420e-07 6.659293e-06 



$cauchy
$cauchy$beta_0
$cauchy$beta_0$`50`
       25%        50%        75% 
0.27452441 0.03616257 0.33677603 

$cauchy$beta_0$`100`
        25%         50%         75% 
0.198215930 0.003289174 0.207109169 

$cauchy$beta_0$`200`
        25%         50%         75% 
0.155318692 0.006726799 0.154703229 

$cauchy$beta_0$`500`
       25%        50%        75% 
0.08800292 0.00278229 0.08844794 

$cauchy$beta_0$`1000`
        25%         50%         75% 
0.068853637 0.003058196 0.064467376 

$cauchy$beta_0$`2000`
         25%          50%          75% 
0.0507696330 0.0001884046 0.0500372607 

$cauchy$beta_0$`5000`
        25%         50%         75% 
0.031058608 0.001727092 0.032296229 


$cauchy$beta_1
$cauchy$beta_1$`50`
        25%         50%         75% 
0.012062603 0.001702130 0.009781188 

$cauchy$beta_1$`100`
         25%          50%          75% 
3.384663e-03 7.464468e-06 3.776746e-03 

$cauchy$beta_1$`200`
         25%          50%          75% 
1.256774e-03 4.415212e-05 1.338013e-03 

$cauchy$beta_1$`500`
         25%          50%          75% 
3.154658e-04 1.308503e-05 3.114952e-04 

$cauchy$beta_1$`1000`
         25%          50%          75% 
1.198770e-04 5.468937e-07 1.175850e-04 

$cauchy$beta_1$`2000`
         25%          50%          75% 
4.140584e-05 9.978604e-07 4.364020e-05 

$cauchy$beta_1$`5000`
         25%          50%          75% 
9.477816e-06 9.226611e-07 1.129071e-05 

Answer 1

显然您有矩阵或矩阵可转换格式的模拟数据。在这种情况下，请查看专为矩阵设计的

matplot

。使用

type='o'

获取线和点。

png('foo.png', 800, 240)
op <- par(mfrow=c(1, 3), mar=c(4, 4, 2, 2)+.1)
for (i in 1:3) {
  sim [[i]] |> 
    matplot(type='o', pch=rep(16:17, each=3), col=rep(colors, 2), 
            lty=rep(lty_values, 2), xlab='Sample Size (T)', 
            ylab=quartile_titles[i], xaxt='n', ylim=range(sim[[i]])*1.05)
  axis(1, 1:7, sample_sizes)
  if (identical(i, 1L)) {
    legend("topright", 
           legend=c(as.list(noise_types), sapply(0:1, \(x) bquote(beta[.(x)]))),
           pch=c(rep(NA, length(noise_types)), 16:17), 
           lty=c(lty_values, rep(NA, 2)), 
           col=c(colors, 1, 1), ncol=2, inset=c(-.1, 0),
           bty="n")
  }
}
par(op)
dev.off()

如果您确实想要多余的标题，请照常使用

main

。

---

数据：

set.seed(42)
sim <- outer((1:6)^2, c(.8, .5, 1), 
             Vectorize(\(z, f) {
               (0.35*exp(-0.5*(1:7 - 1)) + rnorm(7, mean=0, sd=0.01))/z*f
             }, 
             SIMPLIFY=FALSE)) |> 
  apply(2, \(x) do.call('rbind', x), simplify=FALSE)
noise_types <- c('Gaussian', 'Laplace', 'Cauchy')
pch_values <- 16:17
colors <- c("gray60", "red", "blue")
lty_values <- c(3, 1, 2)
quartile_titles <- c("Absolute Bias of First Quartile", 
                     "Absolute Bias of Second Quartile (Median)", 
                     "Absolute Bias of Third Quartile")
sample_sizes <- c(50, 100, 200, 500, 1000, 2000, 5000)