Scale in word cloud - r

I have this dataframe
df <- structure(list(word = structure(c(1L, 12L, 23L, 34L, 43L, 44L,
45L, 46L, 47L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 13L,
14L, 15L, 16L, 17L, 18L, 19L, 20L, 21L, 22L, 24L, 25L, 26L, 27L,
28L, 29L, 30L, 31L, 32L, 33L, 35L, 36L, 37L, 38L, 39L, 40L, 41L,
42L), .Label = c("word1", "word10", "word11", "word12", "word13",
"word14", "word15", "word16", "word17", "word18", "word19", "word2",
"word20", "word21", "word22", "word23", "word24", "word25", "word26",
"word27", "word28", "word29", "word3", "word30", "word31", "word32",
"word33", "word34", "word35", "word36", "word37", "word38", "word39",
"word4", "word40", "word41", "word42", "word43", "word44", "word45",
"word46", "word47", "word5", "word6", "word7", "word8", "word9"
), class = "factor"), frq = c(1975L, 1665L, 1655L, 1469L, 1464L,
1451L, 1353L, 1309L, 1590L, 1545L, 1557L, 1556L, 1130L, 1153L,
1151L, 1150L, 1144L, 1141L, 1115L, 194L, 195L, 135L, 135L, 130L,
163L, 167L, 164L, 159L, 153L, 145L, 143L, 133L, 133L, 153L, 153L,
150L, 119L, 115L, 115L, 115L, 114L, 113L, 113L, 113L, 115L, 102L,
101L)), .Names = c("word", "frq"), class = "data.frame", row.names = c(NA,
-47L))
And I would like to create a word cloud based on the frequency.
In order to make this word cloud I use this lines of code:
library(wordcloud2)
wordcloud2(df, color = "random-light", backgroundColor = "green")
However an issue I face is that the word cloud doesn't have all the words. When I refer all words I mean these words with the lowest frequency.
Is there any scale in order to have all words in word cloud and the most frequency word be a little smaller in order to see all words?
As I can understand this happens because the highest frequencies have big difference with the others in the list

You should directly rescale your frequencies. You could for example do :
p_scaled = p^(1/n) with n sufficiently big so that even the words with the lowest frequencies would appear on the word cloud.

Related

Exact number of every value next to the bar [duplicate]

This question already has answers here:
How to put labels over geom_bar in R with ggplot2
(4 answers)
Closed 5 years ago.
Having a dataset like this:
df <- structure(list(word = structure(c(1L, 12L, 23L, 34L, 43L, 44L,
45L, 46L, 47L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 13L,
14L, 15L, 16L, 17L, 18L, 19L, 20L, 21L, 22L, 24L, 25L, 26L, 27L,
28L, 29L, 30L, 31L, 32L, 33L, 35L, 36L, 37L, 38L, 39L, 40L, 41L,
42L), .Label = c("word1", "word10", "word11", "word12", "word13",
"word14", "word15", "word16", "word17", "word18", "word19", "word2",
"word20", "word21", "word22", "word23", "word24", "word25", "word26",
"word27", "word28", "word29", "word3", "word30", "word31", "word32",
"word33", "word34", "word35", "word36", "word37", "word38", "word39",
"word4", "word40", "word41", "word42", "word43", "word44", "word45",
"word46", "word47", "word5", "word6", "word7", "word8", "word9"
), class = "factor"), frq = c(1975L, 1665L, 1655L, 1469L, 1464L,
1451L, 1353L, 1309L, 1590L, 1545L, 1557L, 1556L, 1130L, 1153L,
1151L, 1150L, 1144L, 1141L, 1115L, 194L, 195L, 135L, 135L, 130L,
163L, 167L, 164L, 159L, 153L, 145L, 143L, 133L, 133L, 153L, 153L,
150L, 119L, 115L, 115L, 115L, 114L, 113L, 113L, 113L, 115L, 102L,
101L)), .Names = c("word", "frq"), class = "data.frame", row.names = c(NA,
-47L))
With this command lines I produce a bar plot graph
dat2 = transform(df,word = reorder(word,frq))
df2 <- head(dat2, 10)
p = ggplot(df2, aes(x = word, y = frq)) + geom_bar(stat = "identity", fill = "yellow")
p2 <- p +coord_flip()
How is it possible to have the number of frq in the end of every bar?
I would use annotate..
p2 + annotate(geom = "text",x = df2$word, y= df2$frq, label = df2$frq)

Fill in matrix values from data frame in a vectorized manner

