Plotting_graphs.R
In tidySEM: Tidy Structural Equation Modeling

## ---- include = FALSE---------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)
generate_pngs <- TRUE

## ----setup, message=FALSE, warning = FALSE------------------------------------
library(tidySEM)
library(lavaan)
library(ggplot2)
library(dplyr)

## ---- eval = FALSE, echo = TRUE-----------------------------------------------
#  library(lavaan)
#  HS.model <- ' visual  =~ x1 + x2 + x3
#                textual =~ x4 + x5 + x6
#                speed   =~ x7 + x8 + x9 '
#  fit <- cfa(HS.model, data=HolzingerSwineford1939)

## ---- eval = TRUE, echo = FALSE, message=FALSE--------------------------------
library(lavaan)
suppressWarnings({
HS.model <- ' visual  =~ x1 + x2 + x3
              textual =~ x4 + x5 + x6
              speed   =~ x7 + x8 + x9 '
fit <- cfa(HS.model, data=HolzingerSwineford1939)
})

## ---- echo = TRUE, eval = FALSE-----------------------------------------------
#  graph_sem(model = fit)

## ----echo = FALSE, warning = FALSE, message = FALSE, out.width='100%'---------
p <- graph_sem(model = fit, text_size = 2, fix_coord = TRUE)
if(generate_pngs) ggsave("pgfig1.png", p, device = "png", width= 9.5, height = 3)
knitr::include_graphics("pgfig1.png")

## ----eval = TRUE, echo = TRUE-------------------------------------------------
get_layout(fit)

## ---- eval = FALSE, echo = FALSE, message=FALSE, warning = FALSE--------------
#  library(lavaan)
#  suppressWarnings({
#  fit <- cfa(' visual  =~ x1 + x2 + x3 ',
#             data = HolzingerSwineford1939[1:50, ])
#  get_layout(fit)
#  })

## ----message=FALSE, warning = FALSE-------------------------------------------
get_layout(fit, layout_algorithm = "layout_in_circle")
get_layout(fit, layout_algorithm = "layout_on_grid")

## -----------------------------------------------------------------------------
get_layout("c", NA,  "d",
           NA,  "e", NA, rows = 2)

## ---- eval = FALSE, echo = TRUE-----------------------------------------------
#  read.csv("example.csv")

## ----echo = FALSE, eval = FALSE-----------------------------------------------
#  write.csv(matrix(c("x1", "x2",  "x3", "",  "visual", ""), nrow = 2, byrow = TRUE), file = "example.csv", row.names = FALSE)
#  read.csv("example.csv")
#  file.remove("example.csv")

## ---- eval = FALSE, echo = TRUE-----------------------------------------------
#  read.table("clipboard", sep = "\t")

## ---- eval = FALSE, echo = TRUE-----------------------------------------------
#  read.table(pipe("pbpaste"), sep="\t")

## ----echo = FALSE, eval = TRUE------------------------------------------------
structure(list(V1 = structure(2:1, .Label = c("", "x1"), class = "factor"), 
    V2 = structure(2:1, .Label = c("visual", "x2"), class = "factor"), 
    V3 = structure(2:1, .Label = c("", "x3"), class = "factor")), class = "data.frame", row.names = c(NA, 
-2L))
HS.model <- ' visual  =~ x1 + x2 + x3
              textual =~ x4 + x5 + x6
              speed   =~ x7 + x8 + x9 '
fit <- cfa(HS.model, data=HolzingerSwineford1939)

## -----------------------------------------------------------------------------
get_layout("x", "y", rows = 1)

## -----------------------------------------------------------------------------
get_layout("", "m", "",
           "x", "", "y", rows = 2)

## -----------------------------------------------------------------------------
get_layout("", "F", "",
           "y1", "y2", "y3", rows = 2)

## -----------------------------------------------------------------------------
lay <- get_layout("", "", "visual","","textual","","speed","", "",
                  "x1", "x2", "x3", "x4", "x5", "x6", "x7", "x8", "x9", rows = 2)

## ---- eval = FALSE------------------------------------------------------------
#  graph_sem(fit, layout = lay)

## ----echo = FALSE, warning = FALSE, message = FALSE, out.width='100%'---------
p <- graph_sem(fit, layout = lay) + coord_fixed()
if(generate_pngs) ggsave("pgfig2_1.png", p, device = "png", width= 9.5, height = 3)
knitr::include_graphics("pgfig2_1.png")

## ---- eval = TRUE-------------------------------------------------------------
get_nodes(fit)

## ---- eval = FALSE, echo = FALSE, results= "asis"-----------------------------
#  knitr::kable(get_nodes(fit))

## -----------------------------------------------------------------------------
get_edges(fit)

## -----------------------------------------------------------------------------
get_edges(fit, label = paste(est, confint))

