赞
踩
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)) # calculate quantiles 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', '#CD443E', '#E76F51', '#EE8959','#F4A261','#EFB366', '#E9C46A', '#F3C891','#BABB74', '#8AB17D', # '#5AA786', '#2A9D8F', '#287271', '#264653' # ) 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) + # geom_boxplot() + #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"))) ) + # 更改坐标轴的breaks标签 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 }
Copyright © 2003-2013 www.wpsshop.cn 版权所有,并保留所有权利。