Commit ⋅ rich-iannone/DiagrammeR

    edge_attrs <- NA
  }


  # Replace NA values with empty strings in `nodes_df`
  if (!is.null(nodes_df)) {

    if (ncol(nodes_df) >= 4) {
      for (i in 4:ncol(nodes_df)) {
        nodes_df[, i] <-
          as.character(nodes_df[, i])
        nodes_df[, i] <-
          ifelse(is.na(nodes_df[, i]), "", nodes_df[, i])
      }

      nodes_df <-
        nodes_df %>%
        dplyr::mutate_at(
          .vars = base::setdiff(colnames(nodes_df), c("id", "type", "label")),
          .funs =  ~ tidyr::replace_na(., "")
        )
    }
  }


  # Replace NA values with empty strings in `edges_df`
  if (!is.null(edges_df)) {
    if (ncol(edges_df) >= 4) {
      for (i in 4:ncol(edges_df)) {
        edges_df[, i] <-
          ifelse(is.na(edges_df[, i]), "", edges_df[, i])
        edges_df[, i] <-
          as.character(edges_df[, i])
      }

    if (ncol(edges_df) >= 5) {

      edges_df <-
        edges_df %>%
        dplyr::mutate_at(
          .vars = base::setdiff(colnames(edges_df), c("id", "from", "to", "rel")),
          .funs =  ~ tidyr::replace_na(., "")
        )
    }
  }


@@ -177,9 +183,9 @@

      if (!is.na(edges_df[i, display_col]) ) {
        if (edges_df[i, display_col] != "") {

        edges_df[i, label_col] <-
          edges_df[
            i, which(colnames(edges_df) == edges_df[i, display_col])]
          edges_df[i, label_col] <-
            edges_df[
              i, which(colnames(edges_df) == edges_df[i, display_col])]
        }
      } else {
        edges_df[i, label_col] <- ""

@@ -275,7 +281,9 @@

                nodes_df[, column_with_x],
                ",",
                nodes_df[, column_with_y],
                "!"))
                "!"),
            stringsAsFactors = FALSE
          )

        nodes_df$pos <- pos$pos
      }

@@ -321,7 +329,7 @@

        color_attr_column_name <-
          unlist(strsplit(colnames(nodes_df)[
            (which(grepl("alpha:.*", colnames(nodes_df))))
            ], ":"))[-1]
          ], ":"))[-1]

        color_attr_column_no <-
          which(colnames(nodes_df) %in% color_attr_column_name)

@@ -445,28 +453,37 @@

                                   '}\n')
                     }
                     return(x)
                   }))
      }
                   })
          )

      } else if ('cluster' %in% colnames(nodes_df)) {

        cluster_vals <- nodes_df$cluster
        cluster_vals[cluster_vals == ""] <- NA_character_

        clustered_node_block <- character(0)
        clusters <- split(node_block, cluster_vals)

        for (i in seq_along(clusters)) {
          if (names(clusters)[[i]] == "") {
            # nodes not in clusters
            cluster_block <- clusters[[i]]
          } else {
            cluster_block <-
              paste0(
                "subgraph cluster", i, "{\nlabel='",
                names(clusters)[[i]], "'\n",
                paste0(clusters[[i]], collapse = "\n"), "}\n"
              )
          }

          clustered_node_block <- c(clustered_node_block, cluster_block)
        }

        node_block <- clustered_node_block

      else if ('cluster' %in% colnames(nodes_df)) {
	clustered_node_block <- character(0)
	clusters <- split(node_block, nodes_df$cluster)
	for (i in seq_along(clusters)) {
	  if (names(clusters)[[i]] == "") {
	    # nodes not in clusters
	    cluster_block <- clusters[[i]]
	  } else {
	    cluster_block <- paste0("subgraph cluster", i, "{\nlabel='",
	                            names(clusters)[[i]], "'\n",
	       			    paste0(clusters[[i]], collapse="\n"), "}\n")
	  }
	  clustered_node_block <- c(clustered_node_block, cluster_block)
	}

	node_block <- clustered_node_block

	# cleanup variables
	rm(clustered_node_block, clusters, cluster_block)
        # cleanup variables
        rm(clustered_node_block, clusters, cluster_block)
      }

      # Construct the `node_block` character object

@@ -430,57 +430,6 @@

      "  CACHE / ",
      cache_str)

  #
  # Create string for the dfs stored in the graph
  #

  # Get a count of all dfs stored in the graph
  if (is.null(x$df_storage)) {

    df_count <- 0

  } else {

    df_count <- length(x$df_storage)

    if (any(!is.na(get_df_ids(graph_df = x$nodes_df)))) {

      dfs_w_nodes <-
        get_df_ids(graph_df = x$nodes_df) %>%
        length()

    } else {

      dfs_w_nodes <- 0
    }

    if (any(!is.na(get_df_ids(graph_df = x$edges_df)))) {

      dfs_w_edges <-
        get_df_ids(graph_df = x$edges_df) %>%
        length()

    } else {

      dfs_w_edges <- 0
    }
  }

  if (df_count > 0) {
    stored_dfs_detail_str <-
      paste0(
        "  STORED DFs / ",
        df_count,
        ": ", dfs_w_nodes,
        " with nodes & ",
        dfs_w_edges,
        " with edges")
  } else {
    stored_dfs_detail_str <-
      paste0(
        "  STORED DFs / <none>")
  }

  #
  # Create string for global attributes
  #

@@ -566,7 +515,6 @@

  edge_detail_str_1_length <- nchar(edge_detail_str_1)
  selection_detail_str_length <- nchar(selection_detail_str)
  cache_detail_str_length <- nchar(cache_detail_str)
  stored_dfs_detail_str_length <- nchar(stored_dfs_detail_str)
  global_attrs_detail_str_length <- nchar(global_attrs_detail_str)

  info_labels_node_df_length <- nchar(info_labels["get_node_df"])[[1]]

@@ -642,22 +590,6 @@

        info_labels["get_cache"])
  }

  if (console_width - stored_dfs_detail_str_length - info_labels_attr_dfs_length >= 5 &
      !is.na(get_df_ids(graph_df = x$nodes_df))[1]) {

    stored_dfs_detail_str <-
      paste0(
        stored_dfs_detail_str,
        paste(
          rep(
            x = " ",
            times = (console_width -
                       stored_dfs_detail_str_length -
                       info_labels_attr_dfs_length)),
          collapse = ""),
        info_labels["get_attr_dfs"])
  }

  if (console_width -
      global_attrs_detail_str_length -
      info_labels_global_graph_attrs >= 5) {

@@ -690,10 +622,10 @@

      edge_detail_str_2, "\n",
      selection_detail_str, "\n",
      cache_detail_str, "\n",
      stored_dfs_detail_str, "\n",
      global_attrs_detail_str, "\n",
      graph_actions_detail_str, "\n",
      graph_history_detail_str, "\n")
      graph_history_detail_str, "\n"
    )

  cat(complete_stmt)
}

@@ -128,8 +128,7 @@

  # Generate a random 8-character, alphanumeric
  # string to use as a graph ID
  graph_id <-
    replicate(
      8, sample(c(LETTERS, letters, 0:9), 1)) %>%
    replicate(8, sample(c(LETTERS, letters, 0:9), 1)) %>%
    paste(collapse = "")

  # Create the `graph_info` data frame

@@ -141,7 +140,8 @@

      graph_tz = graph_tz,
      write_backups = write_backups,
      display_msgs = display_msgs,
      stringsAsFactors = FALSE)
      stringsAsFactors = FALSE
    )

  # Insert a user-defined `graph_name` if supplied
  if (!is.null(graph_name)) {

@@ -152,11 +152,12 @@


  # Create an empty table for global graph attributes
  global_attrs <-
    data.frame(
      attr = as.character(NA),
      value = as.character(NA),
      attr_type = as.character(NA),
      stringsAsFactors = FALSE)[-1, ]
    dplyr::tibble(
      attr = character(0),
      value = character(0),
      attr_type = character(0)
    ) %>%
    as.data.frame(stringsAsFactors = FALSE)

  # If `attr_theme` is `default` then populate the
  # `global_attrs` data frame with global graph attrs

@@ -174,46 +175,49 @@

        kk = attr_theme_kk(),
        emit_error(
          fcn_name = fcn_name,
          reasons = "The value for `attr_theme` doesn't refer to any available theme")
          reasons = "The value for `attr_theme` doesn't refer to any available theme"
        )
      )

  } else if (is.null(attr_theme)) {

    global_attrs <-
      data.frame(
        attr = as.character(NA),
        value = as.character(NA),
        attr_type = as.character(NA),
        stringsAsFactors = FALSE)[-1, ]
      dplyr::tibble(
        attr = character(0),
        value = character(0),
        attr_type = character(0)
      ) %>%
      as.data.frame(stringsAsFactors = FALSE)
  }

  ## DF: `nodes_df`

  # Create an empty node data frame (`ndf`)
  ndf <-
    data.frame(
      id = as.integer(NA),
      type = as.character(NA),
      label = as.character(NA),
      stringsAsFactors = FALSE)[-1, ]
    dplyr::tibble(
      id = integer(0),
      type = character(0),
      label = character(0)
    ) %>%
    as.data.frame(stringsAsFactors = FALSE)

  ## DF: `edges_df`

  # Create an empty edge data frame (`edf`)
  edf <-
    data.frame(
      id = as.integer(NA),
      from = as.integer(NA),
      to = as.integer(NA),
      rel = as.character(NA),
      stringsAsFactors = FALSE)[-1, ]
    dplyr::tibble(
      id = integer(0),
      from = integer(0),
      to = integer(0),
      rel = character(0)
    ) %>%
    as.data.frame(stringsAsFactors = FALSE)

  ## DF: `node_selection`

  # Create an empty node selection data frame (`nsdf`)
  nsdf <-
    dplyr::tibble(
      node = as.integer(NA))[-1, ] %>%
    dplyr::tibble(node = integer(0)) %>%
    as.data.frame(stringsAsFactors = FALSE)

  ## DF: `edge_selection`

@@ -221,35 +225,38 @@

  # Create an empty edge selection data frame (`esdf`)
  esdf <-
    dplyr::tibble(
      edge = as.integer(NA),
      from = as.integer(NA),
      to = as.integer(NA))[-1, ] %>%
      edge = integer(0),
      from = integer(0),
      to = integer(0)
    ) %>%
    as.data.frame(stringsAsFactors = FALSE)

  ## DF: `graph_actions`

  # Create an empty `graph_actions` data frame
  graph_actions <-
    data.frame(
      action_index = as.integer(NA),
      action_name = as.character(NA),
      expression = as.character(NA),
      stringsAsFactors = FALSE)[-1, ]
    dplyr::tibble(
      action_index = integer(0),
      action_name = character(0),
      expression = character(0)
    ) %>%
    as.data.frame(stringsAsFactors = FALSE)

  ## DF: `graph_log`

  # Create an empty `graph_log` data frame
  graph_log <-
    data.frame(
      version_id = as.integer(NA),
      function_used = as.character(NA),
    dplyr::tibble(
      version_id = integer(0),
      function_used = character(0),
      time_modified = graph_time,
      duration = as.numeric(NA),
      nodes = as.integer(NA),
      edges = as.integer(NA),
      d_n = as.integer(NA),
      d_e = as.integer(NA),
      stringsAsFactors = FALSE)[-1, ]
      duration = numeric(0),
      nodes = integer(0),
      edges = integer(0),
      d_n = integer(0),
      d_e = integer(0)
    ) %>%
    as.data.frame(stringsAsFactors = FALSE)

  ## list: `cache`


@@ -272,7 +279,8 @@

      edge_selection = esdf,
      cache = cache,
      graph_actions = graph_actions,
      graph_log = graph_log)
      graph_log = graph_log
    )

  attr(graph, "class") <- "dgr_graph"


@@ -291,7 +299,8 @@

        nodes = nrow(graph$nodes_df),
        edges = nrow(graph$edges_df),
        d_n = nrow(graph$nodes_df),
        d_e = nrow(graph$edges_df))
        d_e = nrow(graph$edges_df)
      )

  } else if (!is.null(nodes_df) & is.null(edges_df)) {


@@ -310,8 +319,7 @@

    }

    # Bind the nodes to the `nodes_df` df in the graph
    graph$nodes_df <-
      dplyr::bind_rows(graph$nodes_df, nodes_df)
    graph$nodes_df <- dplyr::bind_rows(graph$nodes_df, nodes_df)

    # Modify the `last_node` vector
    graph$last_node <- nrow(nodes_df)

@@ -327,7 +335,8 @@

        nodes = nrow(graph$nodes_df),
        edges = nrow(graph$edges_df),
        d_n = nrow(graph$nodes_df),
        d_e = nrow(graph$edges_df))
        d_e = nrow(graph$edges_df)
      )

  } else if (!is.null(nodes_df) & !is.null(edges_df)) {


@@ -344,6 +344,7 @@

      nodes %>%
      dplyr::right_join(ndf, by = "id") %>%
      dplyr::select(id, type, label, dplyr::everything()) %>%
      dplyr::arrange(id) %>%
      as.data.frame(stringsAsFactors = FALSE)

    # Get column numbers that end with ".x" or ".y"

@@ -42,15 +42,16 @@

    count_graphs_in_graph_series(graph_series)

  series_info_df <-
    data.frame(
      graph = as.integer(NA),
      name = as.character(NA),
    dplyr::tibble(
      graph = integer(0),
      name = character(0),
      date_time = Sys.time(),
      tz = as.character(NA),
      nodes = as.integer(NA),
      edges = as.integer(NA),
      directed = as.logical(NA),
      stringsAsFactors = FALSE)[-1, ]
      tz = character(0),
      nodes = integer(0),
      edges = integer(0),
      directed = logical(0)
    ) %>%
    as.data.frame(stringsAsFactors = FALSE)

  if (graphs_in_series == 0) {
    return(series_info_df)

@@ -26,22 +26,21 @@


    emit_error(
      fcn_name = fcn_name,
      reasons = "The graph object is not valid")
      reasons = "The graph object is not valid"
    )
  }

  if (nrow(graph$global_attrs) == 0) {

    global_graph_attrs_tbl <-
      dplyr::tibble(
        attr = NA_character_ ,
        value = NA_character_,
        attr_type = NA_character_)[-1, ]
        attr = character(0),
        value = character(0),
        attr_type = character(0)
      )

  } else if (nrow(graph$global_attrs) > 0) {

    global_graph_attrs_tbl <-
      graph$global_attrs %>%
      dplyr::as_tibble()
    global_graph_attrs_tbl <- dplyr::as_tibble(graph$global_attrs)
  }

  global_graph_attrs_tbl

@@ -147,13 +147,8 @@


  for (k in 1:node_group_count) {

    # Create table with position and node ID
    position_table <-
      dplyr::tibble(
        x = as.numeric(NA),
        y = as.numeric(NA))

    position_table <- position_table[-1, ]
    # Create empty table with position and node ID
    position_table <- dplyr::tibble(x = numeric(0), y = numeric(0))

    node_group <- names(nodes)[k]
    node_select <- nodes[[k]]

@@ -57,7 +57,7 @@

  }

  # Get a vector of node ID values from the graph
  nodes_in_graph <- graph$nodes_df[, 1]
  nodes_in_graph <- get_node_ids(graph)

  # Stop function if any nodes specified are not
  # in the graph

@@ -145,23 +145,11 @@

replace_graph_node_selection <- function(graph,
                                         replacement) {

  # Get the graph's `node_selection` df
  node_selection <- graph$node_selection

  # Remove objects in `graph$node_selection`
  node_selection <-
    node_selection %>%
    dplyr::as_tibble()

  node_selection <-
    node_selection[-seq(1, nrow(node_selection)), 1] %>%
    as.data.frame(stringsAsFactors = FALSE)

  # Add replacement to `graph$node_selection`
  node_selection %>%
    dplyr::bind_rows(
      dplyr::tibble(
        node = as.integer(replacement)))
  # Create a new table for the node selection
  dplyr::bind_rows(
    create_empty_nsdf(),
    dplyr::tibble(node = as.integer(replacement))
  )
}

#' Replace the `edge_selection` df with different edge ID values

@@ -172,32 +160,21 @@

                                         from_node,
                                         to_node) {

  # Get the graph's `edge_selection` df
  edge_selection <- graph$edge_selection

  # Remove objects in `graph$edge_selection`
  edge_selection <-
    edge_selection %>%
    dplyr::as_tibble()

  edge_selection <-
    edge_selection[-seq(1, nrow(edge_selection)), 1] %>%
    as.data.frame(stringsAsFactors = FALSE)

  # Add replacement to `graph$edge_selection`
  edge_selection %>%
    dplyr::bind_rows(
      dplyr::tibble(
        edge = as.integer(edge_id),
        from = as.integer(from_node),
        to = as.integer(to_node)))
  # Create a new table for the edge selection
  dplyr::bind_rows(
    create_empty_esdf(),
    dplyr::tibble(
      edge = as.integer(edge_id),
      from = as.integer(from_node),
      to = as.integer(to_node)
    )
  )
}

create_empty_nsdf <- function() {

  # Create empty `nsdf`
  dplyr::tibble(
    node = as.integer(NA))[-1, ] %>%
  dplyr::tibble(node = integer(0)) %>%
    as.data.frame(stringsAsFactors = FALSE)
}


