drawModel {dynamicGraph}R Documentation

Draw the dynamicGraph window and slaves

Description

The functions drawModel and redrawView within dynamicGraph is for adding models to dynamicGraph, for adding new views of a model, and for overwriting an existing view with an other model.

The functions can not be found at top level.

Arguments

frameModels An object of class DynamicGraph-class. NULL, or frameModels of list(...)$Arguments.
frameViews An object of class DynamicGraphModel-class. NULL, or frameViews of list(...)$Arguments. If frameViews is set to NULL, the default value, then a new model frame will be created by drawModel.
graphWindow An object of class DynamicGraphView-class. If graphWindow is set to the value of list(...)$Arguments$graphWindow then the calling graph window will be redrawn. If graphWindow is set to NULL, the default value, then a new slave graph window will be drawn.
graphComponent Returned structure from graphComponent.
edgeList As for dynamicGraphMain. If edgeList is given (set to a value different from NULL) then this value is used, else the value extracted from graphComponent or list(...)$Arguments is used. If the value is not NULL in graphComponent then this value is used, else the value from list(...)$Arguments is used when edgeList is NULL.
oriented As for dynamicGraphMain. If oriented is given then this value is used, else the value extracted from list(...)$Arguments is used.
blockEdgeList As for dynamicGraphMain. If blockEdgeList ... (as for edgeList).
factorVertexList As for dynamicGraphMain. If factorVertexList ... (as for edgeList).
factorEdgeList As for dynamicGraphMain. If factorEdgeList ... (as for edgeList).
extraEdgeList As for dynamicGraphMain. If extraEdgeList ... (as for edgeList).
visibleVertices As for dynamicGraphMain. If visibleVertices ... (as for edgeList).
visibleBlocks As for dynamicGraphMain. If visibleBlocks ... (as for edgeList).
extraList As for dynamicGraphMain. If extraList ... (as for edgeList).
object As for dynamicGraphMain. If object ... (as for oriented).
viewType As for dynamicGraphMain. If viewType ... (as for oriented).
title As for dynamicGraphMain. If title ... (as for oriented).
transformation As for dynamicGraphMain. If transformation ... (as for oriented).
width As for dynamicGraphMain. If width ... (as for oriented).
height As for dynamicGraphMain. If height ... (as for oriented).
w As for dynamicGraphMain. If w ... (as for oriented).
vertexColor As for dynamicGraphMain. If vertexColor ... (as for oriented).
extraVertexColor As for dynamicGraphMain. If extraVertexColor ... (as for oriented).
edgeColor As for dynamicGraphMain. If edgeColor ... (as for oriented).
factorVertexColor As for dynamicGraphMain. If factorVertexColor ... (as for oriented).
factorEdgeColor As for dynamicGraphMain. If factorEdgeColor ... (as for oriented).
blockEdgeColor As for dynamicGraphMain. If blockEdgeColor ... (as for oriented).
blockColors As for dynamicGraphMain. If blockColors ... (as for oriented).
extraEdgeColor As for dynamicGraphMain. If extraEdgeColor ... (as for oriented).
background As for dynamicGraphMain. If background ... (as for oriented).
initialWindow Logical, if initialWindow is TRUE the the labels of the edges are updated.
returnLink As for dynamicGraphMain. If returnLink ... (as for oriented).
returnNull As for dynamicGraphMain. If returnNull ... (as for oriented).
setUpdateCountModelMain Logical. If setUpdateCountModelMain is TRUE then views of the same model will be updated.
... Used to porting list(...)$Arguments.

Details

The drawModel and redrawView functions can be called from the functions of menus (main menu and pop up menus) of dynamicGraphMain, from .GlobalEnv in DynamicGraph) via returned values from dynamicGraphMain (and from the methods of the model object in the scope of the function dynamicGraphMain). As a result the graph window will be redrawn with an other view of the model, possible with, e.g., other edges, an other model is drawn, or a new slave graph window will appear.

If the value of a argument to drawModel or redrawView is set, then this value is used, else the value from the calling window is used. The value of the calling window is given in the argument Arguments in the call of the function of the menu item.

Below is an example, where items for labeling all the edges of the graph are added to the menu. The edges are visited, a test is computed for each edge, the label and width of the edge is updated, and the graph is drawn with the updated edge list.

Value

The returned value from dynamicGraphMain.

Note

The functions can not be called from top level, that is, the functions does not exists at .GlobalEnv, but only in returned values from dynamicGraphMain.

It is recommended that the functions not are called, but that DynamicGraph is used with the arguments frameModels, frameViews, graphWindow, addModel, addView, and/or overwrite to call the functions.

Author(s)

Jens Henrik Badsberg

See Also

See also dynamicGraphMain, DynamicGraph DynamicGraph-class, and DynamicGraphModel-class.

Examples

# The use of "drawModel"  and "redrawView" by 
# "DynamicGraph" in the example "usermenus" of demo:

