Question

我正在开发一个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数据框很大，但假装它只有时间序列的矢量。

第一个col是日期，然后col 2是'基线'预测，3到8是备选方案。

我只是使用下面的行来测试，我有另一个函数来运行整个事情

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

Answer 1

您可能希望查看http://www.image.ucar.edu/GSP/Software/Fields/Help/add.image.html - 原则上可以将图像添加到绘图中，这样您就可以保存图像，然后创建一个新图形作为背景并绘制在顶部它的。但是，你会遇到缩放等问题。

将绘图保存为图像，然后在其上绘图

1 个答案: