figure_display_batch
<- function(res
) {
res_tmp
<- res
size
<- dim
(res_tmp
)[3]
res_list
<- list
()
for (i
in 1:size
) {
res_list
[[i
]] <- res_tmp
[, , i
]
}
res_list
<- do.call
("rbind", res_list
)
col_name
<- c
("Prediction Error", "Model Size")
colnames
(res_list
) <- col_name
res_list
<- as.data.frame
(res_list
)
rownames
(res_list
) <- NULL
row_name
<- c
(bquote
("G"~L
[2]~"PDAS"), as.expression
(bquote
("P"~L
[2]~"PDAS")),
as.expression
(bquote
(L
[0]~"-SPDAS")), as.expression
(bquote
(L
[0]~"-GPDAS")),
as.expression
(bquote
("LASSO")), "SCAD",
"MCP", "Elastic-Net",
"Relaxed-LASSO", as.expression
(bquote
(L
[0]~L
[2]~"-CD")),
as.expression
(bquote
(L
[0]~L
[2]~"-CDPSI")),
as.expression
(bquote
(L
[0]~"-CD")), as.expression
(bquote
(L
[0]~"-CDPSI")))
res_list
[["method"]] <- rep
(row_name
, size
)
res_list
[["method"]] <- factor
(res_list
[["method"]],
levels
= c
(bquote
("G"~L
[2]~"PDAS"), as.expression
(bquote
("P"~L
[2]~"PDAS")),
as.expression
(bquote
(L
[0]~"-SPDAS")), as.expression
(bquote
(L
[0]~"-GPDAS")),
as.expression
(bquote
("LASSO")), "SCAD",
"MCP", "Elastic-Net",
"Relaxed-LASSO", as.expression
(bquote
(L
[0]~L
[2]~"-CD")),
as.expression
(bquote
(L
[0]~L
[2]~"-CDPSI")),
as.expression
(bquote
(L
[0]~"-CD")), as.expression
(bquote
(L
[0]~"-CDPSI")))
)
library
(tidyr
)
plot_data
= gather
(res_list
, metric
, value
, -method
)
plot_data
$metric
= factor
(plot_data
$metric
, levels
= c
("Prediction Error", "Model Size", "Infinity Norm"))
plot_data
$method
= factor
(plot_data
$method
, levels
= c
(bquote
("G"~L
[2]~"PDAS"), as.expression
(bquote
("P"~L
[2]~"PDAS")),
as.expression
(bquote
(L
[0]~"-SPDAS")), as.expression
(bquote
(L
[0]~"-GPDAS")),
as.expression
(bquote
("LASSO")), "SCAD",
"MCP", "Elastic-Net",
"Relaxed-LASSO", as.expression
(bquote
(L
[0]~L
[2]~"-CD")),
as.expression
(bquote
(L
[0]~L
[2]~"-CDPSI")),
as.expression
(bquote
(L
[0]~"-CD")), as.expression
(bquote
(L
[0]~"-CDPSI")))
)
calc_stat
<- function(x
) {
coef
<- 5
n
<- sum
(!is.na
(x
))
stats
<- quantile
(x
, probs
= c
(0, 0.25, 0.5, 0.75, 1))
names
(stats
) <- c
("ymin", "lower", "middle", "upper", "ymax")
return
(stats
)
}
color
= c
('#B2182B','#BF0C49','#CC0066','#B34D33','#AD6027', '#A6731A', '#A0860D', '#999900',
'#809940', '#669980', '#3399FF', '#2D70A9','#2D70A9', '#264653')
p
= ggplot
(plot_data
, aes
(x
= method
, y
= value
, fill
= method
), coef
= 5) +
stat_summary
(fun.data
= calc_stat
, geom
="boxplot", width
= 0.75, alpha
= 0.8) +
facet_wrap
(~metric
, scales
= "free") +
scale_fill_manual
(values
= color
, labels
= c
(as.expression
(bquote
("G"~L
[2]~"PDAS")), as.expression
(bquote
("P"~L
[2]~"PDAS")),
as.expression
(bquote
(L
[0]~"-SPDAS")), as.expression
(bquote
(L
[0]~"-GPDAS")),
as.expression
(bquote
("LASSO")), "SCAD",
"MCP", "Elastic-Net",
"Relaxed-LASSO", as.expression
(bquote
(L
[0]~L
[2]~"-CD")),
as.expression
(bquote
(L
[0]~L
[2]~"-CDPSI")),
as.expression
(bquote
(L
[0]~"-CD")), as.expression
(bquote
(L
[0]~"-CDPSI")))
) +
scale_x_discrete
(labels
= c
(as.expression
(bquote
("G"~L
[2]~"PDAS")), as.expression
(bquote
("P"~L
[2]~"PDAS")),
as.expression
(bquote
(L
[0]~"-SPDAS")), as.expression
(bquote
(L
[0]~"-GPDAS")),
as.expression
(bquote
("LASSO")), "SCAD",
"MCP", "Elastic-Net",
"Relaxed-LASSO", as.expression
(bquote
(L
[0]~L
[2]~"-CD")),
as.expression
(bquote
(L
[0]~L
[2]~"-CDPSI")),
as.expression
(bquote
(L
[0]~"-CD")), as.expression
(bquote
(L
[0]~"-CDPSI")))
) +
theme_bw
()+
theme
(
legend.position
= "bottom",
panel.grid
= element_blank
(),
axis.text.x
= element_text
(angle
= 45, hjust
= 0.5, vjust
= 0.5),
axis.title
= element_blank
(),
legend.text.align
= 0)
p
}
转载请注明原文地址: https://lol.8miu.com/read-24115.html