Merge pull request #104 from tianshu129/develop

v2.0.2

.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)'

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

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){