@@ -205,9 +182,10 @@


  # Create empty `esdf`
  dplyr::tibble(
    edge = as.integer(NA),
    from = as.integer(NA),
    to = as.integer(NA))[-1, ] %>%
    edge = integer(0),
    from = integer(0),
    to = integer(0)
  ) %>%
    as.data.frame(stringsAsFactors = FALSE)
}


@@ -335,7 +335,8 @@

        dplyr::right_join(edf, c("id" = "to")) %>%
        dplyr::rename(to = id) %>%
        dplyr::rename(id = id.y) %>%
        dplyr::select(id, from, to, rel, dplyr::everything())
        dplyr::select(id, from, to, rel, dplyr::everything()) %>%
        dplyr::arrange(id)
    }

    # If node attribute exists as a column in the edf

@@ -343,8 +344,8 @@


      edges <-
        ndf_2 %>%
        dplyr::right_join(edf, c("id" = "to")) %>%
        dplyr::rename(to = id.y)
        dplyr::right_join(edf, by = c("id" = "to")) %>%
        dplyr::rename(to = id, id = id.y)

      # Get column numbers that end with ".x" or ".y"
      split_var_x_col <-

@@ -370,7 +371,8 @@

      # Reorder columns
      edges <-
        edges %>%
        dplyr::select(id, from, to, rel, dplyr::everything())
        dplyr::select(id, from, to, rel, dplyr::everything()) %>%
        dplyr::arrange(id)
    }

    # Update the graph's internal node data frame

@@ -141,12 +141,11 @@

      reasons = "The node attribute to rescale is not in the ndf")
  }

  # Get the column number for the node attr to rescale
  col_num_rescale <-
    which(colnames(nodes) %in% node_attr_from)

  # Extract the vector to rescale from the `nodes` df
  vector_to_rescale <- as.numeric(nodes[, col_num_rescale])
  vector_to_rescale <-
    nodes %>%
    dplyr::mutate_at(.vars = node_attr_from, .funs = ~as.numeric(.)) %>%
    dplyr::pull(var = !!node_attr_from)

  if ((!is.null(from_lower_bound) &
       is.null(from_upper_bound)) |

@@ -155,11 +154,7 @@

      (is.null(from_lower_bound) &
       is.null(from_upper_bound))) {

    from <-
      range(
        vector_to_rescale,
        na.rm = TRUE,
        finite = TRUE)
    from <- range(vector_to_rescale, na.rm = TRUE, finite = TRUE)

  } else {
    from <- c(from_lower_bound, from_upper_bound)

@@ -144,12 +144,11 @@

      reasons = "The edge attribute to rescale is not in the edf")
  }

  # Get the column number for the edge attr to rescale
  col_num_rescale <-
    which(colnames(edges) %in% edge_attr_from)

  # Extract the vector to rescale from the `edges` df
  vector_to_rescale <- as.numeric(edges[, col_num_rescale])
  vector_to_rescale <-
    edges %>%
    dplyr::mutate_at(.vars = edge_attr_from, .funs = ~as.numeric(.)) %>%
    dplyr::pull(var = !!edge_attr_from)

  if ((!is.null(from_lower_bound) &
       is.null(from_upper_bound)) |

@@ -158,11 +157,7 @@

      (is.null(from_lower_bound) &
       is.null(from_upper_bound))) {

    from <-
      range(
        vector_to_rescale,
        na.rm = TRUE,
        finite = TRUE)
    from <- range(vector_to_rescale, na.rm = TRUE, finite = TRUE)

  } else {
    from <- c(from_lower_bound, from_upper_bound)

Files		•	•	•	Coverage
R	13,838	11,204	0	2,634	80.97%
Project Totals (241 files)	13,838	11,204	0	2,634	80.97%

View CI Build Download

No yaml found.

Create your codecov.yml to customize your Codecov experience

Read the docs

Interact now

The inner-most circle is the entire project, moving away from the center are folders then, finally, a single file. The size and color of each slice is representing the number of statements and the coverage, respectively.

SVG

The top section represents the entire project. Proceeding with folders and finally individual files. The size and color of each slice is representing the number of statements and the coverage, respectively.

SVG

Each block represents a single file in the project. The size and color of each block is represented by the number of statements and the coverage, respectively.

SVG

Learn more about the coverage sunburst graph

97	97		edge_attrs <- NA
98	98		}
99	99
	100	+
100	101		# Replace NA values with empty strings in `nodes_df`
101	102		if (!is.null(nodes_df)) {
	103	+
102	104		if (ncol(nodes_df) >= 4) {
103		-	for (i in 4:ncol(nodes_df)) {
104		-	nodes_df[, i] <-
105		-	as.character(nodes_df[, i])
106		-	nodes_df[, i] <-
107		-	ifelse(is.na(nodes_df[, i]), "", nodes_df[, i])
108		-	}
	105	+
	106	+	nodes_df <-
	107	+	nodes_df %>%
	108	+	dplyr::mutate_at(
	109	+	.vars = base::setdiff(colnames(nodes_df), c("id", "type", "label")),
	110	+	.funs = ~ tidyr::replace_na(., "")
	111	+	)
109	112		}
110	113		}
111	114
	115	+
112	116		# Replace NA values with empty strings in `edges_df`
113	117		if (!is.null(edges_df)) {
114		-	if (ncol(edges_df) >= 4) {
115		-	for (i in 4:ncol(edges_df)) {
116		-	edges_df[, i] <-
117		-	ifelse(is.na(edges_df[, i]), "", edges_df[, i])
118		-	edges_df[, i] <-
119		-	as.character(edges_df[, i])
120		-	}
	118	+
	119	+	if (ncol(edges_df) >= 5) {
	120	+
	121	+	edges_df <-
	122	+	edges_df %>%
	123	+	dplyr::mutate_at(
	124	+	.vars = base::setdiff(colnames(edges_df), c("id", "from", "to", "rel")),
	125	+	.funs = ~ tidyr::replace_na(., "")
	126	+	)
121	127		}
122	128		}
123	129

275	281		nodes_df[, column_with_x],
276	282		",",
277	283		nodes_df[, column_with_y],
278		-	"!"))
	284	+	"!"),
	285	+	stringsAsFactors = FALSE
	286	+	)
