根据循环计算行

时间:2019-07-05 23:33:07

标签: r loops iteration

我正在尝试实现一种迭代方法,使用霍顿渗透方程来计算径流降雨。下面描述的代码实现第一行(time = 0)。

#Entrance
f0=6
f1=1
k=2
dt=0.25
f=0
time= seq(from=0, to=2, by=dt)
inc_rainfall=c(0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.4, 0.6, 0.6)
rainfall_int=inc_rainfall/dt

#fc
gfc = function(fc) {
  f - ((f0 - fc) / k) + ((f1 / k) * log((fc - f1) / (f0 - f1)))}
fc=uniroot(gfc, interval = c(f0, f1))
fc=fc$root

#F'
fl=if(fc>rainfall_int[1]) sum(f,inc_rainfall[1]) else 0

#fc'
gfcl = function(fcl) {
  fl - ((f0 - fcl) / k) + ((f1 / k) * log((fcl - f1) / (f0 - f1)))}
fcl=uniroot(gfcl, interval = c(f0, f1))
fcl=fcl$root

#Fp ou Fs
fporfs=ifelse(fc<rainfall_int[1],f,
       ifelse(fcl<rainfall_int[1],
              (f0-rainfall_int[1])/k-
               f1/k*log((rainfall_int[1]-f1)/(f0-f1)), 0))

#dt'
dtl=ifelse((fc>rainfall_int[1]), 
    ifelse(fcl<rainfall_int[1],
           (fporfs-f)/rainfall_int[1],0),0)

#ts
ts=ifelse(fc<rainfall_int[1],time[1],
   ifelse(fcl<rainfall_int[1],dtl+time[1], 0))

#to
hto = function(to) {
  fporfs-f1*(ts-to)-(f0-f1)/k*(1-exp(-k*(ts-to)))}
to=uniroot(hto, interval = c(0, 1))
to=to$root

#Ft+Dt
ftdt=ifelse(to==0, fl, f1*(time[1]-to)+(f0-f1)/k*(1-exp(-k*(time[1]-to)))) #This value will be the "f" on next row

#Infiltration
infiltr=ftdt+f

#Runoff in line 1
runoff1=inc_rainfall[1]-(ftdt)

#Runoff in line 2 to n
runoffn=inc_rainfall[1]-(ftdt[2]-ftdt[1])

out=as.data.frame(cbind(time[1], inc_rainfall, rainfall_int, f, fc, fl, fcl, 
                        fporfs, dtl, ts, to, ftdt, infiltr, runoff1))

colnames(out)= c("Time", "Incremental Rainfall", "Rainfall Intensity", "F", "fc", "Fl", "Fcl", "Fp or Fs", "dt", "ts", "to", "Ftdt", "Infiltration", "Runoff"    )

out

如何继续进行操作,以便使用上一行的f值作为初始值(ftdt)来计算下一行?

请注意,在最后一列(runoff)中,第一行的功能也有所不同。除此之外,可能还需要添加一个额外的点time(2.25),以便计算出最后一行的变量ftdt

可以在此处看到预期的结果:第http://hydrology.usu.edu/RRP/userdata/4/87/RainfallRunoffProcesses.pdf页109。

2 个答案:

答案 0 :(得分:1)

这应该使您接近。我已经将您的方程式放在一个for循环中使用的函数中。我必须更改您的一些公式才能使其正常工作。我对水文学一无所知,但是在看了一下您链接到的书和一些Wikipedia之后,这些更改才有意义。这些更改还导致数据与表中的数据更加相似。寻找#!!!!!!! <COMMENT> !!!!!!!#以查看我所做的更改。

在第五次迭代/行中,公式ftdt=ifelse(to==0, fl, f1*(time-to)+(f0-f1)/k*(1-exp(-k*(time-to))))产生错误的结果,从而使其他结果搞砸。我将f1替换为fc,是因为在阅读了本书的相关页面后,这样做很有意义,而且结果更接近您想要的内容。我唯一不确定的是时间变量 t ,它在您的公式中为time - to,即时间减去时间偏移量。我认为这可能是问题所在。

compute_horton <- function (f, time, inc_rainfall, rainfall_int) {
    #->->-> calculates runoff rainfall using the Horton infiltration equation

    # constants
    f0=6
    f1=1
    k=2

    #fc
    gfc = function(fc) {
        f - ((f0 - fc) / k) + ((f1 / k) * log((fc - f1) / (f0 - f1)))
    }
    fc=uniroot(gfc, interval = c(f0, f1))
    fc=fc$root

    #F'
    fl=if(fc>rainfall_int) sum(f,inc_rainfall) else 0

    #fc'
    gfcl = function(fcl) {
        fl - ((f0 - fcl) / k) + ((f1 / k) * log((fcl - f1) / (f0 - f1)))
    }
    fcl=uniroot(gfcl, interval = c(f0, f1))
    fcl=fcl$root

    #Fp ou Fs
    fporfs=ifelse(fc<rainfall_int,f,
                  ifelse(fcl<rainfall_int,
                         (f0-rainfall_int)/k-
                             f1/k*log((rainfall_int-f1)/(f0-f1)), 0))

    #dt'
    dtl=ifelse((fc>rainfall_int), 
               ifelse(fcl<rainfall_int,
                      (fporfs-f)/rainfall_int,0),0)

    #ts
    ts=ifelse(fc<rainfall_int,time,
              ifelse(fcl<rainfall_int,dtl+time, 0))

    #to
    hto = function(to) {
        fporfs-f1*(ts-to)-(f0-f1)/k*(1-exp(-k*(ts-to)))
        }
    to=uniroot(hto, interval = c(0, 1))
    to=to$root

    #Ft+Dt - This value will be the "f" on next row
    #!!!!!!! I THINK YOU NEED FC AND NOT F1 !!!!!!!#
    #!!!!!!! EVEN SO, FORMULA DOESN'T WORK QUITE RIGHT !!!!!!!#
    #ftdt=ifelse(to==0, fl, f1*(time-to)+(f0-f1)/k*(1-exp(-k*(time-to))))
    ftdt=ifelse(to==0, fl, fc*(time-to)+(f0-fc)/k*(1-exp(-k*(time-to))))

    #Infiltration
    #!!!!!!! I THINK InFILTRATION IS DIFFERENCE OF FTDT AND F !!!!!!!#
    infiltr=ftdt-f

    #Runoff in line 1
    #!!!!!!! I THINK RUNOFF IS DIFFERENCE OF RAINFALL AND INFILTRATION !!!!!!!#
    runoff1=round(inc_rainfall-infiltr, 3)

    #Runoff in line 2 to n
    #!!!!!!! THIS ISN'T USED ANYWHERE !!!!!!!#
    runoffn=inc_rainfall-(ftdt[2]-ftdt[1]) 

    #### OUTPUT ####
    c(time, inc_rainfall, rainfall_int, f, fc, fl, fcl, fporfs, dtl, ts, to,
      ftdt, infiltr, runoff1
      )
}


