drawModel            package:dynamicGraph            R Documentation

_D_r_a_w _t_h_e _d_y_n_a_m_i_c_G_r_a_p_h _w_i_n_d_o_w _a_n_d _s_l_a_v_e_s

_D_e_s_c_r_i_p_t_i_o_n:

     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.

_A_r_g_u_m_e_n_t_s:

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'. 

_D_e_t_a_i_l_s:

     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.

_V_a_l_u_e:

     The returned value from 'dynamicGraphMain'.

_N_o_t_e:

     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.

_A_u_t_h_o_r(_s):

     Jens Henrik Badsberg

_S_e_e _A_l_s_o:

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

_E_x_a_m_p_l_e_s:

     # 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)) } )
          )

