MODISTools的时间序列

时间:2016-10-13 15:47:40

标签: r

我需要获得完整的EVI时间序列,以及日期和质量信息。执行MODISSubsets()后,原始数据可用,但不会像MODISSummaries()那样以相对好的方式处理。

然而,

MODISSummaries()会减少汇总统计信息的时间序列,同时考虑到质量信息。

有没有办法从原始数据中提取每个图块的时间序列(参见下面的数据框crude)?如果它可以返回一个数据帧列表,那将是很好的,其中每个数据帧代表一个瓦片并保存EVI(或任何变量),其日期和质量标志的数据。

具体来说,在执行以下操作后......

savedir <- './'

modis.subset <- data.frame(  
  lat        = 11.3175, 
  long       = 47.1167, 
  end.date   = "2016-09-29"
  )

MODISSubsets(
  LoadDat   = modis.subset, 
  Products  = "MOD13Q1",
  Bands     = c("250m_16_days_EVI", "250m_16_days_pixel_reliability"),
  Size      = c(1,1),
  StartDate = FALSE,
  SaveDir   = savedir,
  TimeSeriesLength = 3
  )

crude <- read.csv("./Lat47.11670Lon11.31750Start2013-01-01End2016-09-29___MOD13Q1.asc", header = FALSE, as.is = TRUE)

...你怎么会得到像

这样的东西
nice <- list( lonX1_latY1=data.frame( date=..., var=..., qual=... ), lonX2_latX2=...  )

...

1 个答案:

答案 0 :(得分:0)

简而言之,我错过了ExtractTile()可用于MODISTimeSeries()的返回值。我的解决方法基于将ExtractTile()与读取ASCII文件的输出结合使用。这是我为了我的目的而工作的,返回一个包含矩阵(npixels_lon,npixels_lat,n_timesteps)的列表,其中包含所有下载的MODIS数据,在本例中为EVI;包含像素可靠性代码的相同尺寸的矩阵;和长度为n_timesteps的向量,如果其质量标志为0,则保持中心像素信息,否则为其周围像素的平均值:

read_crude_modis <- function( filn, savedir, expand_x, expand_y ){

  # arguments:
  # filn: file name of ASCII file holding MODIS "crude" data
  # savedir: directory, where to look for that file
  # expand_x : number of pixels to the right and left of centre
  # expand_y : number of pixels to the top and bottom of centre

  # MODIS quality flags:
  # -1  Fill/No Data  Not Processed
  # 0 Good Data Use with confidence
  # 1 Marginal data Useful, but look at other QA information
  # 2 Snow/Ice  Target covered with snow/ice
  # 3 Cloudy  Target not visible, covered with cloud

  library( MODISTools )

  ScaleFactor <- 0.0001  # applied to output variable
  ndayyear    <- 365

  ## Read dowloaded ASCII file
  crude   <- read.csv( paste( savedir, filn, sep="" ), header = FALSE, as.is = TRUE )
  crude   <- rename( crude, c( "V1"="nrows", "V2"="ncols", "V3"="modislon_ll", "V4"="modislat_ll", "V5"="dxy_m", "V6"="id", "V7"="MODISprod", "V8"="yeardoy", "V9"="coord", "V10"="MODISprocessdatetime" ) )

  ## this is just read to get length of time series and dates
  tseries    <- MODISTimeSeries( savedir, Band = "250m_16_days_EVI" )
  ntsteps    <- dim(tseries[[1]])[1]
  tmp        <- rownames( tseries[[1]] )
  time       <- data.frame( yr=as.numeric( substr( tmp, start=2, stop=5 )), doy=as.numeric( substr( tmp, start=6, stop=8 )) )
  time$dates <- as.POSIXlt( as.Date( paste( as.character(time$yr), "-01-01", sep="" ) ) + time$doy - 1 )
  time$yr_dec<- time$yr + ( time$doy - 1 ) / ndayyear

  ## get number of products for which data is in ascii file (not used)
  nprod <- dim(crude)[1] / ntsteps
  if ((dim(crude)[1]/nprod)!=ntsteps) { print("problem") }

  ## re-arrange data
  if ( dim(crude)[2]==11 && expand_x==0 && expand_y==0 ){
    ## only one pixel downloaded
    nice_all      <- as.matrix( crude$V11[1:ntsteps], dim(1,1,ntsteps) ) * ScaleFactor     ## EVI data
    nice_qual_flg <- as.matrix( crude$V11[(ntsteps+1):(2*ntsteps)], dim(1,1,ntsteps) )       ## pixel reliability data

  } else if ( dim(crude)[2]>11 ){
    ## multiple pixels downloaded
    # nice <- ExtractTile( Data = tseries, Rows = c(crude$nrows,expand_y), Cols = c(crude$ncols,expand_x), Grid = TRUE )    ## > is not working: applying ExtractTile to return of MODISTimeSeries
    nice_all      <- ExtractTile( Data = crude[1:ntsteps,11:dim(crude)[2]] * ScaleFactor, Rows = c(crude$nrows[1],expand_y), Cols = c(crude$ncols[1],expand_x), Grid = TRUE )
    nice_qual_flg <- ExtractTile( Data = crude[(ntsteps+1):(2*ntsteps),11:dim(crude)[2]], Rows = c(crude$nrows[1],expand_y), Cols = c(crude$ncols[1],expand_x), Grid = TRUE )

  } else {

    print( "Not sufficient data downloaded. Adjust expand_x and expand_y.")

  }

  ## Clean data for centre pixel: in case quality flag is not '0', use mean of all 8 surrounding pixels
  if ( expand_x==1 && expand_y==1 ){
    nice_centre <- nice_all[2,2,]
    nice_centre[ which( nice_qual_flg[2,2,]!=0 ) ] <- apply( nice_all[,,which( nice_qual_flg[2,2,]!=0 )], c(3), FUN=mean)
  }

  modis <- list( nice_all=nice_all, nice_centre=nice_centre, nice_qual_flg=nice_qual_flg, time=time )
  return( modis )

}