2012-10-02 51 views
1

我正在研究一个R包,该包允许用户通过单击并拖动图形上的点来编辑时间序列。将图表保存为图像,然后将其绘制在

我需要在图表上始终显示6行,尽管只有一行是“活动”的,可以用鼠标编辑。

它现在可以正常工作,但是因为当“点击和拖动”功能处于活动状态时,我正在绘制如此多的线条并绘制几次,因此屏幕闪烁很多,这在眼睛上很难看。

我想对非活动系列进行绘图,然后将该绘图保存为图像,然后将图像写入设备并在图像上为活动循环的其余部分绘制“活动”线。根据我的估算,这将使图表中的'图层'数量从6个减少到2个。

有些在评论中说一些真实的代码会有帮助。这里是我的代码:

near.point<-function(point,x.vec,y.vec){ #this function takes 'point' which is an x,y val and then finds the point in x.vec, y.vec which is nearby, and returns it 
    dis.vec<- sqrt(abs(x.vec/(max(x.vec)-min(x.vec))-point[1]/(max(x.vec)-min(x.vec)))^2 + abs(y.vec/(max(y.vec)-min(y.vec))-point[2]/(max(y.vec)-min(y.vec)))^2) #vector of total distances of #pointer click from line points 
    return(which(dis.vec==min(dis.vec))) 
} 

savepar <- par(ask=FALSE) 
picker.mover <- function(bl,scenarios,date.labs,target,name) { #this function allows one to edit #line points with the mouse 

#plot the baseline (the first time series) 
plot(unlist(bl),col="black",type="l",lwd=2,xaxt="n",main=name,xlab="", 
    ylab="Add function to bring in units, later",sub=paste(paste("S",target,sep=""),"active",sep=" "),ylim=c(.96*min(scenarios),1.04*max(scenarios))) 
axis(1,at=seq(1,length(date.labs),12),labels=date.labs[seq(1,length(date.labs),12)]) 
#plot the nontarget scenarios, the other lines to show in the graph but not be edited with mouse 
for(i in c(1:6)[-which(c(1:6)==target)]){ #this 'which' structure returns a sequence from #1 to 6 excluding the target scenario  
    lines(scenarios[,i],col=(i),pch=5,lwd=1) 
    } 
    #plot the target scenario 
    lines(unlist(scenarios[,target]),type="b",col="blue",lwd=3) 
    #####legend structure################################################### 
    l.widths <-rep(1,7);l.widths[target+1] <-3 
    l.colors<-c("black",1:6);l.colors[target+1]<-"blue" 
    legend("bottomright",c("BL","S1","S2","S3","S4","S5","S6"),lty=c(1,1,1,1,1,1,1),lwd=l.widths,col=l.colors) 
     ####End legend structure###############################################  

#some graphics events functions, Frankensteined from the getGrapnicsEven R help example 

devset <- function() 
    if (dev.cur() != eventEnv$which) dev.set(eventEnv$which) 

dragmousedown <- function(buttons, x, y) { #what happens when we click 
    start.x <- grconvertX(x,"ndc","user") #<<- super assignment 
    start.y <- grconvertY(y,"ndc","user") 
    #devset() 

    temp.point<<-near.point(c(start.x,start.y), 
     1:length(unlist(bl)),scenarios[,target]) 
    points(temp.point,scenarios[temp.point,target],col="Red" 
     ,pch=21,bg="red",lwd=2) 

      eventEnv$onMouseMove <- dragmousemove 
    NULL 
} 

dragmousemove <- function(buttons, x, y) { #what happens when we move after clicking 
    #devset() 


    y.scaled<-grconvertY(y,"ndc","user") 
    scenarios[temp.point,target]<<-y.scaled 

#och plotta hela grej igen 
#plot the baseline 
plot(unlist(bl),col="black",type="l",lwd=2,xaxt="n",xlab="", 
    ylab="Add function to bring in units, later",sub=paste(paste("S",target,sep=""),"active",sep=" "),main=name,ylim=c(.96*min(scenarios),1.04*max(scenarios))) 
     axis(1,at=seq(1,length(date.labs),12),labels=date.labs[seq(1,length(date.labs),12)]) 

#plot the nontarget scenarios 
for(i in c(1:6)[-which(c(1:6)==target)]){ #this 'which' structure returns a sequence from 1 to 6 excluding the target scenario  
    lines(scenarios[,i],col=(i),pch=5,lwd=1) 
    } 
    #plot the target scenario 
    lines(unlist(scenarios[,target]),type="b",col="blue",lwd=3) 
    ####legend structure################################################### 
    l.widths <-rep(1,7);l.widths[target+1] <-3 
    l.colors<-c("black",1:6);l.colors[target+1]<-"blue" 
    legend("bottomright",c("BL","S1","S2","S3","S4","S5","S6"),lty=c(1,1,1,1,1,1,1),lwd=l.widths,col=l.colors) 
     ####End legend structure############################################### 

    points(temp.point,scenarios[temp.point,target],col="Red" 
     ,pch=21,bg="red",lwd=2) 

    temp.text<- paste(as.character(date.labs[temp.point]),":",sep="") #report date 
temp.text <- paste(temp.text,paste(round(100*(scenarios[temp.point,target]/unlist(bl)[temp.point]-1),3),"%",sep=""),sep=" ") 
temp.text<- paste(temp.text,"from BL") 
legend("topleft",temp.text) 
    NULL 
} 

mouseup <- function(buttons, x, y) {  
    eventEnv$onMouseMove <- NULL 
} 

keydown <- function(key) { 
    if (key == "q") return(invisible(1)) 
    eventEnv$onMouseMove <- NULL 
    NULL 
} 

setGraphicsEventHandlers(prompt="Click and drag, hit q to quit", 
       onMouseDown = dragmousedown, 
       onMouseUp = mouseup, 
       onKeybd = keydown) 
eventEnv <- getGraphicsEventEnv() 
} 

datas数据帧是巨大的,但假装它只是有时间序列的载体。

第一列是日期,第二列是'基线'预测,3至8列是替代方案。

我只是用下面的线路进行测试,我还有一个功能来运行整个事情

picker.mover(bl=datas[,2],scenarios=datas[,3:8],date.labs=datas[,1],target=1,name=colnames(datas)[2]) 
getGraphicsEvent() 
par(savepar) 
+0

如果您给了我们一些部分工作代码以 – Chase

+0

开头,这将更容易回答此外,这里的问题究竟是什么? – TARehman

回答

0

你可能想看看http://www.image.ucar.edu/GSP/Software/Fields/Help/add.image.html - 它应该主要是可以对图像添加到情节,所以你可以保存图像,然后创建一个新的图形作为背景并在其上绘制。不过,你会遇到缩放等问题。

+0

谢谢TARehman,我试图尽可能快地保持内容,我可以将图像存储在内存中而不是保存到磁盘上?像<功能(情节(....)) – JPErwin