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