I have a dataframe in with 3 columns, two of which represent the i,j indices in a matrix. For each row of the dataframe, I would like to fill the corresponding i,j value in a matrix to 1.
Sharing the data and matrix below, which I think will make it easier to describe the problem:
data = structure(list(sale_id = c(0L, 1L, 2L, 2L, 3L, 3L, 4L, 4L, 5L,
5L, 5L, 5L, 5L, 5L, 6L, 6L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L,
8L, 8L, 8L, 8L, 8L, 8L, 8L, 8L, 9L, 9L, 10L, 10L, 11L, 11L, 11L,
12L, 12L, 12L, 12L, 12L, 12L, 12L, 12L, 13L, 14L, 15L, 16L, 16L,
17L, 17L, 17L, 17L, 17L, 18L, 18L, 19L, 19L, 20L, 20L, 21L, 22L,
22L, 23L, 23L, 23L, 24L, 24L, 25L, 25L, 26L, 26L, 27L, 27L, 28L,
28L, 29L, 30L, 30L, 30L, 30L, 30L, 30L, 30L, 31L, 31L, 32L, 32L,
33L, 33L, 33L, 33L, 33L, 33L, 34L, 34L), user_id = c(3219L, 144L,
2884L, 2884L, 2155L, 2155L, 2155L, 2155L, 2817L, 2817L, 2817L,
2817L, 2817L, 2817L, 144L, 144L, 2850L, 2850L, 2850L, 2850L,
2850L, 2850L, 2850L, 2850L, 2850L, 144L, 144L, 144L, 144L, 144L,
144L, 144L, 144L, 2817L, 2817L, 2075L, 2075L, 2546L, 2546L, 2546L,
2687L, 2687L, 2687L, 2687L, 2687L, 2687L, 2687L, 2687L, 170L,
2546L, 1963L, 144L, 144L, 1825L, 1825L, 1825L, 1825L, 1825L,
144L, 144L, 2155L, 2155L, 2546L, 2546L, 144L, 2155L, 2155L, 144L,
144L, 144L, 3182L, 3182L, 3343L, 3343L, 170L, 170L, 2155L, 2155L,
2793L, 2793L, 1564L, 2250L, 2250L, 2250L, 2250L, 2250L, 2250L,
2250L, 3083L, 3083L, 2075L, 2075L, 144L, 144L, 144L, 144L, 144L,
144L, 829L, 829L), item_id = c(174L, 10L, 179L, 162L, 171L, 182L,
179L, 185L, 199L, 179L, 195L, 174L, 162L, 198L, 144L, 69L, 57L,
47L, 83L, 80L, 10L, 117L, 14L, 90L, 88L, 186L, 167L, 192L, 142L,
162L, 173L, 151L, 134L, 191L, 166L, 118L, 128L, 98L, 95L, 119L,
130L, 154L, 155L, 181L, 120L, 118L, 77L, 120L, 101L, 31L, 139L,
10L, 30L, 182L, 179L, 139L, 173L, 171L, 80L, 39L, 26L, 69L, 163L,
151L, 175L, 150L, 148L, 121L, 147L, 88L, 183L, 177L, 132L, 167L,
176L, 172L, 57L, 78L, 98L, 99L, 118L, 102L, 141L, 97L, 99L, 79L,
32L, 17L, 16L, 30L, 66L, 54L, 57L, 91L, 81L, 39L, 92L, 123L,
87L, 62L)), .Names = c("sale_id", "user_id", "item_id"), row.names = c(NA,
100L), class = "data.frame")
M = matrix(0, nrow = max(data$user_id), ncol = max(data$item_id))
head(data, n = 6)
sale_id user_id item_id
1 0 3219 174
2 1 144 10
3 2 2884 179
4 2 2884 162
5 3 2155 171
6 3 2155 182
The i-column is user_id and the j-column is item_id. So for the first row, I would like for M[3219, 174] = 1, then I would like M[144, 10] = 1, etc. I would like to do this without a for-loop, which is too slow given the size of my matrix.
For reference, what I'm currently doing is:
for(i in 1:nrow(data)) {
M[data$user_id[i], data$item_id[i]] = 1
}
However, my problem scales quite large, and this is too slow for my problem. Any help is greatly appreciated! Thanks
EDIT: i tried something along the lines of:
apply(data, 1, FUN = function(x) M[x[2],x[3]] = 1)
but it didn't work as well as i would hope (takes even longer than the for-loop).
Try this:
M[cbind(data$user_id,data$item_id)] <- 1

Plotting a Dataframe in R

I have a dataframe of the form
Region Name 3-15 4-15 5-15 ... 3-16
Name1 30 82 56 ... 32
Name2 65 23 38 ... 11
... ... ... ... ... ...
Name18 87 33 11 ... 51
The first column being the names of regions and the other columns being recorded events over time (monthly by column)
I'd like to plot the recorded monthly values over time with respect to their associated name. Specifically, a different line for each Named region with a differentiated colour. Any advice would be appreciated, a lot of the plotting functions for data frames seem to function on frames of a different format.
dput() data:
dataframe <- structure(list("LSOA Name" = c("Lancaster 001", "Lancaster 002",
"Lancaster 003", "Lancaster 004", "Lancaster 005", "Lancaster 006",
"Lancaster 008", "Lancaster 009", "Lancaster 010", "Lancaster 011",
"Lancaster 013", "Lancaster 014", "Lancaster 015", "Lancaster 016",
"Lancaster 017", "Lancaster 018", "Lancaster 019", "Lancaster 020"
), "3-15" = c(49L, 16L, 17L, 28L, 21L, 197L, 57L, 143L, 78L,
121L, 67L, 223L, 41L, 86L, 66L, 27L, 40L, 77L), "4-15" = c(63L,
11L, 26L, 29L, 19L, 203L, 69L, 154L, 82L, 125L, 62L, 198L, 44L,
99L, 64L, 26L, 42L, 99L), "5-15" = c(67L, 10L, 20L, 30L, 10L,
194L, 62L, 186L, 61L, 110L, 75L, 273L, 29L, 126L, 92L, 34L, 41L,
88L), "6-15" = c(58L, 8L, 18L, 36L, 29L, 198L, 62L, 167L, 83L,
110L, 59L, 254L, 26L, 99L, 73L, 17L, 30L, 109L), "7-15" = c(53L,
29L, 27L, 23L, 38L, 188L, 56L, 149L, 90L, 129L, 37L, 226L, 32L,
119L, 57L, 14L, 30L, 96L), "8-15" = c(44L, 9L, 25L, 28L, 29L,
237L, 69L, 171L, 78L, 108L, 45L, 261L, 22L, 103L, 68L, 33L, 35L,
108L), "9-15" = c(59L, 12L, 18L, 35L, 19L, 230L, 45L, 128L, 74L,
144L, 56L, 223L, 26L, 90L, 51L, 27L, 23L, 120L), "10-15" = c(45L,
26L, 31L, 23L, 25L, 195L, 53L, 155L, 74L, 120L, 58L, 276L, 38L,
92L, 72L, 25L, 40L, 123L), "11-15" = c(31L, 11L, 33L, 15L, 19L,
188L, 52L, 127L, 66L, 102L, 50L, 241L, 26L, 74L, 72L, 26L, 35L,
68L), "12-15" = c(34L, 22L, 21L, 22L, 17L, 205L, 80L, 150L, 73L,
109L, 50L, 228L, 29L, 57L, 59L, 14L, 45L, 93L), "1-16" = c(20L,
9L, 25L, 21L, 11L, 199L, 46L, 124L, 65L, 117L, 40L, 224L, 28L,
88L, 43L, 22L, 18L, 94L), "2-16" = c(54L, 11L, 29L, 20L, 11L,
164L, 44L, 117L, 70L, 85L, 46L, 192L, 23L, 89L, 50L, 27L, 29L,
86L), "3-16" = c(53L, 11L, 24L, 26L, 19L, 203L, 45L, 144L, 66L,
109L, 47L, 213L, 15L, 120L, 59L, 15L, 33L, 127L)), .Names = c("LSOA Name",
"3-15", "4-15", "5-15", "6-15", "7-15", "8-15", "9-15", "10-15",
"11-15", "12-15", "1-16", "2-16", "3-16"), row.names = c(NA,
-18L), class = "data.frame")
A typical way of plotting lines by groups in ggplot is to shift the data to long format, where one column identifies the group, and the other columns identify the x and y axis values.
This example shifts your data into long format with three columns: LSOAName, month_col, and values_col. It adds a day value onto the month-year, and converts that column to a date. Then it plots a line for each group.
I've renamed your dataframe d, because dataframe could be easily misinterpreted as the function data.frame().
# load libraries
library(magrittr)
library(dplyr)
library(tidyr)
library(ggplot2)
# rename dataframe so it doesn't look so much like the base function
d <- dataframe
# remove spaces in column names
names(d) <- gsub(" ", "", names(d))
# shift data from wide to long and then
# add a day value and convert day-month-year to date class
d %<>% gather(month_col, values_col, -LSOAName) %>%
mutate(month_col = as.Date(paste0("1-", month_col), "%d-%m-%y"))
# plot using ggplot2
ggplot(d, aes(x = month_col, y = values_col, colour = LSOAName)) +
geom_line()
Edit
%<>% is found in the magrittr package. It is a compound pipe assignment operator. While %>% returns the result of a pipeline, %<>% assigns the result back to the left side object.
Instead of writing
d <- d %>% [pipeline]
you can assign the results to d by writing
d %<>% [pipeline]