279	287
280	288		nodes_df$pos <- pos$pos
281	289		}

445	453		'}\n')
446	454		}
447	455		return(x)
448		-	}))
449		-	}
	456	+	})
	457	+	)
	458	+
	459	+	} else if ('cluster' %in% colnames(nodes_df)) {
	460	+
	461	+	cluster_vals <- nodes_df$cluster
	462	+	cluster_vals[cluster_vals == ""] <- NA_character_
	463	+
	464	+	clustered_node_block <- character(0)
	465	+	clusters <- split(node_block, cluster_vals)
	466	+
	467	+	for (i in seq_along(clusters)) {
	468	+	if (names(clusters)[[i]] == "") {
	469	+	# nodes not in clusters
	470	+	cluster_block <- clusters[[i]]
	471	+	} else {
	472	+	cluster_block <-
	473	+	paste0(
	474	+	"subgraph cluster", i, "{\nlabel='",
	475	+	names(clusters)[[i]], "'\n",
	476	+	paste0(clusters[[i]], collapse = "\n"), "}\n"
	477	+	)
	478	+	}
	479	+
	480	+	clustered_node_block <- c(clustered_node_block, cluster_block)
	481	+	}
	482	+
	483	+	node_block <- clustered_node_block
450	484
451		-	else if ('cluster' %in% colnames(nodes_df)) {
452		-	clustered_node_block <- character(0)
453		-	clusters <- split(node_block, nodes_df$cluster)
454		-	for (i in seq_along(clusters)) {
455		-	if (names(clusters)[[i]] == "") {
456		-	# nodes not in clusters
457		-	cluster_block <- clusters[[i]]
458		-	} else {
459		-	cluster_block <- paste0("subgraph cluster", i, "{\nlabel='",
460		-	names(clusters)[[i]], "'\n",
461		-	paste0(clusters[[i]], collapse="\n"), "}\n")
462		-	}
463		-	clustered_node_block <- c(clustered_node_block, cluster_block)
464		-	}
465		-
466		-	node_block <- clustered_node_block
467		-
468		-	# cleanup variables
469		-	rm(clustered_node_block, clusters, cluster_block)
	485	+	# cleanup variables
	486	+	rm(clustered_node_block, clusters, cluster_block)
470	487		}
471	488
472	489		# Construct the `node_block` character object

430	430		" CACHE / ",
431	431		cache_str)
432	432
433		-	#
434		-	# Create string for the dfs stored in the graph
435		-	#
436		-
437		-	# Get a count of all dfs stored in the graph
438		-	if (is.null(x$df_storage)) {
439		-
440		-	df_count <- 0
441		-
442		-	} else {
443		-
444		-	df_count <- length(x$df_storage)
445		-
446		-	if (any(!is.na(get_df_ids(graph_df = x$nodes_df)))) {
447		-
448		-	dfs_w_nodes <-
449		-	get_df_ids(graph_df = x$nodes_df) %>%
450		-	length()
451		-
452		-	} else {
453		-
454		-	dfs_w_nodes <- 0
455		-	}
456		-
457		-	if (any(!is.na(get_df_ids(graph_df = x$edges_df)))) {
458		-
459		-	dfs_w_edges <-
460		-	get_df_ids(graph_df = x$edges_df) %>%
461		-	length()
462		-
463		-	} else {
464		-
465		-	dfs_w_edges <- 0
466		-	}
467		-	}
468		-
469		-	if (df_count > 0) {
470		-	stored_dfs_detail_str <-
471		-	paste0(
472		-	" STORED DFs / ",
473		-	df_count,
474		-	": ", dfs_w_nodes,
475		-	" with nodes & ",
476		-	dfs_w_edges,
477		-	" with edges")
478		-	} else {
479		-	stored_dfs_detail_str <-
480		-	paste0(
481		-	" STORED DFs / <none>")
482		-	}
483		-
484	433		#
485	434		# Create string for global attributes
486	435		#

566	515		edge_detail_str_1_length <- nchar(edge_detail_str_1)
567	516		selection_detail_str_length <- nchar(selection_detail_str)
568	517		cache_detail_str_length <- nchar(cache_detail_str)
569		-	stored_dfs_detail_str_length <- nchar(stored_dfs_detail_str)
570	518		global_attrs_detail_str_length <- nchar(global_attrs_detail_str)
571	519
572	520		info_labels_node_df_length <- nchar(info_labels["get_node_df"])[[1]]

177	183		if (!is.na(edges_df[i, display_col]) ) {
178	184		if (edges_df[i, display_col] != "") {
179	185
180		-	edges_df[i, label_col] <-
181		-	edges_df[
182		-	i, which(colnames(edges_df) == edges_df[i, display_col])]
	186	+	edges_df[i, label_col] <-
	187	+	edges_df[
	188	+	i, which(colnames(edges_df) == edges_df[i, display_col])]
183	189		}
184	190		} else {
185	191		edges_df[i, label_col] <- ""

321	329		color_attr_column_name <-
322	330		unlist(strsplit(colnames(nodes_df)[
323	331		(which(grepl("alpha:.*", colnames(nodes_df))))
324		-	], ":"))[-1]
	332	+	], ":"))[-1]
325	333
326	334		color_attr_column_no <-
327	335		which(colnames(nodes_df) %in% color_attr_column_name)

