当前位置：首页 > news >正文

R_handbook_作图专题

news 2025/8/31 10:44:38

ggplot基本作图

1 条形图

library(ggplot2)
ggplot(biopics) + geom_histogram(aes(x = year_release),binwidth=1,fill="gray")

2 堆砌柱状图

ggplot(biopics, aes(x=year_release)) +geom_bar(aes(fill=subject_sex))

3 堆砌比例柱状图

ggplot(biopics, aes(x=year_release)) +geom_bar(aes(fill=subject_sex),position = 'fill')

4 马赛克图

library(vcd)  
bio_ques_d <- biopics[,c(11,13)]
bio_ques_d$subject_race <- ifelse(is.na(bio_ques_d$subject_race ), "missing",ifelse(bio_ques_d$subject_race == "White","White", "nonwhite"))
biq_ques_d_table <- table(bio_ques_d$subject_race,bio_ques_d$subject_sex)
mosaicplot(biq_ques_d_table)

5 双散点图

process_var <- c('v32', 'v33', 'v34', 'v35', 'v36', 'v37')
for (i in c(1:6)){var_clean <- paste(process_var[i],'clean',sep = '_')data[,var_clean] <- ifelse(data[,process_var[i]] == 'trust completely',1,ifelse(data[,process_var[i]] == 'trust somewhat',2,ifelse(data[,process_var[i]] == 'do not trust very much',3,ifelse(data[,process_var[i]] == 'do not trust at all',4,NA))))
}
data$intp.trust <- rowSums(data[,c(438:443)],na.rm = TRUE)
data$intp.trust <- data$intp.trust/6
ggplot(data[data$country == 'Iceland',], aes(x=confidence, y=intp.trust, colour=v225)) + geom_point()

6 双密度图

ggplot(data=start_s_country_data) +geom_density(aes(x=residual,color=as.factor(v225),))## 自定义图例的情况
ggplot(data=data) +geom_density(aes(x=LW, color = "LW")) + geom_density(aes(x=LP, color = "LP")) + labs(title="") + xlab("Value") + theme(legend.title=element_blank(),legend.position = c(0.9, 0.9))

ggplot(data ) +geom_point(aes(x = No.education, y=Median.year.of.schooling)) + geom_smooth(aes(x = No.education, y=Median.year.of.schooling), method = 'lm') + theme_classic()

7 双折线图与多图展示

library(dplyr)
library(devtools)
library(cowplot)plot_grid(plot1,plot3,plot5,plot2,plot4,plot6,ncol=3,nrow=2)
bio_ques_f <- biopics[,c(4,11,13)]
bio_ques_f$subject_race <- ifelse(is.na(bio_ques_f$subject_race ), "missing",ifelse(bio_ques_f$subject_race == "White","White", "nonwhite"))planes <- group_by(bio_ques_f, year_release, subject_race, subject_sex)
bio_ques_f_summary <- summarise(planes, count = n())
planes <- group_by(bio_ques_f,year_release)
bio_ques_f_year<- summarise(planes,count_year = n())bio_ques_f_summary <- left_join(bio_ques_f_summary,bio_ques_f_year,c("year_release" = "year_release"))
bio_ques_f_summary$prop <- bio_ques_f_summary$count / bio_ques_f_summary$count_yeardata_missing_female <- subset(bio_ques_f_summary,with(bio_ques_f_summary,(subject_race == 'missing') & (subject_sex == 'Female')))
data_missing_male <- subset(bio_ques_f_summary,with(bio_ques_f_summary,(subject_race == 'missing') & (subject_sex == 'Male')))
data_nonwhite_female <- subset(bio_ques_f_summary,with(bio_ques_f_summary,(subject_race == 'nonwhite') & (subject_sex == 'Female')))
data_nonwhite_male <- subset(bio_ques_f_summary,with(bio_ques_f_summary,(subject_race == 'nonwhite') & (subject_sex == 'Male')))
data_white_female <- subset(bio_ques_f_summary,with(bio_ques_f_summary,(subject_race == 'White') & (subject_sex == 'Female')))
data_white_male <- subset(bio_ques_f_summary,with(bio_ques_f_summary,(subject_race == 'White') & (subject_sex == 'Male')))plot1 <- ggplot(data_missing_female)+geom_line(aes(x=year_release,y=count),color="red") + geom_line(aes(x=year_release,y=prop),color="blue") +labs(title="missing and female")
plot2 <- ggplot(data_missing_male)+geom_line(aes(x=year_release,y=count),color="red") + geom_line(aes(x=year_release,y=prop),color="blue") +labs(title="missing and male")
plot3 <- ggplot(data_nonwhite_female)+geom_line(aes(x=year_release,y=count),color="red") + geom_line(aes(x=year_release,y=prop),color="blue") +labs(title="nonwhite and female")
plot4 <- ggplot(data_nonwhite_male)+geom_line(aes(x=year_release,y=count),color="red") + geom_line(aes(x=year_release,y=prop),color="blue") +labs(title="nonwhite and male")
plot5 <- ggplot(data_white_female)+geom_line(aes(x=year_release,y=count),color="red") + geom_line(aes(x=year_release,y=prop),color="blue") +labs(title="white and female")
plot6 <- ggplot(data_white_male)+geom_line(aes(x=year_release,y=count),color="red") + geom_line(aes(x=year_release,y=prop),color="blue") +labs(title="white and male")plot_grid(plot1,plot3,plot5,plot2,plot4,plot6,ncol=3,nrow=2)