Select a set of edges which create the largest graph given that some edges are mutually exclusive of others

I'm trying to determine how to best tackle this problem.
Given a set of nodes and multiple, conflicting ways in which they could be connected I need to select the set of non-conflicting relations such that largest number of nodes remain in connected.
Example.
Here is a graph including all possible relations (edges) ignoring conflicts. Eg., this image doesn't depict the dependence of the edges on each other.
All edges attached to a specific node are dependent on one another. For simplicity each edge implies an attribute to each node it connects say A...Z. If an edge connecting nodes 3 and 16 specifies attributes 3-B and 16-F, then all edges connecting 16 to other nodes must have attribute 16-F. Similarly all edges connecting 3 to other nodes must have attribute 3-B.
Here is the same graph when specifying attribute F to node 16. This attribute removes most edges leaving one edge connecting 16-4 and one edge connecting 16-3. This has left no edges between 16-42.
(16 is near the left in both images.)
This image does not illustrate that the edge connecting 3-42 will specify an attribute for node 42, say 42-X. This will further constrain connections to 42 and further break up the graph. I have not displayed this because this is what my question pertains to.
I am looking for advice.
Is this a known problem? Can you point me to any references?
How
would you approach this problem? My best idea is to iterate,
starting at each edge, over all possible attributes. Evaluate each
partitioning and find which preserves the largest network. This
sounds challenging though and I could use some help.
If this is the solution is there a way using igraph in R to specify an "edge attribute constraint" and pull out the resulting, fragmented graph.
I have dput the graph here:
df = structure(list(nodeA = c(3L, 4L, 42L, 43L, 44L, 29L, 30L, 29L, 30L, 3L, 4L, 6L, 43L, 44L, 43L, 44L, 29L, 30L, 29L, 30L, 52L, 29L, 30L, 35L, 25L, 35L, 25L, 43L, 44L, 29L, 30L, 3L, 4L, 43L, 44L, 29L, 30L, 25L, 29L, 30L, 42L, 3L, 4L, 17L, 43L, 44L, 29L, 30L, 29L, 30L, 17L, 17L, 29L, 30L, 6L, 43L, 44L, 29L, 30L, 52L, 35L, 35L, 25L, 25L, 24L, 24L, 43L, 44L, 29L, 30L, 35L, 35L, 25L, 25L, 24L, 24L, 43L, 44L, 29L, 30L, 35L, 35L, 25L, 25L, 24L, 24L, 52L, 42L, 3L, 42L, 42L, 3L, 4L, 42L, 25L, 42L, 25L, 3L, 4L, 42L, 3L, 4L, 17L, 35L, 3L, 4L, 35L, 43L, 44L, 29L, 30L, 35L, 35L, 35L, 52L, 25L, 25L, 24L, 24L, 35L, 29L, 30L, 3L, 4L, 43L, 44L, 29L, 30L, 25L, 29L, 30L, 52L, 43L, 44L, 29L, 30L, 25L, 29L, 30L, 3L, 4L, 43L, 44L, 29L, 30L, 52L, 43L, 44L, 43L, 44L, 29L, 30L, 3L, 4L, 43L, 44L, 29L, 30L, 52L, 52L, 43L, 44L, 29L, 30L, 35L, 52L, 52L, 3L, 4L, 43L, 44L, 29L, 30L, 52L, 43L, 44L, 29L, 30L, 43L, 44L, 29L, 30L, 17L, 17L, 42L, 42L, 43L, 44L, 29L, 30L, 43L, 44L, 29L, 30L, 43L, 44L, 29L, 30L, 3L, 4L, 25L, 25L, 16L, 16L, 3L, 4L, 43L, 44L, 24L, 3L, 4L, 52L, 52L, 17L, 35L, 35L, 35L, 17L, 3L, 4L, 6L, 35L, 42L, 42L, 42L, 42L, 3L, 4L, 17L, 25L, 17L, 17L, 29L, 30L, 25L, 3L, 4L, 29L, 30L, 3L, 4L, 17L, 17L, 17L, 35L, 3L, 4L, 17L, 17L, 17L, 29L, 30L, 43L, 44L, 43L, 44L, 29L, 30L, 17L, 6L, 43L, 44L, 29L, 30L, 43L, 44L, 29L, 30L, 43L, 44L, 29L, 30L, 3L, 43L, 44L, 29L, 30L, 3L, 43L, 44L, 29L, 30L, 17L, 17L, 42L, 42L, 25L, 42L, 25L, 43L, 44L, 29L, 30L, 42L, 17L, 17L, 42L, 42L, 43L, 44L, 29L, 30L, 25L, 29L, 30L, 43L, 44L, 29L, 30L, 43L, 44L, 29L, 30L, 25L, 29L, 30L, 43L, 44L, 29L, 30L, 43L, 44L, 29L, 30L, 43L, 44L, 29L, 30L, 25L, 25L, 25L, 25L), nodeB = c(16L, 16L, 17L, 24L, 24L, 25L, 25L, 35L, 35L, 16L, 16L, 17L, 24L, 24L, 24L, 24L, 25L, 25L, 25L, 25L, 35L, 35L, 35L, 43L, 43L, 44L, 44L, 24L, 24L, 25L, 25L, 16L, 16L, 24L, 24L, 25L, 25L, 35L, 35L, 35L, 16L, 16L, 16L, 24L, 24L, 24L, 25L, 25L, 35L, 35L, 43L, 44L, 52L, 52L, 17L, 24L, 24L, 25L, 25L, 35L, 43L, 44L, 29L, 30L, 43L, 44L, 24L, 24L, 25L, 25L, 43L, 44L, 29L, 30L, 43L, 44L, 24L, 24L, 25L, 25L, 43L, 44L, 29L, 30L, 43L, 44L, 17L, 24L, 42L, 43L, 44L, 16L, 16L, 17L, 35L, 17L, 35L, 16L, 16L, 52L, 16L, 16L, 6L, 25L, 16L, 16L, 52L, 24L, 24L, 25L, 25L, 43L, 44L, 25L, 25L, 29L, 30L, 43L, 44L, 17L, 42L, 42L, 16L, 16L, 24L, 24L, 25L, 25L, 35L, 35L, 35L, 35L, 24L, 24L, 25L, 25L, 35L, 35L, 35L, 16L, 16L, 24L, 24L, 25L, 25L, 35L, 17L, 17L, 24L, 24L, 25L, 25L, 16L, 16L, 24L, 24L, 25L, 25L, 25L, 35L, 24L, 24L, 25L, 25L, 25L, 29L, 30L, 16L, 16L, 24L, 24L, 25L, 25L, 35L, 24L, 24L, 25L, 25L, 24L, 24L, 25L, 25L, 43L, 44L, 3L, 4L, 24L, 24L, 25L, 25L, 24L, 24L, 25L, 25L, 24L, 24L, 25L, 25L, 16L, 16L, 35L, 35L, 3L, 4L, 16L, 16L, 17L, 17L, 17L, 16L, 16L, 29L, 30L, 6L, 25L, 29L, 30L, 42L, 16L, 16L, 25L, 52L, 16L, 16L, 16L, 16L, 16L, 16L, 24L, 35L, 43L, 44L, 52L, 52L, 35L, 16L, 16L, 52L, 52L, 16L, 16L, 24L, 43L, 44L, 25L, 16L, 16L, 24L, 43L, 44L, 52L, 52L, 17L, 17L, 24L, 24L, 25L, 25L, 52L, 42L, 24L, 24L, 25L, 25L, 24L, 24L, 25L, 25L, 24L, 24L, 25L, 25L, 42L, 24L, 24L, 25L, 25L, 42L, 24L, 24L, 25L, 25L, 43L, 44L, 4L, 17L, 35L, 17L, 35L, 24L, 24L, 25L, 25L, 16L, 43L, 44L, 4L, 4L, 24L, 24L, 25L, 25L, 35L, 35L, 35L, 24L, 24L, 25L, 25L, 24L, 24L, 25L, 25L, 35L, 35L, 35L, 24L, 24L, 25L, 25L, 24L, 24L, 25L, 25L, 24L, 24L, 25L, 25L, 35L, 35L, 35L, 35L), attributeA = c(25L, 25L, 130L, 110L, 110L, 110L, 110L, 113L, 113L, 43L, 43L, 71L, 5L, 5L, 127L, 127L, 5L, 5L, 127L, 127L, 72L, 130L, 130L, 137L, 140L, 137L, 140L, 6L, 6L, 6L, 6L, 56L, 56L, 137L, 137L, 137L, 137L, 130L, 140L, 140L, 29L, 68L, 68L, 56L, 143L, 143L, 143L, 143L, 146L, 146L, 43L, 43L, 45L, 45L, 46L, 80L, 80L, 80L, 80L, 47L, 11L, 11L, 80L, 80L, 80L, 80L, 84L, 84L, 84L, 84L, 14L, 14L, 84L, 84L, 84L, 84L, 90L, 90L, 90L, 90L, 18L, 18L, 90L, 90L, 90L, 90L, 110L, 37L, 122L, 114L, 114L, 108L, 108L, 58L, 27L, 136L, 109L, 26L, 26L, 115L, 111L, 111L, 78L, 109L, 112L, 112L, 78L, 114L, 114L, 114L, 114L, 37L, 37L, 47L, 73L, 114L, 114L, 114L, 114L, 128L, 111L, 111L, 125L, 125L, 54L, 54L, 54L, 54L, 45L, 58L, 58L, 143L, 55L, 55L, 55L, 55L, 126L, 136L, 136L, 44L, 44L, 56L, 56L, 56L, 56L, 145L, 68L, 68L, 57L, 57L, 57L, 57L, 128L, 128L, 58L, 58L, 58L, 58L, 143L, 146L, 59L, 59L, 59L, 59L, 126L, 70L, 70L, 129L, 129L, 60L, 60L, 60L, 60L, 73L, 61L, 61L, 61L, 61L, 62L, 62L, 62L, 62L, 124L, 124L, 91L, 91L, 63L, 63L, 63L, 63L, 64L, 64L, 64L, 64L, 65L, 65L, 65L, 65L, 135L, 135L, 58L, 136L, 127L, 127L, 57L, 57L, 143L, 143L, 68L, 138L, 138L, 143L, 143L, 80L, 136L, 126L, 126L, 109L, 139L, 139L, 128L, 80L, 110L, 112L, 113L, 30L, 141L, 141L, 135L, 70L, 125L, 125L, 126L, 126L, 142L, 69L, 69L, 128L, 128L, 144L, 144L, 138L, 128L, 128L, 142L, 145L, 145L, 139L, 129L, 129L, 130L, 130L, 121L, 121L, 79L, 79L, 79L, 79L, 91L, 109L, 82L, 82L, 82L, 82L, 86L, 86L, 86L, 86L, 88L, 88L, 88L, 88L, 97L, 92L, 92L, 92L, 92L, 118L, 94L, 94L, 94L, 94L, 107L, 107L, 89L, 138L, 111L, 140L, 113L, 116L, 116L, 116L, 116L, 1L, 134L, 134L, 92L, 19L, 135L, 135L, 135L, 135L, 128L, 138L, 138L, 136L, 136L, 136L, 136L, 137L, 137L, 137L, 137L, 130L, 140L, 140L, 138L, 138L, 138L, 138L, 139L, 139L, 139L, 139L, 140L, 140L, 140L, 140L, 138L, 140L, 144L, 146L), attributeB = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 6L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 11L, 11L, 11L, 11L, 13L, 13L, 13L, 13L, 13L, 13L, 14L, 14L, 14L, 14L, 17L, 17L, 17L, 17L, 17L, 17L, 18L, 18L, 18L, 18L, 19L, 19L, 19L, 19L, 19L, 23L, 23L, 23L, 23L, 24L, 24L, 25L, 25L, 25L, 27L, 27L, 28L, 28L, 29L, 29L, 29L, 36L, 36L, 36L, 36L, 36L, 36L, 37L, 37L, 37L, 37L, 37L, 37L, 38L, 38L, 38L, 41L, 41L, 41L, 41L, 41L, 41L, 41L, 41L, 41L, 41L, 42L, 42L, 42L, 42L, 42L, 42L, 42L, 43L, 43L, 43L, 43L, 43L, 43L, 43L, 44L, 44L, 44L, 44L, 44L, 44L, 45L, 45L, 45L, 45L, 45L, 45L, 45L, 45L, 46L, 46L, 46L, 46L, 46L, 46L, 46L, 47L, 47L, 47L, 47L, 47L, 47L, 47L, 48L, 48L, 48L, 48L, 49L, 49L, 49L, 49L, 49L, 49L, 50L, 50L, 50L, 50L, 50L, 50L, 51L, 51L, 51L, 51L, 52L, 52L, 52L, 52L, 54L, 54L, 54L, 55L, 56L, 56L, 56L, 56L, 56L, 56L, 57L, 58L, 58L, 58L, 58L, 59L, 59L, 59L, 59L, 59L, 60L, 60L, 60L, 60L, 62L, 63L, 64L, 65L, 66L, 66L, 66L, 66L, 66L, 66L, 66L, 66L, 67L, 68L, 68L, 68L, 68L, 70L, 70L, 70L, 70L, 70L, 71L, 72L, 72L, 72L, 72L, 72L, 72L, 72L, 77L, 77L, 78L, 78L, 78L, 78L, 79L, 80L, 81L, 81L, 81L, 81L, 85L, 85L, 85L, 85L, 87L, 87L, 87L, 87L, 89L, 91L, 91L, 91L, 91L, 92L, 93L, 93L, 93L, 93L, 96L, 96L, 97L, 108L, 108L, 110L, 110L, 115L, 115L, 115L, 115L, 117L, 117L, 117L, 118L, 122L, 125L, 125L, 125L, 125L, 125L, 125L, 125L, 126L, 126L, 126L, 126L, 127L, 127L, 127L, 127L, 127L, 127L, 127L, 128L, 128L, 128L, 128L, 129L, 129L, 129L, 129L, 130L, 130L, 130L, 130L, 135L, 137L, 141L, 143L)), .Names = c("nodeA", "nodeB", "attributeA", "attributeB" ), row.names = c(3L, 4L, 5L, 7L, 8L, 9L, 10L, 12L, 13L, 18L, 19L, 20L, 24L, 25L, 26L, 27L, 28L, 29L, 31L, 32L, 35L, 36L, 37L, 38L, 39L, 40L, 41L, 52L, 53L, 54L, 55L, 59L, 60L, 62L, 63L, 64L, 65L, 71L, 72L, 73L, 78L, 82L, 83L, 86L, 87L, 88L, 89L, 90L, 96L, 97L, 98L, 99L, 108L, 109L, 112L, 114L, 115L, 116L, 117L, 120L, 121L, 122L, 129L, 131L, 134L, 135L, 141L, 142L, 143L, 144L, 146L, 147L, 153L, 154L, 156L, 157L, 163L, 164L, 165L, 166L, 168L, 169L, 175L, 176L, 178L, 179L, 183L, 186L, 187L, 188L, 189L, 196L, 197L, 198L, 201L, 204L, 206L, 208L, 209L, 213L, 216L, 217L, 221L, 222L, 225L, 226L, 230L, 241L, 242L, 243L, 244L, 248L, 249L, 255L, 256L, 259L, 260L, 264L, 265L, 272L, 276L, 277L, 284L, 285L, 287L, 288L, 289L, 290L, 292L, 293L, 294L, 295L, 303L, 304L, 305L, 306L, 308L, 309L, 310L, 315L, 316L, 318L, 319L, 320L, 321L, 325L, 333L, 334L, 336L, 337L, 338L, 339L, 347L, 348L, 350L, 351L, 352L, 353L, 354L, 359L, 365L, 366L, 367L, 368L, 369L, 373L, 374L, 381L, 382L, 384L, 385L, 386L, 387L, 390L, 395L, 396L, 397L, 398L, 406L, 407L, 408L, 409L, 411L, 412L, 416L, 417L, 421L, 422L, 423L, 424L, 430L, 431L, 432L, 433L, 438L, 439L, 440L, 441L, 447L, 448L, 450L, 452L, 454L, 455L, 456L, 457L, 458L, 459L, 468L, 472L, 473L, 476L, 477L, 481L, 483L, 484L, 485L, 488L, 493L, 494L, 495L, 501L, 504L, 508L, 511L, 512L, 513L, 514L, 516L, 518L, 519L, 520L, 523L, 524L, 526L, 528L, 529L, 534L, 535L, 538L, 539L, 540L, 543L, 544L, 550L, 555L, 556L, 558L, 561L, 562L, 564L, 565L, 576L, 577L, 582L, 583L, 584L, 585L, 590L, 594L, 596L, 597L, 598L, 599L, 605L, 606L, 607L, 608L, 613L, 614L, 615L, 616L, 620L, 622L, 623L, 624L, 625L, 629L, 631L, 632L, 633L, 634L, 643L, 644L, 647L, 657L, 660L, 665L, 666L, 673L, 674L, 675L, 676L, 691L, 692L, 693L, 696L, 700L, 705L, 706L, 707L, 708L, 711L, 712L, 713L, 720L, 721L, 722L, 723L, 728L, 729L, 730L, 731L, 733L, 734L, 735L, 741L, 742L, 743L, 744L, 750L, 751L, 752L, 753L, 759L, 760L, 761L, 762L, 772L, 777L, 787L, 790L), class = "data.frame")
library(igraph)
g = graph.data.frame(df)
plot(g, vertex.size = 6, edge.arrow.mode=1, edge.arrow.size = 0)
> head(df)
nodeA nodeB attributeA attributeB
1 3 16 25 1
4 4 16 25 1
5 42 17 130 1
7 43 24 110 1
8 44 24 110 1
9 29 25 110 1
In the above, row 1 attributeA is the exclusive attribute for node 3 such that all other edges connecting to node 3 must have attribute 25. Similarly, attributeB indicates that all edges connecting to node 16 must have the attribute 1. It is not necessary that row 1 be an edge, but it is necessary that no retained edges conflict.
Thanks for reading!
Is this a known problem? Can you point me to any references?
This is quite an interesting problem, and not one that I've encountered before.
How would you approach this problem?
I would approach this problem from an integer programming perspective. The decision variables will be used to select the attribute of each node (only edges labeled with the attributes of both of their endpoints will be allowed). Further, we will select a "root node" that we expect to be in the large connected component, and we will create flow outward from this root node. Each other node will have demand 1, and flow will only be possible over valid edges. We will maximize the amount of flow pushed out from the root node; this will be the number of other nodes in the large component.
To achieve this formulation, I would create two classes of variables:
Node attribute variables: For each node i and attribute a, I would create a binary variable z_ia that is 1 if node i is assigned attribute a and 0 otherwise.
Flow variables: For each edge from node i to j (I assume "from" is nodeA in your data frame and "to" is nodeB in your data frame), variable x_ij indicates the amount of flow from i to j (negative values indicate flow from j to i).
We also have a number of different constraints:
Each node only has 1 attribute: This can be achieved with \sum_{a\in A} z_ia = 1 for each node i, where A is the set of all attributes.
Edge flows are 0 if the edge is not valid: For each edge from i to j with attributes a and b, respectively, we will have x_ij <= n*z_ia, x_ij <= n*z_jb, x_ij >= -n*z_ia, and x_ij >= -n*z_jb. In all four constraints, n is the total number of nodes. These constraints will force x_ij=0 if z_ia=0 or z_jb=0, and otherwise will not be binding.
The net flow to any non-root node falls in [0, 1]: This constraint ensures that all outflow must come from the root, so nodes can only get flow if they are connected to the root. For each non-root node i with edges incoming from node set I and edges outgoing to node set O, these constraints are of the form \sum_{j\in I} x_ji - \sum_{j\in O} x_ij >= 0 and \sum_{j\in I} x_ji - \sum_{j\in O} x_ij <= 1.
The objective is to maximize the amount of flow out of the root node r. If r has incoming edges from nodes in set I and outgoing edges to nodes in set O, then this objective (which we maximize) is \sum_{j\in O} x_ji - \sum_{j\in I} x_ij.
With these variables and constraints in place, all you need to do is specify the root node r and solve; the solution will indicate the best possible assignment of attributes to nodes, assuming that r is in the largest component. If you re-solved for each root node r, you would end up with the global optimal assignment.
The following in an implementation of this approach with the lpSolve package in R:
library(lpSolve)
optim <- function(df, r) {
# Some book keeping
nodes = c(df$nodeA, df$nodeB)
u.nodes <- unique(nodes)
if (!r %in% u.nodes) {
stop("Invalid root node provided")
}
n.node <- length(u.nodes)
attrs = c(df$attributeA, df$attributeB)
node.attrs <- do.call(rbind, lapply(u.nodes, function(x) {
data.frame(node=x, attr=unique(attrs[nodes == x]))
}))
n.na <- nrow(node.attrs)
n.e <- nrow(df)
# Constraints limiting each node to have exactly one attribute
node.one.attr <- t(sapply(u.nodes, function(i) {
c(node.attrs$node == i, rep(0, 2*n.e))
}))
node.one.attr.dir <- rep("==", n.node)
node.one.attr.rhs <- rep(1, n.node)
# Constraints limiting edges to only be used if both attributes are selected
edge.flow <- do.call(rbind, lapply(seq_len(n.e), function(idx) {
i <- df$nodeA[idx]
j <- df$nodeB[idx]
a <- df$attributeA[idx]
b <- df$attributeB[idx]
na.i <- node.attrs$node == i & node.attrs$attr == a
na.j <- node.attrs$node == j & node.attrs$attr == b
rbind(c(-n.node*na.i, seq_len(n.e) == idx, -(seq_len(n.e) == idx)),
c(-n.node*na.j, seq_len(n.e) == idx, -(seq_len(n.e) == idx)),
c(n.node*na.i, seq_len(n.e) == idx, -(seq_len(n.e) == idx)),
c(n.node*na.j, seq_len(n.e) == idx, -(seq_len(n.e) == idx)))
}))
edge.flow.dir <- rep(c("<=", "<=", ">=", ">="), n.e)
edge.flow.rhs <- rep(0, 4*n.e)
# Constraints limiting net flow on non-root nodes
net.flow <- do.call(rbind, lapply(u.nodes, function(i) {
if (i == r) {
return(NULL)
}
rbind(c(rep(0, n.na), (df$nodeB == i) - (df$nodeA == i),
-(df$nodeB == i) + (df$nodeA == i)),
c(rep(0, n.na), (df$nodeB == i) - (df$nodeA == i),
-(df$nodeB == i) + (df$nodeA == i)))
}))
net.flow.dir <- rep(c(">=", "<="), n.node-1)
net.flow.rhs <- rep(c(0, 1), n.node-1)
# Build the model
mod <- lp(direction = "max",
objective.in = c(rep(0, n.na), (df$nodeA == r) - (df$nodeB == r),
-(df$nodeA == r) + (df$nodeB == r)),
const.mat = rbind(node.one.attr, edge.flow, net.flow),
const.dir = c(node.one.attr.dir, edge.flow.dir, net.flow.dir),
const.rhs = c(node.one.attr.rhs, edge.flow.rhs, net.flow.rhs),
binary.vec = seq_len(n.na))
opt <- node.attrs[mod$solution[1:n.na] > 0.999,]
valid.edges <- df[opt$attr[match(df$nodeA, opt$node)] == df$attributeA &
opt$attr[match(df$nodeB, opt$node)] == df$attributeB,]
list(attrs = opt,
edges = valid.edges,
objval = mod$objval)
}
It can solve the problem for subsets of the nodes in your original graph, but it becomes quite slow as you include an increasing number of nodes:
# Limit to 5 nodes
keep <- c(3, 4, 6, 16, 42)
df.play <- df[df$nodeA %in% keep & df$nodeB %in% keep,]
(opt.play <- optim(df.play, 42))
# $attrs
# node attr
# 24 3 50
# 45 4 50
# 50 42 91
# 60 16 127
# 87 6 109
#
# $edges
# nodeA nodeB attributeA attributeB
# 416 42 3 91 50
# 417 42 4 91 50
#
# $objval
# [1] 2
That run took 15 seconds. To speed this up, you could consider switching to a more powerful solver such as cplex or gurobi. These solvers are free for academic use but non-free otherwise.
If this is the solution is there a way using igraph in R to specify an "edge attribute constraint" and pull out the resulting, fragmented graph.
Yes, given the attributes you can easily subset and plot the graph. For the 5-node example that I solved above:
g <- graph.data.frame(opt.play$edges, vertices=unique(c(df.play$nodeA, df.play$nodeB)))
plot(g, vertex.size = 6, edge.arrow.mode=1, edge.arrow.size = 0)
While working through this problem I stumbled upon a simpler solution. It seems my formulation of the problem was making the answer hard to see.
The core of the matter is: when two different constraints are applied to a node it effectively becomes two distinct nodes.
Framing the challenge in this way allows us to rapidly construct graphs for each set of constraints. We can then quickly inspect these, look at the size, and (as my original question desired) select the set of constraints which preserves the largest graph.
g = graph.data.frame(df); plot(g, vertex.size = 6, edge.arrow.mode=1, edge.arrow.size = 0)
# Combine the node and the rule into a new, unique node id referencing both the node and the constraint
df.split = c(df[,1:2]) + df[,3:4]*1E3
# Keep track of edge numbers in this dataset for later
df.split = cbind(df.split, row = seq(nrow(df)))
g.split = graph.data.frame(df.split); plot(g.split, vertex.size = 6, edge.arrow.mode=1, edge.arrow.size = 0)
# Decompose into unlinked sub graphs and count the edges in each
g.list = decompose.graph(g.split)
g.list.nodenum = sapply(g.list, ecount)
head(g.list.nodenum[order(g.list.nodenum, decreasing=T)])
[1] 9 8 5 5 5 5
# Select the largest subgraph
g.sub = g.list[[order(g.list.nodenum, decreasing=T)[1]]]
plot(g.sub)
# Find what edges these were in the original dataset
originaledges = E(g.sub)$row
originaledges
[1] 129 157 130 158 131 159 212 213 132
# Play with the resulting graph, the largest graph which obeys constraints at all nodes.
df.largest = df[originaledges,]
df.largest
nodeA nodeB attributeA attributeB
292 25 35 45 41
352 29 25 58 45
293 29 35 58 41
353 30 25 58 45
294 30 35 58 41
354 52 25 143 45
476 52 29 143 58
477 52 30 143 58
295 52 35 143 41
g.largest = graph.data.frame(df.largest); plot(g.largest, vertex.size = 6, edge.arrow.mode=1, edge.arrow.size = 0)
Hopefully this helps someone someday!

