1# IGraph R package 2# Copyright (C) 2005-2012 Gabor Csardi <csardi.gabor@gmail.com> 3# 334 Harvard street, Cambridge, MA 02139 USA 4# 5# This program is free software; you can redistribute it and/or modify 6# it under the terms of the GNU General Public License as published by 7# the Free Software Foundation; either version 2 of the License, or 8# (at your option) any later version. 9# 10# This program is distributed in the hope that it will be useful, 11# but WITHOUT ANY WARRANTY; without even the implied warranty of 12# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13# GNU General Public License for more details. 14# 15# You should have received a copy of the GNU General Public License 16# along with this program; if not, write to the Free Software 17# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 18# 02110-1301 USA 19# 20################################################################### 21 22 23 24#' Run igraph demos, step by step 25#' 26#' Run one of the accompanying igraph demos, somewhat interactively, using a Tk 27#' window. 28#' 29#' This function provides a somewhat nicer interface to igraph demos that come 30#' with the package, than the standard \code{\link{demo}} function. Igraph 31#' demos are divided into chunks and \code{igraph_demo} runs them chunk by 32#' chunk, with the possibility of inspecting the workspace between two chunks. 33#' 34#' The \code{tcltk} package is needed for \code{igraph_demo}. 35#' 36#' @aliases igraphdemo 37#' @param which If not given, then the names of the available demos are listed. 38#' Otherwise it should be either a filename or the name of an igraph demo. 39#' @return Returns \code{NULL}, invisibly. 40#' @author Gabor Csardi \email{csardi.gabor@@gmail.com} 41#' @seealso \code{\link{demo}} 42#' @export 43#' @keywords graphs 44#' @examples 45#' 46#' igraph_demo() 47#' if (interactive()) { 48#' igraph_demo("centrality") 49#' } 50#' 51igraph_demo <- function(which) { 52 53 if (missing(which)) { 54 demodir <- system.file("demo", package="igraph") 55 if (demodir=="") { 56 stop("Could not find igraph demos, broken igraph installation?") 57 } 58 return( sub("\\.R$", "", list.files(demodir)) ) 59 } 60 61 if (!grepl("\\.R$", which)) { 62 which <- paste(which, sep=".", "R") 63 } 64 65 if (!file.exists(which) && ! grepl("^/", which)) { 66 which <- system.file( paste("demo", sep="/", which), package="igraph" ) 67 } 68 69 if (which=="" || !file.exists(which)) { 70 stop("Could not find demo file") 71 } 72 73 .igraphdemo.next <- function(top, txt) { 74 act <- as.character(tcltk::tktag.nextrange(txt, "active", "0.0")) 75 if (length(act)==0) { 76 return() 77 } 78 79 options(keep.source=TRUE) 80 81 text <- tcltk::tclvalue(tcltk::tkget(txt, act[1], act[2])) 82 cat("=======================================================\n"); 83 84 expr <- parse(text=text) 85 for (i in seq_along(expr)) { 86 co <- as.character(attributes(expr)$srcref[[i]]) 87 co[1] <- paste("> ", sep="", co[1]) 88 if (length(co)>1) { 89 co[-1] <- paste(" +", sep="", co[-1]) 90 } 91 cat(co, sep="\n") 92 res <- withVisible(eval(expr[[i]], envir=.GlobalEnv)) 93 if (res$visible) { 94 print(res$value) 95 } 96 } 97 cat("> -------------------------------------------------------\n"); 98 cat(options()$prompt) 99 100 tcltk::tktag.remove(txt, "activechunk", act[1], act[2]) 101 tcltk::tktag.remove(txt, "active", act[1], act[2]) 102 103 nex <- as.character(tcltk::tktag.nextrange(txt, "activechunk", act[1])) 104 if (length(nex)!=0) { 105 tcltk::tktag.add(txt, "active", nex[1], nex[2]) 106 tcltk::tksee(txt, paste(sep="", as.numeric(nex[2]), ".0")) 107 tcltk::tksee(txt, paste(sep="", as.numeric(nex[1]), ".0")) 108 } 109 } 110 111 .igraphdemo.close <- function(top) { 112 tcltk::tkdestroy(top) 113 } 114 115 .igraphdemo.reset <- function(top, txt, which) { 116 demolines <- readLines(which) 117 demolines <- demolines[!grepl("^pause\\(\\)$", demolines)] 118 demolines <- paste(" ", sep="", demolines) 119 120 ch <- grep("^[ ]*###", demolines) 121 ch <- c(ch, length(demolines)+1) 122 if (length(ch)==1) { 123 warning("Demo source file does not contain chunks") 124 } else { 125 demolines <- demolines[ch[1]:length(demolines)] 126 ch <- grep("^[ ]*###", demolines) 127 ch <- c(ch, length(demolines)+1) 128 } 129 130 tcltk::tkconfigure(txt, state="normal") 131 tcltk::tkdelete(txt, "0.0", "end") 132 tcltk::tkinsert(txt, "insert", paste(demolines, collapse="\n")) 133 tcltk::tkconfigure(txt, state="disabled") 134 135 for (i in seq_along(ch[-1])) { 136 from <- paste(sep="", ch[i], ".0") 137 to <- paste(sep="", ch[i+1]-1, ".0") 138 tcltk::tktag.add(txt, "chunk", from, to) 139 tcltk::tktag.add(txt, "activechunk", from, to) 140 } 141 tcltk::tktag.configure(txt, "chunk", "-borderwidth", "1") 142 tcltk::tktag.configure(txt, "chunk", "-relief", "sunken") 143 if (length(ch) >= 2) { 144 tcltk::tktag.add(txt, "active", paste(sep="", ch[1], ".0"), 145 paste(sep="", ch[2]-1, ".0")) 146 tcltk::tktag.configure(txt, "active", "-foreground", "red") 147 tcltk::tktag.configure(txt, "active", "-background", "lightgrey") 148 } 149 150 comm <- grep("^#", demolines) 151 for (i in comm) { 152 tcltk::tktag.add(txt, "comment", paste(sep="", i, ".0"), 153 paste(sep="", i, ".end")) 154 } 155 tcltk::tktag.configure(txt, "comment", "-font", "bold") 156 tcltk::tktag.configure(txt, "comment", "-foreground", "darkolivegreen") 157 } 158 159 top <- tcltk::tktoplevel(background="lightgrey") 160 tcltk::tktitle(top) <- paste("igraph demo:", which) 161 162 main.menu <- tcltk::tkmenu(top) 163 tcltk::tkadd(main.menu, "command", label="Close", command=function() 164 .igraphdemo.close(top)) 165 tcltk::tkadd(main.menu, "command", label="Reset", command=function() 166 .igraphdemo.reset(top, txt, which)) 167 tcltk::tkconfigure(top, "-menu", main.menu) 168 169 scr <- tcltk::tkscrollbar(top, repeatinterval=5, 170 command=function(...) tcltk::tkyview(txt,...)) 171 txt <- tcltk::tktext(top, yscrollcommand=function(...) tcltk::tkset(scr, ...), 172 width=80, height=40) 173 but <- tcltk::tkbutton(top, text="Next", command=function() 174 .igraphdemo.next(top, txt)) 175 176 tcltk::tkpack(but, side="bottom", fill="x", expand=0) 177 tcltk::tkpack(scr, side="right", fill="y", expand=0) 178 tcltk::tkpack(txt, side="left", fill="both", expand=1) 179 180 .igraphdemo.reset(top, txt, which) 181 182 invisible() 183} 184