R help - Mar 2002 - gif, jpeg and png image files reader AND tcltk image

Hi all,

Roger Peng and Jason Turner's suggestion with ImageMagick seem to be the
simplest "dirty" way
to get the problem solved. 

But I ran into yet another interesting but quite round-about way to solve
the problem (partially). Through tcltk package, one can read in the gif
image with
> x <- tkcmd("image", "create", "photo",
file=mypic.gif)
> x.data <- tkcmd(x, "data")
gives you the data for the image, but is in a format internal to tcltk. But
then it turns out
that the format is very straightforward to understand: the enclosed simple
function decodes
the format and returns a matrix for the data,
> x.data.ascii <- tk2ascii(x.data)
Then we are done! (This function currently only deals with red color
channel, but expansion to other 2 are very straightforward.) 

On a related note, I have earlier posted a message to ask about whether one
can directly paint an image matrix to a tcltk canvas, the answer is no. One
has to create a pnm file from the image matrix then read in file and then
paint it. When the image is large, the speed of reading and writing disk can
be annoyingly slow. 

Now I begin to believe that it's possible to use 
> x.data <- ascii2tk(imagematrix)
> tkcmd(x, "put", x.data)
where ascii2tk would encode the ascii data into tk internal format for an
image. 

Agustine Lobo offers to provide some functions on display matrices as
images. I would be quite interested in knowing them! On the other hand,
tcltk images provide strong capability for interactivity: cool things such
as point your mouse on the image to get the gray level reading, clipping an
area of the image using mouse etc. Auguably, all these cool image processing
things can be done in other tools such as GIMP. But I would also argue that
to be able to do them in R would increase the productivity of image
processing tasks considerably once the foundation of these tools are laid
out. 
(I have made a few functions that do these cool things entirely in R with
help of tcltk, but they are buggy right now). 

Cheers!
Jonathan




tk2ascii <- function(x){
	###########################
	## tk2ascii converts a tk returned image data
	## into a matrix of integers
	##
	## x: is a tk returned string
	## value: is a matrix of integer representing
	## the image
	###########################	

	list1 <- strsplit(x, "} {")[[1]]
	ROWS <- length(list1)
	list1.1 <- strsplit(list1[1], " #")[[1]]
	COLS <- length(list1.1)
	im <- matrix(0, ROWS, COLS)

	for(i in 1:ROWS){
		row <- strsplit(list1[i], " #")[[1]]
		if(i==1){
			row[1] <- substring(row[1], 2)
		}
		if(i==ROWS){
			row[COLS] <- substring(row[COLS],0, 6)	
		}	
		row[1] <- substring(row[1],2)
		for(j in 1:COLS){
			im[i,j] <- as.integer.hex(substr(row[j], 1,2))
		}	
		#im[i,] <- row
	}

	im
}

as.integer.hex <- function(x){
	##############################
	# as.integer.hex converts a string that
	# represents the hexidecimal number
	# into an integer
	#
	#
	# x must be a string with
	# first digit being the high digit. 
	# value: converted integer
	##############################
	
	len <- nchar(x)
	val <- 0
	for(i in 1:len){
		digit <- substr(x, i,i)
		if(is.na(digit.val <- as.integer(digit))){
			if(digit == "a") digit.val <- 10
			if(digit == "b") digit.val <- 11
			if(digit == "c") digit.val <- 12
			if(digit == "d") digit.val <- 13
			if(digit == "e") digit.val <- 14
			if(digit == "f") digit.val <- 15
		}
		val <- val + digit.val* 16^{len-i}
	}
val
}


-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
r-help mailing list -- Read http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
Send "info", "help", or "[un]subscribe"
(in the "body", not the subject !)  To: r-help-request at
stat.math.ethz.ch
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._

Hi all,

Following my previous posting, here is a function that takes a image matrix
and paint it
into a tcltk canvas. Then one can interact with the image using mouse;
things you could do
include: return mouse position, display the graylevel (now it works only
with graylevel image),
clipping( click left mouse button-hold-drag to new position) to generate
subimage. I have finally
debugged it although there are still some problems:
1. the speed of loading a new window is fairly slow, I don't know if the
slowness comes from the fact that we are using tcltk scripting, or if it
comes from the generating and reading of temporary files;
2. there are warnings messages, they actually come from my function
tk2ascii() where I am using a less-than-smart way to convert hexidecimal
string into integers. they don't really hurt, but I will need to make them
go away.

