R/interp_main.R

In kongdd/MissInfo: missing information detect and interpolate

#' interp_main
#'
#' Main funtion of interpolation, combined with na.approx, linear
#' and hisavg interpolation.
#'
#' @param df data.frame, with dimension of [n_date, 1+n_station], and the first
#' column is date.
#' @param st data.frame, with column at least of 'site', 'lat', 'lon' (degree).
#' @param maxgap maximum gap used in interp_approx interpolation
#' @inheritParams interp_linear
#'
#' @examples
#' \dontrun{
#' data("prcp")
#' data("st840")
#' r <- interp_main(prcp, st840, smax = 200)
#' }
#' @importFrom purrr map
#' @export
interp_main <- function(
    df, st, smax = 100, nmax = 10, maxgap = 5, verbose = TRUE, sinkfile1 = "interp_lm1.log",
    sinkfile2 = "interp_lm2.log", ...) {
  ## DIST
  sites <- st$site
  sites_sel <- colnames(df)[-1]
  I_sel <- match(sites_sel, sites)

  loc <- st[I_sel, .(lat, lon)] %>%
    as.matrix()
  dist <- rdist.earth(loc) %>%
    set_colnames(sites_sel)
  # filter searching distance

  ## MAIN SCIRPTS
  cat("[0    ] Detect missing information of original data ...\n")

  Info <- missInfo.data.frame(df, clipdata = TRUE, verbose = verbose, ...)
  stationInfo <- Info$info
  xtrim <- Info$xtrim

  cat("[1.1  ] runing na.approx interpolate ...\n")
  ## 首先采用线性插值，对最长连续缺失< mapgap的站点采用邻近线性插值
  xx_approx <- interp_approx(xtrim, stationInfo, maxgap, verbose = verbose)

  cat("[1.2  ] Detect missing info after na.approx interpolate ...\n")
  stationInfo_approx <- missInfo.list(xx_approx, verbose = verbose, ...)$info
  ## 邻近插值之后，采用相邻站点进行插值（线性拟合p<0.05通过显著性检验）

  cat("[2.1.1] runing linear lm interpolate ...\n")
  xx <- interp_linear(xx_approx, stationInfo_approx, dist = dist, smax, nmax, sinkfile = sinkfile1)

  xx_linear <- xx$xtrim
  cat("[2.1.2] Detect missing info after first lm interpolate ...\n")
  stationInfo_linear <- missInfo.list(xx_linear, verbose = verbose, ...)$info

  # 进行二次插值，显示线性插值失败的站点 cat('Running : 正在进行相邻站点线性插值02\n')
  cat("[2.2.1] runing second linear lm interpolate ...\n")
  xx <- interp_linear(xx_linear, stationInfo_linear, dist, smax, nmax, sinkfile = sinkfile2)
  xx_linear <- xx$xtrim
  cat("[2.2.2] Detect missing info after second lm interpolate ...\n")
  stationInfo_linear2 <- missInfo.list(xx_linear, verbose = verbose, ...)$info

  cat("[3.1  ] History average interpolate...\n")
  # save(xx_linear, stationInfo_linear2, file = 'InterpBug.rda')#debug
  xx_hisavg <- interp_hisavg(xx_linear, stationInfo_linear2)
  cat("[3.2  ] Detect missing info after hisavg interpolate ...\n")
  stationInfo_hisavg <- missInfo.list(xx_linear, verbose = verbose, ...)$info

  # return every step detected missing info
  stationInfo_list <- list(
    origin = stationInfo, approx = stationInfo_approx, linear = stationInfo_linear,
    hisavg = stationInfo_hisavg
  )
  list(stationInfo = stationInfo_list, x = xx_hisavg)
}