v2.0.2

The geom_ts function can set the left and right axis ranges. Solve the problem that the maximum value of vocct, OFP, LOH is equal to 75th percentile. Solve the problem that the trs function fails to keep the original column names. Updated the mechanism of extracting data from tuv. Prepared default templates for vignette and pkgdown, upload them first for testing. Commented llab, plab, alab, blab in geom_ts as "list of text expressions".
tianshu129 · Apr 3, 2022 · 33e571e · 33e571e
1 parent 0a02881
commit 33e571e
Show file tree

Hide file tree

Showing 11 changed files with 311 additions and 60 deletions.
diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml
@@ -0,0 +1,35 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/master/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
+on:
+  push:
+    branches: [main, master]
+  release:
+    types: [published]
+  workflow_dispatch:
+
+name: pkgdown
+
+jobs:
+  pkgdown:
+    runs-on: ubuntu-latest
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+    steps:
+      - uses: actions/checkout@v2
+
+      - uses: r-lib/actions/setup-pandoc@v1
+
+      - uses: r-lib/actions/setup-r@v1
+        with:
+          use-public-rspm: true
+
+      - uses: r-lib/actions/setup-r-dependencies@v1
+        with:
+          extra-packages: pkgdown
+          needs: website
+
+      - name: Deploy package
+        run: |
+          git config --local user.name "$GITHUB_ACTOR"
+          git config --local user.email "[email protected]"
+          Rscript -e 'pkgdown::deploy_to_branch(new_process = FALSE)'
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: foqat
 Type: Package
 Title: Field Observation Quick Analysis Toolkit
-Version: 2.0.1
+Version: 2.0.2
 Author: Tianshu Chen
 Maintainer: Tianshu Chen <[email protected]>
 Description: Tools for quickly processing and analyzing 
@@ -16,7 +16,8 @@ Description: Tools for quickly processing and analyzing
 	2. Ozone Formation Potential (OFP): <https://ww2.arb.ca.gov/sites/default/files/classic/regact/2009/mir2009/mir10.pdf>, Zhang et al.(2021) <doi:10.5194/acp-21-11053-2021>.
 	3. Aerosol Formation Potential (AFP): Wenjing Wu et al. (2016) <doi:10.1016/j.jes.2016.03.025>.
 	4. TUV model: <https://www2.acom.ucar.edu/modeling/tropospheric-ultraviolet-and-visible-tuv-radiation-model>.
-URL: https://github.com/tianshu129/foqat
+URL: https://github.com/tianshu129/foqat,
+    https://tianshu129.github.io/foqat/
 BugReports: https://github.com/tianshu129/foqat/issues
 Depends: R (>= 3.5.0)
 Imports: lubridate, magrittr, dplyr, plyr, stats, stringr, utils,
@@ -25,6 +26,10 @@ Imports: lubridate, magrittr, dplyr, plyr, stats, stringr, utils,
 License: GPL-3 | file LICENSE
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.1.1
+RoxygenNote: 7.1.2
 NeedsCompilation: no
 Packaged: 2021-08-17 16:44:03 UTC; Administrator
+Suggests: 
+    knitr,
+    rmarkdown
+VignetteBuilder: knitr
diff --git a/R/geom_ts.r b/R/geom_ts.r
@@ -12,10 +12,10 @@
 #' @param plist vector, col index of species to be ploted by points.The default vaule is NULL.
 #' @param alist plist vector, col index of species to be ploted by areas. The default vaule is NULL.
 #' @param blist plist vector, col index of species to be ploted by bars. The default vaule is NULL.
-#' @param llab text expression of legend labels of lines. The default vaule is NULL.
-#' @param plab text expression of legend labels of points. The default vaule is NULL.
-#' @param alab text expression of legend labels of areas. The default vaule is NULL.
-#' @param blab text expression of legend labels of bars. The default vaule is NULL.
+#' @param llab list of text expressions of legend labels of lines. The default vaule is NULL.
+#' @param plab list of text expressions of legend labels of points. The default vaule is NULL.
+#' @param alab list of text expressions of legend labels of areas. The default vaule is NULL.
+#' @param blab list of text expressions of legend labels of bars. The default vaule is NULL.
 #' @param ltype vector, type of lines. The default vaule is NULL.
 #' @param pshape vector, shape of points. The default vaule is NULL.
 #' @param lsize vector, size of lines. The default vaule is NULL.The default vaule is 1.
