Skip to contents

Example: Edge Table

edge_table <- tribble(
  ~from,          ~to,             ~label,
  "Individual",   "Organization",  "Reassigns Benefits To",
  "Organization", "Individual",    "Accepts Reassignment From")

edge_table
#> # A tibble: 2 × 3
#>   from         to           label                    
#>   <chr>        <chr>        <chr>                    
#> 1 Individual   Organization Reassigns Benefits To    
#> 2 Organization Individual   Accepts Reassignment From

Example: Node Table

node_table <- tribble(
  ~name,            ~x,  ~y,
  "Individual",     1,    0,
  "Organization",   2,    0)

node_table
#> # A tibble: 2 × 3
#>   name             x     y
#>   <chr>        <dbl> <dbl>
#> 1 Individual       1     0
#> 2 Organization     2     0
example <- graph_from_data_frame(
  d = edge_table,
  vertices = node_table,
  directed = T)

example
#> IGRAPH 8d902cf DN-- 2 2 -- 
#> + attr: name (v/c), x (v/n), y (v/n), label (e/c)
#> + edges from 8d902cf (vertex names):
#> [1] Individual  ->Organization Organization->Individual
ggraph(example, layout = "manual", x = x, y = y) +
  geom_node_text(aes(label = name), size = 5) +
  geom_edge_arc(
    aes(label = label), 
                   angle_calc = 'none',
                   label_dodge = unit(2, 'lines'),
                   arrow = arrow(length = unit(0.5, 'lines')), 
                   start_cap = circle(4, 'lines'),
                   end_cap = circle(4, 'lines'),
    strength = 1) +
  theme_void() +
  coord_fixed()

Provider Networks

williams <- provider:::georgia_reassignments() |>
  filter(npi          == "1346391299") |> 
  mutate(provider     = str_glue("{first} {last}"),
         #provider     = str_to_title(provider),
         organization = str_to_title(organization),
         organization = str_remove_all(organization, 
                        regex("Llc|Inc| Pc|-|,+|\\.")),
         organization = str_squish(organization)) |> 
  select(provider, organization, reassignments) |> 
  arrange(desc(reassignments))
williams
#> # A tibble: 38 × 3
#>    provider          organization                                  reassignments
#>    <glue>            <chr>                                                 <int>
#>  1 JONATHAN WILLIAMS Emergency Coverage Corp                                 257
#>  2 JONATHAN WILLIAMS Southland Bainbridge Hospitalist Group                  212
#>  3 JONATHAN WILLIAMS Crisp Regional Hospital                                 200
#>  4 JONATHAN WILLIAMS Phoebe Putney Memorial Hospital                         184
#>  5 JONATHAN WILLIAMS Southland Emergency Medical Services Consoli…           137
#>  6 JONATHAN WILLIAMS Union County Hospital Authority                         117
#>  7 JONATHAN WILLIAMS Clinch County Hospital Authority                        104
#>  8 JONATHAN WILLIAMS Sgmp Southland                                          102
#>  9 JONATHAN WILLIAMS Southland Consolidated Emergency Services                75
#> 10 JONATHAN WILLIAMS Southland Emergency Medical Services                     74
#> # ℹ 28 more rows



{tidygraph}

will_tdgrph <- tidygraph::as_tbl_graph(williams, directed = FALSE)

summary(will_tdgrph)
#> IGRAPH 5decc7e UN-- 39 38 -- 
#> + attr: name (v/c), reassignments (e/n)
will_tdgrph
#> # A tbl_graph: 39 nodes and 38 edges
#> #
#> # An unrooted tree
#> #
#> # Node Data: 39 × 1 (active)
#>    name                                             
#>    <chr>                                            
#>  1 JONATHAN WILLIAMS                                
#>  2 Emergency Coverage Corp                          
#>  3 Southland Bainbridge Hospitalist Group           
#>  4 Crisp Regional Hospital                          
#>  5 Phoebe Putney Memorial Hospital                  
#>  6 Southland Emergency Medical Services Consolidated
#>  7 Union County Hospital Authority                  
#>  8 Clinch County Hospital Authority                 
#>  9 Sgmp Southland                                   
#> 10 Southland Consolidated Emergency Services        
#> # ℹ 29 more rows
#> #
#> # Edge Data: 38 × 3
#>    from    to reassignments
#>   <int> <int>         <int>
#> 1     1     2           257
#> 2     1     3           212
#> 3     1     4           200
#> # ℹ 35 more rows



ggraph(will_tdgrph, "stress") + 
  geom_edge_link(end_cap = circle(0.5, 'mm'), 
                 edge.width = 0.5, color = "grey") +
  geom_node_point(show.legend = FALSE, 
                  alpha = 1, 
                  color = 'steelblue',
                  size = 2.5) + 
  geom_node_label(aes(label = name),
                 repel = FALSE,
                 size = 3,
                 alpha = 0.85,
                 label.r = unit(0.25, "lines"),
                 label.size = 0.1,
                 check_overlap = TRUE) +
  theme_graph(fg_text_colour = 'white')

# individuals <- southland |>
#   filter(associations > 5) |> 
#   distinct(npi_ind, .keep_all = TRUE) |> 
#   pull(npi_ind) |>
#   map_dfr(~reassignments(npi = .x)) |> 
#   mutate(individual = str_glue("{first} {last}")) |> 
#   select(individual,
#          organization, 
#          associations,
#          entry, 
#          reassignments_org = reassignments, 
#          pac_org, 
#          enid_org, 
#          npi_ind = npi, 
#          pac_ind = pac, 
#          enid_ind = enid) |> 
#   filter(organization != "SGMP SOUTHLAND LLC")
# 
# individuals
x <- c(1, 0.9871, 0.9485, 0.8855, 0.7994, 0.6927, 0.5681, 0.4287, 0.2782, 0.1205,
    -0.0403, -0.2, -0.3546, -0.5, -0.6324, -0.7485, -0.8452, -0.92, -0.9709, -0.9968,
    -0.9968, -0.9709, -0.92, -0.8452, -0.7485, -0.6324, -0.5, -0.3546, -0.2, -0.0403,
    0.1205, 0.2782, 0.4287, 0.5681, 0.6927, 0.7994, 0.8855, 0.9485, 0.9871)
y <- c(0, 0.1604, 0.3167, 0.4647, 0.6007, 0.7212, 0.823, 0.9035, 0.9605, 0.9927,
    0.9992, 0.9798, 0.935, 0.866, 0.7746, 0.6631, 0.5345, 0.392, 0.2393, 0.0805,
    -0.0805, -0.2393, -0.392, -0.5345, -0.6631, -0.7746, -0.866, -0.935, -0.9798,
    -0.9992, -0.9927, -0.9605, -0.9035, -0.823, -0.7212, -0.6007, -0.4647, -0.3167,
    -0.1604)

ggraph(will_tdgrph, layout = "manual", x = x, y = y) + 
    geom_edge_link0(aes(alpha = reassignments, width = reassignments, colour = reassignments)) + 
    scale_edge_colour_gradient(low = "#AEDDFC", high = "#27408B") + 
    scale_edge_width(range = c(0.2, 2)) + 
    scale_edge_alpha(range = c(0.1, 1)) + 
    geom_node_point(aes(fill = degree, size = degree), colour = "#9F94F2", shape = 21, stroke = 3) + 
    scale_fill_gradient(low = "#87CEFF", high = "#27408B") + 
  scale_size(range = c(1, 5)) + 
  geom_node_text(aes(label = name), colour = "#0F0909", size = 4, family = "Helvetica") + 
  theme_graph()
#> Error in `geom_node_point()`:
#> ! Problem while computing aesthetics.
#>  Error occurred in the 2nd layer.
#> Caused by error in `compute_aesthetics()`:
#> ! Aesthetics are not valid data columns.
#>  The following aesthetics are invalid:
#>  `fill = NULL`
#>  `size = NULL`
#>  Did you mistype the name of a data column or forget to add `after_stat()`?