files/Marie/qtbaseANDpaint_v344AND351/facet_chromatoplots.R
In schloerke/cranvasOLD: Interactive plots on a layered canvas
library(qtpaint)
library(plumbr)
library(xcms)
library(chromatoplots)
source("/home/marie/Documents/cranvas/utilities/api-sketch.r")
source("/home/marie/Documents/cranvas/utilities/helper.r")
source("/home/marie/Documents/cranvas/utilities/axes.r")
#source("/home/marie/Documents/cranvas/Marie/facet_chromatoplots.R")
#expStruc.display(wd="/home/marie/Documents/cranvas/Marie/expDesign")
#
# @param wd root directory of experimental design
expStruc.display<-function(wd=NULL,...){
zoom_start<<-NULL
zoom_end<<-NULL
###PART 1
#format data into a data.frame object
# 1.A determine how many facets we want
# each row represents a treatment (e.g. control, condition_1, condition_2, etc)
# number of elements in each row is the number of datafiles for that condition
facet_structure<-getFacetStructure(wd)
# 1.B Format the CDF data
df1<-formatAllData(facet_structure)
###PART 2
# draw the background and axes
#2.A determine data limits
ranges<-c(getAllRanges(facet_structure, df1, 1),getAllRanges(facet_structure,df1,2))
windowranges<-make_window_ranges(ranges)
plot1<-make_new_plot(width=1200,height=1200,windowRanges=c(windowranges[1]-1000,windowranges[2],windowranges[3]-150,windowranges[4]))
xspan<-windowranges[2]-windowranges[1]
yspan<-windowranges[4]-windowranges[3]
Ygrids<-max(facet_structure$treatments.numExp)
Xgrids<-length(facet_structure$treatments.numExp)
#2.B draw the factoring
for (i in 1:Xgrids){
for (j in 1:Ygrids){
#2.C draw the grids
draw_grid_with_positions(plot1,dataRanges=c(windowranges[1],
windowranges[2]-(.02*xspan),
windowranges[3],
windowranges[4]-(0.02*yspan)),horiPos=getfacetPrettyRangesX(i,j,Xgrids,Ygrids,windowranges,xspan,yspan,margin=.02),vertPos=getfacetPrettyRangesY(i,j,Xgrids,Ygrids,windowranges,xspan,yspan,marigin=0.02), row=as.integer(i),col=as.integer(j))
draw_grid_axes(plot1,dataRanges=c(windowranges[1],
windowranges[2]-(.02*xspan),
windowranges[3],
windowranges[4]-(0.02*yspan)),row=as.integer(i),col=as.integer(j),
maxRows=Xgrids,maxCols=Ygrids,xspan=xspan,yspan=yspan)
temp<-getwd()
setwd(paste(facet_structure$dir,facet_structure$treatments[i],sep="/"))
if(j<=length(list.files() ) ){
data<-matrix(nrow=round(dim(df1[[i]][[j]])[1]/100)-1,ncol=3)
for (k in 1:dim(data)[1]){
data[k,1]<-df1[[i]][[j]][100*k,1]
data[k,2]<-df1[[i]][[j]][100*k,2]
data[k,3]<-df1[[i]][[j]][100*k,3]
}
plot1$add_layer(glyph(
left=data[,1],
bottom=data[,2],
fill=col2rgb(rgb(1-(log(data[,3])-min(log(data[,3])))/(max(log(data[,3]))-min(log(data[,3]))) ,
1- (log(data[,3])-min(log(data[,3])))/(max(log(data[,3]))-min(log(data[,3]))) ,
0,
0.25),
T),
stroke=col2rgb(rgb(1-(log(data[,3])-min(log(data[,3])))/(max(log(data[,3]))-min(log(data[,3]))) ,
1-(log(data[,3])-min(log(data[,3])))/(max(log(data[,3]))-min(log(data[,3]))) ,
0,
0.25),
T),
size=1),
row=as.integer(i),col=as.integer(j),
mousePressFun=function(...){drawZoomed(df1[[i]][[j]])})
setwd(temp)
}
}
# return(plot1)
}
#the axes layer
#TODO: generalize for all expDesign structure
axes<-function(item,painter){
qdrawRect(painter,xleft=1-(.15/Ygrids),ybottom=.15/Xgrids+.01,xright=1-(.15/(2*Ygrids)),
ytop=1-(.15/(Xgrids)),stroke="grey80",fill="grey80")
qdrawRect(painter,xleft=.0635,xright=.96,ybottom=1-(.15/(2*Xgrids)),
ytop=1-(.15/(Xgrids)),stroke="grey80",fill="grey80")
qstrokeColor(painter)<-"black"
qfillColor(painter)<-"black"
qdrawText(painter,text=c(1,2,3,4), x=c(.15,.39,.63,.865),
y=1-(.75*(.15/Xgrids)),halign="center",valign="center")
qdrawText(painter,text=facet_structure$treatments,x=1-(.45*(.15/Ygrids)),
y=c(.73,.41,.1),halign="right",valign="center",rot=-90)
qdrawText(painter,text="time",x=.5, y=.15/(3*Xgrids),halign="center",valign="center")
qdrawText(painter,text= "m/z",x=.15/(15*Ygrids),y=.5,halign="center",valign="center",rot=90)
}
#add axis as an overlay layer and size plotting area
#TODO: generalize for all expDesigns
overlay<-plot1$view$overlay()
axesOverlay<-qlayer(overlay,axes,limits=qrect(c(0,1),c(0,1)))
print(plot1)
plot1$root$geometry<-qrect(15,26,822,525)
plot1$root$setLimits(qrect(-22,643,1080,-33))
return(plot1)
}
getFacetStructure<-function(wd,...){
temp.1<-getwd()
setwd(wd)
treatments<-dir()
treatments.numExp<-matrix(nrow=length(treatments),ncol=1)
colnames(treatments.numExp)<-"numExp"
dir<-getwd()
for (i in 1:length(treatments)){
setwd(treatments[i])
treatments.numExp[i,1]<-length(dir())
setwd(dir)
}
setwd(temp.1)
self<-structure (list(dir=dir,treatments=treatments,treatments.numExp=treatments.numExp))
self
}
formatAllData<-function(facet_structure,...){
temp.1<-getwd()
df<-vector("list",length(facet_structure$treatments))
for (i in 1:length(facet_structure$treatments)){
df[[i]]<-vector("list", facet_structure$treatments.numExp[i])
setwd(paste(facet_structure$dir,facet_structure$treatments[i],sep="/"))
for (j in 1:facet_structure$treatments.numExp[i]){
df[[i]][[j]]<-as.data.frame(rawMat(loadSample(paste(facet_structure$dir,facet_structure$treatments[i],dir()[j],sep="/"))))
}
}
setwd(temp.1)
return(df)
}
getAllRanges<-function(data,df,col,...){
min<-NULL
max<-NULL
for (i in 1:length(data$treatments)){
for (j in 1:data$treatments.numExp[i]){
min<-min(make_data_ranges(df[[i]][[j]][,col]),min)
max<-max(make_data_ranges(df[[i]][[j]][,col]),max)
}
}
return(c(min,max))
}
#determine margin values
getMargins<-function(i,j,value,Xgrids,Ygrids,xspan,yspan){
margin<-c(0,0,0,0)
#value=.15; yspan=4.8; xspan=28.8
#margin=c(0,.35,.05,0)
if(i==1){
margin[4]<-yspan/value
}
if(i==Xgrids){
margin[3]<-yspan/value
}
if(j==1){
margin[1]<-xspan/value
}
if(j==Ygrids){
margin[2]<-xspan/value
}
return(margin)
}
#TODO: generalize for all data ranges
draw_grid_axes<-function(plotObj,dataRanges, row,maxRows,col,maxCols,xspan,yspan){
if(row==maxRows){
draw_x_axes_with_labels(plotObj,dataRanges=dataRanges,axisLabels=c(0,1000,2000,3000),labelHoriPos=c(0,1000,2000,3000),name=NULL,row=row,col=col)
}
if(col==1){
draw_y_axes_with_labels(plotObj,dataRanges=dataRanges,axisLabels=c(0,200,400,600,800),labelVertPos=c(0,200,400,600,800), name=NULL,row=row,col=col)
}
}
#TODO: generalize for all data ranges
getfacetPrettyRangesX<-function(i,j,Xgrids,Ygrids,windowranges,xspan,yspan,margin=.04,...){
return(c(0,1000,2000,3000,4000))
}
#TODO: generalize for all data ranges
getfacetPrettyRangesY<-function(i,j,Xgrids,Ygrids,windowranges,xspan,yspan,margin=.04,...){
return(c(0,200,400,600,800))
}
drawZoomed<-function(data,...){
ranges<-c(range(data[,1]),range(data[,2]))
windowranges<-make_window_ranges(ranges)
xspan<-windowranges[2]-windowranges[1]
yspan<-windowranges[4]-windowranges[3]
plot2<-make_new_plot( width=1200,
height=1200,
windowRanges=c(windowranges[1]-450,
windowranges[2],
windowranges[3]-100,
windowranges[4]))
plot2$root$setLimits(qrect(0,525,879,0))
draw_grid_with_positions( plot2,
dataRanges=c(windowranges[1],
windowranges[2]-(.02*xspan),
windowranges[3],
windowranges[4]-(0.02*yspan)),
horiPos=c(0,1000,2000,3000,4000),
vertPos=c(0,200,400,600,800),
row=0L, col=0L)
#TODO: fold these into data overlayer
draw_x_axes_with_labels(plot2,dataRanges=c( windowranges[1],
windowranges[2]-(.02*xspan),
windowranges[3],
windowranges[4]-(0.02*yspan)),
axisLabels=c(0,1000,2000,3000),
labelHoriPos=c(0,1000,2000,3000),
name=NULL,row=0L,col=0L)
#TODO: fold these into data overlayer
draw_y_axes_with_labels(plot2,dataRanges=c( windowranges[1],
windowranges[2]-(.02*xspan),
windowranges[3],
windowranges[4]-(0.02*yspan)),
axisLabels=c(0,200,400,600,800),
labelVertPos=c(0,200,400,600,800),
name=NULL,row=0L,col=0L)
plot2$add_layer(glyph( left=data[,1],
bottom=data[,2],
fill=col2rgb(rgb(1-(log(data[,3])-min(log(data[,3])))/(max(log(data[,3]))-min(log(data[,3]))) ,
1- (log(data[,3])-min(log(data[,3])))/(max(log(data[,3]))-min(log(data[,3]))) ,
0,
0.25),
T),
stroke=col2rgb(rgb(1-(log(data[,3])-min(log(data[,3])))/(max(log(data[,3]))-min(log(data[,3]))) ,
1-(log(data[,3])-min(log(data[,3])))/(max(log(data[,3]))-min(log(data[,3]))) ,
0,
0.25),
T),
size=1),
row=0L,col=0L,
mouseDoubleClickFun=function(action,event,...){
plot2$root$geometry<-qrect( (plot2$root$geometry$left()-0.1*plot2$root$geometry$width()),
(plot2$root$geometry$top()-0.1*plot2$root$geometry$height()),
(plot2$root$geometry$right()+0.1*plot2$root$geometry$width()),
(plot2$root$geometry$bottom()+0.1*plot2$root$geometry$height()))
},
mousePressFun=function(action,event,...){
# print(ls(event))
# print(ls(event$pos))
print("event$pos")
print(c(event$pos()$left(),event$pos()$right(),event$pos()$top(),event$pos()$bottom()))
print("event$screenPos")
print(c(event$screenPos()$left(),event$screenPos()$right(),event$screenPos()$top(),event$screenPos()$bottom()))
zoom_start<<-c(event$screenPos()$x(),event$screenPos()$y())
zoom_start2<<-c(event$pos()$x(),event$pos()$y())
print("event$screenPos()$x()")
print(zoom_start2)
},
mouseReleaseFun=function(action,event,...){
if(is.null(zoom_start)){
print("need start point!")
} else {
zoom_end<<-c(event$screenPos()$x(),event$screenPos()$y())
zoom_end2<<-c(event$pos()$x(),event$pos()$y())
# right<-plot2$root$geometry$right() + max(zoom_start[1],zoom_end[1])-plot2$root$geometry$right()
# bottom<-plot2$root$geometry$bottom() + max(zoom_start[2],zoom_end[2])
print("zoom_start")
print(zoom_start)
print("zoom_end")
print(zoom_end)
print("zoom_start2")
print(zoom_start2)
print("zoom_end2")
print(zoom_end2)
print("curr - zoom")
print(plot2$root$limits()$left()-zoom_start[1])
# plot2$root$setLimits(qrect(200,325,395,0))
print(plot2$root$limits()$left())
plot2$root$setLimits(qrect(zoom_start[1],525,879,0))
}
zoom_start<<-NULL
zoom_end<<-NULL
})
axesLabel<-function(item,painter){
qstrokeColor(painter)<-"black"
qfillColor(painter)<-"black"
qdrawText(painter,text="time",x=.5, y=.025,halign="center",valign="center")
qdrawText(painter,text= "m/z",x=.01,y=.5,halign="center",valign="center",rot=90)
}
axes<-function(item,painter){
qstrokeColor(painter)<-"grey30"
qfillColor(painter)<-"black"
axesRanges<-c( windowranges[1],
windowranges[2]-(.02*xspan),
windowranges[3],
windowranges[4]-(0.02*yspan))
y_left <- axesRanges[1] - 0.03 * diff(axesRanges[1:2])
y_bottom <- axesRanges[3:4]
y_labelpos <- axesRanges[1] - 0.04 * diff(axesRanges[1:2])
qdrawLine( painter,
x=rep( c( axesRanges[1] - 0.02 * diff(axesRanges[1:2]),
axesRanges[1],
NA),
length(labelVertPos=c(0,200,400,600,800))),
y=rep(c(0,200,400,600,800),each=3),
stroke="grey30")
qdrawText( painter,
text=c(0,200,400,600,800),
x=y_labelpos,
y=c(0,200,400,600,800),
halign="right")
}
overlay<-plot2$view$overlay()
overlay.frame<-mutaframe()
overlay.frame[[1]]<-qlayer(overlay,axesLabel,limits=qrect(c(0,1),c(0,1)))
# overlay.frame[[2]]<-qlayer(overlay,axes,limits=qrect(c(0,1),c(0,1)))
# print(length(overlay.frame))
print(plot2)
}
schloerke/cranvasOLD documentation built on May 29, 2019, 3:39 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
library(qtpaint)
library(plumbr)
library(xcms)
library(chromatoplots)
source("/home/marie/Documents/cranvas/utilities/api-sketch.r")
source("/home/marie/Documents/cranvas/utilities/helper.r")
source("/home/marie/Documents/cranvas/utilities/axes.r")
#source("/home/marie/Documents/cranvas/Marie/facet_chromatoplots.R")
#expStruc.display(wd="/home/marie/Documents/cranvas/Marie/expDesign")
#
# @param wd root directory of experimental design
expStruc.display<-function(wd=NULL,...){
zoom_start<<-NULL
zoom_end<<-NULL
###PART 1
#format data into a data.frame object
# 1.A determine how many facets we want
# each row represents a treatment (e.g. control, condition_1, condition_2, etc)
# number of elements in each row is the number of datafiles for that condition
facet_structure<-getFacetStructure(wd)
# 1.B Format the CDF data
df1<-formatAllData(facet_structure)
###PART 2
# draw the background and axes
#2.A determine data limits
ranges<-c(getAllRanges(facet_structure, df1, 1),getAllRanges(facet_structure,df1,2))
windowranges<-make_window_ranges(ranges)
plot1<-make_new_plot(width=1200,height=1200,windowRanges=c(windowranges[1]-1000,windowranges[2],windowranges[3]-150,windowranges[4]))
xspan<-windowranges[2]-windowranges[1]
yspan<-windowranges[4]-windowranges[3]
Ygrids<-max(facet_structure$treatments.numExp)
Xgrids<-length(facet_structure$treatments.numExp)
#2.B draw the factoring
for (i in 1:Xgrids){
for (j in 1:Ygrids){
#2.C draw the grids
draw_grid_with_positions(plot1,dataRanges=c(windowranges[1],
windowranges[2]-(.02*xspan),
windowranges[3],
windowranges[4]-(0.02*yspan)),horiPos=getfacetPrettyRangesX(i,j,Xgrids,Ygrids,windowranges,xspan,yspan,margin=.02),vertPos=getfacetPrettyRangesY(i,j,Xgrids,Ygrids,windowranges,xspan,yspan,marigin=0.02), row=as.integer(i),col=as.integer(j))
draw_grid_axes(plot1,dataRanges=c(windowranges[1],
windowranges[2]-(.02*xspan),
windowranges[3],
windowranges[4]-(0.02*yspan)),row=as.integer(i),col=as.integer(j),
maxRows=Xgrids,maxCols=Ygrids,xspan=xspan,yspan=yspan)
temp<-getwd()
setwd(paste(facet_structure$dir,facet_structure$treatments[i],sep="/"))
if(j<=length(list.files() ) ){
data<-matrix(nrow=round(dim(df1[[i]][[j]])[1]/100)-1,ncol=3)
for (k in 1:dim(data)[1]){
data[k,1]<-df1[[i]][[j]][100*k,1]
data[k,2]<-df1[[i]][[j]][100*k,2]
data[k,3]<-df1[[i]][[j]][100*k,3]
}
plot1$add_layer(glyph(
left=data[,1],
bottom=data[,2],
fill=col2rgb(rgb(1-(log(data[,3])-min(log(data[,3])))/(max(log(data[,3]))-min(log(data[,3]))) ,
1- (log(data[,3])-min(log(data[,3])))/(max(log(data[,3]))-min(log(data[,3]))) ,
0,
0.25),
T),
stroke=col2rgb(rgb(1-(log(data[,3])-min(log(data[,3])))/(max(log(data[,3]))-min(log(data[,3]))) ,
1-(log(data[,3])-min(log(data[,3])))/(max(log(data[,3]))-min(log(data[,3]))) ,
0,
0.25),
T),
size=1),
row=as.integer(i),col=as.integer(j),
mousePressFun=function(...){drawZoomed(df1[[i]][[j]])})
setwd(temp)
}
}
# return(plot1)
}
#the axes layer
#TODO: generalize for all expDesign structure
axes<-function(item,painter){
qdrawRect(painter,xleft=1-(.15/Ygrids),ybottom=.15/Xgrids+.01,xright=1-(.15/(2*Ygrids)),
ytop=1-(.15/(Xgrids)),stroke="grey80",fill="grey80")
qdrawRect(painter,xleft=.0635,xright=.96,ybottom=1-(.15/(2*Xgrids)),
ytop=1-(.15/(Xgrids)),stroke="grey80",fill="grey80")
qstrokeColor(painter)<-"black"
qfillColor(painter)<-"black"
qdrawText(painter,text=c(1,2,3,4), x=c(.15,.39,.63,.865),
y=1-(.75*(.15/Xgrids)),halign="center",valign="center")
qdrawText(painter,text=facet_structure$treatments,x=1-(.45*(.15/Ygrids)),
y=c(.73,.41,.1),halign="right",valign="center",rot=-90)
qdrawText(painter,text="time",x=.5, y=.15/(3*Xgrids),halign="center",valign="center")
qdrawText(painter,text= "m/z",x=.15/(15*Ygrids),y=.5,halign="center",valign="center",rot=90)
}
#add axis as an overlay layer and size plotting area
#TODO: generalize for all expDesigns
overlay<-plot1$view$overlay()
axesOverlay<-qlayer(overlay,axes,limits=qrect(c(0,1),c(0,1)))
print(plot1)
plot1$root$geometry<-qrect(15,26,822,525)
plot1$root$setLimits(qrect(-22,643,1080,-33))
return(plot1)
}
getFacetStructure<-function(wd,...){
temp.1<-getwd()
setwd(wd)
treatments<-dir()
treatments.numExp<-matrix(nrow=length(treatments),ncol=1)
colnames(treatments.numExp)<-"numExp"
dir<-getwd()
for (i in 1:length(treatments)){
setwd(treatments[i])
treatments.numExp[i,1]<-length(dir())
setwd(dir)
}
setwd(temp.1)
self<-structure (list(dir=dir,treatments=treatments,treatments.numExp=treatments.numExp))
self
}
formatAllData<-function(facet_structure,...){
temp.1<-getwd()
df<-vector("list",length(facet_structure$treatments))
for (i in 1:length(facet_structure$treatments)){
df[[i]]<-vector("list", facet_structure$treatments.numExp[i])
setwd(paste(facet_structure$dir,facet_structure$treatments[i],sep="/"))
for (j in 1:facet_structure$treatments.numExp[i]){
df[[i]][[j]]<-as.data.frame(rawMat(loadSample(paste(facet_structure$dir,facet_structure$treatments[i],dir()[j],sep="/"))))
}
}
setwd(temp.1)
return(df)
}
getAllRanges<-function(data,df,col,...){
min<-NULL
max<-NULL
for (i in 1:length(data$treatments)){
for (j in 1:data$treatments.numExp[i]){
min<-min(make_data_ranges(df[[i]][[j]][,col]),min)
max<-max(make_data_ranges(df[[i]][[j]][,col]),max)
}
}
return(c(min,max))
}
#determine margin values
getMargins<-function(i,j,value,Xgrids,Ygrids,xspan,yspan){
margin<-c(0,0,0,0)
#value=.15; yspan=4.8; xspan=28.8
#margin=c(0,.35,.05,0)
if(i==1){
margin[4]<-yspan/value
}
if(i==Xgrids){
margin[3]<-yspan/value
}
if(j==1){
margin[1]<-xspan/value
}
if(j==Ygrids){
margin[2]<-xspan/value
}
return(margin)
}
#TODO: generalize for all data ranges
draw_grid_axes<-function(plotObj,dataRanges, row,maxRows,col,maxCols,xspan,yspan){
if(row==maxRows){
draw_x_axes_with_labels(plotObj,dataRanges=dataRanges,axisLabels=c(0,1000,2000,3000),labelHoriPos=c(0,1000,2000,3000),name=NULL,row=row,col=col)
}
if(col==1){
draw_y_axes_with_labels(plotObj,dataRanges=dataRanges,axisLabels=c(0,200,400,600,800),labelVertPos=c(0,200,400,600,800), name=NULL,row=row,col=col)
}
}
#TODO: generalize for all data ranges
getfacetPrettyRangesX<-function(i,j,Xgrids,Ygrids,windowranges,xspan,yspan,margin=.04,...){
return(c(0,1000,2000,3000,4000))
}
#TODO: generalize for all data ranges
getfacetPrettyRangesY<-function(i,j,Xgrids,Ygrids,windowranges,xspan,yspan,margin=.04,...){
return(c(0,200,400,600,800))
}
drawZoomed<-function(data,...){
ranges<-c(range(data[,1]),range(data[,2]))
windowranges<-make_window_ranges(ranges)
xspan<-windowranges[2]-windowranges[1]
yspan<-windowranges[4]-windowranges[3]
plot2<-make_new_plot( width=1200,
height=1200,
windowRanges=c(windowranges[1]-450,
windowranges[2],
windowranges[3]-100,
windowranges[4]))
plot2$root$setLimits(qrect(0,525,879,0))
draw_grid_with_positions( plot2,
dataRanges=c(windowranges[1],
windowranges[2]-(.02*xspan),
windowranges[3],
windowranges[4]-(0.02*yspan)),
horiPos=c(0,1000,2000,3000,4000),
vertPos=c(0,200,400,600,800),
row=0L, col=0L)
#TODO: fold these into data overlayer
draw_x_axes_with_labels(plot2,dataRanges=c( windowranges[1],
windowranges[2]-(.02*xspan),
windowranges[3],
windowranges[4]-(0.02*yspan)),
axisLabels=c(0,1000,2000,3000),
labelHoriPos=c(0,1000,2000,3000),
name=NULL,row=0L,col=0L)
#TODO: fold these into data overlayer
draw_y_axes_with_labels(plot2,dataRanges=c( windowranges[1],
windowranges[2]-(.02*xspan),
windowranges[3],
windowranges[4]-(0.02*yspan)),
axisLabels=c(0,200,400,600,800),
labelVertPos=c(0,200,400,600,800),
name=NULL,row=0L,col=0L)
plot2$add_layer(glyph( left=data[,1],
bottom=data[,2],
fill=col2rgb(rgb(1-(log(data[,3])-min(log(data[,3])))/(max(log(data[,3]))-min(log(data[,3]))) ,
1- (log(data[,3])-min(log(data[,3])))/(max(log(data[,3]))-min(log(data[,3]))) ,
0,
0.25),
T),
stroke=col2rgb(rgb(1-(log(data[,3])-min(log(data[,3])))/(max(log(data[,3]))-min(log(data[,3]))) ,
1-(log(data[,3])-min(log(data[,3])))/(max(log(data[,3]))-min(log(data[,3]))) ,
0,
0.25),
T),
size=1),
row=0L,col=0L,
mouseDoubleClickFun=function(action,event,...){
plot2$root$geometry<-qrect( (plot2$root$geometry$left()-0.1*plot2$root$geometry$width()),
(plot2$root$geometry$top()-0.1*plot2$root$geometry$height()),
(plot2$root$geometry$right()+0.1*plot2$root$geometry$width()),
(plot2$root$geometry$bottom()+0.1*plot2$root$geometry$height()))
},
mousePressFun=function(action,event,...){
# print(ls(event))
# print(ls(event$pos))
print("event$pos")
print(c(event$pos()$left(),event$pos()$right(),event$pos()$top(),event$pos()$bottom()))
print("event$screenPos")
print(c(event$screenPos()$left(),event$screenPos()$right(),event$screenPos()$top(),event$screenPos()$bottom()))
zoom_start<<-c(event$screenPos()$x(),event$screenPos()$y())
zoom_start2<<-c(event$pos()$x(),event$pos()$y())
print("event$screenPos()$x()")
print(zoom_start2)
},
mouseReleaseFun=function(action,event,...){
if(is.null(zoom_start)){
print("need start point!")
} else {
zoom_end<<-c(event$screenPos()$x(),event$screenPos()$y())
zoom_end2<<-c(event$pos()$x(),event$pos()$y())
# right<-plot2$root$geometry$right() + max(zoom_start[1],zoom_end[1])-plot2$root$geometry$right()
# bottom<-plot2$root$geometry$bottom() + max(zoom_start[2],zoom_end[2])
print("zoom_start")
print(zoom_start)
print("zoom_end")
print(zoom_end)
print("zoom_start2")
print(zoom_start2)
print("zoom_end2")
print(zoom_end2)
print("curr - zoom")
print(plot2$root$limits()$left()-zoom_start[1])
# plot2$root$setLimits(qrect(200,325,395,0))
print(plot2$root$limits()$left())
plot2$root$setLimits(qrect(zoom_start[1],525,879,0))
}
zoom_start<<-NULL
zoom_end<<-NULL
})
axesLabel<-function(item,painter){
qstrokeColor(painter)<-"black"
qfillColor(painter)<-"black"
qdrawText(painter,text="time",x=.5, y=.025,halign="center",valign="center")
qdrawText(painter,text= "m/z",x=.01,y=.5,halign="center",valign="center",rot=90)
}
axes<-function(item,painter){
qstrokeColor(painter)<-"grey30"
qfillColor(painter)<-"black"
axesRanges<-c( windowranges[1],
windowranges[2]-(.02*xspan),
windowranges[3],
windowranges[4]-(0.02*yspan))
y_left <- axesRanges[1] - 0.03 * diff(axesRanges[1:2])
y_bottom <- axesRanges[3:4]
y_labelpos <- axesRanges[1] - 0.04 * diff(axesRanges[1:2])
qdrawLine( painter,
x=rep( c( axesRanges[1] - 0.02 * diff(axesRanges[1:2]),
axesRanges[1],
NA),
length(labelVertPos=c(0,200,400,600,800))),
y=rep(c(0,200,400,600,800),each=3),
stroke="grey30")
qdrawText( painter,
text=c(0,200,400,600,800),
x=y_labelpos,
y=c(0,200,400,600,800),
halign="right")
}
overlay<-plot2$view$overlay()
overlay.frame<-mutaframe()
overlay.frame[[1]]<-qlayer(overlay,axesLabel,limits=qrect(c(0,1),c(0,1)))
# overlay.frame[[2]]<-qlayer(overlay,axes,limits=qrect(c(0,1),c(0,1)))
# print(length(overlay.frame))
print(plot2)
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.