inst/examples/draw.r

In mariev/chromatoplotsgui: Interactive graphics and interface for chromatoplots

drawPlace <- function(){
scatterplot <- function(item, painter) {
  qstrokeColor(painter) <- 'red'
  qdrawCircle(painter, r = 10, x = .5, y =.5, fill = 'red')
}

scene <- qscene()
root <- qlayer(scene)
points <- qlayer(root, scatterplot, limits = qrect(c(0,1), c(0,1)))
view <- qplotView(scene = scene, opengl = T)
return(view)
}

resizeView <- function(view, width, height){
  view$setFixedSize(Qt$QSize(width,height))
  return(view)
}

get_imaged <- function(x){
	prof <- x@env$profile
	imaged <- data.frame(time = rep(x@scantime, each = nrow(prof)),
			mz = rep(profMz(x), ncol(prof)),
			intensity = as.vector(prof))
	if(min(prof)>=0) {minprof <- min(prof)}
	else(minprof <- 0)
	imaged <- imaged[prof>minprof,]
	return(imaged)
}

getbackrange <- function(x, rangex){
	
	if((rangex[2] - max(x)) < (0.05 * (rangex[2] - rangex[1]))){
		maxX <- max(x) + (0.05 * (rangex[2] - rangex[1]))
	} else {
		maxX <- rangex[2]
	}
	if((min(x) - rangex[1]) < (0.05 * (rangex[2] - rangex[1]))){
		minX <- min(x) - (0.05 * (rangex[2] - rangex[1]))
	}else {
		minX <- rangex[1]
	}
	return(c(minX, maxX))
}

drawPlace1 <- function(df1, x = 'time', y = 'mz',stroke = NA, fill = 'intensity', size = 2, alpha = 1){
	.updateValues1 <<- T
	df1.df <- NULL
	xvalue <- NULL
	yvalue <- NULL
	color <- NULL

	
	updateValues1 <- function(){
		df1.df <<- data.frame(df1, stringsAsFactors = F)
		xvalue <<-subset(df1.df, select = x)[[1]]
		yvalue <<- subset(df1.df, select = y)[[1]]
		color <<- as.character(subset(df1.df, select = fill)[[1]])
		.updateValues1 <<- F
	}
	
	updateValues1()

	# x and y tick values
	xticks <- pretty(xvalue)
	yticks <- pretty(yvalue)
	
	# vector to draw x and y lines
	xlines <- NULL
	for(i in xticks){
		xlines <- c(xlines, rep(i, 2), NA)
	}
	ylines <- NULL
	for(i in yticks){
		ylines <- c(ylines, rep(i, 2), NA)
	}
	
	# limits for background and plot area
	#backXrange <- c(min(xticks) - 0.05 * (range(xticks)[2] - range(xticks)[1]), 
					#	max(xticks) + 0.05 * (range(xticks)[2] - range(xticks)[1]))
	#backYrange <- c(min(yticks) - 0.05 * (range(yticks)[2] - range(yticks)[1]), 
			#max(yticks) + 0.05 * (range(yticks)[2] - range(yticks)[1]))
	backXrange <- getbackrange(xvalue, range(xticks))
	backYrange <- getbackrange(yvalue, range(yticks))


	
	
	# data points
	scatterplot <- function(item, painter, exposed,...){
		print(dim(df1))
		if(.updateValues1){ 
			updateValues1()
		}
		
		qstrokeColor(painter) = stroke
		qdrawCircle(painter, r = size, x = xvalue, y = yvalue, fill = color, stroke = stroke)
	}
	
	# tick labels
	labels <- function(item, painter){
		qstrokeColor(painter) = 'white'
		qdrawText(painter, text = xticks, x = xticks, y = .85)
	}
	# background
	background <- function(item, painter){
		qstrokeColor(painter) = 'white'
		qdrawRect(painter, xleft = backXrange[1], ybottom = backYrange[1], 
				xright = backXrange[2], ytop = backYrange[2], fill = 'gray95')
		qdrawLine(painter, x = xlines, y = rep(c(backYrange, NA), length(xticks)))
		qdrawLine(painter, x = rep(c(backXrange, NA), length(yticks)), y = ylines)
	}
	
	scene <- qscene()
	root <- qlayer(scene)
	back <- qlayer(root, background, limits = qrect(backXrange, backYrange))
	points <- qlayer(root, scatterplot, limits = qrect(backXrange, backYrange))
	points$setOpacity(alpha)
#	ticks <- qlayer(root, labels, limits = qrect(backXrange, backYrange))
	add_listener(df1, function(i,j){
				.updateValues <<- T
				qupdate(points)
			})

	view <- qplotView(scene = scene, opengl = T)
}


getplotValues <- function(steps = 100,...){
	home <- getwd()
	setwd('/home/marie/Documents/chromatoplotsgui/data/raw')
	out <- vector(mode = 'list', length = length(dir()))
	for(j in 1:length(dir())){
		setwd(dir()[j])
#	assigna(paste('test_', j, sep = ''), j)
#	print(get(paste('test_',j, sep = '')))
		out[[j]]<- getplotValues2(steps = steps)
		setwd('..')
	}
	setwd(home)
	return(out)
}