642	590		info_labels["get_cache"])
643	591		}
644	592
645		-	if (console_width - stored_dfs_detail_str_length - info_labels_attr_dfs_length >= 5 &
646		-	!is.na(get_df_ids(graph_df = x$nodes_df))[1]) {
647		-
648		-	stored_dfs_detail_str <-
649		-	paste0(
650		-	stored_dfs_detail_str,
651		-	paste(
652		-	rep(
653		-	x = " ",
654		-	times = (console_width -
655		-	stored_dfs_detail_str_length -
656		-	info_labels_attr_dfs_length)),
657		-	collapse = ""),
658		-	info_labels["get_attr_dfs"])
659		-	}
660		-
661	593		if (console_width -
662	594		global_attrs_detail_str_length -
663	595		info_labels_global_graph_attrs >= 5) {

690	622		edge_detail_str_2, "\n",
691	623		selection_detail_str, "\n",
692	624		cache_detail_str, "\n",
693		-	stored_dfs_detail_str, "\n",
694	625		global_attrs_detail_str, "\n",
695	626		graph_actions_detail_str, "\n",
696		-	graph_history_detail_str, "\n")
	627	+	graph_history_detail_str, "\n"
	628	+	)
697	629
698	630		cat(complete_stmt)
699	631		}

128	128		# Generate a random 8-character, alphanumeric
129	129		# string to use as a graph ID
130	130		graph_id <-
131		-	replicate(
132		-	8, sample(c(LETTERS, letters, 0:9), 1)) %>%
	131	+	replicate(8, sample(c(LETTERS, letters, 0:9), 1)) %>%
133	132		paste(collapse = "")
134	133
135	134		# Create the `graph_info` data frame

141	140		graph_tz = graph_tz,
142	141		write_backups = write_backups,
143	142		display_msgs = display_msgs,
144		-	stringsAsFactors = FALSE)
	143	+	stringsAsFactors = FALSE
	144	+	)
145	145
146	146		# Insert a user-defined `graph_name` if supplied
147	147		if (!is.null(graph_name)) {

152	152
153	153		# Create an empty table for global graph attributes
154	154		global_attrs <-
155		-	data.frame(
156		-	attr = as.character(NA),
157		-	value = as.character(NA),
158		-	attr_type = as.character(NA),
159		-	stringsAsFactors = FALSE)[-1, ]
	155	+	dplyr::tibble(
	156	+	attr = character(0),
	157	+	value = character(0),
	158	+	attr_type = character(0)
	159	+	) %>%
	160	+	as.data.frame(stringsAsFactors = FALSE)
160	161
161	162		# If `attr_theme` is `default` then populate the
162	163		# `global_attrs` data frame with global graph attrs

174	175		kk = attr_theme_kk(),
175	176		emit_error(
176	177		fcn_name = fcn_name,
177		-	reasons = "The value for `attr_theme` doesn't refer to any available theme")
	178	+	reasons = "The value for `attr_theme` doesn't refer to any available theme"
	179	+	)
178	180		)
179	181
180	182		} else if (is.null(attr_theme)) {
181	183
182	184		global_attrs <-
183		-	data.frame(
184		-	attr = as.character(NA),
185		-	value = as.character(NA),
186		-	attr_type = as.character(NA),
187		-	stringsAsFactors = FALSE)[-1, ]
	185	+	dplyr::tibble(
	186	+	attr = character(0),
	187	+	value = character(0),
	188	+	attr_type = character(0)
	189	+	) %>%
	190	+	as.data.frame(stringsAsFactors = FALSE)
188	191		}
189	192
190	193		## DF: `nodes_df`
191	194
192	195		# Create an empty node data frame (`ndf`)
193	196		ndf <-
194		-	data.frame(
195		-	id = as.integer(NA),
196		-	type = as.character(NA),
197		-	label = as.character(NA),
198		-	stringsAsFactors = FALSE)[-1, ]
	197	+	dplyr::tibble(
	198	+	id = integer(0),
	199	+	type = character(0),
	200	+	label = character(0)
	201	+	) %>%
	202	+	as.data.frame(stringsAsFactors = FALSE)
199	203
200	204		## DF: `edges_df`
201	205
202	206		# Create an empty edge data frame (`edf`)
203	207		edf <-
204		-	data.frame(
205		-	id = as.integer(NA),
206		-	from = as.integer(NA),
207		-	to = as.integer(NA),
208		-	rel = as.character(NA),
209		-	stringsAsFactors = FALSE)[-1, ]
	208	+	dplyr::tibble(
	209	+	id = integer(0),
	210	+	from = integer(0),
	211	+	to = integer(0),
	212	+	rel = character(0)
	213	+	) %>%
	214	+	as.data.frame(stringsAsFactors = FALSE)
210	215
211	216		## DF: `node_selection`
212	217
213	218		# Create an empty node selection data frame (`nsdf`)
214	219		nsdf <-
215		-	dplyr::tibble(
216		-	node = as.integer(NA))[-1, ] %>%
	220	+	dplyr::tibble(node = integer(0)) %>%
217	221		as.data.frame(stringsAsFactors = FALSE)
218	222
219	223		## DF: `edge_selection`

221	225		# Create an empty edge selection data frame (`esdf`)
222	226		esdf <-
223	227		dplyr::tibble(
224		-	edge = as.integer(NA),
225		-	from = as.integer(NA),
226		-	to = as.integer(NA))[-1, ] %>%
	228	+	edge = integer(0),
	229	+	from = integer(0),
	230	+	to = integer(0)
	231	+	) %>%
227	232		as.data.frame(stringsAsFactors = FALSE)
228	233
229	234		## DF: `graph_actions`
230	235
231	236		# Create an empty `graph_actions` data frame
232	237		graph_actions <-
233		-	data.frame(
234		-	action_index = as.integer(NA),
235		-	action_name = as.character(NA),
236		-	expression = as.character(NA),
237		-	stringsAsFactors = FALSE)[-1, ]
	238	+	dplyr::tibble(
	239	+	action_index = integer(0),
	240	+	action_name = character(0),
	241	+	expression = character(0)
	242	+	) %>%
	243	+	as.data.frame(stringsAsFactors = FALSE)
238	244
239	245		## DF: `graph_log`
240	246
241	247		# Create an empty `graph_log` data frame
242	248		graph_log <-
243		-	data.frame(
244		-	version_id = as.integer(NA),
245		-	function_used = as.character(NA),
	249	+	dplyr::tibble(
	250	+	version_id = integer(0),
	251	+	function_used = character(0),
246	252		time_modified = graph_time,
247		-	duration = as.numeric(NA),
248		-	nodes = as.integer(NA),
249		-	edges = as.integer(NA),
250		-	d_n = as.integer(NA),
251		-	d_e = as.integer(NA),
252		-	stringsAsFactors = FALSE)[-1, ]
	253	+	duration = numeric(0),
	254	+	nodes = integer(0),
	255	+	edges = integer(0),
	256	+	d_n = integer(0),
	257	+	d_e = integer(0)
	258	+	) %>%
	259	+	as.data.frame(stringsAsFactors = FALSE)
253	260
254	261		## list: `cache`
255	262

272	279		edge_selection = esdf,
273	280		cache = cache,
274	281		graph_actions = graph_actions,
275		-	graph_log = graph_log)
	282	+	graph_log = graph_log
	283	+	)
276	284
277	285		attr(graph, "class") <- "dgr_graph"
278	286

291	299		nodes = nrow(graph$nodes_df),
292	300		edges = nrow(graph$edges_df),
293	301		d_n = nrow(graph$nodes_df),
294		-	d_e = nrow(graph$edges_df))
	302	+	d_e = nrow(graph$edges_df)
	303	+	)
295	304
296	305		} else if (!is.null(nodes_df) & is.null(edges_df)) {
297	306

Navigation	Overlay
`t` Navigate files	`h` Toggle hits
`y` Change url to tip of branch	`m` Toggle misses
`b / v` Jump to prev/next hit line	`p` Toggle partial
`z / x` Jump to prev/next missed or partial line	`1..9` Toggle flags
`shift + o` Open current page in GitHub	`a` Toggle all on
`/ or ?` Show keyboard shortcuts dialog	`c` Toggle context lines or commits

310	319		}
311	320
312	321		# Bind the nodes to the `nodes_df` df in the graph
313		-	graph$nodes_df <-
314		-	dplyr::bind_rows(graph$nodes_df, nodes_df)
	322	+	graph$nodes_df <- dplyr::bind_rows(graph$nodes_df, nodes_df)
315	323
316	324		# Modify the `last_node` vector
317	325		graph$last_node <- nrow(nodes_df)

344	344		nodes %>%
345	345		dplyr::right_join(ndf, by = "id") %>%
346	346		dplyr::select(id, type, label, dplyr::everything()) %>%
	347	+	dplyr::arrange(id) %>%
347	348		as.data.frame(stringsAsFactors = FALSE)
348	349
349	350		# Get column numbers that end with ".x" or ".y"

42	42		count_graphs_in_graph_series(graph_series)
43	43
44	44		series_info_df <-
45		-	data.frame(
46		-	graph = as.integer(NA),
47		-	name = as.character(NA),
	45	+	dplyr::tibble(
	46	+	graph = integer(0),
	47	+	name = character(0),
48	48		date_time = Sys.time(),
49		-	tz = as.character(NA),
50		-	nodes = as.integer(NA),
51		-	edges = as.integer(NA),
52		-	directed = as.logical(NA),
53		-	stringsAsFactors = FALSE)[-1, ]
	49	+	tz = character(0),
	50	+	nodes = integer(0),
	51	+	edges = integer(0),
	52	+	directed = logical(0)
	53	+	) %>%
	54	+	as.data.frame(stringsAsFactors = FALSE)
54	55
55	56		if (graphs_in_series == 0) {
56	57		return(series_info_df)

26	26
27	27		emit_error(
28	28		fcn_name = fcn_name,
29		-	reasons = "The graph object is not valid")
	29	+	reasons = "The graph object is not valid"
	30	+	)
30	31		}
31	32
32	33		if (nrow(graph$global_attrs) == 0) {
33	34
34	35		global_graph_attrs_tbl <-
35	36		dplyr::tibble(
36		-	attr = NA_character_ ,
37		-	value = NA_character_,
38		-	attr_type = NA_character_)[-1, ]
	37	+	attr = character(0),
	38	+	value = character(0),
	39	+	attr_type = character(0)
	40	+	)
39	41
40	42		} else if (nrow(graph$global_attrs) > 0) {
41		-
42		-	global_graph_attrs_tbl <-
43		-	graph$global_attrs %>%
44		-	dplyr::as_tibble()
	43	+	global_graph_attrs_tbl <- dplyr::as_tibble(graph$global_attrs)
45	44		}
46	45
47	46		global_graph_attrs_tbl

147	147
148	148		for (k in 1:node_group_count) {
149	149
150		-	# Create table with position and node ID
151		-	position_table <-
152		-	dplyr::tibble(
153		-	x = as.numeric(NA),
154		-	y = as.numeric(NA))
155		-
156		-	position_table <- position_table[-1, ]
	150	+	# Create empty table with position and node ID
	151	+	position_table <- dplyr::tibble(x = numeric(0), y = numeric(0))
157	152
158	153		node_group <- names(nodes)[k]
159	154		node_select <- nodes[[k]]

57	57		}
58	58
59	59		# Get a vector of node ID values from the graph
60		-	nodes_in_graph <- graph$nodes_df[, 1]
	60	+	nodes_in_graph <- get_node_ids(graph)
61	61
62	62		# Stop function if any nodes specified are not
63	63		# in the graph

145	145		replace_graph_node_selection <- function(graph,
146	146		replacement) {
147	147
148		-	# Get the graph's `node_selection` df
149		-	node_selection <- graph$node_selection
150		-
151		-	# Remove objects in `graph$node_selection`
152		-	node_selection <-
153		-	node_selection %>%
154		-	dplyr::as_tibble()
155		-
156		-	node_selection <-
157		-	node_selection[-seq(1, nrow(node_selection)), 1] %>%
158		-	as.data.frame(stringsAsFactors = FALSE)
159		-
160		-	# Add replacement to `graph$node_selection`
161		-	node_selection %>%
162		-	dplyr::bind_rows(
163		-	dplyr::tibble(
164		-	node = as.integer(replacement)))
	148	+	# Create a new table for the node selection
	149	+	dplyr::bind_rows(
	150	+	create_empty_nsdf(),
	151	+	dplyr::tibble(node = as.integer(replacement))
	152	+	)
165	153		}
166	154
167	155		#' Replace the `edge_selection` df with different edge ID values

172	160		from_node,
173	161		to_node) {
174	162
175		-	# Get the graph's `edge_selection` df
176		-	edge_selection <- graph$edge_selection
177		-
178		-	# Remove objects in `graph$edge_selection`
179		-	edge_selection <-
180		-	edge_selection %>%
181		-	dplyr::as_tibble()
182		-
183		-	edge_selection <-
184		-	edge_selection[-seq(1, nrow(edge_selection)), 1] %>%
185		-	as.data.frame(stringsAsFactors = FALSE)
186		-
187		-	# Add replacement to `graph$edge_selection`
188		-	edge_selection %>%
189		-	dplyr::bind_rows(
190		-	dplyr::tibble(
191		-	edge = as.integer(edge_id),
192		-	from = as.integer(from_node),
193		-	to = as.integer(to_node)))
	163	+	# Create a new table for the edge selection
	164	+	dplyr::bind_rows(
	165	+	create_empty_esdf(),
	166	+	dplyr::tibble(
	167	+	edge = as.integer(edge_id),
	168	+	from = as.integer(from_node),
	169	+	to = as.integer(to_node)
	170	+	)
	171	+	)
194	172		}
195	173
196	174		create_empty_nsdf <- function() {
197	175
198	176		# Create empty `nsdf`
199		-	dplyr::tibble(
200		-	node = as.integer(NA))[-1, ] %>%
	177	+	dplyr::tibble(node = integer(0)) %>%
201	178		as.data.frame(stringsAsFactors = FALSE)
202	179		}
203	180

205	182
206	183		# Create empty `esdf`
207	184		dplyr::tibble(
208		-	edge = as.integer(NA),
209		-	from = as.integer(NA),
210		-	to = as.integer(NA))[-1, ] %>%
	185	+	edge = integer(0),
	186	+	from = integer(0),
	187	+	to = integer(0)
	188	+	) %>%
211	189		as.data.frame(stringsAsFactors = FALSE)
212	190		}
213	191

335	335		dplyr::right_join(edf, c("id" = "to")) %>%
336	336		dplyr::rename(to = id) %>%
337	337		dplyr::rename(id = id.y) %>%
338		-	dplyr::select(id, from, to, rel, dplyr::everything())
	338	+	dplyr::select(id, from, to, rel, dplyr::everything()) %>%
	339	+	dplyr::arrange(id)
339	340		}
340	341
341	342		# If node attribute exists as a column in the edf

Updating our web app

No yaml found.

343	344
344	345		edges <-
345	346		ndf_2 %>%
346		-	dplyr::right_join(edf, c("id" = "to")) %>%
347		-	dplyr::rename(to = id.y)
	347	+	dplyr::right_join(edf, by = c("id" = "to")) %>%
	348	+	dplyr::rename(to = id, id = id.y)
348	349
349	350		# Get column numbers that end with ".x" or ".y"
350	351		split_var_x_col <-

370	371		# Reorder columns
371	372		edges <-
372	373		edges %>%
373		-	dplyr::select(id, from, to, rel, dplyr::everything())
	374	+	dplyr::select(id, from, to, rel, dplyr::everything()) %>%
	375	+	dplyr::arrange(id)
374	376		}
375	377
376	378		# Update the graph's internal node data frame

141	141		reasons = "The node attribute to rescale is not in the ndf")
142	142		}
143	143
144		-	# Get the column number for the node attr to rescale
145		-	col_num_rescale <-
146		-	which(colnames(nodes) %in% node_attr_from)
147		-
148	144		# Extract the vector to rescale from the `nodes` df
149		-	vector_to_rescale <- as.numeric(nodes[, col_num_rescale])
	145	+	vector_to_rescale <-
	146	+	nodes %>%
	147	+	dplyr::mutate_at(.vars = node_attr_from, .funs = ~as.numeric(.)) %>%
	148	+	dplyr::pull(var = !!node_attr_from)
150	149
151	150		if ((!is.null(from_lower_bound) &
152	151		is.null(from_upper_bound)) \|

155	154		(is.null(from_lower_bound) &
156	155		is.null(from_upper_bound))) {
157	156
158		-	from <-
159		-	range(
160		-	vector_to_rescale,
161		-	na.rm = TRUE,
162		-	finite = TRUE)
	157	+	from <- range(vector_to_rescale, na.rm = TRUE, finite = TRUE)
163	158
164	159		} else {
165	160		from <- c(from_lower_bound, from_upper_bound)

144	144		reasons = "The edge attribute to rescale is not in the edf")
145	145		}
146	146
147		-	# Get the column number for the edge attr to rescale
148		-	col_num_rescale <-
149		-	which(colnames(edges) %in% edge_attr_from)
150		-
151	147		# Extract the vector to rescale from the `edges` df
152		-	vector_to_rescale <- as.numeric(edges[, col_num_rescale])
	148	+	vector_to_rescale <-
	149	+	edges %>%
	150	+	dplyr::mutate_at(.vars = edge_attr_from, .funs = ~as.numeric(.)) %>%
	151	+	dplyr::pull(var = !!edge_attr_from)
153	152
154	153		if ((!is.null(from_lower_bound) &
155	154		is.null(from_upper_bound)) \|