@@ -28,6 +28,11 @@
 #' @param apos Position adjustment for areas, either as a string, or the result of a call to a position adjustment function.
 #' @param bna logical value, the way to handle NA values for bars. If you select FALSE, NA value will be replaced by 0.
 #' @param bpos Position adjustment for bars, either as a string, or the result of a call to a position adjustment function.
+#' @param yl_limit two numeric values, specifying the lower limit and the upper limit of the scale in left y axis. 
+#' @param yr_limit two numeric values, specifying the lower limit and the upper limit of the scale in right y axis. 
+#' @param yl_breaks a numeric vector of positions for breaks in left y axis. 
+#' @param yr_breaks a numeric vector of positions for breaks in right y axis. 
+#' @param yl_minor_breaks a numeric vector of positions for minor breaks in left y axis. 
 #'
 #' @export
 #' @examples 
@@ -58,16 +63,139 @@ yllab=NULL, yrlab=NULL, xlab=NULL,
 llist=NULL, plist=NULL, alist=NULL, blist=NULL, 
 llab=NULL, plab=NULL, alab=NULL, blab=NULL,
 ltype=NULL, pshape=NULL, lsize=1, psize=1,
-lcc=NULL, pcc=NULL, aff=NULL, bff=NULL, ana=TRUE, apos='stack', bna=TRUE, bpos='identity'){
+lcc=NULL, pcc=NULL, aff=NULL, bff=NULL, ana=TRUE, apos='stack', bna=TRUE, bpos='identity', 
+yl_limit=NULL, yr_limit=NULL, 
+yl_breaks= waiver(), yr_breaks= waiver(), yl_minor_breaks = waiver()){
 	#命名时间列#################################
 	names(df)[1]="Datetime"
 
-	#副轴数值范围确定#################################
-	ryl=abs(max(df[,yl],na.rm = TRUE)-min(df[,yl],na.rm = TRUE))
+	#按照上下限替换超出范围的数据#################################
+	##左侧如果输入了yl_limit
+	if(length(yl_limit)!=0){
+		###如果左侧有点线，超过范围的替换
+		if(length(intersect(llist,yl))!=0|length(intersect(plist,yl))!=0){
+			if(length(yl_limit)!=0){
+				yllp=c(intersect(llist,yl),intersect(plist,yl))
+				df[,yllp][df[,yllp]>yl_limit[2]]=NA#upper
+				df[,yllp][df[,yllp]<yl_limit[1]]=NA#lower
+			}
+		}
+
+		###如果左侧有面，且堆积，超过范围的替换
+		if(length(intersect(alist,yl))!=0&apos=='stack'){
+			if(length(intersect(alist,yl))==1){
+					yla=intersect(alist,yl)
+					df[,yla][df[,yla]>yl_limit[2]]=NA#upper
+					df[,yla][df[,yla]<yl_limit[1]]=NAlower	
+			}else{
+					yla=intersect(alist,yl)
+					df[which(rowSums(df[,yla], na.rm=TRUE)>yl_limit[2]),yla]=NA#upper
+					df[which(rowSums(df[,yla], na.rm=TRUE)<yl_limit[1]),yla]=NA#upper
+			}
+		}
+
+		###如果左侧有面，不堆积，超过范围的替换
+		if(length(intersect(alist,yl))!=0&apos=='identity'){
+			if(length(alist)==1){
+					yla=intersect(alist,yl)
+					df[,yla][df[,yla]>yl_limit[2]]=NA#upper
+					df[,yla][df[,yla]<yl_limit[1]]=NA#lower	
+			}
+		}
+		###如果左侧有柱，且堆积，超过范围的替换
+		if(length(intersect(blist,yl))!=0&bpos=='stack'){
+				if(length(intersect(blist,yl))==1){
+					ylb=intersect(blist,yl)
+					df[,ylb][df[,ylb]>yl_limit[2]]=NA#upper
+					df[,ylb][df[,ylb]<yl_limit[1]]=NA#lower	
+				}else{
+					ylb=intersect(blist,yl)
+					df[which(rowSums(df[,ylb], na.rm=TRUE)>yl_limit[2]),ylb]=NA#upper
+					df[which(rowSums(df[,ylb], na.rm=TRUE)<yl_limit[1]),ylb]=NA#upper
+				}
+		}
+
+		###如果左侧有柱，不堆积，超过范围的替换
+		if(length(intersect(blist,yl))!=0&bpos=='identity'){
+				ylb=intersect(blist,yl)
+				df[,ylb][df[,ylb]>yl_limit[2]]=NA#upper
+				df[,ylb][df[,ylb]<yl_limit[1]]=NA#lower
+		}
+    }
+
+	##右侧如果输入了yr_limit
+	if(length(yr_limit)!=0){
+		###如果右侧有点线，超过范围的替换
+		if(length(intersect(llist,yr))!=0|length(intersect(plist,yr))!=0){
+			if(length(yr_limit)!=0){
+				yrlp=c(intersect(llist,yr),intersect(plist,yr))
+				df[,yrlp][df[,yrlp]>yr_limit[2]]=NA#upper
+				df[,yrlp][df[,yrlp]<yr_limit[1]]=NA#lower
+			}
+		}
+
+		###如果右侧有面，且堆积，超过范围的替换
+		if(length(intersect(alist,yr))!=0&apos=='stack'){
+			if(length(intersect(alist,yr))==1){
+					yra=intersect(alist,yr)
+					df[,yra][df[,yra]>yr_limit[2]]=NA#upper
+					df[,yra][df[,yla]<yr_limit[1]]=NA#lower	
+			}else{
+					yra=intersect(alist,yr)
+					df[which(rowSums(df[,yra], na.rm=TRUE)>yr_limit[2]),yra]=NA#upper
+					df[which(rowSums(df[,yra], na.rm=TRUE)<yr_limit[1]),yra]=NA#upper
+			}
+		}
+
+		###如果右侧有面，不堆积，超过范围的替换
+		if(length(intersect(alist,yr))!=0&apos=='identity'){
+			if(length(alist)==1){
+					yra=intersect(alist,yr)
+					df[,yra][df[,yra]>yr_limit[2]]=NA#upper
+					df[,yra][df[,yra]<yr_limit[1]]=NA#lower	
+			}
+		}
+
+		###如果右侧有柱，且堆积，超过范围的替换
+		if(length(intersect(blist,yr))!=0&bpos=='stack'){
+				if(length(intersect(blist,yr))==1){
+					yrb=intersect(blist,yr)
+					df[,yrb][df[,yrb]>yr_limit[2]]=NA#upper
+					df[,yrb][df[,yrb]<yr_limit[1]]=NA#lower	
+				}else{
+					yrb=intersect(blist,yr)
+					df[which(rowSums(df[,yrb], na.rm=TRUE)>yr_limit[2]),ylb]=NA#upper
+					df[which(rowSums(df[,yrb], na.rm=TRUE)<yr_limit[1]),ylb]=NA#upper
+				}
+		}
+
+		###如果右侧有柱，不堆积，超过范围的替换
+		if(length(intersect(blist,yr))!=0&bpos=='identity'){
+				yrb=intersect(blist,yr)
+				df[,yrb][df[,yrb]>yr_limit[2]]=NA#upper
+				df[,yrb][df[,yrb]<yr_limit[1]]=NA#lower
+		}
+    }
+
+	#必须赋值yl_limit,如果有输入的，则按输入的提取，没有的话，则从df[,yl]提取
+	if(length(yl_limit)==0){
+		yl_limit=c(min(df[,yl],na.rm = TRUE), max(df[,yl],na.rm = TRUE))
+	}
+
+	#如果有yr，则赋值yr_limit。如果有输入的，则按输入的提取，没有的话，则从df[,yr]提取
+	if(length(yr)!=0&length(yr_limit)==0){
+		yr_limit=c(min(df[,yr],na.rm = TRUE), max(df[,yr],na.rm = TRUE))
+	}
+
+
+	#副轴与主轴的比例系数确定#################################
+	#如果有yr则计算
 	if(length(yr)!=0){
-		ryr=abs(max(df[,yr],na.rm = TRUE)-min(df[,yr],na.rm = TRUE))
+		ryl=abs(yl_limit[2]-yl_limit[1])
+	    ryr=abs(yr_limit[2]-yr_limit[1])
 	}
 
+
 	#初始化图层#################################
 	p = ggplot()
 
@@ -106,7 +234,7 @@ lcc=NULL, pcc=NULL, aff=NULL, bff=NULL, ana=TRUE, apos='stack', bna=TRUE, bpos='
 		df_yr_alist$variable=factor(df_yr_alist$variable,levels=fc_yr_alist)
 		###NA值用0
 		if(ana==FALSE){df_yr_alist[is.na(df_yr_alist)]=0}
-		p=p+geom_area(data=df_yr_alist, aes(x = Datetime,y = value*ryl/ryr, fill = variable), position = apos)
+		p=p+geom_area(data=df_yr_alist, aes(x = Datetime,y = (value-yr_limit[1])*ryl/ryr+yl_limit[1], fill = variable), position = apos)
 	}
 
 	#if(!exists("yl_alist")){yl_alist=NULL}