your.DrawModel <- function(object, slave = FALSE, viewType = "Simple", ...) {
    args <- list(...)
    Args <- args$Arguments

    # Here you should make your new model (this is just a copy):

    Object <- object
    title <- Object@name

    # and compute edges (here 'NULL' if the model not has been updated):

    Edges <- graphComponents(Object, viewType, Arguments = Args)
    EdgeList       <- Edges$vertexEdges
    ExtraVertices  <- Edges$extraVertices
    FactorVertices <- Edges$factorVertices
    FactorEdges    <- Edges$factorEdges
    BlockEdges     <- Edges$blockEdges
    ExtraEdges     <- Edges$extraEdges
    visualVertices <- Edges$visualVertices
    visualBlocks   <- Edges$visualBlocks

    if (slave) {
      # Drawing ''an other model'' in a new window:
      DynamicGraph(addModel = TRUE,                   # <-
                   frameModels = Args$frameModels, 
                   frameViews = NULL,                 # <- not used here
                   graphWindow = NULL,                # <- not used here
                   edgeList = EdgeList,
                   object = Object, 
                   extraList = ExtraVertices, 
                   extraEdgeList = ExtraEdges, 
                   factorVertexList = FactorVertices, 
                   factorEdgeList = FactorEdges, 
                   blockEdgeList = BlockEdges, 
                   visualVertices = visualVertices,
                   visualBlocks = visualBlocks,
                   title = title, 
                   Arguments = Args)
    } else {
      # Overwriting with ''an other model'' in same view:
      DynamicGraph(overwrite = TRUE,                 # <-
                   addModel = TRUE,                  # <-
                   frameModels = Args$frameModels, 
                   frameViews = Args$frameViews, 
                   graphWindow = Args$graphWindow,   # <-
                   edgeList = EdgeList, 
                   object = Object, 
                   extraList = ExtraVertices, 
                   extraEdgeList = ExtraEdges, 
                   factorVertexList = FactorVertices, 
                   factorEdgeList = FactorEdges, 
                   blockEdgeList = BlockEdges, 
                   visualVertices = visualVertices,
                   visualBlocks = visualBlocks,
                   title = "Not used!", 
                   width = NULL, height = NULL, 
                   Arguments = Args) }
}