Please try the function out and let me know what you think. It's fairly easy
to use. Note: you must have the functions tk2ascii() and as.integer.hex() I
posted earlier.

Cheers,
Jonathan

Jonathan Q. Li, PhD
Agilent Technologies
3500 Deer Creek Road
Palo Alto, CA 94041



imageviewer <- function(im){

	###############################
	# imageviewer creates a canvas to
	# hold the graylevel image represented
	# by a matrix im
	#
	#
	# im: matrix of graylevel image
	# value: no return values
	################################

	rw <- tktoplevel()
	display.frame <- tkframe(rw,"-height", "1",
"-width","20")
	pixel.display1 <- tktext(display.frame,
"-height","1","-width","4")
	pixel.display2 <- tktext(display.frame, "-height",
"1","-width", "4")
	pixel.display3 <- tktext(display.frame, "-height", "1",
"-width", "3")

	tkpack(pixel.display1, pixel.display2, pixel.display3, "-side",
"left")

	if(!require(pixmap))  stop("pixmap not present")
	newfile <- tempfile()
	write.pnm( pixmap(im), file=newfile)
	xxx <- tkcmd("image","create","photo",
file=newfile)
	unlink(newfile)

	can <- tkcanvas(rw, width=1024,height=800, "-scrollregion",
"0 0 1920
1536")
	yscroll <- tkscrollbar(rw, command
=function(...)tkcmd(can,"yview",...),
orient="vertical")
	xscroll <- tkscrollbar(rw, command=
function(...)tkcmd(can,"xview",...),
"-orient", "horizontal")
	tkconfigure(can, yscrollcommand=function(...)tkcmd(yscroll,
"set",...))
	tkconfigure(can, xscrollcommand=function(...)tkset(xscroll,...))

	#################################
	# arrange the grid display pattern
	#################################

	tkgrid(display.frame, sticky="news")
	tkgrid(can, yscroll, sticky="news")
	tkgrid(xscroll, sticky="ew")
	tkgrid.rowconfigure(rw$ID, "1", weight=1)
	tkgrid.columnconfigure(rw$ID, "0", weight=1)

	####################################
	# now the functionalities
	####################################

	canvas.position <- function(x,y){

		xpos <- tkcmd(can$ID, "canvasx", as.integer(x))
		ypos <- tkcmd(can$ID, "canvasy", as.integer(y))

		tkcmd(pixel.display1, "delete", "1.0","1.4")
		tkcmd(pixel.display1, "insert", "1.0", paste(xpos))
		tkcmd(pixel.display2, "delete", "1.0", "1.4")
		tkcmd(pixel.display2, "insert","1.0", paste(ypos))
	list(xpos=xpos, ypos=ypos)
	}

	tkbind(can, "<Motion>", canvas.position)

	xxxim <- tkcmd(can, "create","image", 0,0, image=xxx,
anchor="nw")

	start.roi <- function(x,y){
		e1 <- parent.frame()
		eval(substitute( start.x <- x),e1)
		eval(substitute( start.y <- y), e1)
	}

	tkitembind(can, xxxim, "<Button-1>", start.roi)

	end.roi <- function(x,y){
		yyy <- tkcmd("image","create","photo")
		tkcmd(yyy, "copy", xxx, "-from", start.x,start.y,x,y)
		im.data <- tk2ascii( tkcmd(yyy,"data") )

		imageviewer(im.data)
	}

	tkitembind(can, xxxim, "<B1-ButtonRelease>", end.roi)

	graylevel <- function(x,y){
		pos <- canvas.position(x,y)
		width <- as.integer(tkcmd("image","width",xxx))
		if( pos$xpos >= width){
			pos$xpos <- width -1
		}
		height <- as.integer(tkcmd("image","height",xxx))
		if(pos$ypos >= height){
			pos$ypos <- height -1
		}

		tkcmd(pixel.display3, "delete", "1.0", "1.2")

		xpos <- unlist(strsplit(pos$xpos,"\\."))[1]#convert into string
integer
		ypos <- unlist(strsplit(pos$ypos,"\\."))[1]
		tkcmd(pixel.display3, "insert", "1.0", substr(tkcmd(xxx,
"get", xpos,
ypos), 1,3))
	}

	tkitembind(can, xxxim, "<Any-Enter>", graylevel)
	tkitembind(can, xxxim, "<Motion>", graylevel)

}

-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
r-help mailing list -- Read http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
Send "info", "help", or "[un]subscribe"
(in the "body", not the subject !)  To: r-help-request at
stat.math.ethz.ch
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._