1

ユーザーがグラフ上のポイントをクリックしてドラッグすることで時系列を編集できるRパッケージに取り組んでいます。

グラフには常に 6 本の線を表示する必要がありますが、「アクティブ」でマウスで編集できるのは 1 本の線だけです。

今は問題なく動作しますが、'クリック アンド ドラッグ' 機能がアクティブなときに非常に多くの線を描画し、1 秒間に数回プロットしているため、画面が頻繁に点滅し、目に負担がかかります。

非アクティブなシリーズでプロットを作成し、このプロットを画像として保存し、画像をデバイスに書き込み、残りのイベント ループのために画像の上に「アクティブ」ラインをプロットしたいと思います。私の推測では、これはグラフの「レイヤー」の数を 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データ フレームは巨大ですが、時系列のベクトルだけが含まれているふりをします。

最初の列は日付、次に列 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)
4

1 に答える 1

0

http://www.image.ucar.edu/GSP/Software/Fields/Help/add.image.htmlを見たいと思うかもしれません- 原則として画像をプロットに追加できるはずなので、保存できます画像を背景にして新しいグラフを作成し、その上に描画します。ただし、スケーリングなどの問題に遭遇するでしょう。

于 2012-10-02T21:13:49.467 に答える