设为首页收藏本站获取积分奖励

R语言中文网

 找回密码
 立即注册
查看: 16606|回复: 13

[实例投稿提交] Mann Kendall 突变检验及绘图

[复制链接]
发表于 2014-5-28 13:46:46 | 显示全部楼层 |阅读模式
本帖最后由 zhouyuanshen 于 2014-5-28 13:48 编辑

【作者】(必填):青易
【问题描述】(必填):进行非参数Mann Kendall突变检验,及绘图
【R语言代码】
  1. Mann_Kendall <- function(timeserial){#Mann Kendall 突变检验,传递参数
  2.   Mann_Kendall_sub <- function(timeserial){#需要进行两次秩的分析,因此在函数中嵌套了一个函数
  3.     r <- c()#分析的三个变量,具体含义可以参照魏凤英老师的书
  4.     s <- c()#秩序列。
  5.     U <- c()
  6.    
  7.     for(i in 2:length(timeserial))#进行大小比较,从第二个开始与以前的数据进行大小比较
  8.     {r[i] <- 0
  9.      
  10.      for(j in 1:i)
  11.      {
  12.        if(timeserial[i]>timeserial[j]){r[i]=r[i]+1}#如果后面的数大于前面的数,则秩加1
  13.      }
  14.      
  15.      
  16.      s[i] <- 0
  17.      for (ii in 2:i){
  18.        s[i] <- s[i]+r[ii]#秩序列。Sk是第i时刻数值大于ii时刻数值个数的累计数
  19.      }
  20.      
  21.      
  22.      U[i] <- 0
  23.      U[i] <- (s[i]- (i*(i-1)/4))/sqrt(i*(i-1)*(2*i+5)/72)
  24.      
  25.     }
  26.    
  27.     r[1] <- 0
  28.     s[1] <- 0
  29.     U[1] <- 0
  30.    
  31.     LST <- list(r = r, s = s, U = U)
  32.    
  33.     return (LST)
  34.   }
  35.   timeserial_rev <- rev(timeserial)#生成逆序列
  36.   
  37.   y1 <- Mann_Kendall_sub(timeserial)#计算正序列
  38.   y2 <- Mann_Kendall_sub(timeserial_rev)#计算逆序列
  39.   
  40.   y2$U <- -(rev(y2$U))#转换符号与顺序
  41.   
  42.   LST <- list(UF=y1,UB=y2)
  43.   return(LST)  
  44. }



  45. #这里是你要修改的地方
  46. setwd("d:/")
  47. od <- read.table("1.txt", header=T)
  48. Variable <- c("Jan","Feb","Mar","Apr","May","Jun")
  49. #修改上面代码

  50. #可以自己定义,或者根据数据自动生成
  51. rows <- length(Variable)
  52. startyear <- as.numeric(od[1,1])
  53. years <- od$Year

  54. #如果要生成图片,请执行相应代码
  55. tiff("filename.tif", width=14.6, height=16, units="cm", res=300, family = 'serif')
  56. par(mfrow=c(rows,2),oma=c(3,0,0,0), mar=c(0,2,0,0),cex=0.7)

  57. for(i in 1:length(Variable)){
  58.   
  59.   name <- paste("od[        DISCUZ_CODE_0        ]quot;,Variable[i], sep="")
  60.   value <- eval(parse(text=name))
  61.   
  62.   plot(value,type="l", ylab=Variable[i], cex.axis=0.6,xaxt="n",mgp=c(1,0.1,0),tck=-0.02)
  63.   if(i==length(Variable)){
  64.     axis(side=1, at=years, tck=-0.04, hadj=0.4, labels=years,mgp=c(1,0.4,0), cex.axis=1) # add x-axis to the last figure
  65.     axis(side=1, at=1:length(od$Year), tck=-0.01, hadj=0.4, labels=NA, cex.axis=1) # add month labels to the x-axis
  66.     mtext("年份",side=1,line=1.5)
  67.   }
  68.   
  69.   
  70.   d<-Mann_Kendall(value)#进行突变检验
  71.   yUF <- as.data.frame(d$UF[3])$U
  72.   yUB <- as.data.frame(d$UB[3])$U
  73.   
  74.   plot(x=c(1:length(od$Year)),y=yUF, type="l", ylim=c(min(yUF,yUB,-1.96),max(yUF,yUB,1.96)),lwd=1, lty=5, ylab="", cex=0.5,xaxt="n",mgp=c(1,0.1,0),tck=-0.02)
  75.   points(x=c(1:length(od$Year)),y=yUB,type="l",lty=3,col=6,lwd=1)
  76.   abline(h=1.969,lty=4,lwd=0.5)# 1.969是a=0.05的显著性水平
  77.   abline(h=-1.96,lty=4,lwd=0.5)
  78.   abline(h=0,col="gray",lwd=0.5)
  79. }

  80. axis(side=1, at=years, tck=-0.04, hadj=0.4, labels=years,mgp=c(1,0.4,0), cex.axis=1) # add x-axis to the last figure
  81. axis(side=1, at=1:length(od$Year), tck=-0.01, hadj=0.4, labels=NA, cex.axis=1) # add month labels to the x-axis
  82. mtext("年份",side=1,line=1.5)
  83. dev.off()
复制代码
【代码说明】:需改根据自身使用修改部分代码,已经标注了
【运行结果】:
【参考出处】:魏凤英的书

修改了后缀名,原图为TIF格式

修改了后缀名,原图为TIF格式
回复

使用道具 举报

发表于 2014-6-14 21:52:59 | 显示全部楼层
不错。。。欢迎楼主再接再厉
回复 支持 反对

使用道具 举报

发表于 2014-6-22 12:42:22 | 显示全部楼层
初学者,拜读下,呵呵
回复 支持 反对

使用道具 举报

 楼主| 发表于 2014-7-7 10:34:11 | 显示全部楼层
jonas 发表于 2014-6-14 21:52
不错。。。欢迎楼主再接再厉

谢谢鼓励!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2014-7-7 10:34:45 | 显示全部楼层
stevanwei 发表于 2014-6-22 12:42
初学者,拜读下,呵呵

以后多交流!
回复 支持 反对

使用道具 举报

发表于 2015-8-16 00:58:31 | 显示全部楼层
楼主太给力了!就在找MK检验的代码,自己写了半天,最后用fortran搞定的。。。为毛R语言没有自己的包可以画图啊!?
回复 支持 反对

使用道具 举报

发表于 2015-11-11 16:52:42 | 显示全部楼层
本帖最后由 zhuimengren 于 2015-11-11 17:06 编辑

非常好,赞一个
回复 支持 反对

使用道具 举报

发表于 2015-11-11 20:05:52 | 显示全部楼层
在实际运行的时候,数据会有一部分是缺失值,这样的话程序就无法运行了啊。这个在程序中如何处理呢?
回复 支持 反对

使用道具 举报

发表于 2015-11-11 20:06:21 | 显示全部楼层
在实际运行的时候,数据会有一部分是缺失值,这样的话程序就无法运行了啊,总是提示Error in if (x[i] > x[j]) { : missing value where TRUE/FALSE needed
这个在程序中如何处理呢?
回复 支持 反对

使用道具 举报

发表于 2015-12-9 06:05:35 | 显示全部楼层
大神啊,给你跪了!   
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

手机版|小黑屋|Archiver|R语言中文网    

GMT+8, 2024-5-1 05:11 , Processed in 0.036501 second(s), 25 queries .

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表