ggplot作图美化

1 标题居中

ggplot(data_selected, aes(x=AREA.NAME)) +geom_bar(aes(fill=year)) + labs(title = 'The bar plot of AREA.NAME') +theme_classic() + theme(plot.title = element_text(hjust = 0.5))

2 X轴标签旋转

ggplot(data_selected, aes(x=AREA.NAME)) +geom_bar(aes(fill=year)) + labs(title = 'The bar plot of AREA.NAME') +theme_classic() + theme(plot.title = element_text(hjust = 0.5)) + theme(axis.text.x=element_text(face="bold",size=8,angle=270,color="black"))

3 变更label名

ggplot(data=data) + geom_line(aes(x=index,y=data,group=line,color=result)) + theme_classic() + scale_colour_manual(values=c("red", "blue"), labels=c("lose", "win"))

ggforce

ggforce能对绘制的图增加聚类图层，包括圆形、椭圆形、方形能多种。

North_latitude <- c(47.5, 52.3, 54.8, 48.4, 54.2,54.8, 54.4, 48.8, 50.5, 52.7,46.5, 46.9, 45.1, 45.9, 50.7,48.5, 48.3, 48.1, 48.8, 49.4)
Elevation <- c(2, 1, 1, 2, 1,1, 1, 2, 2, 1,2, 2, 2, 2, 1,2, 2, 1, 1, 1)
Temperature <- c(39.27, 39.00, 38.35, 37.58, 39.38,39.05, 39.65, 38.66, 37.97, 40.10,37.05, 37.19, 36.92, 36.70, 38.01,37.26, 36.97, 36.95, 37.68, 37.55)
data <- data.frame(North_latitude = North_latitude,Elevation = Elevation,Temperature = Temperature)
data$Elevation <- as.factor(data$Elevation)
dim(data)

library(ggplot2)
library(ggforce)
ggplot(data=data,aes(x=North_latitude,y=Temperature,color=Elevation))+
geom_point()+
geom_mark_circle(aes(fill=Elevation),alpha=0.4)+
theme_classic() +
labs(title = 'The relationship between latitude and temperature') +theme(plot.title = element_text(hjust = 0.5))

地理位置图

library(ggplot2)
library(viridis)
library(cvTools)
library(dplyr)data <- read.csv("Reef_Check_with_cortad_variables_with_annual_rate_of_SST_change.csv")world_map <- map_data("world")
ggplot() + geom_polygon(data =world_map, aes(x=long, y = lat, group = group), fill="grey", alpha=0.3) +geom_point(data =data, alpha = 0.2, aes(y=Latitude.Degrees, x= Longitude.Degrees , size=Average_bleaching, color=Average_bleaching))  + scale_colour_viridis() + theme_minimal()

igraph网络图

library(igraph)webforum_graph <- webforum[webforum$Date > as.Date("2010-12-01"), ]
webforum_graph <- webforum_graph[webforum_graph$Date < as.Date("2010-12-31"), ]# generate node dataframe
AuthorID <- unique(as.numeric(webforum_graph$AuthorID))
ThreadID <- unique(as.numeric(webforum_graph$ThreadID))
name <- c(AuthorID, ThreadID)
type <- c(rep("Author", length(AuthorID)) , rep("Thread", length(ThreadID)))
webforum_node <- data.frame(name = name, type = type)# generate edge dataframe
webforum_graph <- webforum_graph[,c("AuthorID", "ThreadID")]# generate graph dataframe
graph <- graph_from_data_frame(webforum_graph, directed = FALSE, vertices=webforum_node) set.seed(30208289)plot(graph,  layout= layout.fruchterman.reingold,  vertex.size=10,   vertex.shape="circle",    vertex.color=ifelse(V(graph)$type == "Thread", "red", "blue"),vertex.label=NULL, 	 vertex.label.cex=0.7,    vertex.label.color='black',  vertex.label.dist=0,edge.arrow.size=0.2, edge.width = 0.5, edge.label=V(graph)$year, edge.label.cex=0.5,edge.color="black")