############################################################################## # QuickCapture v.0 2014 - An R GUI for 2D landmark acquisition # # Compiled by CN Stephan # # This program uses the ‘Conte’ function, and builds on some other code, # # described by J. Claude in Morphometrics with R (Springer: New York, 2008). # ############################################################################## ## Import libraries required.packages <- c("tcltk", "jpeg", "pixmap") new.packages <- required.packages[!(required.packages %in% installed.packages()[,"Package"])] if(length(new.packages)) install.packages(new.packages) library(pixmap) ## for image manipulations library(jpeg) ## for image import library(tcltk) ## for GUI ## Display Logo Window R.base.dir <- system.file() setwd(paste(R.base.dir,"/../../doc/html",sep="")) image <- as.numeric(file.access(paste(R.base.dir,"/../../doc/html/QuickCapture_logo.gif",sep=""), mode=0)) if (image==-1) { tkmessageBox(title="Error", message="Save the QuickCapture logo to the following path: \nC:/Program Files/R/R-[version]/doc/html. \n",icon="warning") q() } if (image==0) { tt <- tktoplevel() tkwm.title(tt, "QuickCapture") tkwm.geometry(tt,"638x264+30+30") image1<-tclVar() tcl("image","create","photo",image1,file="QuickCapture_logo.gif") imgAsLabel<-tklabel(tt,image=image1,bg="white") tkpack(imgAsLabel) tkconfigure(tt,cursor="watch") Sys.sleep (7) tkconfigure(tt,cursor="arrow") tkdestroy(tt) ## Test if Conte function exits if (!exists("Conte")) { tkmessageBox(title="Error", message="Load the Conte function described by J. Claude in Morphometrics with R (Springer: New York, 2008, p.47)",icon="warning") q() } ## Choose Working Directory directory<-tclvalue(tkchooseDirectory(title="Select the directory that contians the images that you want to anlayze. This location will double as your working directory for file output.")) setwd(directory) ## Select which Landmark Capture Function to use tt <- tktoplevel() tkgrab.set(tt) tkfocus(tt) tkwm.title(tt,"QuickCapture program selection") rb1 <- tkradiobutton(tt) rb2 <- tkradiobutton(tt) rb3 <- tkradiobutton(tt) rbValue <- tclVar("Equidistant semilandmarks ") tkconfigure(rb1,variable=rbValue,value="Equidistant semilandmarks defined from a starting position ") tkconfigure(rb2,variable=rbValue,value="The same quantity of equidistant semilandmarks between prespecified (type I and/or II) landmarks ") tkconfigure(rb3,variable=rbValue,value="Different quantities of equidistant semilandmarks between prespecified (type I and/or II) landmarks ") tkgrid(tklabel(tt,text="Which landmark capture function do you want to use?")) tkgrid(tklabel(tt,text="")) tkgrid(tklabel(tt,text="Equidistant semilandmarks defined from a starting position "),rb1, sticky="e") tkgrid(tklabel(tt,text="The same quantity of equidistant semilandmarks between prespecified (type I and/or II) landmarks "),rb2, sticky="e") tkgrid(tklabel(tt,text="Different quantities of equidistant semilandmarks between prespecified (type I and/or II) landmarks "),rb3, sticky="e") tkgrid(tklabel(tt,text="")) OnOK <- function() { rbVal <- as.character(tclvalue(rbValue)) tkdestroy(tt) } OK.but <- tkbutton(tt,text="OK",command=OnOK) tkgrid(OK.but) tkfocus(tt) tkbind(tt, "", function() {tkgrab.release(tt)}) tkwait.window(tt) rbVal <- as.character(tclvalue(rbValue)) if (rbVal=="Equidistant semilandmarks defined from a starting position ") { ## Instructions wait<-tkmessageBox(title="QuickCapture: Instructions for equidistant landmarks", message="QuickCapture will ask you to do the following: \n \n1. Specify the number of equidistant semilandmarks you want to place on the image object. \n \n2. Click the cursor on the image object to initiate the outline capture. This starting point will serve as the first landmark. As the Conte function will automatically find the object's edge, you must click to the right of the desired starting position and on the image object. \n \nThe stipulated number of equidistant semilandmarks will be automatically placed. These semilandmarks will be white. \n \nThe landmarks coordinates will be outputted to your R working directory under the filename: 'Landmark_SL.csv'.",icon="info",type="ok") ## Get number of Landmarks dlg<-tktoplevel() tkwm.title(dlg,"QuickCapture") tkgrid(tklabel(dlg,text="Enter the number of equidistantly spaced landmarks to capture. \n")) lmks<-tclVar() entry.lmks<-tkentry(dlg,width="10",textvariable=lmks) tkgrid(entry.lmks) OnOK<- function () { NameVal<-tclvalue(lmks) tkdestroy(dlg) } OK.but<-tkbutton(dlg,text="OK",command=OnOK) tkgrid(OK.but) tkfocus(dlg) tkbind(dlg, "", function() {tkgrab.release(dlg)}) tkwait.window(dlg) lmks <- as.numeric(tclvalue(lmks)) ## fixed landmarks ## Load files filenames<-dir(path=directory, pattern="...*.jpg") for (k in 1:length(filenames)) { y<-readJPEG(filenames[k]) y<-pixmapGrey(y) y<-as(y, "pixmapGrey") y@grey[which(y@grey>=0.9)]<-1 y@grey[which(y@grey<0.9)]<-0.7 par(mar=c(1,1,1,1)) plot(y) ## Find the starting point for outline capture start<-locator (1) Rc<-Conte(c(round(start$x), round(start$y)), y@grey) lines(Rc$X, Rc$Y, lwd=1, col="black") arrows(0,Rc$Y[1], Rc$X[1], Rc$Y[1], length=0.1) ldmx<-(Rc$X[seq(1,length(Rc$X),length=lmks+1)])[-1] ldmy<-(Rc$Y[seq(1,length(Rc$Y),length=lmks+1)])[-1] points(ldmx,ldmy, pch=21, bg="white") ldm_row <- rbind(ldmx,ldmy) rownames(ldm_row)<-c("x","y") ldm_col <- cbind(ldmx,ldmy) colnames(ldm_col)<-c("x","y") assign(paste("lmk_s_",filenames[k],sep=""), ldm_col) } all_lmks<-sapply(ls(pat="lmk_s_...*.jpg"), get, simplify = FALSE) sink("Landmarks_SL.txt"); print(all_lmks); sink() ##graphics.off() ## Output summary dlg <- tktoplevel() tkwm.title(dlg,"QuickCapture") labelText <- tclVar(paste("The number of landmarks successfully placed per image are:","\n \n","Semi-landmarks = ",lmks,".","\n","Total landmarks = ",lmks,". \n \n Your .csv file has been successfully written.",sep="","\n")) label1 <- tklabel(dlg,text=tclvalue(labelText)) tkconfigure(label1,textvariable=labelText) tkgrid(label1) Cont.but <- tkbutton(dlg,text="OK",command=function()tkdestroy(dlg)) tkgrid(Cont.but) tkfocus(dlg) tkbind(dlg, "", function() {tkgrab.release(dlg)}) tkwait.window(dlg) shell(cmd=paste("start ",directory,"/Landmarks_SL.txt",sep=""), translate = TRUE) } if (rbVal=="The same quantity of equidistant semilandmarks between prespecified (type I and/or II) landmarks ") { ## Instructions wait<-tkmessageBox(title="QuickCapture: Instructions for SAME number of equidistant semilandmarks between prespecified (type I and/or II) landmarks", message="QuickCapture will ask you to do the following: \n \n1. Specify the number of type I and/or II (fixed) landmarks you want to place on your images. \n \n2. Specify a single number of equidistant semilandmarks that you want to place between each of your fixed landmarks. \n \n3. Click the cursor on the image object to initiate the outline capture. As the Conte function will automatically find the object's edge, click to the right of the desired starting position and on the image object. \n \n4. Define the first fixed landmark by clicking the cursor on the image outline adjacent to, and in an ANTICLOCKWISE direction from, the starting position. \n \nThe program operates on the exact object outline, so it does not matter if the clicked location is not exactly on the outline (the landmark will automatically be drawn onto the edge of the object). This first landmark will be black in color. \n \n5. Define the remaining fixed landmarks, in an anticlockwise direction, using the cursor. The final fixed landmark MUST be placed before encountering the original starting point on the outline. \n \nThese fixed landmarks will be grey. The stipulated number of equidistantly placed semilandmarks will be automatically placed between the pre-defined fixed landmarks. These semilandmarks will be white. \n \nThe landmarks coordinates will be outputted to your R working directory under the filename: 'Landmark_FL_eSL.csv'.",icon="info",type="ok") ## Set number of fixed landmarks dlg<-tktoplevel() tkwm.title(dlg,"QuickCapture") tkgrid(tklabel(dlg,text="Enter the number of desired fixed landmarks. \n")) lmks<-tclVar() entry.lmks<-tkentry(dlg,width="10",textvariable=lmks) tkgrid(entry.lmks) OnOK<- function () { NameVal<-tclvalue(lmks) tkdestroy(dlg) } OK.but<-tkbutton(dlg,text="OK",command=OnOK) tkgrid(OK.but) tkfocus(dlg) tkbind(dlg, "", function() {tkgrab.release(dlg)}) tkwait.window(dlg) lmks <- as.numeric(tclvalue(lmks)) ## fixed landmarks ## Set number of Semilandmarks dlg<-tktoplevel() tkwm.title(dlg,"QuickCapture") tkgrid(tklabel(dlg,text="Enter a single value for the number of desired semilandmarks between fixed landmarks. \n")) semi_lmks<-tclVar() entry.lmks<-tkentry(dlg,width="10",textvariable=semi_lmks) tkgrid(entry.lmks) OnOK<- function () { NameVal<-tclvalue(semi_lmks) tkdestroy(dlg) } OK.but<-tkbutton(dlg,text="OK",command=OnOK) tkgrid(OK.but) tkfocus(dlg) tkbind(dlg, "", function() {tkgrab.release(dlg)}) tkwait.window(dlg) semi_lmks <- as.numeric(tclvalue(semi_lmks)) ## fixed landmarks ## Load images filenames<-dir(path=directory, pattern="...*.jpg") for (k in 1:length(filenames)) { y<-readJPEG(filenames[k]) y<-pixmapGrey(y) y<-as(y, "pixmapGrey") y@grey[which(y@grey>=0.9)]<-1 y@grey[which(y@grey<0.9)]<-0.7 par(mar=c(1,1,1,1)) plot(y) ## Find the starting point for outline capture start<-locator (1) Rc<-Conte(c(round(start$x), round(start$y)), y@grey) lines(Rc$X, Rc$Y, lwd=1, col="black") arrows(0,Rc$Y[1], Rc$X[1], Rc$Y[1], length=0.1) ## Define matrix of outline coordinates M1<- rbind(Rc$X,Rc$Y); rownames(M1) <- c("x","y") ## matrix of x/y coordinates ##Find the FIRST fixed landmark on an outline L1<-locator(1) ## mouse click for location of stationary landmark L2<-rbind(round(L1$x),round(L1$y)); rownames(L2) <- c("x","y") ## "unlist" coordinates of mouse click and put into 2:1 matrix M2<-matrix(L2,2,length(Rc$X)) ## greate mouse click matrix of equal dimensions to Rc M3<-M1-M2 M3<-rbind(M3,abs(M3[1,])+abs(M3[2,])) ## get distances of mouse click from each point on outline closest<-min(M3[3,]) ## find smallest deviation from mouse click lmk1<-which(M3[3,]==closest) closest_lmk_1<-lmk1[1] points(M1[1,lmk1[1]],M1[2,lmk1[1]], pch=21, bg="black") ##Find the rest of the fixed landmarks on an outline lmks_p<-c(lmks-1) for (i in 2:lmks) { L1<-locator(1) ## mouse click for location of stationary landmark L2<-rbind(round(L1$x),round(L1$y)); rownames(L2) <- c("x","y") ## "unlist" coordinates of mouse click and put into 2:1 matrix assign(paste("L2",i,sep="_"), rbind(round(L1$x),round(L1$y))); rownames(L2) <- c("x","y") M2<-matrix(L2,2,length(Rc$X)) ## greate mouse click matrix of equal dimensions to Rc M3<-M1-M2 M3<-rbind(M3,abs(M3[1,])+abs(M3[2,])) ## get distances of mouse click from each point on outline closest<-min(M3[3,]) ## find smallest deviation from mouse click lmk1<-which(M3[3,]==closest) assign(paste("closest_lmk",i,sep="_"), lmk1[1]) points(M1[1,lmk1[1]],M1[2,lmk1[1]], pch=21, bg=grey(0.4)) ## plot landmark at this point } ## re-organize outline matrix so first fixed landmark IS the starting position fixed_lmks<-sapply(ls(pat="closest_lmk_"), get, simplify = FALSE) temp_f_lmks<-cbind(fixed_lmks) mrx_lmks<-sapply(temp_f_lmks, function (a) a-(closest_lmk_1-1)) M1new<-cbind(M1[,closest_lmk_1:length(Rc$X)],M1[,1:closest_lmk_1]) M1f<-list(X=M1new[1,],Y=M1new[2,]) m_f_lmks<-c(mrx_lmks, length(M1f$X)) ## get matrix of fixed landmarks under new matrix configuration all_lmks<-matrix(NA,2,(semi_lmks*lmks)+lmks); rownames(all_lmks)=c("x","y"); cnames<-matrix(NA,1,(semi_lmks*lmks)+lmks) for (i in 1:lmks) { flmk_x<-M1f$X[mrx_lmks[i]] flmk_y<-M1f$Y[mrx_lmks[i]] ctemp<-rbind(flmk_x, flmk_y) all_lmks[,(i+(semi_lmks*i))-semi_lmks]<-ctemp cnames[,(i+(semi_lmks*i))-semi_lmks]<-paste("Lm",(i+(semi_lmks*i))-semi_lmks,"(F",i,")",sep="") } ## add equidistantly placed curvilinear landmarks between fixed for (i in 1:lmks) { for (j in 1:semi_lmks) { ldmx<-(M1f$X[seq(m_f_lmks[i], m_f_lmks[i+1],length=semi_lmks+2)])[c(-1,-(semi_lmks+2))] ldmy<-(M1f$Y[seq(m_f_lmks[i], m_f_lmks[i+1],length=semi_lmks+2)])[c(-1,-(semi_lmks+2))] ctemp<-rbind(ldmx,ldmy) all_lmks[,((i+(semi_lmks*i))-(j-1))]<-ctemp[,j] cnames[,((i+(semi_lmks*i))-(j-1))]<-paste(" Lm",((i+(semi_lmks*i))-(j-1)),sep="") points(ldmx,ldmy, pch=21, bg="white") } } assign(paste("lmk_s_",filenames[k],sep=""), all_lmks) } ## generate matrix of landmark coordinates in order of placement on figure all_lmks<-sapply(ls(pat="lmk_s_...*.jpg"), get, simplify = FALSE) all_lmks<-lapply(all_lmks,function(a) t(a)) sink("Landmarks_FL_eSL.txt"); print(all_lmks); sink() ##graphics.off() ## Output summary dlg <- tktoplevel() tkwm.title(dlg,"QuickCapture") labelText <- tclVar(paste("The number of landmarks successfully placed per image are:","\n \n","Fixed-landmarks = ",lmks,".","\n","Semi-landmarks = ",semi_lmks,".","\n","Total landmarks = ",(semi_lmks*lmks)+lmks,". \n \n Your .csv file has been successfully written.",sep="","\n")) label1 <- tklabel(dlg,text=tclvalue(labelText)) tkconfigure(label1,textvariable=labelText) tkgrid(label1) Cont.but <- tkbutton(dlg,text="OK",command=function()tkdestroy(dlg)) tkgrid(Cont.but) tkfocus(dlg) tkbind(dlg, "", function() {tkgrab.release(dlg)}) tkwait.window(dlg) shell(cmd=paste("start ",directory,"/Landmarks_FL_eSL.txt",sep=""), translate = TRUE) } if (rbVal=="Different quantities of equidistant semilandmarks between prespecified (type I and/or II) landmarks ") { ## Wait wait<-tkmessageBox(title="QuickCapture: Instructions for DIFFERENT numbers of equidistant semilandmarks between prespecified (type I and/or II) landmarks", message="QuickCapture will ask you to do the following: \n \n1. Specify the number of type I and/or II (fixed) landmarks you want to place on your images. \n \n2. Specify the number of equidistant semilandmarks you want to place between each of the fixed landmarks. \n \n3. Click the cursor on the image object to initiate the outline capture. As the Conte function will automatically find the object's edge, click to the right of the desired starting position and on the image object. \n \n4. Define the first fixed landmark by clicking the cursor on the image outline adjacent to, and in an ANTICLOCKWISE direction from, the starting position. \n \nThe program operates on the exact object outline, so it does not matter if the clicked location is not exactly on the outline (the landmark will automatically be drawn onto the edge of the object). This first landmark will be black in color. \n \n5. Define the remaining fixed landmarks, in an anticlockwise direction, using the cursor. The final fixed landmark MUST be placed before encountering the original starting point on the outline. \n \nThese fixed landmarks will be grey. The stipulated number of equidistantly placed semilandmarks will be automatically placed between the pre-defined fixed landmarks. These semilandmarks will be white. \n \nThe landmarks coordinates will be outputted to your R working directory under the filename: 'Landmark_FL_dSL.csv'.",icon="info",type="ok") ## Set number of Fixed Landmarks dlg<-tktoplevel() tkwm.title(dlg,"QuickCapture") tkgrid(tklabel(dlg,text="Enter the number of desired fixed landmarks. \n")) lmks<-tclVar() entry.lmks<-tkentry(dlg,width="10",textvariable=lmks) tkgrid(entry.lmks) OnOK<- function () { NameVal<-tclvalue(lmks) tkdestroy(dlg) } OK.but<-tkbutton(dlg,text="OK",command=OnOK) tkgrid(OK.but) tkfocus(dlg) tkbind(dlg, "", function() {tkgrab.release(dlg)}) tkwait.window(dlg) lmks <- as.numeric(tclvalue(lmks)) ## fixed landmarks ##Set the number of Semi Landmarks dlg<-tktoplevel() tkwm.title(dlg,"QuickCapture") tkgrid(tklabel(dlg,text="\n Specify the numbers of semi-landmarks to be placed after each fixed landmark. \nEnter the values in sequence, followed by a comma, and moving in an anti-clockwise direction about the image object. \n"),sticky="e") slmks<-tclVar() entry.lmks<-tkentry(dlg,width="10",textvariable=slmks) tkgrid(entry.lmks) OnOK<- function () { NameVal<-tclvalue(slmks) tkdestroy(dlg) } OK.but<-tkbutton(dlg,text="OK",command=OnOK) tkgrid(OK.but) tkfocus(dlg) tkbind(dlg, "", function() {tkgrab.release(dlg)}) tkwait.window(dlg) slmks <- as.character(tclvalue(slmks)) ## fixed landmarks slmks<-as.numeric(unlist(strsplit(slmks,","))) ## Error messages and quit function if landmark numbers are incorrect if (length(slmks)>lmks) { tkmessageBox(title="Error", message="Too many semi-lankmarks. \n",icon="warning") q() } if (length(slmks)=0.9)]<-1 y@grey[which(y@grey<0.9)]<-0.7 par(mar=c(1,1,1,1)) plot(y) ## Find the starting point for outline capture start<-locator (1) Rc<-Conte(c(round(start$x), round(start$y)), y@grey) lines(Rc$X, Rc$Y, lwd=1, col="black") arrows(0,Rc$Y[1], Rc$X[1], Rc$Y[1], length=0.1) ## Define matrix of outline coordinates M1<- rbind(Rc$X,Rc$Y); rownames(M1) <- c("x","y") ## matrix of x/y coordinates ##Find the FIRST fixed landmark on an outline L1<-locator(1) ## mouse click for location of stationary landmark L2<-rbind(round(L1$x),round(L1$y)); rownames(L2) <- c("x","y") ## "unlist" coordinates of mouse click and put into 2:1 matrix M2<-matrix(L2,2,length(Rc$X)) ## greate mouse click matrix of equal dimensions to Rc M3<-M1-M2 M3<-rbind(M3,abs(M3[1,])+abs(M3[2,])) ## get distances of mouse click from each point on outline closest<-min(M3[3,]) ## find smallest deviation from mouse click lmk1<-which(M3[3,]==closest) closest_lmk_1<-lmk1[1] points(M1[1,lmk1[1]],M1[2,lmk1[1]], pch=21, bg="black") ##Find the rest of the fixed landmarks on an outline lmks_p<-c(lmks-1) for (i in 2:lmks) { L1<-locator(1) ## mouse click for location of stationary landmark L2<-rbind(round(L1$x),round(L1$y)); rownames(L2) <- c("x","y") ## "unlist" coordinates of mouse click and put into 2:1 matrix assign(paste("L2",i,sep="_"), rbind(round(L1$x),round(L1$y))); rownames(L2) <- c("x","y") M2<-matrix(L2,2,length(Rc$X)) ## create mouse click matrix of equal dimensions to Rc M3<-M1-M2 M3<-rbind(M3,abs(M3[1,])+abs(M3[2,])) ## get distances of mouse click from each point on outline closest<-min(M3[3,]) ## find smallest deviation from mouse click lmk1<-which(M3[3,]==closest) assign(paste("closest_lmk",i,sep="_"), lmk1[1]) points(M1[1,lmk1[1]],M1[2,lmk1[1]], pch=21, bg=grey(0.4)) ## plot landmark at this point } ## re-organize outline matrix so first fixed landmark IS the starting position fixed_lmks<-sapply(ls(pat="closest_lmk_"), get, simplify = FALSE) temp_f_lmks<-cbind(fixed_lmks) mrx_lmks<-sapply(temp_f_lmks, function (a) a-(closest_lmk_1-1)) M1new<-cbind(M1[,closest_lmk_1:length(Rc$X)],M1[,1:closest_lmk_1]) M1f<-list(X=M1new[1,],Y=M1new[2,]) m_f_lmks<-c(mrx_lmks, length(M1f$X)) ## setup matrix for all landmarks, and add fixed landmarks under new matrix configuration semi_lmks<-sum(slmks) cnames<-paste(" Lm",seq(1,(semi_lmks+lmks),1),sep="") all_lmks<-matrix(NA,2,(semi_lmks)+lmks); rownames(all_lmks)=c("x","y"); for (i in 1:lmks) { flmk_x<-M1f$X[mrx_lmks[i]] flmk_y<-M1f$Y[mrx_lmks[i]] ctemp<-rbind(flmk_x, flmk_y) all_lmks[,((sum(slmks[1:i-1]))+(i))]<-ctemp cnames[((sum(slmks[1:i-1]))+(i))]<-paste("Lm",((sum(slmks[1:i-1]))+(i)),"(F",i,")",sep="") } ## add semi landmarks between fixed landmarks for (i in 1:lmks) { X<-slmks[i] ldmx<-(M1f$X[seq(m_f_lmks[i], m_f_lmks[i+1],length=X+2)])[c(-1,-(X+2))] ldmy<-(M1f$Y[seq(m_f_lmks[i], m_f_lmks[i+1],length=X+2)])[c(-1,-(X+2))] ctemp<-rbind(ldmx,ldmy) all_lmks[,(((sum(slmks[1:i-1]))+(i+1)):(i+(sum(slmks[1:i]))))]<-ctemp points(ldmx,ldmy, pch=21, bg="white") } assign(paste("lmk_s_",filenames[k],sep=""), all_lmks) } ## generate matrix of landmark coordinates in order of placement on figure all_lmks<-sapply(ls(pat="lmk_s_...*.jpg"), get, simplify = FALSE) all_lmks<-lapply(all_lmks,function(a) t(a)) sink("Landmarks_FL_dSL.txt"); print(all_lmks); sink() ##graphics.off() ## Output summary dlg <- tktoplevel() tkwm.title(dlg,"QuickCapture") labelText <- tclVar(paste("The number of landmarks successfully placed per image are:","\n \n","Fixed-landmarks = ",lmks,".","\n","Semi-landmarks = ",sum(slmks),".","\n","Total landmarks = ",sum(slmks)+lmks,". \n \n Your .csv file has been successfully written.",sep="","\n")) label1 <- tklabel(dlg,text=tclvalue(labelText)) tkconfigure(label1,textvariable=labelText) tkgrid(label1) Cont.but <- tkbutton(dlg,text="OK",command=function()tkdestroy(dlg)) tkgrid(Cont.but) tkfocus(dlg) tkbind(dlg, "", function() {tkgrab.release(dlg)}) tkwait.window(dlg) shell(cmd=paste("start ",directory,"/Landmarks_FL_dSL.txt",sep=""), translate = TRUE) } } ## End of QuickCapture