## -----------------------------------------------------------------------------
fit <- cfa(HS.model, data=HolzingerSwineford1939, meanstructure = TRUE)

## -----------------------------------------------------------------------------
get_nodes(fit)

## -----------------------------------------------------------------------------
get_nodes(fit, label = paste0(name, "\n", est, " ", confint))

## -----------------------------------------------------------------------------
p <- prepare_graph(fit)
edges(p)

## -----------------------------------------------------------------------------
prepare_graph(fit) %>%
  edit_graph({ label = paste(est_sig_std, "\n", confint_std) }) %>%
  plot()

## -----------------------------------------------------------------------------
prepare_graph(fit) %>%
  edit_graph({ label = paste(est_sig_std, "\n", confint_std) }) %>%
  edit_graph({ label = paste(name, "\n", est_sig_std, "\n", confint_std) }, element = "nodes") %>%
  plot()

## -----------------------------------------------------------------------------
prepare_graph(fit) %>%
  edit_graph({ label_color = "blue" }) %>%
  plot()

## -----------------------------------------------------------------------------
graph_data <- prepare_graph(model = fit, layout = lay)

## -----------------------------------------------------------------------------
nodes(graph_data)
edges(graph_data)

## ---- message=FALSE-----------------------------------------------------------
library(dplyr)
library(stringr)
nodes(graph_data) <- nodes(graph_data) %>%
  mutate(label = str_to_title(label))

## ----echo = FALSE-------------------------------------------------------------
# $label[1:3] <- str_to_title(nodes(graph_data)$label[1:3])
graph_data <- prepare_graph(model = fit, layout = lay)

## ---- eval = FALSE------------------------------------------------------------
#  edges(graph_data) %>%
#    mutate(connect_from = replace(connect_from, is.na(curvature), "bottom")) %>%
#    mutate(connect_to = replace(connect_to, is.na(curvature), "top")) -> edges(graph_data)

## ---- eval = FALSE------------------------------------------------------------
#  plot(graph_data)

## ----echo = FALSE, warning = FALSE, message = FALSE, out.width='100%'---------
p <- plot(graph_data) + coord_fixed()
if(generate_pngs) ggsave("pgfig2.png", p, device = "png", width= 9.5, height = 3)
knitr::include_graphics("pgfig2.png")

## ---- eval = FALSE------------------------------------------------------------
#  graph_sem(model = fit, layout = lay, angle = 170)

## ----echo = FALSE, warning = FALSE, message = FALSE, out.width='100%'---------
p <- graph_sem(model = fit, layout = lay, angle = 170)
if(generate_pngs) ggsave("pgfig3.png", p, device = "png", width= 9.5, height = 3)
knitr::include_graphics("pgfig3.png")

## ---- eval = FALSE------------------------------------------------------------
#  edg <- data.frame(from = "x",
#                    to = "y",
#                    linetype = 2,
#                    colour = "red",
#                    size = 2,
#                    alpha = .5)
#  
#  graph_sem(edges = edg, layout = get_layout("x", "y", rows = 1))

## ----echo = FALSE, warning = FALSE, message = FALSE, out.width='30%'----------
edg <- data.frame(from = "x",
                  to = "y",
                  linetype = 2,
                  colour = "red",
                  size = 2,
                  alpha = .5)

p <- graph_sem(edges = edg, layout = get_layout("x", "y", rows = 1))

if(generate_pngs) ggsave("pgfig4.png", p, device = "png", width= 4, height = 1)
knitr::include_graphics("pgfig4.png")

## ---- eval = FALSE------------------------------------------------------------
#  edg <- data.frame(from = "x",
#                    to = "y")
#  nod <- data.frame(name = c("x", "y"),
#                      shape = c("rect", "oval"),
#                      linetype = c(2, 2),
#                      colour = c("blue", "blue"),
#                      fill = c("blue", "blue"),
#                      size = c(2, 2),
#                      alpha = .5)
#  graph_sem(edges = edg, nodes = nod, layout = get_layout("x", "y", rows = 1))

## ----echo = FALSE, warning = FALSE, message = FALSE, out.width='30%'----------
edg <- data.frame(from = "x",
                  to = "y")
nod <- data.frame(name = c("x", "y"),
                    shape = c("rect", "oval"),
                    linetype = c(2, 2),
                    colour = c("blue", "blue"),
                    fill = c("blue", "blue"),
                    size = c(2, 2),
                    alpha = .5)
p <- graph_sem(edges = edg, nodes = nod, layout = get_layout("x", "y", rows = 1))

if(generate_pngs) ggsave("pgfig5.png", p, device = "png", width= 4, height = 1)
knitr::include_graphics("pgfig5.png")