# Function input
f=0
dt=0.25
time= seq(from=0, to=2, by=dt)
inc_rainfall=c(0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.4, 0.6, 0.6)
rainfall_int=inc_rainfall/dt

# Matrix column names
cnames <- c("Time", "Incremental Rainfall", "Rainfall Intensity", "F", "fc",
           "Fl", "Fcl", "Fp or Fs", "dt", "ts", "to", "Ftdt", "Infiltration",
           "Runoff"
           )

# Initialize matrix and add column names
hort_mat <- matrix(0, nrow = length(inc_rainfall), ncol = length(cnames))
colnames(hort_mat) <- cnames

for (i in 1:nrow(hort_mat)) {
    hort_mat[i,] <- compute_horton(f = hort_mat[ifelse(i-1 > 0, i-1, i), "Ftdt"],
                                   time = time[i],
                                   inc_rainfall = inc_rainfall[i],
                                   rainfall_int = rainfall_int[i]
                                   )
}

答案 1 :(得分:0)

感谢您的贡献,@gersht。基于此,我清除了代码,并在以前没有的地方插入了ifelse函数。

但是,我仍然很难在循环中使用第一行中计算出的ftdt值来开始第二行。

遵循设置的代码。我本来想为每一行做一个for,但是我想不出一种有效的方法来保持代码整洁。

#Constants
f0=6
f1=1
k=2
dt=0.25
f=0
time= seq(from=0, to=2, by=dt)
inc_rainfall=c(0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.4, 0.6, 0.6)
rainfall_int=inc_rainfall/dt

horton=data.frame(matrix(ncol = 14, nrow = 9))
names(horton)=c("Time", "Incremental Rainfall", "Rainfall Intensity", "F", "fc",
                "Fl", "Fcl", "Fp or Fs", "dt", "ts", "to", "Ftdt", "Infiltration",
                "Runoff")

#g(Fc)
gfc=ifelse (f==0, 

  function(fc) {
  f - ((f0 - fc) / k) + ((f1 / k) * log((fc - f1) / (f0 - f1)))}, 

  function(fc) {
  ftdt[i-1] - ((f0 - fc) / k) + ((f1 / k) * log((fc - f1) / (f0 - f1)))})

fc=uniroot(gfc, interval = c(f0, f1))
fc=fc$root

#F'
fl=ifelse(fc>rainfall_int, f+inc_rainfall, 0)

#fc'
gfcl= ifelse (fl==0,

  0,

  function(fcl) {
  fl - ((f0 - fcl) / k) + ((f1 / k) * log((fcl - f1) / (f0 - f1)))})

fcl=uniroot(gfcl, interval = c(f0, f1))
fcl=fcl$root

#Fp or Fs
fporfs=ifelse(fc<rainfall_int[1],f,
              ifelse(fcl<rainfall_int[1],
                     (f0-rainfall_int[1])/k-
                       f1/k*log((rainfall_int[1]-f1)/(f0-f1)), 0))

#dt'
dtl=ifelse((fc>rainfall_int[1]), 
           ifelse(fcl<rainfall_int[1],
                  (fporfs-f)/rainfall_int[1],0),0)

#ts
ts=ifelse(fc<rainfall_int[1],time[1],
          ifelse(fcl<rainfall_int[1],dtl+time[1], 0))

#to
hto=function(to) {
  fporfs-f1*(ts-to)-(f0-f1)/k*(1-exp(-k*(ts-to)))}

to=uniroot(hto, interval = c(0, 1))
to=to$root

#Ft+Dt
ftdt=ifelse(to==0, fl, f1*(time-to)+(f0-f1)/k*(1-exp(-k*(time-to)))) #Value that starts next row at "gFc"

#Infiltration
infiltr=ifelse(to==0,ftdt-f, ftdt[i]-ftdt[i-1])

runoff=ifelse(time==0, inc_rainfall[i]-(ftdt),  inc_rainfall[i]-(ftdt[i-1]-ftdt[i]))


horton$Time=time
horton$`Incremental Rainfall`=inc_rainfall
horton$`Rainfall Intensity`=rainfall_int
horton$F[1]=f
horton$fc[1]=fc
horton$Fl[1]=fl
horton$Fcl[1]=fcl
horton$`Fp or Fs`[1]=fporfs
horton$dt[1]=dtl
horton$ts[1]=ts
horton$to[1]=to
horton$Ftdt[1]=ftdt
horton$Infiltration[1]=infiltr
horton$Runoff[1]=runoff

horton