This question already has answers here:
Create binary column (0/1) based on condition in another column
(2 answers)
Closed 3 years ago.
I am trying to create a new column in R (yes/no indicator) where if the data in X3 is >= 50 it would = 1(yes) or if <= 49 it would = 0(no).
I have tried various combinations of ifelse statements, I just cannot get it work. I need this step in order to construct my confidence interval.
dput (crime)
structure(list(Y = c(478L, 494L, 643L, 341L, 773L, 603L, 484L,
546L, 424L, 548L, 506L, 819L, 541L, 491L, 514L, 371L, 457L, 437L,
570L, 432L, 619L, 357L, 623L, 547L, 792L, 799L, 439L, 867L, 912L,
462L, 859L, 805L, 652L, 776L, 919L, 732L, 657L, 1419L, 989L,
821L, 1740L, 815L, 760L, 936L, 863L, 783L, 715L, 1504L, 1324L,
940L), X1 = c(184L, 213L, 347L, 565L, 327L, 260L, 325L, 102L,
38L, 226L, 137L, 369L, 109L, 809L, 29L, 245L, 118L, 148L, 387L,
98L, 608L, 218L, 254L, 697L, 827L, 693L, 448L, 942L, 1017L, 216L,
673L, 989L, 630L, 404L, 692L, 1517L, 879L, 631L, 1375L, 1139L,
3545L, 706L, 451L, 433L, 601L, 1024L, 457L, 1441L, 1022L, 1244L
), X2 = c(40L, 32L, 57L, 31L, 67L, 25L, 34L, 33L, 36L, 31L, 35L,
30L, 44L, 32L, 30L, 16L, 29L, 36L, 30L, 23L, 33L, 35L, 38L, 44L,
28L, 35L, 31L, 39L, 27L, 36L, 38L, 46L, 29L, 32L, 39L, 44L, 33L,
43L, 22L, 30L, 86L, 30L, 32L, 43L, 20L, 55L, 44L, 37L, 82L, 66L
), X3 = c(74L, 72L, 70L, 71L, 72L, 68L, 68L, 62L, 69L, 66L, 60L,
81L, 66L, 67L, 65L, 64L, 64L, 62L, 59L, 56L, 46L, 54L, 54L, 45L,
57L, 57L, 61L, 52L, 44L, 43L, 48L, 57L, 47L, 50L, 48L, 49L, 72L,
59L, 49L, 54L, 62L, 47L, 45L, 48L, 69L, 42L, 49L, 57L, 72L, 67L
), X4 = c(11L, 11L, 18L, 11L, 9L, 8L, 12L, 13L, 7L, 9L, 13L,
4L, 9L, 11L, 12L, 10L, 12L, 7L, 15L, 15L, 22L, 14L, 20L, 26L,
12L, 9L, 19L, 17L, 21L, 18L, 19L, 14L, 19L, 19L, 16L, 13L, 13L,
14L, 9L, 13L, 22L, 17L, 34L, 26L, 23L, 23L, 18L, 15L, 22L, 26L
), X5 = c(31L, 43L, 16L, 25L, 29L, 32L, 24L, 28L, 25L, 58L, 21L,
77L, 37L, 37L, 35L, 42L, 21L, 81L, 31L, 50L, 24L, 27L, 22L, 18L,
23L, 60L, 14L, 31L, 24L, 23L, 22L, 25L, 25L, 21L, 32L, 31L, 13L,
21L, 46L, 27L, 18L, 39L, 15L, 23L, 7L, 23L, 30L, 35L, 15L, 18L
), X6 = c(20L, 18L, 16L, 19L, 24L, 15L, 14L, 11L, 12L, 15L, 9L,
36L, 12L, 16L, 11L, 14L, 10L, 27L, 16L, 15L, 8L, 13L, 11L, 8L,
11L, 18L, 12L, 10L, 9L, 8L, 10L, 12L, 9L, 9L, 11L, 14L, 22L,
13L, 13L, 12L, 15L, 11L, 10L, 12L, 12L, 11L, 12L, 13L, 16L, 16L
), X7 = structure(list(Y = c(478L, 494L, 643L, 341L, 773L, 603L,
484L, 546L, 424L, 548L, 506L, 819L, 541L, 491L, 514L, 371L, 457L,
437L, 570L, 432L, 619L, 357L, 623L, 547L, 792L, 799L, 439L, 867L,
912L, 462L, 859L, 805L, 652L, 776L, 919L, 732L, 657L, 1419L,
989L, 821L, 1740L, 815L, 760L, 936L, 863L, 783L, 715L, 1504L,
1324L, 940L), X1 = c(184L, 213L, 347L, 565L, 327L, 260L, 325L,
102L, 38L, 226L, 137L, 369L, 109L, 809L, 29L, 245L, 118L, 148L,
387L, 98L, 608L, 218L, 254L, 697L, 827L, 693L, 448L, 942L, 1017L,
216L, 673L, 989L, 630L, 404L, 692L, 1517L, 879L, 631L, 1375L,
1139L, 3545L, 706L, 451L, 433L, 601L, 1024L, 457L, 1441L, 1022L,
1244L), X2 = c(40L, 32L, 57L, 31L, 67L, 25L, 34L, 33L, 36L, 31L,
35L, 30L, 44L, 32L, 30L, 16L, 29L, 36L, 30L, 23L, 33L, 35L, 38L,
44L, 28L, 35L, 31L, 39L, 27L, 36L, 38L, 46L, 29L, 32L, 39L, 44L,
33L, 43L, 22L, 30L, 86L, 30L, 32L, 43L, 20L, 55L, 44L, 37L, 82L,
66L), X3 = c(74L, 72L, 70L, 71L, 72L, 68L, 68L, 62L, 69L, 66L,
60L, 81L, 66L, 67L, 65L, 64L, 64L, 62L, 59L, 56L, 46L, 54L, 54L,
45L, 57L, 57L, 61L, 52L, 44L, 43L, 48L, 57L, 47L, 50L, 48L, 49L,
72L, 59L, 49L, 54L, 62L, 47L, 45L, 48L, 69L, 42L, 49L, 57L, 72L,
67L), X4 = c(11L, 11L, 18L, 11L, 9L, 8L, 12L, 13L, 7L, 9L, 13L,
4L, 9L, 11L, 12L, 10L, 12L, 7L, 15L, 15L, 22L, 14L, 20L, 26L,
12L, 9L, 19L, 17L, 21L, 18L, 19L, 14L, 19L, 19L, 16L, 13L, 13L,
14L, 9L, 13L, 22L, 17L, 34L, 26L, 23L, 23L, 18L, 15L, 22L, 26L
), X5 = c(31L, 43L, 16L, 25L, 29L, 32L, 24L, 28L, 25L, 58L, 21L,
77L, 37L, 37L, 35L, 42L, 21L, 81L, 31L, 50L, 24L, 27L, 22L, 18L,
23L, 60L, 14L, 31L, 24L, 23L, 22L, 25L, 25L, 21L, 32L, 31L, 13L,
21L, 46L, 27L, 18L, 39L, 15L, 23L, 7L, 23L, 30L, 35L, 15L, 18L
), X6 = c(20L, 18L, 16L, 19L, 24L, 15L, 14L, 11L, 12L, 15L, 9L,
36L, 12L, 16L, 11L, 14L, 10L, 27L, 16L, 15L, 8L, 13L, 11L, 8L,
11L, 18L, 12L, 10L, 9L, 8L, 10L, 12L, 9L, 9L, 11L, 14L, 22L,
13L, 13L, 12L, 15L, 11L, 10L, 12L, 12L, 11L, 12L, 13L, 16L, 16L
), X7 = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 1, 1, 1, 0, 1, 0, 1, 1, 0, 0,
1, 0, 0, 1, 1, 1, 0, 1, 1, 0, 0, 0)), row.names = c(NA, -50L), .Names = c("Y",
"X1", "X2", "X3", "X4", "X5", "X6", "X7"), class = "data.frame")), .Names = c("Y",
"X1", "X2", "X3", "X4", "X5", "X6", "X7"), row.names = c(NA,
-50L), class = "data.frame")
The dput didn't work. But I'd managed to dump the data from column Y and X3 in a dataset (called data) and use dplyr::mutate to do the transformation with a straightforward ifelse condition.
library(dplyr)
data <- data %>% mutate(X3_cat = ifelse(X3 >= 50, 1, 0))
Related
I've been trying to find a way to convert text files with pixels values into images (no matter the format) in R but I couldn't find a way to do it.
I found solutions for MatLab and Python, for example.
I have a file with 520 x 640 pixels with values from 0 to 255.
This is a small piece of it.
mid1al <- read.table("C:/Users/u015/Mid1_R_Al.txt", header = FALSE, sep = ";")
mid1al <- mid1al[1:20,1:20]
dput(mid1al)
structure(list(V1 = c(84L, 79L, 97L, 67L, 98L, 113L, 77L, 46L,
41L, 37L, 42L, 46L, 23L, 28L, 24L, 34L, 45L, 51L, 24L, 24L),
V2 = c(118L, 107L, 105L, 82L, 87L, 108L, 100L, 40L, 71L,
74L, 81L, 55L, 41L, 25L, 22L, 58L, 53L, 38L, 26L, 36L), V3 = c(103L,
116L, 128L, 82L, 77L, 104L, 97L, 50L, 65L, 78L, 98L, 111L,
86L, 59L, 35L, 51L, 43L, 46L, 33L, 47L), V4 = c(114L, 91L,
90L, 96L, 103L, 98L, 86L, 36L, 50L, 65L, 98L, 125L, 86L,
32L, 24L, 36L, 36L, 44L, 34L, 43L), V5 = c(68L, 70L, 85L,
85L, 100L, 111L, 61L, 12L, 42L, 70L, 103L, 103L, 45L, 27L,
18L, 27L, 32L, 43L, 51L, 41L), V6 = c(43L, 87L, 85L, 89L,
130L, 123L, 78L, 43L, 15L, 39L, 62L, 44L, 27L, 14L, 19L,
61L, 83L, 90L, 88L, 88L), V7 = c(20L, 72L, 116L, 124L, 133L,
133L, 103L, 56L, 21L, 9L, 19L, 26L, 18L, 32L, 67L, 92L, 100L,
105L, 94L, 79L), V8 = c(69L, 96L, 120L, 144L, 142L, 101L,
96L, 46L, 14L, 4L, 8L, 2L, 24L, 73L, 96L, 106L, 103L, 116L,
109L, 74L), V9 = c(118L, 122L, 134L, 135L, 133L, 98L, 57L,
20L, 5L, 5L, 2L, 14L, 51L, 89L, 117L, 95L, 103L, 93L, 104L,
77L), V10 = c(122L, 107L, 127L, 147L, 128L, 88L, 24L, 11L,
10L, 4L, 10L, 31L, 74L, 104L, 113L, 107L, 109L, 99L, 103L,
45L), V11 = c(105L, 120L, 114L, 132L, 125L, 112L, 51L, 6L,
3L, 9L, 18L, 49L, 82L, 111L, 111L, 96L, 92L, 81L, 75L, 18L
), V12 = c(98L, 104L, 103L, 126L, 147L, 128L, 61L, 26L, 2L,
9L, 18L, 50L, 105L, 103L, 101L, 98L, 74L, 53L, 18L, 1L),
V13 = c(107L, 91L, 108L, 109L, 138L, 114L, 88L, 33L, 2L,
4L, 9L, 61L, 71L, 77L, 78L, 83L, 43L, 38L, 8L, 5L), V14 = c(53L,
60L, 43L, 49L, 104L, 128L, 72L, 44L, 6L, 8L, 10L, 24L, 35L,
27L, 33L, 37L, 31L, 24L, 10L, 5L), V15 = c(13L, 16L, 11L,
27L, 62L, 78L, 73L, 30L, 8L, 7L, 31L, 66L, 66L, 33L, 13L,
27L, 16L, 18L, 12L, 7L), V16 = c(11L, 12L, 7L, 3L, 16L, 35L,
45L, 13L, 5L, 7L, 22L, 74L, 73L, 31L, 16L, 43L, 35L, 14L,
15L, 8L), V17 = c(15L, 16L, 7L, 8L, 1L, 5L, 15L, 13L, 31L,
33L, 22L, 34L, 38L, 17L, 18L, 41L, 39L, 26L, 19L, 12L), V18 = c(9L,
15L, 7L, 2L, 2L, 5L, 5L, 25L, 50L, 55L, 35L, 25L, 14L, 8L,
18L, 44L, 36L, 36L, 19L, 0L), V19 = c(15L, 16L, 4L, 6L, 4L,
6L, 22L, 45L, 59L, 48L, 56L, 58L, 52L, 30L, 22L, 46L, 41L,
50L, 23L, 7L), V20 = c(20L, 7L, 4L, 2L, 6L, 14L, 40L, 55L,
74L, 60L, 69L, 74L, 60L, 56L, 38L, 45L, 67L, 39L, 25L, 11L
)), row.names = c(NA, 20L), class = "data.frame")
Is there a way to create this image in Rstudio?
I have a data.frame fish.test0 for which I want to grep specific variables (in varlist) matching the group column to create a sub-data.frame that will undergo a statistical test. The results of the test is saved in tests.res.t. I want to loop the varlist so that I get one results for each input in varlist
Script:
varlist <- c("Abiotrophia","Alphatorquevirus")
for (i in varlist) {
fish.test <- fish.test0[grep("i",fish.test0$group),]
column <- c("ACDC")
tests <- list()
dat_test <- sapply( column, function(colx)
lapply( unique(fish.test$Merge), function(x)
fisher.test( data.frame(
a=c(( fish.test[ which(fish.test$Merge %in% x)[2],"Present"] -
fish.test[ which(fish.test$Merge %in% x)[2], colx] ),fish.test[ which(fish.test$Merge %in% x)[2], colx]
),
b=c(( fish.test[ which(fish.test$Merge %in% x)[1],"NotPresent"] -
fish.test[ which(fish.test$Merge %in% x)[1], colx] ), fish.test[ which(fish.test$Merge %in% x)[1], colx]))) #,alternative = "greater"
) )
rownames(dat_test) <- unique(fish.test$Merge )
colnames(dat_test) <- column
tests.res <- sapply(dat_test[1:dim(dat_test)[1],1], function(x) {
c(x$estimate[1],
x$estimate[2],
ci.lower = x$conf.int[1],
ci.upper = x$conf.int[2],
p.value = x$p.value)
})
tests.res.t <- as.data.frame(t(tests.res))
}
test-data:
fish.test0 <- structure(list(Present = c(4L, 4L, 9L, 9L, 57L, 57L, 146L, 146L,
91L, 91L, 26L, 26L, 6L, 6L, 12L, 12L, 33L, 33L, 10L, 10L, 66L,
66L, 4L, 4L, 4L, 4L, 9L, 9L, 18L, 18L, 19L, 19L, 51L, 51L, 50L,
50L, 12L, 12L, 7L, 7L, 14L, 14L, 27L, 27L, 9L, 9L, 5L, 5L, 6L,
6L, 22L, 22L, 3L, 3L, 14L, 14L, 4L, 4L, 15L, 15L, 6L, 6L, 8L,
8L, 4L, 4L), NotPresent = c(11L, 11L, 44L, 44L, 126L, 126L, 532L,
532L, 382L, 382L, 97L, 97L, 14L, 14L, 43L, 43L, 85L, 85L, 41L,
41L, 336L, 336L, 19L, 19L, 27L, 27L, 67L, 67L, 108L, 108L, 81L,
81L, 240L, 240L, 258L, 258L, 47L, 47L, 31L, 31L, 82L, 82L, 110L,
110L, 63L, 63L, 178L, 178L, 672L, 672L, 451L, 451L, 120L, 120L,
104L, 104L, 47L, 47L, 387L, 387L, 94L, 94L, 300L, 300L, 133L,
133L), group = c("G__Abiotrophia_NotPresent_Anus", "G__Abiotrophia_Present_Anus",
"G__Abiotrophia_NotPresent_Bile duct", "G__Abiotrophia_Present_Bile duct",
"G__Abiotrophia_NotPresent_Bone/Soft tissue", "G__Abiotrophia_Present_Bone/Soft tissue",
"G__Abiotrophia_NotPresent_Breast", "G__Abiotrophia_Present_Breast",
"G__Abiotrophia_NotPresent_Colorectum", "G__Abiotrophia_Present_Colorectum",
"G__Abiotrophia_NotPresent_Esophagus", "G__Abiotrophia_Present_Esophagus",
"G__Abiotrophia_NotPresent_Gallbladder", "G__Abiotrophia_Present_Gallbladder",
"G__Abiotrophia_NotPresent_Head and neck", "G__Abiotrophia_Present_Head and neck",
"G__Abiotrophia_NotPresent_Kidney", "G__Abiotrophia_Present_Kidney",
"G__Abiotrophia_NotPresent_Liver", "G__Abiotrophia_Present_Liver",
"G__Abiotrophia_NotPresent_Lung", "G__Abiotrophia_Present_Lung",
"G__Abiotrophia_NotPresent_Lymphoid tissue", "G__Abiotrophia_Present_Lymphoid tissue",
"G__Abiotrophia_NotPresent_Mesothelium", "G__Abiotrophia_Present_Mesothelium",
"G__Abiotrophia_NotPresent_Nervous system", "G__Abiotrophia_Present_Nervous system",
"G__Abiotrophia_NotPresent_Ovary", "G__Abiotrophia_Present_Ovary",
"G__Abiotrophia_NotPresent_Pancreas", "G__Abiotrophia_Present_Pancreas",
"G__Abiotrophia_NotPresent_Prostate", "G__Abiotrophia_Present_Prostate",
"G__Abiotrophia_NotPresent_Skin", "G__Abiotrophia_Present_Skin",
"G__Abiotrophia_NotPresent_Small intestine", "G__Abiotrophia_Present_Small intestine",
"G__Abiotrophia_NotPresent_Stomach", "G__Abiotrophia_Present_Stomach",
"G__Abiotrophia_NotPresent_Unknown", "G__Abiotrophia_Present_Unknown",
"G__Abiotrophia_NotPresent_Urothelial tract", "G__Abiotrophia_Present_Urothelial tract",
"G__Abiotrophia_NotPresent_Uterus", "G__Abiotrophia_Present_Uterus",
"G__Alphatorquevirus_NotPresent_Bone/Soft tissue", "G__Alphatorquevirus_Present_Bone/Soft tissue",
"G__Alphatorquevirus_NotPresent_Breast", "G__Alphatorquevirus_Present_Breast",
"G__Alphatorquevirus_NotPresent_Colorectum", "G__Alphatorquevirus_Present_Colorectum",
"G__Alphatorquevirus_NotPresent_Esophagus", "G__Alphatorquevirus_Present_Esophagus",
"G__Alphatorquevirus_NotPresent_Kidney", "G__Alphatorquevirus_Present_Kidney",
"G__Alphatorquevirus_NotPresent_Liver", "G__Alphatorquevirus_Present_Liver",
"G__Alphatorquevirus_NotPresent_Lung", "G__Alphatorquevirus_Present_Lung",
"G__Alphatorquevirus_NotPresent_Pancreas", "G__Alphatorquevirus_Present_Pancreas",
"G__Alphatorquevirus_NotPresent_Skin", "G__Alphatorquevirus_Present_Skin",
"G__Alphatorquevirus_NotPresent_Urothelial tract", "G__Alphatorquevirus_Present_Urothelial tract"
), ABCD = c(3L, 2L, 17L, 6L, 34L, 18L, 240L, 53L, 321L, 73L,
87L, 25L, 6L, 3L, 20L, 8L, 15L, 7L, 19L, 4L, 265L, 42L, 6L, 1L,
4L, 2L, 22L, 4L, 70L, 13L, 54L, 12L, 116L, 33L, 58L, 11L, 6L,
2L, 26L, 6L, 42L, 8L, 74L, 18L, 19L, 3L, 52L, 0L, 288L, 5L, 377L,
17L, 110L, 2L, 19L, 3L, 21L, 2L, 298L, 9L, 60L, 6L, 68L, 1L,
89L, 3L), Total = c(15L, 15L, 53L, 53L, 183L, 183L, 678L, 678L,
473L, 473L, 123L, 123L, 20L, 20L, 55L, 55L, 118L, 118L, 51L,
51L, 402L, 402L, 23L, 23L, 31L, 31L, 76L, 76L, 126L, 126L, 100L,
100L, 291L, 291L, 308L, 308L, 59L, 59L, 38L, 38L, 96L, 96L, 137L,
137L, 72L, 72L, 183L, 183L, 678L, 678L, 473L, 473L, 123L, 123L,
118L, 118L, 51L, 51L, 402L, 402L, 100L, 100L, 308L, 308L, 137L,
137L), Merge = c("Abiotrophia_Anus", "Abiotrophia_Anus", "Abiotrophia_Bile duct",
"Abiotrophia_Bile duct", "Abiotrophia_Bone/Soft tissue", "Abiotrophia_Bone/Soft tissue",
"Abiotrophia_Breast", "Abiotrophia_Breast", "Abiotrophia_Colorectum",
"Abiotrophia_Colorectum", "Abiotrophia_Esophagus", "Abiotrophia_Esophagus",
"Abiotrophia_Gallbladder", "Abiotrophia_Gallbladder", "Abiotrophia_Head and neck",
"Abiotrophia_Head and neck", "Abiotrophia_Kidney", "Abiotrophia_Kidney",
"Abiotrophia_Liver", "Abiotrophia_Liver", "Abiotrophia_Lung",
"Abiotrophia_Lung", "Abiotrophia_Lymphoid tissue", "Abiotrophia_Lymphoid tissue",
"Abiotrophia_Mesothelium", "Abiotrophia_Mesothelium", "Abiotrophia_Nervous system",
"Abiotrophia_Nervous system", "Abiotrophia_Ovary", "Abiotrophia_Ovary",
"Abiotrophia_Pancreas", "Abiotrophia_Pancreas", "Abiotrophia_Prostate",
"Abiotrophia_Prostate", "Abiotrophia_Skin", "Abiotrophia_Skin",
"Abiotrophia_Small intestine", "Abiotrophia_Small intestine",
"Abiotrophia_Stomach", "Abiotrophia_Stomach", "Abiotrophia_Unknown",
"Abiotrophia_Unknown", "Abiotrophia_Urothelial tract", "Abiotrophia_Urothelial tract",
"Abiotrophia_Uterus", "Abiotrophia_Uterus", "Alphatorquevirus_Bone/Soft tissue",
"Alphatorquevirus_Bone/Soft tissue", "Alphatorquevirus_Breast",
"Alphatorquevirus_Breast", "Alphatorquevirus_Colorectum", "Alphatorquevirus_Colorectum",
"Alphatorquevirus_Esophagus", "Alphatorquevirus_Esophagus", "Alphatorquevirus_Kidney",
"Alphatorquevirus_Kidney", "Alphatorquevirus_Liver", "Alphatorquevirus_Liver",
"Alphatorquevirus_Lung", "Alphatorquevirus_Lung", "Alphatorquevirus_Pancreas",
"Alphatorquevirus_Pancreas", "Alphatorquevirus_Skin", "Alphatorquevirus_Skin",
"Alphatorquevirus_Urothelial tract", "Alphatorquevirus_Urothelial tract"
)), row.names = c(1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 10L, 9L, 12L,
11L, 13L, 14L, 16L, 15L, 17L, 18L, 19L, 20L, 21L, 22L, 23L, 24L,
25L, 26L, 28L, 27L, 29L, 30L, 31L, 32L, 34L, 33L, 35L, 36L, 38L,
37L, 40L, 39L, 42L, 43L, 45L, 44L, 47L, 46L, 1011L, 1012L, 1014L,
1013L, 1015L, 1016L, 1017L, 1018L, 1019L, 1020L, 1022L, 1021L,
1023L, 1024L, 1026L, 1025L, 1027L, 1028L, 1029L, 1030L), class = "data.frame")
This is probably not an answer but it should help to improve you code. If I'm terribly wrong, I'll remove my answer right away. I have loeft out the test business which I don't understand, but your problem seems to be extraction.
The first thing is that you need to remove the quotation marks in your grep command, try:
varlist <- c("Abiotrophia","Alphatorquevirus")
for( i in varlist )
{
# extract rows which contain the variable
fish.test <- fish.test0[ grep( i, fish.test0$group ), ]
print( head( fish.test ) )
}
From what I understand, you need to define column and tests outside your loop. Does that give you more of what you want:
varlist <- c("Abiotrophia","Alphatorquevirus")
column <- "ACDC"
tests <- list()
for( i in 1 : length( varlist ) ) # index can be used later to fill the list
{
# extract rows which contain the variable
fish.test <- fish.test0[ grep( varlist[ i ], fish.test0$group ), ]
# add a column with your name of choice
fish.test <- cbind( fish.test, c( 1: length( fish.test$group ) ) )
colnames( fish.test )[ length( fish.test ) ] <- column
# write each result into your defined list
tests[[ i ]] <- fish.test
}
I have the a dataframe that includes +/- confidence intervals. I assembled the dataset myself from secondary open datasets that only had +/- CIs, so there is not much that I can do. I understand that the quickest way to plot multiple series with ggplot2 is to reshape2 the dataframe, which I can easily do like
melt(df, id.vars = c("Year"))
except that that turns CI columns into proper series. Now, I'd eventually like to produce a plot like this.
which I produced with
ggplot(df, aes(x = Year)) +
geom_line(aes(y = Total.inflow), color="red") +
geom_ribbon(aes(ymin = Total.inflow-Total.inflow.CI, ymax = Total.inflow+Total.inflow.CI), colour="red", fill="red", alpha=0.1) +
geom_line(aes(y = EU.inflow), color="blue") +
geom_ribbon(aes(ymin = EU.inflow-EU.inflow.CI, ymax = EU.inflow+EU.inflow.CI), colour="blue", fill="blue", alpha=0.1) +
geom_line(aes(y = ROW.inflow), color="green") +
geom_ribbon(aes(ymin = ROW.inflow-ROW.inflow.CI, ymax = ROW.inflow+ROW.inflow.CI), colour="green", fill="green", alpha=0.1)
Ideas?
WORKING SOLUTION
Thanks to #lukeA for pointing me towards the right method. For some reason, his solution produced an empty data frame, but I managed to figure out what he was trying to do and found a reasonable solution myself.
First of all, let's separate the GDP column from the flows dataset. I suspected this was necessary from the beginning, but I was confident I could filter it out while plotting. Turns out it's just easier to separate the two. Also, I'll normalise its values for later, because tens of billions…
df <- read.csv('stats.csv', header=T)
gdp <- data.frame(Year = df$Year, GDP = df$GDP/10000000000)
df <- within(df, rm(GDP))
The goal is to get the CI values side by side with their corresponding series. This was the code inside the inner_join in #lukeA answer. Once I took it apart, the path to the solution became clearer to me.
var_value <- df %>%
select(-ends_with("CI")) %>%
gather(var, value, -Year)
var_conf <- df %>%
select(Year, ends_with("CI")) %>%
setNames(sub("(.*)\\sCI$", "\\1", names(.))) %>%
gather(var, conf, -Year)
final.df = data.frame(var_value, conf = var_conf$conf)
Finally, #lukeA's ggplot code does produce the chart he shows.
ggplot(final.df, aes(
x = Year,
y = value,
ymin = value - conf,
ymax = value + conf,
color = var,
fill = var
)) +
geom_ribbon(alpha = .2) +
geom_line()
Data
df <- structure(list(Year = 1991:2014, Total.inflow = c(329L, 268L,
266L, 315L, 312L, 318L, 327L, 391L, 454L, 479L, 481L, 516L, 511L,
589L, 567L, 596L, 574L, 590L, 567L, 591L, 566L, 498L, 526L, 632L
), Total.inflow.CI = c(23L, 20L, 19L, 23L, 22L, 25L, 27L, 27L,
31L, 31L, 30L, 32L, 33L, 40L, 37L, 39L, 40L, 39L, 30L, 31L, 28L,
27L, 29L, 36L), Total.outflow = c(-285L, -281L, -266L, -238L,
-236L, -264L, -279L, -251L, -291L, -321L, -309L, -363L, -363L,
-344L, -361L, -398L, -341L, -427L, -368L, -339L, -351L, -321L,
-317L, -319L), Total.outflow.CI = c(23L, 21L, 20L, 20L, 19L,
28L, 24L, 22L, 24L, 27L, 25L, 29L, 32L, 28L, 31L, 34L, 27L, 41L,
22L, 20L, 22L, 20L, 19L, 22L), UK.inflow = c(93L, 81L, 75L, 91L,
67L, 75L, 79L, 90L, 92L, 83L, 89L, 74L, 85L, 73L, 82L, 66L, 60L,
71L, 82L, 84L, 69L, 73L, 70L, 68L), UK.inflow.CI = c(15L, 15L,
12L, 16L, 13L, 15L, 14L, 15L, 16L, 16L, 16L, 14L, 16L, 12L, 16L,
14L, 12L, 14L, 13L, 14L, 11L, 11L, 12L, 11L), UK.outflow = c(-142L,
-146L, -141L, -112L, -130L, -141L, -140L, -121L, -133L, -151L,
-150L, -172L, -184L, -189L, -175L, -200L, -158L, -159L, -130L,
-125L, -133L, -131L, -125L, -128L), UK.outflow.CI = c(17L, 16L,
16L, 14L, 15L, 22L, 19L, 18L, 16L, 18L, 18L, 22L, 22L, 23L, 22L,
26L, 19L, 22L, 11L, 11L, 12L, 14L, 11L, 13L), EU.inflow = c(60L,
49L, 48L, 53L, 60L, 74L, 70L, 75L, 64L, 55L, 54L, 57L, 58L, 128L,
149L, 173L, 189L, 186L, 162L, 171L, 168L, 148L, 193L, 256L),
EU.inflow.CI = c(12L, 10L, 8L, 10L, 11L, 14L, 18L, 14L, 16L,
13L, 15L, 16L, 17L, 22L, 23L, 26L, 28L, 27L, 19L, 21L, 18L,
17L, 20L, 25L), EU.outflow = c(-51L, -39L, -40L, -46L, -38L,
-50L, -51L, -52L, -57L, -55L, -50L, -54L, -47L, -45L, -56L,
-63L, -66L, -126L, -104L, -92L, -92L, -75L, -78L, -86L),
EU.outflow.CI = c(10L, 6L, 7L, 8L, 7L, 13L, 10L, 9L, 13L,
12L, 13L, 13L, 16L, 10L, 14L, 15L, 15L, 31L, 16L, 13L, 14L,
12L, 12L, 15L), ROW.inflow = c(175L, 138L, 143L, 171L, 185L,
169L, 178L, 226L, 298L, 340L, 338L, 385L, 368L, 388L, 336L,
358L, 325L, 333L, 323L, 336L, 329L, 277L, 264L, 308L), ROW.inflow.CI = c(13L,
10L, 11L, 13L, 15L, 14L, 14L, 17L, 21L, 23L, 20L, 24L, 22L,
31L, 25L, 25L, 25L, 25L, 19L, 18L, 19L, 18L, 18L, 24L), ROW.outflow = c(-91L,
-96L, -85L, -80L, -69L, -73L, -88L, -78L, -101L, -114L, -109L,
-136L, -133L, -109L, -129L, -135L, -117L, -142L, -134L, -122L,
-126L, -115L, -114L, -105L), ROW.outflow.CI = c(12L, 12L,
10L, 11L, 8L, 10L, 11L, 9L, 14L, 15L, 13L, 15L, 16L, 13L,
17L, 16L, 12L, 16L, 9L, 9L, 11L, 9L, 9L, 11L), GDP = c(1142797178130.51,
1179659529659.53, 1061388722255.55, 1140489745944.29, 1237561937825.47,
1306575663026.52, 1446444007858.55, 1537103345478.64, 1565408509949.85,
1554801028899.98, 1535942133294.95, 1680256294964.03, 1943025306122.45,
2297889051629.44, 2418941818181.82, 2588077276908.92, 2969733893557.42,
2793376838235.29, 2314577036921.64, 2403504326328.8, 2594904662714.31,
2630472981169.65, 2712296271989.99, 2990201431078.23)), .Names = c("Year",
"Total.inflow", "Total.inflow.CI", "Total.outflow", "Total.outflow.CI",
"UK.inflow", "UK.inflow.CI", "UK.outflow", "UK.outflow.CI", "EU.inflow",
"EU.inflow.CI", "EU.outflow", "EU.outflow.CI", "ROW.inflow",
"ROW.inflow.CI", "ROW.outflow", "ROW.outflow.CI", "GDP"), row.names = c(NA,
-24L), class = "data.frame")
For example
download.file(
"http://www.sharecsv.com/dl/88f76c7be8ade3a626f474f4857e16f8/stats.csv",
tf <- tempfile(),
method = "libcurl"
)
library(tidyverse)
df <- read_csv(tf)
inner_join(
df %>%
select(-ends_with("CI")) %>%
gather(var, value, -Year),
df %>%
select(Year, ends_with("CI")) %>%
setNames(sub("(.*)\\sCI$", "\\1", names(.))) %>%
gather(var, conf, -Year),
by = c("Year", "var")
) %>%
ggplot(aes(
x = Year,
y = value,
ymin = value - conf,
ymax = value + conf,
color = var,
fill = var
)) +
geom_ribbon(alpha = .2) +
geom_line()
gives you
(I'm using the latest development version of ggplot2)
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!
dput(t)
structure(list(Volume = c(2625941L, 4685483L, 3160694L, 2627816L,
2430273L, 2498011L, 2632445L, 3224434L, 2531941L, 5043867L, 2788003L,
3278796L, 3273977L, 3192613L, 3456297L, 2668175L, 2805861L, 2689392L,
2733510L, 3285889L, 2957370L, 3420479L, 3868692L, 4353776L, 3134759L,
2914727L, 3160491L, 3803716L, 3427911L, 2646258L, 3616962L, 3071943L,
3013008L, 4024996L, 4357129L, 3110560L, 3063334L, 4537971L, 1902002L,
2618413L, 2473005L, 2844029L, 2398462L, 3406776L, 3071573L, 3714231L,
4276458L, 3825187L, 2652650L, 3040994L, 2695117L, 3038566L, 2695652L,
2919113L, 2840214L, 2768958L, 5246649L, 3023172L, 3565584L, 2928450L,
3503840L, 2948165L, 3512192L, 3409995L, 3511665L, 3155152L, 3020401L,
2758133L, 2548245L, 3033309L, 2740213L, 2851881L, 3134557L, 4445879L,
3173913L, 3720477L, 3753070L, 3609973L, 3826284L, 4864280L, 4159588L,
3095322L, 3138732L, 3591433L, 3063357L, 3215559L, 3258059L, 3559727L,
4886550L, 4025763L, 4108614L, 5720774L, 4075195L, 3322352L, 3048940L,
3249172L, 3148053L, 3321660L, 3159642L, 3976820L, 3848960L, 3466783L,
3811408L, 6033563L, 4114751L, 3181385L, 2926695L, 2866148L, 2692198L,
3400891L, 2922295L, 3912049L, 3079066L, 2833293L, 3560196L, 3317644L,
3151086L, 3776538L, 5479510L, 3954497L, 3594429L, 3088262L, 2778180L,
3532457L), SLA = c(28L, 44L, 12L, 28L, 4L, 28L, 4L, 4L, 8L, 12L,
8L, 4L, 8L, 4L, 8L, 8L, 32L, 4L, 36L, 8L, 4L, 8L, 20L, 8L, 32L,
12L, 32L, 8L, 16L, 40L, 8L, 20L, 4L, 4L, 8L, 20L, 16L, 4L, 12L,
8L, 4L, 8L, 4L, 4L, 8L, 12L, 12L, 16L, 28L, 28L, 12L, 16L, 16L,
8L, 20L, 20L, 24L, 44L, 12L, 24L, 24L, 24L, 20L, 24L, 36L, 16L,
40L, 24L, 4L, 44L, 8L, 16L, 12L, 8L, 32L, 12L, 20L, 16L, 28L,
8L, 24L, 24L, 4L, 4L, 8L, 8L, 4L, 12L, 8L, 44L, 12L, 24L, 40L,
8L, 4L, 8L, 12L, 12L, 8L, 16L, 24L, 8L, 36L, 48L, 36L, 12L, 36L,
28L, 20L, 12L, 20L, 32L, 24L, 4L, 12L, 16L, 8L, 24L, 16L, 36L,
44L, 12L, 8L, 4L), Duration = c(21L, 25L, 15L, 13L, 15L, 20L,
17L, 20L, 12L, 15L, 31L, 12L, 24L, 16L, 25L, 13L, 13L, 20L, 21L,
20L, 26L, 15L, 26L, 21L, 27L, 20L, 34L, 29L, 74L, 62L, 33L, 27L,
26L, 23L, 30L, 26L, 26L, 18L, 19L, 13L, 25L, 18L, 20L, 18L, 37L,
20L, 22L, 25L, 24L, 22L, 42L, 17L, 18L, 18L, 28L, 18L, 28L, 32L,
23L, 31L, 12L, 30L, 40L, 30L, 18L, 18L, 19L, 27L, 21L, 31L, 23L,
26L, 14L, 22L, 21L, 21L, 26L, 30L, 21L, 23L, 12L, 22L, 24L, 29L,
36L, 19L, 21L, 25L, 24L, 29L, 26L, 34L, 33L, 17L, 17L, 24L, 19L,
18L, 12L, 18L, 11L, 19L, 22L, 48L, 49L, 25L, 16L, 43L, 18L, 18L,
19L, 15L, 38L, 19L, 22L, 28L, 28L, 34L, 16L, 53L, 38L, 23L, 27L,
17L)), .Names = c("Volume", "SLA", "Duration"), class = "data.frame", row.names = c(2L,
3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 13L, 14L, 15L, 16L,
17L, 18L, 19L, 20L, 21L, 22L, 23L, 24L, 25L, 26L, 27L, 28L, 29L,
30L, 31L, 32L, 33L, 34L, 35L, 36L, 37L, 38L, 39L, 40L, 41L, 42L,
43L, 44L, 45L, 46L, 47L, 48L, 49L, 50L, 51L, 52L, 53L, 54L, 55L,
56L, 57L, 58L, 59L, 60L, 61L, 62L, 63L, 64L, 65L, 66L, 67L, 68L,
69L, 70L, 71L, 72L, 73L, 75L, 76L, 77L, 79L, 80L, 81L, 82L, 84L,
85L, 86L, 87L, 88L, 89L, 90L, 91L, 92L, 93L, 94L, 95L, 96L, 97L,
98L, 99L, 100L, 101L, 102L, 103L, 105L, 106L, 107L, 108L, 110L,
111L, 112L, 113L, 115L, 116L, 117L, 118L, 119L, 120L, 121L, 122L,
123L, 124L, 125L, 126L, 127L, 128L, 129L, 130L, 131L))
when I do this:
z.out1 <- zelig(Duration ~ Volume, model = "logit", data = t)
I get this error:
Error in `rownames<-`(`*tmp*`, value = c(1L, 0L)) :
attempt to set rownames on object with no dimensions
any ideas?