@@ -130,9 +258,9 @@ lcc=NULL, pcc=NULL, aff=NULL, bff=NULL, ana=TRUE, apos='stack', bna=TRUE, bpos='
 
 	##if area in left
 	if(length(intersect(blist,yl))!=0){
-		###右Y和面积型交集列号
+		###左Y和面积型交集列号
 		yl_blist=intersect(blist,yl)
-		###用右Y和面积型交集列号从df取子数据集
+		###用左Y和面积型交集列号从df取子数据集
 		df_yl_blist=df[,c(1,yl_blist)]
 		###为因子排序提前提取交集物种名
 		fc_yl_blist=names(df_yl_blist)[-1]
@@ -147,9 +275,9 @@ lcc=NULL, pcc=NULL, aff=NULL, bff=NULL, ana=TRUE, apos='stack', bna=TRUE, bpos='
 
 	##if area in right
 	if(length(intersect(blist,yr))!=0){
-		###左Y和面积型交集列号
+		###右Y和面积型交集列号
 		yr_blist=intersect(blist,yr)
-		###用左Y和面积型交集列号从df取子数据集
+		###用右Y和面积型交集列号从df取子数据集
 		df_yr_blist=df[,c(1,yr_blist)]
 		###为因子排序提前提取交集物种名
 		fc_yr_blist=names(df_yr_blist)[-1]
@@ -159,7 +287,7 @@ lcc=NULL, pcc=NULL, aff=NULL, bff=NULL, ana=TRUE, apos='stack', bna=TRUE, bpos='
 		df_yr_blist$variable=factor(df_yr_blist$variable,levels=fc_yr_blist)
 		###NA值用0
 		if(bna==FALSE){df_yr_blist[is.na(df_yr_blist)]=0}
-		p=p+geom_bar(data=df_yr_blist, aes(x = Datetime,y = value*ryl/ryr, fill = variable), stat = bpos)
+		p=p+geom_bar(data=df_yr_blist, aes(x = Datetime,y = (value-yr_limit[1])*ryl/ryr+yl_limit[1], fill = variable), stat = bpos)
 	}
 
 	#if(!exists("yl_blist")){yl_blist=NULL}
@@ -215,9 +343,9 @@ lcc=NULL, pcc=NULL, aff=NULL, bff=NULL, ana=TRUE, apos='stack', bna=TRUE, bpos='
 		###因子排序
 		df_yr_llist$variable=factor(df_yr_llist$variable,levels=fc_yr_llist)
 		if(length(ltype)==0){
-			p=p+geom_line(data=df_yr_llist, aes(x=df_yr_llist[,1], y=value*ryl/ryr, color=variable), size=lsize)
+			p=p+geom_line(data=df_yr_llist, aes(x=df_yr_llist[,1], y=(value-yr_limit[1])*ryl/ryr+yl_limit[1], color=variable), size=lsize)
 		}else{
-			p=p+geom_line(data=df_yr_llist, aes(x=df_yr_llist[,1], y=value*ryl/ryr, color=variable, linetype=variable), size=lsize)
+			p=p+geom_line(data=df_yr_llist, aes(x=df_yr_llist[,1], y=(value-yr_limit[1])*ryl/ryr+yl_limit[1], color=variable, linetype=variable), size=lsize)
 		}
 	}
 