Add column based on header cell; then remove header cell

I have interesting data that is not uniform. A group of items are listed under the category name, but it is all in the same column. I need to add a column with the row corresponding to the item's category that it belongs to (then remove the category heading). The only way to distinguish a new category is determining whether the value under the year is empty.... My dputs should explain my issue more clearly.
Before:
structure(list(X = structure(c(13L, 1L, 19L, 16L, 5L, 17L, 11L,
8L, 2L, 10L, 4L, 6L, 18L, 15L, 21L, 12L, 14L, 9L, 3L, 20L, 7L
), .Label = c("-Burgers", "-Cameras", "-Shirts", "+Laptops",
"+Salads", "+TVs", "Caps", "Cell", "Clothes:", "Desktops", "Electronics",
"Flowers", "Food", "Garden Nomes", "Grills", "Hotdogs", "Nachoes",
"Outdoors:", "Pizza", "Shorts", "Swimming Gear"), class = "factor"),
X2000 = c(NA, 104L, 159L, 184L, 189L, 182L, NA, 49L, 28L,
46L, 34L, 43L, NA, 129L, 190L, 189L, 119L, NA, 45L, 80L,
80L), X2001 = c(NA, 147L, 192L, 164L, 174L, 196L, NA, 40L,
34L, 43L, 35L, 22L, NA, 114L, 130L, 120L, 145L, NA, 56L,
35L, 54L), X2002 = c(NA, 163L, 172L, 138L, 146L, 190L, NA,
38L, 40L, 21L, 22L, 33L, NA, 186L, 172L, 139L, 119L, NA,
88L, 78L, 91L), X2003 = c(NA, 125L, 152L, 182L, 148L, 125L,
NA, 36L, 44L, 34L, 27L, 50L, NA, 119L, 115L, 188L, 166L,
NA, 91L, 77L, 77L), X2004 = c(NA, 116L, 111L, 120L, 153L,
199L, NA, 49L, 48L, 43L, 37L, 32L, NA, 159L, 116L, 143L,
153L, NA, 18L, 53L, 51L)), .Names = c("X", "X2000", "X2001",
"X2002", "X2003", "X2004"), class = "data.frame", row.names = c(NA,
-21L))
After:
structure(list(X = structure(c(1L, 15L, 13L, 5L, 14L, 8L, 2L,
9L, 4L, 6L, 12L, 17L, 10L, 11L, 3L, 16L, 7L), .Label = c("-Burgers",
"-Cameras", "-Shirts", "+Laptops", "+Salads", "+TVs", "Caps",
"Cell", "Desktops", "Flowers", "Garden Nomes", "Grills", "Hotdogs",
"Nachoes", "Pizza", "Shorts", "Swimming Gear"), class = "factor"),
X.1 = structure(c(3L, 3L, 3L, 3L, 3L, 2L, 2L, 2L, 2L, 2L,
4L, 4L, 4L, 4L, 1L, 1L, 1L), .Label = c("Clothes:", "Electronics",
"Food", "Outdoors:"), class = "factor"), X2000 = c(104L,
159L, 184L, 189L, 182L, 49L, 28L, 46L, 34L, 43L, 129L, 190L,
189L, 119L, 45L, 80L, 80L), X2001 = c(147L, 192L, 164L, 174L,
196L, 40L, 34L, 43L, 35L, 22L, 114L, 130L, 120L, 145L, 56L,
35L, 54L), X2002 = c(163L, 172L, 138L, 146L, 190L, 38L, 40L,
21L, 22L, 33L, 186L, 172L, 139L, 119L, 88L, 78L, 91L), X2003 = c(125L,
152L, 182L, 148L, 125L, 36L, 44L, 34L, 27L, 50L, 119L, 115L,
188L, 166L, 91L, 77L, 77L), X2004 = c(116L, 111L, 120L, 153L,
199L, 49L, 48L, 43L, 37L, 32L, 159L, 116L, 143L, 153L, 18L,
53L, 51L)), .Names = c("X", "X.1", "X2000", "X2001", "X2002",
"X2003", "X2004"), class = "data.frame", row.names = c(NA, -17L
))
The items are arbitrarily have + or - signs...I need that to remain the same. Also, some category headers have : while others do not.
We create an index based on the 'NA' values in columns other than the 1st ('indx'). We split the dataset using the 'indx', remove the first row i.e. NA values from columns 2nd to the last, cbind with the 1st row, 1st column value, rearrange the columns and rbind.
indx <- cumsum(!rowSums(!is.na(df1[-1])))
res <- do.call(rbind,lapply(split(df1, indx), function(x)
cbind(x, X.1= x[1,1])[-1,c(1,7,2:6)]))
row.names(res) <- NULL
all.equal(res, out, check.attributes=FALSE)
#[1] TRUE
where 'out' is the dput output of the expected result
Update
If the columns have '' instead of NA,
indx <- cumsum(!rowSums(df1[-1]!=''))
and do the rest as above. Having said that, when we have '' in a numeric column, the class will be either factor or character based on whether you specify stringsAsFactors=FALSE or =TRUE in the read.table/read.csv. So, keeping the '' as such will get the output also a factor/character class. I would convert the columns to their correct class first which will also coerce the '' to NA, i.e.
df1[-1] <- lapply(df1[-1], function(x) as.numeric(as.character(x)))
The as.character is only needed if the columns are factor class.
Once, we have done the conversion, the first approach should work fine as well.

Resources