## ---- eval = FALSE------------------------------------------------------------
#  edges(graph_data) %>%
#    mutate(colour = "black") %>%
#    mutate(colour = replace(colour, from == "visual" & to == "x2", "red")) %>%
#    mutate(linetype = 1) %>%
#    mutate(linetype = replace(linetype, from == "visual" & to == "x2", 2)) %>%
#    mutate(alpha = 1) %>%
#    mutate(alpha = replace(alpha, from == "visual" & to == "x2", .5)) -> edges(graph_data)
#  plot(graph_data)

## ----echo = FALSE, warning = FALSE, message = FALSE, out.width='100%'---------
edges(graph_data) %>%
  mutate(colour = "black") %>%
  mutate(colour = replace(colour, from == "visual" & to == "x2", "red")) %>%
  mutate(linetype = 1) %>%
  mutate(linetype = replace(linetype, from == "visual" & to == "x2", 2)) %>%
  mutate(alpha = 1) %>%
  mutate(alpha = replace(alpha, from == "visual" & to == "x2", .5)) -> edges(graph_data)
p <- plot(graph_data)

if(generate_pngs) ggsave("pgfig6.png", p, device = "png", width= 9.5, height = 3)
knitr::include_graphics("pgfig6.png")

## ---- eval = FALSE------------------------------------------------------------
#  edg <- data.frame(from = "x",
#                    to = "y",
#                    label = "text",
#                    label_colour = "blue",
#                    label_fill = "red",
#                    label_size = 6,
#                    label_alpha = .5,
#                    label_family = "mono",
#                    label_fontface = "bold",
#                    label_hjust = "left",
#                    label_vjust = "top",
#                    label_lineheight = 1.5,
#                    label_location = .2
#                    )
#  
#  graph_sem(edges = edg, layout = get_layout("x", "y", rows = 1))

## ----echo = FALSE, warning = FALSE, message = FALSE, out.width='30%'----------
edg <- data.frame(from = "x",
                  to = "y",
                  label = "text",
                  label_colour = "blue",
                  label_fill = "red",
                  label_size = 6,
                  label_alpha = .5,
                  label_family = "mono",
                  label_fontface = "bold",
                  label_hjust = "left",
                  label_vjust = "top",
                  label_lineheight = 1.5,
                  label_location = .2
                  )

p = graph_sem(edges = edg, layout = get_layout("x", "y", rows = 1))

if(generate_pngs) ggsave("pgfig7.png", p, device = "png", width= 4, height = 1)
knitr::include_graphics("pgfig7.png")

## ---- eval = TRUE, echo = FALSE, warning = FALSE, message = FALSE, out.width='30%'----
fit <- sem("mpg ~ cyl
           mpg ~ am", data = mtcars, meanstructure = TRUE)
get_edges(fit)

## ---- eval = FALSE, out.width="300px"-----------------------------------------
#  set.seed(6)
#  prepare_graph(fit) %>%
#    color_pos_edges("green") %>%
#    plot()

## ---- echo = FALSE, out.width="300px"-----------------------------------------
set.seed(6)
prepare_graph(fit) %>%
  color_pos_edges("green") %>%
  plot() -> p
ggsave("pgfig8.png", p, device = "png", width= 4, height = 4)
knitr::include_graphics("pgfig8.png")

## ---- eval = FALSE------------------------------------------------------------
#  prepare_graph(fit) %>%
#    color_pos_edges("green") %>%
#    color_neg_edges("red") %>%
#    color_var("black") %>%
#    alpha_var(.2) %>%
#    plot()

## ---- echo = FALSE, out.width="300px"-----------------------------------------
set.seed(6)
prepare_graph(fit) %>%
  color_pos_edges("green") %>%
  color_neg_edges("red") %>%
  color_var("black") %>%
  alpha_var(.2) %>%
  plot() -> p
ggsave("pgfig9.png", p, device = "png", width= 4, height = 4)
knitr::include_graphics("pgfig9.png")

## ---- eval = FALSE------------------------------------------------------------
#  prepare_graph(fit) %>%
#    # Add color column to the graph elements
#    edit_graph({ color = "black" }) %>%
#    # Conditionally change color to blue when the column 'est' contains the number 4
#    if_edit(grepl("4", est), {color = "blue"}) %>%
#    plot()

## ---- echo = FALSE, out.width="300px"-----------------------------------------
set.seed(6)
prepare_graph(fit) %>%
  # Add color column to the graph elements
  edit_graph({ color = "black" }) %>% 
  # Conditionally change color to blue when the column 'est' contains the number 4
  if_edit(grepl("4", est), {color = "blue"}) %>%
  plot()->p
ggsave("pgfig10.png", p, device = "png", width= 4, height = 4)
knitr::include_graphics("pgfig10.png")