Movatterモバイル変換

[0]ホーム
URL:

Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly

 Sign up
Appearance settings

Commitb20a9f5

Browse files
committed
Added APLE summary and print methods.
1 parent3981815 commitb20a9f5

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

48 files changed

+205
-42
lines changed

‎.gitignore‎

100644100755
Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -31,3 +31,7 @@ vignettes/*.pdf
3131
# Temporary files created by R markdown
3232
*.utf8.md
3333
*.knit.md
34+
35+
# Mac files
36+
.DS_Store
37+
._*

‎DESCRIPTION‎

100644100755
Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
Package: VFS
22
Title: Vegetated Filter Strip and Erosion Model
3-
Version: 0.9.3-2
3+
Version: 0.9.3-3
44
Date: 2018-09-11
55
Authors@R: c(person("Sarah", "Goslee", role = c("aut", "cre"),
66
email = "Sarah.Goslee@ars.usda.gov"),
@@ -16,4 +16,5 @@ Description: A model for erosion and runoff across a vegetated filter strip,
1616
simulating weather. Functions to summarize the model results are
1717
provided.
1818
License: GPL-3
19+
LazyData: true
1920

‎NAMESPACE‎

100644100755
Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -7,3 +7,6 @@ import(stats, graphics)
77
S3method(summary, VFS)
88
S3method(print, VFS)
99

10+
S3method(summary, APLE)
11+
S3method(print, APLE)
12+

‎R/APLE.R‎

100644100755
Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -88,7 +88,10 @@ lossDissolvedFert <- fertPavail * runoff / precip * fertPD
8888
lossTotal<-lossErosion+lossDissolvedSoil+lossDissolvedManure+lossDissolvedFert
8989

9090

91-
list(lossErosion=lossErosion,lossDissolvedSoil=lossDissolvedSoil,lossDissolvedManure=lossDissolvedManure,lossDissolvedFert=lossDissolvedFert,lossTotal=lossTotal)
91+
results<-list(lossErosion=lossErosion,lossDissolvedSoil=lossDissolvedSoil,lossDissolvedManure=lossDissolvedManure,lossDissolvedFert=lossDissolvedFert,lossTotal=lossTotal)
92+
93+
class(results)<-"APLE"
94+
results
9295

9396
}
9497

‎R/MUSLE.R‎

100644100755
File mode changed.

‎R/MUSLEfactors.R‎

100644100755
File mode changed.

‎R/VFS.R‎

100644100755
Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -489,12 +489,13 @@ function(nyears = 1000, thissoil, thisbuffer, rain, temperature, Duration = 2, F
489489

490490
}
491491

492+
musle<-data.frame(MUSLE=musle)
492493

493494
## Annual Calculations
494495
AnnualRainfall<- aggregate(rain,by=list(date.Year),sum)[,-1,drop=FALSE]
495496
AnnualRunoff<- aggregate(runoff,by=list(date.Year),sum)[,-1,drop=FALSE]
496497

497-
output<-list(daily=data.frame(rain=rain,temperature=temperature,S=S,kt=kt,ET=ET,intensity=intensity,runoff=runoff,Q=Q,fd=fd,R=R,Vm=Vm,Re=Re,Va=Va,Nfc=Nfc,Nfm=Nfm,Nff=Nff,fdc=fdc,fdm=fdm,fdf=fdf,Ft=Ft,peakflow=peakflow,MUSLE=musle),field=c(clay=ff,area=FieldArea),AnnualRainfall=AnnualRainfall,AnnualRunoff=AnnualRunoff,Conc=Conc,Load=Load,MassRemoved=MassRemoved,MassOut=MassOut,AnnualLoadIn=AnnualLoadIn,AnnualLoadOut=AnnualLoadOut,AnnualRemovalEfficiency=AnnualRemovalEfficiency,MassRemovedMUSLE=MassRemovedMUSLE,MassOutMUSLE=MassOutMUSLE,AnnualLoadInMUSLE=AnnualLoadInMUSLE,AnnualLoadOutMUSLE=AnnualLoadOutMUSLE,AnnualRemovalEfficiencyMUSLE=AnnualRemovalEfficiencyMUSLE,Ftannual=Ftannual,Ftannualavg=Ftannualavg,Ftannualstdev=Ftannualstdev)
498+
output<-list(daily=data.frame(rain=rain,temperature=temperature,S=S,kt=kt,ET=ET,intensity=intensity,runoff=runoff,Q=Q,fd=fd,R=R,Vm=Vm,Re=Re,Va=Va,Nfc=Nfc,Nfm=Nfm,Nff=Nff,fdc=fdc,fdm=fdm,fdf=fdf,Ft=Ft,peakflow=peakflow),field=c(clay=ff,area=FieldArea),AnnualRainfall=AnnualRainfall,AnnualRunoff=AnnualRunoff,Conc=Conc,MassIn=Load,MassOut=MassOut,MassRemoved=MassRemoved,AnnualMassIn=AnnualLoadIn,AnnualMassOut=AnnualLoadOut,AnnualRemovalEfficiency=AnnualRemovalEfficiency,MassInMUSLE=musle,MassOutMUSLE=MassOutMUSLE,MassRemovedMUSLE=MassRemovedMUSLE,AnnualMassInMUSLE=AnnualLoadInMUSLE,AnnualMassOutMUSLE=AnnualLoadOutMUSLE,AnnualRemovalEfficiencyMUSLE=AnnualRemovalEfficiencyMUSLE,Ftannual=Ftannual,Ftannualavg=Ftannualavg,Ftannualstdev=Ftannualstdev)
498499

499500
class(output)<-"VFS"
500501

‎R/VFSAPLE.R‎

100644100755
Lines changed: 17 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -1,34 +1,34 @@
11
VFSAPLE<-function(x,soilP,OM,manureP=25,manureSolids=25,manureWEP=50,manureIn=40,fertP=10,fertIn=40) {
2-
if(!inherits(x,"VFS")) {
3-
stop("VFSAPLE requires the output of VFS\n")
4-
}
2+
if(!inherits(x,"VFS")) {
3+
stop("VFSAPLE requires the output of VFS\n")
4+
}
55

6-
# mean annual rainfall in mm
6+
# mean annual rainfall in mm
77
precip<-x$AnnualRainfall[,1]
88
precip<-precip/25.4# inches
99

10-
# mean annual runoff in mm
11-
runoff<-x$AnnualRunoff[,1]
10+
# mean annual runoff in mm
11+
runoff<-x$AnnualRunoff[,1]
1212
runoff<-runoff/25.4# inches
1313

1414
# field characteristics
1515
clay<-100*x$field[["clay"]]# percent
1616

17-
# mean annual erosion BEFORE vegetated filter strip t/ha
18-
erosionPre<-x$AnnualLoadInMUSLE[,1]
17+
# mean annual erosion BEFORE vegetated filter strip t/ha
18+
erosionPre<-x$AnnualMassInMUSLE[,1]
1919
# years with no runoff are flagged NA; change them to 0
2020
erosionPre[is.na(erosionPre)]<-0
2121
erosionPre<-erosionPre*0.44609
2222

23-
# mean annual erosion AFTER vegetated filter strip t/ha
24-
erosionPost<-x$AnnualLoadOutMUSLE[,1]
23+
# mean annual erosion AFTER vegetated filter strip t/ha
24+
erosionPost<-x$AnnualMassOutMUSLE[,1]
2525
# years with no runoff are flagged NA; change them to 0
2626
erosionPost[is.na(erosionPost)]<-0
2727
erosionPost<-erosionPost*0.44609
2828

2929

3030

31-
preVFS<- APLE(soilP,clay,OM,precip,runoff,erosionPre,manureP=25,manureSolids=25,manureWEP=50,manureIn=40,fertP=10,fertIn=40)
31+
preVFS<- APLE(soilP,clay,OM,precip,runoff,erosionPre,manureP=25,manureSolids=25,manureWEP=50,manureIn=40,fertP=10,fertIn=40)
3232

3333
postVFS<- APLE(soilP,clay,OM,precip,runoff,erosionPost,manureP=25,manureSolids=25,manureWEP=50,manureIn=40,fertP=10,fertIn=40)
3434

@@ -40,7 +40,12 @@ VFSAPLE <- function(x, soilP, OM, manureP = 25, manureSolids = 25, manureWEP = 5
4040
pTotal<-100* (1-postVFS$lossTotal/preVFS$lossTotal)
4141
pTotal[is.na(pTotal)]<-0
4242

43-
list(preVFS=preVFS,postVFS=postVFS,pErosion=pErosion,pTotal=pTotal)
43+
results<-list(preVFS=preVFS,postVFS=postVFS,pErosion=pErosion,pTotal=pTotal)
44+
45+
46+
class(results)<-"APLE"
47+
results
48+
4449

4550
}
4651

‎R/print.APLE.R‎

Lines changed: 18 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,18 @@
1+
print.APLE<-
2+
function(x,...) {
3+
# prints a short summary of APLE object
4+
nyears<- nrow(x$daily)/365
5+
6+
if(names(x)[1]=="preVFS") {
7+
# VFSAPLE object
8+
cat("Mean annual erosion P reduction by VFS:", mean(x$pErosion),"\n")
9+
cat("Mean annual total P reduction by VFS:", mean(x$pTotal),"\n")
10+
}else {
11+
cat("Mean annual P loss:", mean(x$lossTotal),"\n")
12+
}
13+
14+
invisible(x)
15+
16+
}
17+
18+

‎R/print.VFS.R‎

100644100755
Lines changed: 14 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
print.VFS<-
22
function(x,...) {
3-
# prints a short summary of VFSx
3+
# prints a short summary of VFSobject
44
nyears<- nrow(x$daily)/365
55

66
if(all(is.na(x$MassOut)))
@@ -12,14 +12,22 @@ function(x, ...) {
1212

1313
if(modeltype=="VFS") {
1414
cat("Mean annual load into vegetated filter strip:\n")
15-
print(colMeans(x$AnnualLoadIn,na.rm=TRUE))
16-
cat("\nMean annual load out of vegetated filter strip:\n")
17-
print(colMeans(x$AnnualLoadOut,na.rm=TRUE))
18-
cat("\nMean annual removal efficiency:\n")
15+
print(colMeans(x$AnnualMassIn,na.rm=TRUE))
16+
cat("Mean annual load out of vegetated filter strip:\n")
17+
print(colMeans(x$AnnualMassOut,na.rm=TRUE))
18+
cat("Mean annual removal efficiency:\n")
1919
print(colMeans(x$AnnualRemovalEfficiency,na.rm=TRUE))
20+
cat("\nMean annual load into vegetated filter strip (MUSLE):\n")
21+
print(colMeans(x$AnnualMassInMUSLE,na.rm=TRUE))
22+
cat("Mean annual load out of vegetated filter strip (MUSLE):\n")
23+
print(colMeans(x$AnnualMassOutMUSLE,na.rm=TRUE))
24+
cat("Mean annual removal efficiency (MUSLE):\n")
25+
print(colMeans(x$AnnualRemovalEfficiencyMUSLE,na.rm=TRUE))
2026
}else {
2127
cat("Mean annual sediment load:\n")
22-
print(colMeans(x$AnnualLoadIn,na.rm=TRUE))
28+
print(colMeans(x$AnnualMassIn,na.rm=TRUE))
29+
cat("Mean annual sediment load (MUSLE):\n")
30+
print(colMeans(x$AnnualMassInMUSLE,na.rm=TRUE))
2331
}
2432
invisible(x)
2533

0 commit comments

Comments
 (0)
[8]ページ先頭
©2009-2025 Movatter.jp