@@ -279,9 +407,9 @@ lcc=NULL, pcc=NULL, aff=NULL, bff=NULL, ana=TRUE, apos='stack', bna=TRUE, bpos='
 		###因子排序
 		df_yr_plist$variable=factor(df_yr_plist$variable,levels=fc_yr_plist)
 		if(length(pshape)==0){
-			p=p+geom_point(data=df_yr_plist, aes(x=df_yr_plist[,1], y=value*ryl/ryr, color=variable), size=lsize)
+			p=p+geom_point(data=df_yr_plist, aes(x=df_yr_plist[,1], y=(value-yr_limit[1])*ryl/ryr+yl_limit[1], color=variable), size=lsize)
 		}else{
-			p=p+geom_point(data=df_yr_plist, aes(x=df_yr_plist[,1], y=value*ryl/ryr, color=variable, shape=variable), size=lsize)  
+			p=p+geom_point(data=df_yr_plist, aes(x=df_yr_plist[,1], y=(value-yr_limit[1])*ryl/ryr+yl_limit[1], color=variable, shape=variable), size=lsize)  
 		}
 	}
 
@@ -306,14 +434,48 @@ lcc=NULL, pcc=NULL, aff=NULL, bff=NULL, ana=TRUE, apos='stack', bna=TRUE, bpos='
 		p = p + scale_color_manual(values=cols, labels=labs)#, limits = lgorder)
 	} 
 