getplotValues2 <- function(steps = 100,...){
	out <- vector(mode = 'list', length = length(dir()))
	for (j in 1:length(dir())){
		test <- loadSample(dir()[j])
		raw_prof1 <- genProfile(test, step = diff(range(test@env$mz))/steps)
		
		temp <- matrix(nrow = nrow(raw_prof1@env$profile), ncol = 200)
		colfact <- floor(ncol(raw_prof1@env$profile)/200)
		for(i in 1:200){
			temp[,i] <- rowSums(raw_prof1@env$profile[,((i*colfact)-(colfact-1)):(i*colfact)])
		}		
		raw_prof1@env$profile <- temp
		raw_prof1@scantime <- raw_prof1@scantime[seq(from = 1, by = colfact, length.out = 200)]
		temp <- get_imaged(raw_prof1)
		temp$intensity <- rgb(1 - ((log(temp$intensity) 
								- min(log(temp$intensity)))/(max(log(temp$intensity)) 
								- min(log(temp$intensity)))),1 - ((log(temp$intensity) 
								- min(log(temp$intensity)))/(max(log(temp$intensity)) 
								- min(log(temp$intensity)))),0)
		assign(paste('df',i, sep =''), temp)
		#normInt <- 1 - ((log(df1$intensity) - min(log(df1$intensity)))/(max(log(df1$intensity)) - min(log(df1$intensity))))
		out[[j]] <-resizeView(drawPlace1(df1 = mutaframe(get(paste('df',i, sep = ''))), size = 1), 200,100)
		
	}
	return(out)
}

#####

get_baseplot <- function(object, raw, mz, subtract = T){
	time <- raw@scantime
	mzmin <- raw@mzrange[1]
	rawint <- raw@env$profile[mz-mzmin+1,]
	chrom <- data.frame(time = time, intensity = rawint)
	corint <- object@env$profile[mz-mzmin+1,]
	if (subtract) {
		res <- corint
		fit <- rawint - corint
	} else {
		res <- rawint - corint
		fit <- corint
	}
	ylim <- range(rawint)
	return(data.frame(time = time, rawint = rawint, fit = fit, 
					res = res))
}

