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

Commit5c7683d

Browse files
Fixed error in Kf estimation.
1 parent0beafbc commit5c7683d

File tree

5 files changed

+56
-24
lines changed

5 files changed

+56
-24
lines changed

‎.gitignore‎

Lines changed: 29 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,15 @@
1+
# vim tempfiles
2+
*~
3+
.*swp
4+
15
# History files
26
.Rhistory
37
.Rapp.history
48

59
# Session Data files
610
.RData
11+
*.RDA
12+
*.RDS
713

814
# Example code in package build process
915
*-Ex.R
@@ -35,3 +41,26 @@ vignettes/*.pdf
3541
# Mac files
3642
.DS_Store
3743
._*
44+
45+
# output files
46+
*.tif
47+
*.jpg
48+
*.ps
49+
*.pdf
50+
51+
# binary data
52+
*.xlsx
53+
*.xls
54+
*.doc
55+
*.docx
56+
*.ods
57+
*.odt
58+
59+
# archived data
60+
*.zip
61+
*.gz
62+
*.bz2
63+
64+
# output
65+
results/*
66+
figs/*

‎R/MUSLEfactors.R‎

Lines changed: 2 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -14,11 +14,9 @@ MUSLE.K <- function(fc, fm, ff) {
1414
Cl2<-Cl^2
1515
ClL<- log(Cl)
1616

17+
Kf<-0.94141+-0.00007*Sa2+-0.06612*SaI+-0.04916*SaL+-0.00242*Si+0.01343*SiI+0.00512*SiL+-0.01209*Cl+0.00004*Cl2+0.00789*ClL
1718

18-
Kf<-0.93721+-0.00007*Sa2+-0.06562*SaI+-0.04880*SaL+-0.00239*Si+0.01337*SiI+0.00534*SiL+-0.01202*Cl+0.00004*Cl2+0.00762*ClL
19-
20-
21-
if(Kf<0.30)Kf<-0.03
19+
if(Kf<0.03)Kf<-0.03
2220
if(Kf>0.69)Kf<-0.69
2321

2422
Kf

‎R/VFS.R‎

Lines changed: 1 addition & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -362,7 +362,6 @@ function(nyears = 1000, thissoil, thisbuffer, rain, temperature, Duration = 2, F
362362
Ftannual<-matrix(Ft,ncol=365,byrow=TRUE)*100
363363

364364
Ftannualavg<- apply(Ftannual,1,function(x)mean(x[x>0]))
365-
Ftannualstdev<- apply(Ftannual,1,function(x)sd(x[x>0]))
366365

367366
AnnualLoadIn[runoffannual==0, ]<-NA
368367
AnnualLoadOut[runoffannual==0, ]<-NA
@@ -385,7 +384,6 @@ function(nyears = 1000, thissoil, thisbuffer, rain, temperature, Duration = 2, F
385384
Ftannual<-matrix(NA,ncol=365,nrow=nyears)
386385

387386
Ftannualavg<- rep(NA,length=nyears)
388-
Ftannualstdev<-Ftannualavg
389387
}
390388

391389
}else {
@@ -421,7 +419,6 @@ function(nyears = 1000, thissoil, thisbuffer, rain, temperature, Duration = 2, F
421419
Ftannual<-matrix(Ft,ncol=365,byrow=TRUE)*100
422420

423421
Ftannualavg<- apply(Ftannual,1,function(x)mean(x[x>0]))
424-
Ftannualstdev<- apply(Ftannual,1,function(x)sd(x[x>0]))
425422

426423
AnnualLoadIn[runoffannual==0, ]<-NA
427424
AnnualLoadOut[runoffannual==0, ]<-NA
@@ -445,7 +442,6 @@ function(nyears = 1000, thissoil, thisbuffer, rain, temperature, Duration = 2, F
445442
Ftannual<-matrix(NA,ncol=365,nrow=nyears)
446443

447444
Ftannualavg<- rep(NA,length=nyears)
448-
Ftannualstdev<-Ftannualavg
449445

450446
}
451447
}
@@ -495,7 +491,7 @@ function(nyears = 1000, thissoil, thisbuffer, rain, temperature, Duration = 2, F
495491
AnnualRainfall<- aggregate(rain,by=list(date.Year),sum)[,-1,drop=FALSE]
496492
AnnualRunoff<- aggregate(runoff,by=list(date.Year),sum)[,-1,drop=FALSE]
497493

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)
494+
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)
499495

500496
class(output)<-"VFS"
501497

‎R/summary.APLE.R‎

Lines changed: 3 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -5,22 +5,21 @@ function(object, ...) {
55

66
if(names(object)[1]=="preVFS") {
77
# VFSAPLE object
8-
results<-list(
8+
results<-c(
99
AnnualErosionPRemoval= mean(object$pErosion),
1010
AnnualErosionPRemovalsd= sd(object$pErosion),
1111
AnnualTotalPRemoval= mean(object$pTotal),
1212
AnnualTotalPRemovalsd= sd(object$pTotal))
1313
}else {
14-
results<-list(
14+
results<-c(
1515
AnnualLossErosion= mean(object$lossErosion),
1616
AnnualLossDissolvedSoil= mean(object$lossDissolvedSoil),
1717
AnnualLossDissolvedManure= mean(object$lossDissolvedManure),
1818
AnnualLossDissolvedFert= mean(object$lossDissolvedFert),
1919
AnnualLossTotal= mean(object$lossTotal))
2020
}
2121

22-
print(round(unlist(results),4))
23-
invisible(results)
22+
results
2423

2524
}
2625

‎R/summary.VFS.R‎

Lines changed: 21 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,8 @@ function(object, ...) {
44
# averages across all b values
55

66
runoff<-matrix(object$daily$runoff,nrow=365,byrow=FALSE)
7-
runoff[runoff>0]<-1
7+
runoffd<-runoff
8+
runoffd[runoffd>0]<-1
89

910

1011
if(all(is.na(object$MassOut)))
@@ -17,13 +18,14 @@ function(object, ...) {
1718

1819

1920
if(modeltype=="VFS") {
20-
results<-list(
21+
results<- c(
22+
# load reduction across years with runoff
2123
ALR= mean(colMeans(object$AnnualRemovalEfficiency,na.rm=TRUE)),
2224

2325
# error propagation: correct SD is sqrt(mean(variance of each trt))
2426
ALRsd= sqrt(mean(apply(object$AnnualRemovalEfficiency,2,var,na.rm=TRUE))),
2527

26-
# load reduction across all years
28+
# load reduction across all years; no runoff = 100% reduction
2729
ALRall= mean(apply(object$AnnualRemovalEfficiency,2,function(object){object[is.na(object)]<-100; mean(object)})),
2830

2931
# error propagation: correct SD is sqrt(mean(variance of each trt))
@@ -56,28 +58,36 @@ function(object, ...) {
5658
# SedLoss/SedIn
5759
MUSLETLR=100-100* mean(colSums(object$MassOutMUSLE,na.rm=TRUE)/nyears)/ mean(colSums(object$MassInMUSLE,na.rm=TRUE)/nyears),
5860

59-
RunoffDays= mean(colSums(runoff)),
61+
Runoff= mean(colSums(runoff)),
6062

61-
RunoffDayssd= sd(colSums(runoff)))
63+
Runoffsd= sd(colSums(runoff)),
64+
65+
RunoffDays= mean(colSums(runoffd)),
66+
67+
RunoffDayssd= sd(colSums(runoffd)))
6268

6369
}else {
64-
results<-list(
70+
results<-c(
6571
SedIn= mean(colSums(object$MassIn,na.rm=TRUE)/nyears),
6672

6773
SedInsd= sqrt(mean(apply(object$MassIn,2,var,na.rm=TRUE))),
6874

6975
MUSLEIn= mean(colSums(object$MassInMUSLE,na.rm=TRUE)/nyears),
7076

7177
MUSLEInsd= sqrt(mean(apply(object$MassInMUSLE,2,var,na.rm=TRUE))),
78+
79+
Runoff= mean(colSums(runoff)),
7280

73-
RunoffDays= mean(colSums(runoff)),
81+
Runoffsd= sd(colSums(runoff)),
82+
83+
RunoffDays= mean(colSums(runoffd)),
84+
85+
RunoffDayssd= sd(colSums(runoffd)))
7486

75-
RunoffDayssd= sd(colSums(runoff)))
76-
7787
}
7888

79-
print(round(unlist(results),4))
80-
invisible(results)
89+
90+
results
8191

8292
}
8393

0 commit comments

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