your.LabelAllEdges <- function(object, slave = FALSE, ...) 
 {
  args <- list(...)
  Args <- args$Arguments

  getNodeName <- function(index, type)
    if (type == "Vertex")
      name(Args$vertexList[[index]])
    else if (type == "Factor")
      name(Args$factorVertexList[[abs(index)]])
    else if (type == "Extra")
      name(Args$extraList[[abs(index)]])
    else if (type == "Block")
      label(Args$blockList[[abs(index)]])
    else
      NULL

  visitEdges <- function(edges) {
    for (i in seq(along = edges)) {
      vertices <- nodeIndicesOfEdge(edges[[i]])
      types    <- nodeTypesOfEdge(edges[[i]])

      name.f <- getNodeName(vertices[1], types[1])
      name.t <- getNodeName(vertices[2], types[2])

      R <- testEdge(object, action = "remove",
                    name.1 = name.f, name.2 = name.t,
                    from = vertices[1], to = vertices[2],
                    from.type = types[1], to.type = types[2],
                    edge.index = i, force = force, Arguments = Args)

      if (!is.null(R)) {
        if (TRUE || (hasMethod("label", class(R))))
          label(edges[[i]]) <- label(R)
        if (TRUE || (hasMethod("width", class(R))))
          width(edges[[i]]) <- width(R)
      }
    }
    return(edges)
  }

  edgeList <- visitEdges(Args$edgeList)
  factorEdgeList <- visitEdges(Args$factorEdgeList)
  blockEdgeList <- visitEdges(Args$blockEdgeList)

  if (slave) {
    # Adding an other view of the same model:
    DynamicGraph(addView = TRUE,                  # <-
                 frameModels = Args$frameModels, 
                 frameViews = Args$frameViews, 
                 graphWindow = NULL,              # <- not used here
                 edgeList = edgeList, 
                 factorEdgeList = factorEdgeList, 
                 blockEdgeList = blockEdgeList, 
                 title = "A slave window", 
                 Arguments = Args)
  } else {
    # Overwriting with an other view of the same model:
    DynamicGraph(overwrite = TRUE,                # <-
                 addView = TRUE,                  # <-
                 frameModels = Args$frameModels, 
                 frameViews = Args$frameViews, 
                 graphWindow = Args$graphWindow,  # <-
                 edgeList = edgeList, 
                 factorEdgeList = factorEdgeList, 
                 blockEdgeList = blockEdgeList, 
                 title = "Not used!", 
                 width = NULL, height = NULL, 
                 Arguments = Args) } 
 }

 palle <- function(...) print("Palle")
 palle <- function(...) print(list(...)$Arguments$object@name)

 Menus <- 
 list(MainUser = 
      list(label = "Transformation by 'prcomp' on position of \"vertices\", and redraw",
           command = function(object, ...) {
             Args <- list(...)$Arguments
             transformation <- t(prcomp(Positions(Args$vertexList))$rotation)
             Args$redrawView(graphWindow = Args$graphWindow,
                             transformation = transformation, Arguments = Args)
             }),
      MainUser = 
      list(label = "Position of \"vertices\" by 'cmdscale', and redraw",
           command = function(object, ...) {
             Args <- list(...)$Arguments
             Vertices <- Args$vertexList
             Edges <- Args$edgeList
             positions <- Positions(Args$vertexList)
             N <- dim(positions)[2]
             e <- NodeIndices(Edges)
             n <- Names(Vertices)
             X <- matrix(rep(-1, length(n)^2), ncol = length(n))
             for (i in 1:length(e)) {
               suppressWarnings(w <- as.numeric(names(e)[i]))
               if (is.na(w)) w <- .5
               X[e[[i]][1], e[[i]][2]] <- w
               X[e[[i]][2], e[[i]][1]] <- w
             }
             dimnames(X) <- list(n, n)
             d <- 1.25
             X[X==-1] <- d
             X <- X - d * diag(length(n))
             mdsX <- cmdscale(X, k = N, add = TRUE, eig = TRUE, x.ret = TRUE)
             # mdsX <- isoMDS(X, k = N)
             M <- max(abs(mdsX$points))
             Positions(Args$vertexList) <<- mdsX$points / M * 45
             Args$redrawView(graphWindow = Args$graphWindow, 
                             # Positions = Positions(Args$vertexList), 
                             vertexList = Args$vertexList, Arguments = Args)
             }),
      MainUser = 
      list(label = "Position of \"vertices\"",
           command = function(object, ...) 
             print(Positions(list(...)$Arguments$vertexList))),
      MainUser = 
      list(label = "Label all edges, in this window",
           command = function(object, ...) 
                       your.LabelAllEdges(object, slave = FALSE, ...)),
      MainUser = 
      list(label = "Label all edges, in slave window",
           command = function(object, ...) 
                       your.LabelAllEdges(object, slave = TRUE, ...)),
      MainUser = 
      list(label = "Draw model, in this window",
           command = function(object, ...) 
                       your.DrawModel(object, slave = FALSE, ...)),
      MainUser = 
      list(label = "Draw model, in slave window",
           command = function(object, ...) 
                       your.DrawModel(object, slave = TRUE, ...)),
      MainUser = 
      list(label = "Call of function 'modalDialog', result on 'title' at top",
           command = function(object, ...) {
             Args <- list(...)$Arguments
             ReturnVal <- modalDialog("Test modalDialog Entry",
                                      "Enter name", Args$title,
                                      top = Args$top)
             print(ReturnVal)
             if (ReturnVal == "ID_CANCEL")
               return()
             tktitle(Args$top) <- ReturnVal } ),
      MainUser = 
      list(label = "Call of function 'palle', result on 'viewLabel' at bottom",
           command = function(object, ...) {
             Args <- list(...)$Arguments
             tkconfigure(Args$viewLabel, 
                         text = paste(Args$viewType, " | ", palle(...))) } ),
      Vertex = 
      list(label = "Test of user popup menu for vertices: Label",
           command = function(object, name, ...) {
             # print(name)
             args <- list(...)
             # print(names(args))
             # print(c(args$type))
             # print(c(args$index))
             Args <- args$Arguments
             print(Args$vertexList[[args$index]]@label) } ),
      Edge = 
      list(label = "Test of user popup menu for edges: Class",
           command = function(object, name1, name2, ...) {
             args <- list(...)
             # print(c(name1, name2))
             # print(c(args$edge.index, args$which.edge, args$from, args$to))
             # print(c(args$from.type, args$to.type, args$edge.type))
             Args <- list(...)$Arguments
             ReturnVal <- selectDialog("Test selectDialog Entry",
                                       "Select name", Args$edgeClasses[,1],
                                       top = Args$top)
             print(ReturnVal)
             if (ReturnVal == "ID_CANCEL")
               return()
             if ((args$from > 0) && (args$to > 0)) {
               edgeList <- Args$edgeList
               class(edgeList[[args$edge.index]]) <- 
                                              Args$edgeClasses[ReturnVal, 2]
               # vertexEdges(Args$object) <<- edgeList # Not working !!!
               Args$redrawView(graphWindow = Args$graphWindow,
                               edgeList = edgeList, title = "Not used!", 
                               width = NULL, height = NULL, Arguments = Args)
             } } ),
      ClosedBlock = 
      list(label = "Test of user popup menu for blocks",
           command = function(object, name, ...) {
             print(name)
             print(c(list(...)$index)) } )
     )

[Package Contents]