###################################################
### chunk number 1: setup
###################################################
#line 57 "vignettes/biocGraph/inst/doc/layingOutPathways.Rnw"
library("Rgraphviz")
data("integrinMediatedCellAdhesion")
IMCAGraph


###################################################
### chunk number 2: initial
###################################################
#line 78 "vignettes/biocGraph/inst/doc/layingOutPathways.Rnw"
attrs <- list(graph=list(rankdir="LR"))
IMCAGraph <- layoutGraph(IMCAGraph, attrs=attrs)
renderGraph(IMCAGraph)


###################################################
### chunk number 3: longLabel
###################################################
#line 96 "vignettes/biocGraph/inst/doc/layingOutPathways.Rnw"
n <- nodes(IMCAGraph)
names(labels) <- labels <- n
nc <- nchar(labels)
table(nc)
long <- labels[order(nc, decreasing=TRUE)][1:4]
long


###################################################
### chunk number 4: linefeed
###################################################
#line 111 "vignettes/biocGraph/inst/doc/layingOutPathways.Rnw"
labels[long] <- c(paste("Phosphatidyl-\ninositol\n",
    "signaling\nsystem", sep=""), "cell\nproliferation", 
    "cell\nmaintenance", "cell\nmotility") 


###################################################
### chunk number 5: setLabel
###################################################
#line 122 "vignettes/biocGraph/inst/doc/layingOutPathways.Rnw"
nodeRenderInfo(IMCAGraph) <- list(label=labels)
renderGraph(IMCAGraph)


###################################################
### chunk number 6: redoLayout1
###################################################
#line 136 "vignettes/biocGraph/inst/doc/layingOutPathways.Rnw"
attrs$node <- list(fixedsize=FALSE)
width <- c(2.5, 1.5, 1.5, 1.5)
height <- c(1.5, 1.5, 1.5, 1.5)
names(width) <- names(height) <- long
nodeAttrs <- list(width=width, height=height)
IMCAGraph <- layoutGraph(IMCAGraph, attrs=attrs, 
                         nodeAttrs=nodeAttrs)
renderGraph(IMCAGraph)


###################################################
### chunk number 7: redoLayout2
###################################################
#line 157 "vignettes/biocGraph/inst/doc/layingOutPathways.Rnw"
shape <- rep("rectangle", length(n))
names(shape) <- n
shape[long[1]] <- "ellipse" 
shape[c(long[2:4], "F-actin")] <- "plaintext"
nodeRenderInfo(IMCAGraph) <- list(shape=shape)
IMCAGraph <- layoutGraph(IMCAGraph, attrs=attrs, 
                         nodeAttrs=nodeAttrs)
renderGraph(IMCAGraph)


###################################################
### chunk number 8: colorPlot
###################################################
#line 172 "vignettes/biocGraph/inst/doc/layingOutPathways.Rnw"
colors <- rep("lightgreen", length(n))
names(colors) <- n
transp <- c("ITGB", "ITGA", "MYO", "ACTN", "JNK", "p110", 
            "Phosphatidylinositol signaling system", 
            "PI5K", "MYO-P", "cell maintenance", "cell motility", 
            "F-actin", "cell proliferation")
colors[transp] <- "transparent"
nodeRenderInfo(IMCAGraph) <- list(fill=colors)
renderGraph(IMCAGraph)


###################################################
### chunk number 9: subgraphs
###################################################
#line 210 "vignettes/biocGraph/inst/doc/layingOutPathways.Rnw"
sg1 <- subGraph(c("ITGA", "ITGB", "ILK", "CAV"), IMCAGraph)
sg2 <- subGraph(c("cell maintenance", "cell motility", 
                  "F-actin", "cell proliferation"), IMCAGraph)
sg3 <- subGraph(c("ACTN", "VCL", "TLN", "PXN", "TNS", "VASP"), 
                IMCAGraph)
sg4 <- subGraph(setdiff(n, c(nodes(sg1), nodes(sg2), nodes(sg3))), 
                IMCAGraph)


###################################################
### chunk number 10: subGList
###################################################
#line 232 "vignettes/biocGraph/inst/doc/layingOutPathways.Rnw"
subGList <- vector(mode="list", length=4)
subGList[[1]] <- list(graph=sg1, attrs=c(rank="source"))
subGList[[2]] <- list(graph=sg2, attrs=c(rank="sink"))
subGList[[3]] <- list(graph=sg3, cluster=TRUE)
subGList[[4]] <- list(graph=sg3, cluster=TRUE)


###################################################
### chunk number 11: plotSubgraph
###################################################
#line 245 "vignettes/biocGraph/inst/doc/layingOutPathways.Rnw"
IMCAGraph <- layoutGraph(IMCAGraph, attrs=attrs, 
                         nodeAttrs=nodeAttrs, subGList=subGList)
renderGraph(IMCAGraph)


###################################################
### chunk number 12: expressionGraph
###################################################
#line 274 "vignettes/biocGraph/inst/doc/layingOutPathways.Rnw"
require("geneplotter")
require("fibroEset")
require("hgu95av2.db")
data("fibroEset")
plotExpressionGraph(IMCAGraph, IMCAAttrs$LocusLink,
                    exprs(fibroEset)[,1], hgu95av2ENTREZID, 
                    attrs=attrs,
                    subGList=subGList, nodeAttr=nodeAttrs)


###################################################
### chunk number 13: VJCGraph
###################################################
#line 291 "vignettes/biocGraph/inst/doc/layingOutPathways.Rnw"
z <- IMCAGraph
nodeRenderInfo(z) <- list(shape="plaintext", fontsize=100)
nag <- layoutGraph(z, attrs=list(edge=list(arrowsize=2.8, minlen=3)))
renderGraph(nag)


###################################################
### chunk number 14: 
###################################################
#line 314 "vignettes/biocGraph/inst/doc/layingOutPathways.Rnw"
sessionInfo()


###################################################
### chunk number 15: 
###################################################
#line 319 "vignettes/biocGraph/inst/doc/layingOutPathways.Rnw"
graphvizVersion()