-	p
-
-	#调节副轴范围#################################
+	#主轴范围控制#################################
+	if(length(yl_limit)!=0){
+		df$yl_up=yl_limit[2]
+		df$yl_down=yl_limit[1]
+
+		p=p+new_scale_color()+new_scale_fill()
+
+		###从df取上下限子数据集
+		df_yl_plist=df[,c(names(df)[1],"yl_up","yl_down")]
+		###为因子排序提前提取交集物种名
+		fc_yl_plist=names(df_yl_plist)[-1]
+		###子数据集变形以供画图
+		df_yl_plist=melt(df_yl_plist, id.vars = names(df_yl_plist)[1])
+		###因子排序
+		df_yl_plist$variable=factor(df_yl_plist$variable,levels=fc_yl_plist)
+		p=p+geom_point(data=df_yl_plist, alpha = 0, aes(x=df_yl_plist[,1], y=value))  
+    }
+
+    #副轴范围控制#################################
+	if(length(yr_limit)!=0){
+		df$yr_up=yr_limit[2]
+		df$yr_down=yr_limit[1]
+
+		p=p+new_scale_color()+new_scale_fill()
+
+		###从df取上下限子数据集
+		df_yr_plist=df[,c(names(df)[1],"yr_up","yr_down")]
+		###为因子排序提前提取交集物种名
+		fc_yr_plist=names(df_yr_plist)[-1]
+		###子数据集变形以供画图
+		df_yr_plist=melt(df_yr_plist, id.vars = names(df_yr_plist)[1])
+		###因子排序
+		df_yr_plist$variable=factor(df_yr_plist$variable,levels=fc_yr_plist)
+		p=p+geom_point(data=df_yr_plist, alpha = 0, aes(x=df_yr_plist[,1], y=(value-yr_limit[1])*ryl/ryr+yl_limit[1]))  	
+	}
+
 	if(length(yr)!=0){
-		p = p + scale_y_continuous(expand = c(0, 0), sec.axis = sec_axis(~.*ryr/ryl, name = yrlab))
+		p = p + scale_y_continuous(expand = c(0, 0), breaks = yl_breaks, minor_breaks = yl_minor_breaks,
+		sec.axis = sec_axis(~.*ryr/ryl-yl_limit[1]*ryr/ryl+yr_limit[1], name = yrlab, breaks = yr_breaks))
 	}else{
-		p = p + scale_y_continuous(expand = c(0, 0))
-	}
+		p = p + scale_y_continuous(expand = c(0, 0), breaks = yl_breaks)
+	}		
 
 	#加yl标题#################################
 	if(length(yllab)!=0){