drawBaseRm <- function(mz = mutaframe(mz = 221), cor_prof, raw_prof1, x = 'time', y = c('rawint', 'res'), stroke = NA, 
		fill = 'black'){
	
	.updateValues <<- T
	df1 <<- NULL
	#df1 <<- data.frame(x = 100, y = 100)
	 
	temp <- get_imaged(cor_prof)
	temp2 <- temp
	temp$intensity <- rgb(1 - ((log(temp$intensity) 
						 - min(log(temp$intensity)))/(max(log(temp$intensity)) 
						 - min(log(temp$intensity)))),1 - ((log(temp$intensity) 
						 - min(log(temp$intensity)))/(max(log(temp$intensity)) 
						 - min(log(temp$intensity)))),0)
	 
	# x and y tick values
	xticks <- pretty(temp$time)
	yticks <- pretty(temp$mz)
	yticks2 <- pretty(log(temp2$intensity))

	# vector to draw x and y lines
	xlines <- NULL
	for(i in xticks){
	 xlines <- c(xlines, rep(i, 2), NA)
	}
	ylines <- NULL
	for(i in yticks){
	 ylines <- c(ylines, rep(i, 2), NA)
	}
	ylines2 <- NULL
	for(i in yticks2){
		ylines2 <- c(ylines2, rep(i,2), NA)
	}

	# limits for background and plot area
	#backXrange <- c(min(xticks) - 0.05 * (range(xticks)[2] - range(xticks)[1]), 
	#	max(xticks) + 0.05 * (range(xticks)[2] - range(xticks)[1]))
	#backYrange <- c(min(yticks) - 0.05 * (range(yticks)[2] - range(yticks)[1]), 
	#max(yticks) + 0.05 * (range(yticks)[2] - range(yticks)[1]))
	backXrange <- getbackrange(temp$time, range(xticks))
	backYrange <- getbackrange(temp$mz, range(yticks))
	backYrange2 <- getbackrange(log(temp2$intensity), range(yticks2))
	 
		
	updateValues <- function(){
		mz.num <- as.numeric(as.data.frame(mz))
		df1 <<- get_baseplot(object = cor_prof, raw = raw_prof1, mz = mz.num)
		if(nrow(df1[df1$rawint == 0,]) > 0){
			df1[df1$rawint == 0,]$rawint <<- 1
		}
		if(nrow(df1[df1$res <= 0,]) > 0){
			df1[df1$res <= 0,]$res <<- 1
		}
		df1$rawint <<- log(df1$rawint)
		df1$res <<- log(df1$res)
	#	df1 <<- df1 + 100
		.updateValues <<- F
	}
	
	mainplot <- function(cor_prof){
	
		getnewMz <- function(item, event){
			mz$mz <- round(event$pos()$y(), 0)
			.updateValues <<- T
		}
		# data points
		scatterplot <- function(item, painter, exposed,...){
			if(.updateValues){updateValues()}
			qstrokeColor(painter) = stroke
			qdrawCircle(painter, r = 1, x = temp$time, y = temp$mz, fill = temp$intensity, 
					stroke = stroke)
		}
		
		# tick labels
		labels <- function(item, painter){
			qstrokeColor(painter) = 'black'
			qdrawText(painter, text = xticks, x = xticks, y = .025*(backYrange[2] - backYrange[1]))
			qdrawText(painter, text = yticks, x = .025*(backXrange[2] - backXrange[1]), y = yticks)
		}
		# background
		background <- function(item, painter){
			qstrokeColor(painter) = 'white'
			qdrawRect(painter, xleft = backXrange[1], ybottom = backYrange[1], 
					xright = backXrange[2], ytop = backYrange[2], fill = 'gray95')
			qdrawLine(painter, x = xlines, y = rep(c(backYrange, NA), length(xticks)))
			qdrawLine(painter, x = rep(c(backXrange, NA), length(yticks)), y = ylines)
		}
		
		scene <- qscene()
		root <- qlayer(scene)
		back <- qlayer(root, background, limits = qrect(backXrange, backYrange))
		points <- qlayer(root, scatterplot, mousePressFun = getnewMz, limits = qrect(backXrange, backYrange))
    	ticks <- qlayer(root, labels, limits = qrect(backXrange, backYrange))
		
		view <- qplotView(scene = scene, opengl = T)
		view$setWindowTitle('Baseline Removed Profile')
		return(view)
		
	}
	
	subplot <- function(title, intensity){
		# tick labels
		labels <- function(item, painter){
			qstrokeColor(painter) = 'black'
			qdrawText(painter, text = xticks, x = xticks, y = .025*(backYrange2[2] - backYrange2[1]))
			qdrawText(painter, text = yticks2, x = .025*(backXrange[2] - backXrange[1]), y = yticks2)
		}
		# background
		background <- function(item, painter){
			qstrokeColor(painter) = 'white'
			qdrawRect(painter, xleft = backXrange[1], ybottom = backYrange2[1], 
					xright = backXrange[2], ytop = backYrange2[2], fill = 'gray95')
			qdrawLine(painter, x = xlines, y = rep(c(backYrange2, NA), length(xticks)))
			qdrawLine(painter, x = rep(c(backXrange, NA), length(yticks2)), y = ylines2)
		}
		# data points
		scatterplot <- function(item, painter, exposed,...){
			if(.updateValues){updateValues()}
			qstrokeColor(painter) = stroke
			qdrawCircle(painter, r = 5, x = df1$time, y = subset(df1, select = intensity)[[1]], fill = 'black', 
					stroke = stroke)
		}
		scene <- qscene()
		root <- qlayer(scene)
		back <- qlayer(root, background, limits = qrect(backXrange, backYrange2))
		points <- qlayer(root, scatterplot, limits = qrect(backXrange, backYrange2))
		ticks <- qlayer(root, labels, limits = qrect(backXrange, backYrange2))

		add_listener(mz, function(i,j){
					qupdate(points)
				})
		
		view <- qplotView(scene = scene, opengl = T)
		view$setWindowTitle(title)
		return(view)
	}
#	
#	botplot <- function(){
#		# tick labels
#		labels <- function(item, painter){
#			qstrokeColor(painter) = 'black'
#			qdrawText(painter, text = xticks, x = xticks, y = .025*(backYrange2[2] - backYrange2[1]))
#			qdrawText(painter, text = yticks2, x = .025*(backXrange[2] - backXrange[1]), y = yticks2)
#		}
#		# background
#		background <- function(item, painter){
#			qstrokeColor(painter) = 'white'
#			qdrawRect(painter, xleft = backXrange[1], ybottom = backYrange2[1], 
#					xright = backXrange[2], ytop = backYrange2[2], fill = 'gray95')
#			qdrawLine(painter, x = xlines, y = rep(c(backYrange2, NA), length(xticks)))
#			qdrawLine(painter, x = rep(c(backXrange, NA), length(yticks2)), y = ylines2)
#		}
#		# data points
#		scatterplot <- function(item, painter, exposed,...){
#			if(.updateValues){updateValues()}
#			qstrokeColor(painter) = stroke
#			qdrawCircle(painter, r = 5, x = df1$time, y = df1$res, fill = 'black', 
#					stroke = stroke)
#		}
#		scene <- qscene()
#		root <- qlayer(scene)
#		back <- qlayer(root, background, limits = qrect(backXrange, backYrange2))
#		points <- qlayer(root, scatterplot, limits = qrect(backXrange, backYrange2))
#		ticks <- qlayer(root, labels, limits = qrect(backXrange, backYrange2))
#		
#		add_listener(mz, function(i,j){
#					qupdate(points)
#				})
#		
#		view <- qplotView(scene = scene, opengl = T)
#		
#		
#	}
#	
	mplot <- mainplot(cor_prof)
	splot1 <- subplot(title = 'intensity', intensity = 'rawint')
	splot2 <- subplot(title = 'corrected intensity', intensity = 'res')
	return(list(mainplot = mplot, raw = splot1, corr = splot2 ))
}