2018年8月3日金曜日

Draw histgrams to compare high and low


Write function to draw the histgram being optimized for recording blood pressure.

my_bp_hist_x <- function(par_xts,kikan,highlow,len,loc_x,loc_y,br,ymax,xmin,xmax,color){
  # kikan like kikan or "2018::06-21::2018-07-13"
  # highlow 1 or 2. 1 means high, 2 for low.(loc_y+0.04)
  # len is a number of samples.
  # loc_x is x-axis position kikan 0 to 1.
  # loc_y is y-axis.
  # br is breaks for hist()
  # ymax is max value of y-axis.
  # xmin and xmax are for x-axis
  # color is from 1 to 9?
  # function(bp.bangkok,"::2016-06-21,2",length(as.vector(bp.bangkok["2018-06-21::"][,2]),0.3,0.5,20,55,120,2)
  hist(as.vector(last(par_xts[kikan][,highlow],n=len)),breaks=br,xlim=c(xmin,xmax),ylim=c(0,ymax),col=color)
  # axis(side=2, pos=84,labels=F)
  axis(side=2, pos=round(mean(par_xts[kikan][,highlow])),labels=F)
  graph_dim <- par('usr')
  text( graph_dim[1] + graph_dim[2] *  loc_x   ,(graph_dim[4] - graph_dim[3]) * (loc_y+0) + graph_dim[3] ,paste("#",len,sep="="),adj=c(0,0))
  text( graph_dim[1] + graph_dim[2] * loc_x   ,(graph_dim[4] - graph_dim[3]) * (loc_y+0.1) + graph_dim[3] ,paste("mean",round(mean(par_xts[kikan][,highlow]),2),sep="="),adj=c(0,0))
  text( graph_dim[1] + graph_dim[2] * loc_x   ,(graph_dim[4] - graph_dim[3]) * (loc_y+0.2) + graph_dim[3] ,paste("sd",round(sd(par_xts[kikan][,highlow]),2),sep="="),adj=c(0,0))
  text( graph_dim[1] + graph_dim[2] * loc_x   ,(graph_dim[4] - graph_dim[3]) * (loc_y+0.3) + graph_dim[3] ,paste("period ",kikan,sep="="),adj=c(0,0))
}


Use as below which replaces Aug 2 entry.


par(mfrow=c(3,1))
my_bp_hist_x(bp.bangkok,"::2018-06-19",2,70,0.1,0.6,20,15,55,100,4)
my_bp_hist_x(bp.bangkok,"2018-06-21::2018-07-13",2,length(bp.bangkok["2018-06-21::2018-07-13"][,2]),0.1,0.6,20,15,55,100,5)
my_bp_hist_x(bp.bangkok,"2018-07-15::",2,length(bp.bangkok["2018-07-15::"][,2]),0.1,0.6,10,15,55,100,6)
par(mfrow=c(1,1))


par(mfrow=c(3,1))
my_bp_hist_x(bp.bangkok,"::2018-06-19",1,70,0.1,0.6,30,15,90,150,4)
my_bp_hist_x(bp.bangkok,"2018-06-21::2018-07-13",1,length(bp.bangkok["2018-06-21::2018-07-13"][,2]),0.1,0.6,20,15,90,150,5)
my_bp_hist_x(bp.bangkok,"2018-07-15::",1,length(bp.bangkok["2018-07-15::"][,2]),0.1,0.6,20,15,90,150,6)
par(mfrow=c(1,1))

0 件のコメント: