Skip to content

Commit ffdc248

Browse files
lilyclementslilyclements
committed
2 parents 90e4597 + f41fc12 commit ffdc248

File tree

7 files changed

+416
-68
lines changed

7 files changed

+416
-68
lines changed

‎NAMESPACE

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,4 +2,7 @@
22

33
export("%>%")
44
export(map_data)
5+
export(individuals_by)
6+
export(initiative_by)
7+
export(replace_other)
58
importFrom(magrittr,"%>%")

‎R/individuals_by.R

Lines changed: 197 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,197 @@
1+
#' "individuals_by"
2+
#'
3+
#' @description individuals_by function creates a force-directed network visualization using the forceNetwork function from the networkD3 package.
4+
#'
5+
#' @param individual_data The data frame containing the individual-level data. By default, it assumes a data frame called `individuals`.
6+
#' @param ind_id The variable/column in the `individual_data` data frame that represents the individual identifier. By default, it assumes a column named "nom".
7+
#' @param group The variable/column in the `individual_data` data frame that represents the grouping variable. It is used to assign colors to the nodes in the visualization. If not provided, the visualization will not group the nodes.
8+
#' @param group_other is a string representing the name of the column in the "individual_data" data block that contains additional group information for each individual.
9+
#' @param group_other_name is a string representing a custom name for the "group_other" column to display in the plot.
10+
#' @param font_size numeric font size in pixels for the node text labels.By default, it is set to 7.
11+
#' @param height numeric height for the network graph's frame area in pixels.
12+
#' @param width numeric width for the network graph's frame area in pixels.
13+
#' @param colour_scale character string specifying the categorical colour scale for the nodes. See \code{https://github.com/d3/d3/blob/master/API.md#ordinal-scales}.
14+
#' @param font_family font family for the node text labels.
15+
#' @param link_distance numeric or character string. Either numberic fixed distance between the links in pixels (actually arbitrary relative to the diagram's size). Or a JavaScript function, possibly to weight by Value. For example: linkDistance = JS("function(d){return d.value * 10}").
16+
#' @param link_width numeric or character string. Can be a numeric fixed width in pixels (arbitrary relative to the diagram's size). Or a JavaScript function, possibly to weight by Value. The default is linkWidth = JS("function(d) { return Math.sqrt(d.value); }").
17+
#' @param radius_calculation character string. A javascript mathematical expression, to weight the radius by Nodesize. The default value is radiusCalculation = JS("Math.sqrt(d.nodesize)+6").
18+
#' @param charge numeric value indicating either the strength of the node repulsion (negative value) or attraction (positive value).
19+
#' @param link_colour character vector specifying the colour(s) you want the link lines to be. Multiple formats supported (e.g. hexadecimal).
20+
#' @param opacity numeric value of the proportion opaque you would like the graph elements to be.
21+
#' @param zoom logical value to enable (TRUE) or disable (FALSE) zooming.
22+
#' @param arrows logical value to enable directional link arrows.
23+
#' @param bounded logical value to enable (TRUE) or disable (FALSE) the bounding box limiting the graph's extent. See \code{http://bl.ocks.org/mbostock/1129492}.
24+
#' @param display_labels is a numeric value representing the number of characters of the label to display on each node.
25+
#' @param click_action character string with a JavaScript expression to evaluate when a node is clicked.
26+
#'
27+
#' @return Returns a network graph object
28+
#' @export
29+
#'
30+
#' @examples # TODO
31+
individuals_by <- function(individual_data = individuals, ind_id = nom, group = NULL, group_other = NULL, group_other_name = NULL,
32+
font_size = 7, height = NULL, width = NULL, colour_scale = JS("d3.scaleOrdinal(d3.schemeCategory20);"),
33+
font_family = "serif", link_distance = 50, link_width = JS("function(d) { return Math.sqrt(d.value); }"),
34+
radius_calculation = "4*Math.sqrt(d.nodesize)+2", charge = -30,
35+
link_colour = "#666", opacity = 0.6, zoom = FALSE, arrows = FALSE,
36+
bounded = FALSE, display_labels = 0, click_action = NULL){
37+
38+
# if (!is.null(filter_var)){
39+
# individual_data <- individual_data %>%
40+
# filter(.data[[filter_var]] %in% filter_vals)
41+
# }
42+
43+
# ind data
44+
ind <- individual_data %>%
45+
dplyr::mutate(id_ind = gsub("^.*?/","", {{ ind_id }}))
46+
47+
# put this if statement elsewhere - own function
48+
# replace "other" columns with what the user selected:
49+
if (group %in% c("pays", "activite_prof")){
50+
if (group == "pays") {
51+
group_other_name = "autre_pays"
52+
} else if (group %in% c("activite_prof")){
53+
group_other_name = "autre"
54+
}
55+
ind <- replace_other(data = ind,
56+
group = group,
57+
group_other_name = group_other_name,
58+
RAS = TRUE)
59+
}
60+
61+
ind <- replace_other(data = ind,
62+
group = "institutions_associees",
63+
group_other_name = "autre")
64+
ind <- replace_other(data = ind,
65+
group = "initiatives_associees",
66+
group_other_name = "autre_initiative")
67+
68+
# for prep fun
69+
ind.init_inst <- ind %>%
70+
# Create a variable giving the institution
71+
tidyr::pivot_longer(cols = starts_with("institutions_associees/"), names_to = "id_inst") %>%
72+
dplyr::mutate(id_inst = gsub("^.*?/", "", id_inst)) %>%
73+
dplyr::mutate(id_inst = gsub("institutions_associees/","", id_inst)) %>%
74+
dplyr::filter(value == 1) %>%
75+
dplyr::select(!value) %>%
76+
77+
# Create a variable giving the initiative
78+
tidyr::pivot_longer(cols = starts_with("initiatives_associees/"), names_to = "id_init") %>%
79+
dplyr::mutate(id_init = gsub("^.*?/","", id_init)) %>%
80+
dplyr::mutate(id_init = gsub("initiatives_associees/","", id_init)) %>%
81+
dplyr::filter(value == 1) %>%
82+
dplyr::select(!value)%>%
83+
84+
# combine the initiative and institution column into one
85+
tidyr::pivot_longer(cols = c(id_inst,id_init),
86+
names_to = "inst_init_type", values_to = "id_inst_init") %>%
87+
dplyr::mutate(inst_init_type = case_when(
88+
inst_init_type == 'id_inst' ~ "Institution",
89+
inst_init_type == 'id_init' ~ "Initiative"))
90+
91+
# Split the data `ind.init_inst` to just Institutions
92+
inst.ind <- ind.init_inst %>%
93+
dplyr::filter(inst_init_type == "Institution") %>%
94+
dplyr::distinct(id_inst_init) %>%
95+
dplyr::rename(id_inst = id_inst_init)
96+
97+
# Split the data `ind.init_inst` to just Initatives
98+
init.ind <- ind.init_inst %>%
99+
dplyr::filter(inst_init_type == "Initiative") %>%
100+
dplyr::distinct(id_inst_init) %>%
101+
dplyr::rename(id_init = id_inst_init) # rename "id_init" by "id_inst_init"
102+
103+
# Creating the node data: bind our three data sets together
104+
# (individual, inst.ind, init.ind)
105+
# Add a column to state if it is individual, institution, or initiative data
106+
nodes_init_by <- bind_rows (
107+
"Individu(e)" = rename(ind, id=id_ind),
108+
"Institution" = rename(inst.ind, id=id_inst),
109+
"Initiative" = rename(init.ind, id=id_init),
110+
.id = "type") %>%
111+
# add a weight
112+
tidyr::mutate(type_weight = case_when(
113+
type == 'Individu(e)' ~ 1,
114+
type == 'Institution' ~ 2,
115+
type == 'Initiative' ~ 3))
116+
117+
# Create notes and links data
118+
# if there is a group variable, then create a "group_type" variable
119+
if (!is.null(group)){
120+
nodes_init_by <- nodes_init_by %>%
121+
dplyr::mutate(group_type = case_when(
122+
type == 'Individu(e)' ~ .data[[group]],
123+
type == 'Institution' ~ "Institution",
124+
type == 'Initiative' ~ "Initiative")) %>%
125+
dplyr::mutate(id_index = row_number() - 1) %>%
126+
dplyr::select(c("id", "id_index", "type_weight", "group_type"))
127+
} else {
128+
nodes_init_by <- nodes_init_by %>%
129+
dplyr::mutate(id_index = row_number()-1) %>%
130+
dplyr::select(c("id", "id_index", "type", "type_weight"))
131+
}
132+
133+
# Merge the id_index column into the ind.init_inst data by initiative
134+
# set this id_index column to be "target"
135+
links_init_by <- ind.init_inst %>%
136+
dplyr::left_join(y=rename(select(nodes_init_by, id, id_index),
137+
target=id_index),
138+
by = c("id_inst_init"="id"))
139+
140+
# Now merge in the id_index column into the ind.init_inst data by individual
141+
# set this id_index column to be "source"
142+
links_init_by <- links_init_by %>%
143+
dplyr::left_join(y=rename(select(nodes_init_by, id, id_index),
144+
source=id_index),
145+
by = c("id_ind"="id"))
146+
147+
# Add a numerical weight to whether it is institution or initiative
148+
links_init_by <- links_init_by %>%
149+
dplyr::mutate(inst_init_type_weight = case_when(
150+
inst_init_type == "Institution" ~ '2',
151+
inst_init_type == "Initiative" ~ '1')) %>%
152+
dplyr::select(c(target, source, inst_init_type, inst_init_type_weight))
153+
154+
if (display_labels) {
155+
display_labels = 1
156+
} else {
157+
display_labels = 0
158+
}
159+
160+
if (is.null(group)){
161+
networkD3::forceNetwork(Links = links_init_by,
162+
Nodes = nodes_init_by,
163+
Source = "source",
164+
Target = "target",
165+
NodeID = "id",
166+
Nodesize = "type_weight",
167+
Group = "type",
168+
legend = TRUE,
169+
fontSize = font_size,
170+
height = height, width = width,
171+
colourScale = colour_scale, fontFamily = font_family,
172+
linkDistance = link_distance, linkWidth = link_width,
173+
radiusCalculation = radius_calculation, charge = charge,
174+
linkColour = link_colour, opacity = opacity, zoom = zoom,
175+
arrows = arrows, bounded = bounded, opacityNoHover = display_labels,
176+
clickAction = click_action)
177+
}
178+
else {
179+
networkD3::forceNetwork(Links = links_init_by,
180+
Nodes = nodes_init_by,
181+
Source = "source",
182+
Target = "target",
183+
NodeID = "id",
184+
Nodesize = "type_weight",
185+
Group = "group_type",
186+
legend = TRUE,
187+
fontSize = font_size,
188+
height = height, width = width,
189+
colourScale = colour_scale, fontFamily = font_family,
190+
linkDistance = link_distance, linkWidth = link_width,
191+
radiusCalculation = radius_calculation, charge = charge,
192+
linkColour = link_colour, opacity = opacity, zoom = zoom,
193+
arrows = arrows, bounded = bounded, opacityNoHover = display_labels,
194+
clickAction = click_action)
195+
}
196+
}
197+

‎R/initiative_by.R

Lines changed: 41 additions & 34 deletions
Original file line numberDiff line numberDiff line change
@@ -4,67 +4,74 @@
44
#' explain what it does -
55
#'
66
#' @param initiative_data a data frame object containing the initiative data
7-
#' @param by
8-
#' @param filter_var
9-
#' @param filter_vals
7+
#' @param by the values around which nodes are formed
8+
#' @param filter_var filtered variable
9+
#' @param filter_vals values associated to the filter
1010
#' @param node_size character string specifying the a column in the `initiative_data` data frame with some value to vary the node radius's with. See also \code{radiusCalculation}.
1111
#' @param group character string specifying the group of each node in the `initiative_data` data frame.
12-
#' @param font_size
13-
#' @param height
14-
#' @param width
15-
#' @param colour_scale
16-
#' @param font_family
17-
#' @param link_distance
18-
#' @param link_width
19-
#' @param radius_calculation
20-
#' @param charge
21-
#' @param link_colour
22-
#' @param opacity
23-
#' @param zoom
24-
#' @param arrows
25-
#' @param bounded
12+
#' @param font_size numeric font size in pixels for the node text labels.
13+
#' @param height numeric height for the network graph's frame area in pixels.
14+
#' @param width numeric width for the network graph's frame area in pixels.
15+
#' @param colour_scale character string specifying the categorical colour scale for the nodes. See https://github.com/d3/d3/blob/master/API.md#ordinal-scales.
16+
#' @param font_family font family for the node text labels.
17+
#' @param link_distance numeric or character string. Either numberic fixed distance between the links in pixels (actually arbitrary relative to the diagram's size). Or a JavaScript function, possibly to weight by Value. For example: linkDistance = JS("function(d){return d.value * 10}").
18+
#' @param link_width numeric or character string. Can be a numeric fixed width in pixels (arbitrary relative to the diagram's size). Or a JavaScript function, possibly to weight by Value. The default is linkWidth = JS("function(d) { return Math.sqrt(d.value); }").
19+
#' @param radius_calculation character string. A javascript mathematical expression, to weight the radius by Nodesize. The default value is radiusCalculation = JS("Math.sqrt(d.nodesize)+6").
20+
#' @param charge numeric value indicating either the strength of the node repulsion (negative value) or attraction (positive value).
21+
#' @param link_colour character vector specifying the colour(s) you want the link lines to be. Multiple formats supported (e.g. hexadecimal).
22+
#' @param opacity numeric value of the proportion opaque you would like the graph elements to be.
23+
#' @param zoom logical value to enable (TRUE) or disable (FALSE) zooming.
24+
#' @param arrows logical value to enable directional link arrows.
25+
#' @param bounded logical value to enable (TRUE) or disable (FALSE) the bounding box limiting the graph's extent. See http://bl.ocks.org/mbostock/1129492.
2626
#' @param display_labels
27-
#' @param click_action
27+
#' @param click_action character string with a JavaScript expression to evaluate when a node is clicked.
2828
#'
2929
#' @return Returns a network graph object
3030
#'
3131
#' @examples # todo
32-
initiative_by <- function(initiative_data, by = "pays", filter_var = NULL, filter_vals = NULL,
32+
initiative_by <- function(initiative_data, by = "pays", sep = ".", filter_var = NULL, filter_vals = NULL,
3333
node_size = c("type", "age"), group = NULL,
3434
font_size = 7, height = NULL, width = NULL, colour_scale = JS("d3.scaleOrdinal(d3.schemeCategory20);"),
3535
font_family = "serif", link_distance = 50, link_width = JS("function(d) { return Math.sqrt(d.value); }"),
3636
radius_calculation = "4*Math.sqrt(d.nodesize)+2", charge = -30,
3737
link_colour = "#666", opacity = 0.6, zoom = FALSE, arrows = FALSE,
3838
bounded = FALSE, display_labels = 0, click_action = NULL){
39+
# characteristics of nodes
3940
node_size <- match.arg(node_size)
4041
# if (!is.null(filter_var)){
4142
# initiative_data <- initiative_data %>%
4243
# filter(.data[[filter_var]] %in% filter_vals)
4344
# }
45+
# Replacement of the boxes in the "initiative_name" column with the associated values in the "other_initiative" column"
4446
init <- replace_other(data = initiative_data, group = "nom_initiative", group_other = "autre_initiative", group_other_name = "autre_initiative")
45-
init <- rename(init, id_init = nom_initiative)
47+
# Rename the column "initiative_name" by id_init
48+
init <- dplyr::rename(init, id_init = nom_initiative)
49+
# creation of the CCRP column for CCRP donors
4650
if (!is.null(group)){
4751
init <- init %>%
4852
dplyr::mutate(CCRP = case_when(
49-
`donateur/ccrp_mcknight_foundation` == 1 ~ group,
53+
paste0("donateur", sep, "ccrp_mcknight_foundation") == 1 ~ group,
5054
TRUE ~ "autre"))
51-
}
55+
}
56+
# Creation of age column
5257
if (node_size == "age"){
5358
init <- init %>% dplyr::mutate(age = 2023 - date_creation)
5459
}
60+
# pivoting and filtering of data
5561
init.by <- init %>%
5662
# pivot_wider(names_from = Pays_Autre_nom, values_from = Pays_Autre, names_prefix = "Pays_") %>%
5763
# select(!c(Pays_)) %>%
58-
tidyr::pivot_longer(cols = starts_with(paste0(by, "/")), names_to = "id_by") %>%
64+
tidyr::pivot_longer(cols = starts_with(paste0(by, sep)), names_to = "id_by")%>%
5965
dplyr::mutate(id_by = gsub("^.*?/","", id_by)) %>%
60-
dplyr::mutate(id_by = gsub(paste0(by, "/"), "", id_by)) %>%
66+
dplyr::mutate(id_by = gsub(paste0(by, sep), "", id_by))%>%
6167
dplyr::filter(value == 1)
62-
68+
# Elimination of repetitions.
6369
by.init <- init.by %>%
6470
distinct(id_by)
6571

6672
# Create notes and links data ------------------------------------------------
6773
by_var <- by
74+
print("A")
6875

6976
nodes_init_by <- bind_rows (
7077
"Initiative" = rename(init, id = id_init),
@@ -78,30 +85,30 @@ initiative_by <- function(initiative_data, by = "pays", filter_var = NULL, filte
7885
type == 'Initiative' ~ 2))
7986
} else {
8087
nodes_init_by <- nodes_init_by %>%
81-
mutate(type_weight = case_when(
88+
dplyr::mutate(type_weight = case_when(
8289
type == by ~ 0,
8390
type == 'Initiative' ~ age))
8491
}
8592
if (!is.null(group)){
8693
nodes_init_by <- nodes_init_by %>%
87-
mutate(group_type = case_when(
94+
dplyr::mutate(group_type = case_when(
8895
type == by ~ by,
8996
type == 'Initiative' ~ .data[[group]])) %>% # replace CCRP with {{ group }}?
90-
mutate(id_index = row_number()-1) %>%
97+
dplyr::mutate(id_index = row_number()-1) %>%
9198
select(id, id_index, type, type_weight, group_type) %>%
92-
mutate(group_type = replace_na(group_type, "Unknown"))
99+
dplyr::mutate(group_type = replace_na(group_type, "Unknown"))
93100
} else {
94101
nodes_init_by <- nodes_init_by %>%
95-
mutate(id_index = row_number()-1) %>%
102+
dplyr::mutate(id_index = row_number()-1) %>%
96103
select(id, id_index, type, type_weight)
97104
}
98105

99106
links_init_by <- init.by %>%
100-
left_join(y=rename(select(nodes_init_by, id, id_index),
101-
target=id_index),
107+
left_join(y=dplyr::rename(select(nodes_init_by, id, id_index),
108+
target=id_index),
102109
by = c("id_by"="id")) %>%
103-
left_join(y=rename(select(nodes_init_by, id, id_index),
104-
source=id_index),
110+
left_join(y=dplyr::rename(select(nodes_init_by, id, id_index),
111+
source=id_index),
105112
by = c("id_init"="id")) %>%
106113
select(c(target, source))
107114

0 commit comments

Comments
 (0)