Side-by-side stacked barplot with facetting using ggplot2 - r
The majority of information I can find on side-by-side stacked barplots deals with instances in where some variable (number of side-by-side bars) are repeated for each variable along the x-axis - see: 1, 2, 3, 4, 5, 6. In these cases they use ggplot with besides=TRUE.
I have a more complex example which I believe will require faceting like these two examples: 7 & 8.
Quick background (for those interested in the why?):
I'm trying to compare the efficiency of a proteomics protocol that enriches for chromatin by comparing to the proportion of nuclear proteins found in the core/whole proteome experiments for 4 cell lines. to do this I used The Human Protein Atlas to annotate proteins by their subcellular location and compare nuclear proteins from chromatin-enrichment to whole-enrichment. However, the chromatin-enrichment protocol was 1D-shotgun while the whole proteome data was 2D-shotgun with 50 fractions. In layman terms this means the whole/core proteome data is a more expensive experiment done at higher coverage. Therefore, it wouldn't make sense to look at absolute proportion though because the overall amount of found proteins would be higher in the whole proteome pull-downs (see figure: absolute protein comparison sketch). To circumvent this issue I divided by the total number of proteins found in each pull-down to get relative proportion of proteins from each subcellular location.
Using these relative proportions I've produced a stacked barplot of the following data in my gist with the following code:
df1 <- read.csv("data.csv") # Load data.frame of the data
df2 <- melt(df1, # Reshape the data from
id.vars = "subcellular_location", # wide format into long format
variable.name = "cell_line", # (i.e. tidy data)
value.name = "relative_proportion")
For some reason this didn't change the variable name or value name (headers) - they are called "variable" and "value" still? So I had to rename column headers via the following.
names(df2) <- c("subcellular_location", "cell_line", "relative_proportion")
As there are many subcellular locations I needed to custom add colors, furthermore I grouped them by similar locations (e.g. nuclear in blue).
p <- ggplot() +
geom_bar(aes(x = cell_line, y = percentage, fill = subcellular_location),
data = df2, stat="identity")
p +
coord_flip() +
scale_fill_manual(values = c("#bd5db0","#9ae17c", "#be0024", "#7388ff", "#c456b7",
"#8ed470", "#7ec361", "#7d7304", "#f87a00", "#d543c7",
"#bead47", "#d148c3", "#da8836", "#e28504", "#d93eca",
"#c720b9", "#bc07ae", "#a40098", "#9a008e", "#e8d448",
"#104ed7", "#2c4ecc", "#00428c", "#393c6d", "#173b8f",
"#3f4c96", "#9ba2f5", "#727bcc", "#e59c5f", "#790000",
"#045d00", "#f9ad6f"))
See image here: stacked barplot
The core proteome pull-downs are highlighted in yellow. Ideally what I would like to do is facet this barplot into 4 sections - one for each cell line. I followed the instructions from reference 7 for faceting but am getting an error.
First I split my dataframe into 4 separate tidy dataframes (e.g. below):
K562 <- read.csv("K562-relative.csv")
K562 <- melt(K562, id.vars = "subcellular_location") # Reshape the data into tidy form
names(K562) <- c("subcellular_location", "cell_line", "relative_proportion")
etc.
Than I created a vector for cell line:
cell <- sample(c("HAP1","K562","A673","MDS"))
When I try the following code I get an error:
ref_by_cell <- data.frame(HAP1 = HAP1, K562 = K562, A673 = A673, MDS = MDS, cell = cell)
Error in data.frame(HAP1 = HAP1, K562 = K562, A673 = A673, MDS = MDS,
arguments imply differing number of rows: 576, 544, 64, 4
I would appreciate any help with faceting or alternative ideas for displaying this information.
Thank you!
I'm not entirely sure what you want, but if you want to facet by the first part of each cell_line value...
# add faceting variable to df2
df2 <- df2 %>%
mutate(cell = stringi::stri_extract_first_regex(cell_line, "^[^\\.|_]+"))
# facet by cell, specifying free scales / space on the y-axis
ggplot(data = df2,
aes(x = cell_line, y = relative_proportion, fill = subcellular_location)) +
geom_bar(stat = "identity") +
coord_flip() +
facet_grid(cell~., scales = "free_y", space = "free_y") +
scale_fill_manual(values = c("#bd5db0","#9ae17c", "#be0024", "#7388ff", "#c456b7",
"#8ed470", "#7ec361", "#7d7304", "#f87a00", "#d543c7",
"#bead47", "#d148c3", "#da8836", "#e28504", "#d93eca",
"#c720b9", "#bc07ae", "#a40098", "#9a008e", "#e8d448",
"#104ed7", "#2c4ecc", "#00428c", "#393c6d", "#173b8f",
"#3f4c96", "#9ba2f5", "#727bcc", "#e59c5f", "#790000",
"#045d00", "#f9ad6f")) +
theme_bw() +
theme(strip.text.y = element_text(angle = 0))
Data (copied from your gist link; next time please use dput so that others can reproduce your example more easily):
> dput(df1)
structure(list(subcellular_location = c("actinFilaments", "aggresome",
"cellJunctions", "centrosome", "cytokineticBridge", "cytoplasmicBodies",
"cytosol", "endoplasmicReticulum", "endosome", "focalAdhesion",
"golgiApparatus", "intermediateFilaments", "lipidDroplets", "lysosomes",
"microtubuleEnds", "microtubuleOrganizingCenter", "microtubules",
"midbodyRing", "midbody", "mitochondria", "mitoticSpindle", "nuclearBodies",
"nuclearMembrane", "nuclearSpeckles", "nucleliFibrallar", "nucleoli",
"nucleoplasm", "nucleus", "peroxisomes", "plasmaMembrane", "rodsAndRings",
"vesicles"), HAP1_P5242 = c(0.009581882, 0.000338753, 0.011033682,
0.015824623, 0.003774681, 0.00232288, 0.227013163, 0.024535424,
0.001258227, 0.005807201, 0.04229578, 0.008710801, 0.0014518,
0.001064654, 0.00029036, 0.006484708, 0.013646922, 0.000483933,
0.001064654, 0.063637244, 0.00087108, 0.02303523, 0.013646922,
0.024535424, 0.013259775, 0.054587689, 0.195509098, 0.101480836,
0.00174216, 0.058072009, 0.000822687, 0.071815718), HAP1.wt_P8255.1 = c(0.0176,
0, 0.0032, 0.0096, 0, 0.0032, 0.3664, 0.0912, 0.008, 0.0032,
0.0128, 0, 0, 0.0064, 0, 0.0032, 0.0288, 0, 0, 0.0528, 0, 0.0128,
0.0048, 0.0096, 0, 0.0496, 0.1552, 0.0576, 0, 0.064, 0.0016,
0.0384), HAP1.wt_P8255.2 = c(0.013179572, 0, 0, 0.008237232,
0, 0.004942339, 0.36738056, 0.098846788, 0.003294893, 0.003294893,
0.016474465, 0.001647446, 0, 0.004942339, 0, 0.003294893, 0.029654036,
0, 0, 0.05107084, 0, 0.009884679, 0.004942339, 0.011532125, 0,
0.044481054, 0.154859967, 0.05601318, 0, 0.064250412, 0.001647446,
0.046128501), HAP1.wt_P8254.1 = c(0.012841091, 0, 0, 0.006420546,
0.001605136, 0.004815409, 0.362760835, 0.08988764, 0.001605136,
0.004815409, 0.017656501, 0.003210273, 0, 0.003210273, 0, 0.004815409,
0.032102729, 0, 0, 0.04975923, 0, 0.011235955, 0.003210273, 0.011235955,
0, 0.04975923, 0.160513644, 0.060995185, 0, 0.069020867, 0.001605136,
0.036918138), HAP1.wt_P8254.2 = c(0.015873016, 0, 0, 0.00952381,
0.001587302, 0.004761905, 0.357142857, 0.103174603, 0.003174603,
0.003174603, 0.014285714, 0.001587302, 0.001587302, 0.003174603,
0, 0.003174603, 0.03015873, 0, 0, 0.055555556, 0, 0.012698413,
0.006349206, 0.012698413, 0, 0.050793651, 0.152380952, 0.063492063,
0, 0.057142857, 0.001587302, 0.034920635), HAP1.kd_P8253.1 = c(0,
0, 0, 0, 0, 0, 0.270270271, 0.027027028, 0, 0, 0.027027028, 0,
0, 0, 0, 0, 0.054054053, 0, 0, 0, 0, 0, 0, 0.054054053, 0, 0.054054053,
0.405405405, 0.027027028, 0, 0, 0, 0.081081081), HAP1.kd_P8253.2 = c(0.021381579,
0, 0.003289474, 0.013157895, 0, 0.003289474, 0.368421053, 0.100328947,
0.004934211, 0.003289474, 0.013157895, 0.003289474, 0, 0.006578947,
0, 0.001644737, 0.027960526, 0, 0, 0.046052632, 0, 0.011513158,
0.004934211, 0.009868421, 0, 0.050986842, 0.15131579, 0.050986842,
0, 0.065789474, 0.001644737, 0.036184211), HAP1.kd_P8252.1 = c(0.018518518,
0, 0.00308642, 0.010802469, 0, 0.00462963, 0.354938272, 0.092592593,
0.00617284, 0.00462963, 0.018518518, 0, 0.00154321, 0.00462963,
0, 0.00617284, 0.026234568, 0, 0, 0.043209877, 0, 0.015432099,
0.00308642, 0.015432099, 0, 0.049382716, 0.154320988, 0.061728395,
0, 0.063271605, 0.00154321, 0.040123457), HAP1.kd_P8252.2 = c(0.012965964,
0, 0, 0.011345219, 0.001620746, 0.003241491, 0.367909238, 0.095623987,
0.003241491, 0.004862237, 0.017828201, 0.003241491, 0, 0.004862237,
0, 0.003241491, 0.030794165, 0, 0, 0.051863857, 0, 0.016207455,
0.003241491, 0.009724473, 0, 0.04376013, 0.1636953, 0.055105348,
0, 0.064829822, 0.001620746, 0.02917342), HAP1.kd_P8249.1 = c(0.010309278,
0.001718213, 0, 0.006872852, 0, 0.005154639, 0.197594502, 0.091065292,
0.001718213, 0, 0.013745704, 0.005154639, 0.001718213, 0.001718213,
0, 0, 0.027491409, 0, 0, 0.054982818, 0, 0.017182131, 0.013745704,
0.060137457, 0, 0.082474227, 0.240549828, 0.094501718, 0, 0.04467354,
0, 0.027491409), HAP1.kd_P8249.2 = c(0.010752688, 0, 0, 0.007168459,
0, 0.003584229, 0.20609319, 0.084229391, 0.001792115, 0, 0.007168459,
0.005376344, 0, 0.001792115, 0, 0, 0.03046595, 0, 0, 0.069892473,
0, 0.019713262, 0.014336918, 0.064516129, 0, 0.08781362, 0.224014337,
0.096774194, 0, 0.039426523, 0, 0.025089606), HAP1.kd_P8248.1 = c(0.007207207,
0, 0.001801802, 0.007207207, 0, 0.003603604, 0.198198198, 0.099099099,
0, 0, 0.009009009, 0.007207207, 0, 0, 0, 0.001801802, 0.025225225,
0, 0, 0.061261261, 0, 0.021621622, 0.016216216, 0.068468468,
0, 0.079279279, 0.234234234, 0.093693694, 0.001801802, 0.028828829,
0, 0.034234234), HAP1.kd_P8248.2 = c(0.005272408, 0.001757469,
0, 0.008787346, 0, 0.005272408, 0.202108963, 0.09314587, 0, 0,
0.014059754, 0.005272408, 0, 0, 0, 0.001757469, 0.029876977,
0, 0, 0.056239016, 0, 0.021089631, 0.014059754, 0.065026362,
0, 0.086115993, 0.228471002, 0.094903339, 0.001757469, 0.036906854,
0, 0.028119508), HAP1.wt_P8247.1 = c(0.016333938, 0, 0, 0.001814882,
0, 0.005444646, 0.197822141, 0.09800363, 0.001814882, 0, 0.007259528,
0.005444646, 0, 0.001814882, 0, 0.001814882, 0.030852995, 0,
0, 0.061705989, 0, 0.021778584, 0.012704174, 0.065335753, 0,
0.087114338, 0.234119782, 0.096188748, 0, 0.029038113, 0, 0.023593466
), HAP1.wt_P8247.2 = c(0.011173184, 0, 0, 0.003724395, 0, 0.003724395,
0.197392924, 0.098696462, 0.001862197, 0, 0.009310987, 0.005586592,
0, 0.001862197, 0, 0.001862197, 0.029795158, 0, 0, 0.059590317,
0, 0.018621974, 0.013035382, 0.067039106, 0, 0.08566108, 0.240223464,
0.096834264, 0, 0.029795158, 0, 0.024208566), HAP1.wt_P8246.1 = c(0.008880995,
0, 0, 0.005328597, 0.003552398, 0.003552398, 0.195381883, 0.090586146,
0, 0, 0.005328597, 0.008880995, 0, 0, 0, 0.001776199, 0.030195382,
0, 0, 0.051509769, 0, 0.023090586, 0.01598579, 0.063943162, 0,
0.097690941, 0.245115453, 0.097690941, 0, 0.026642984, 0, 0.024866785
), HAP1.wt_P8246.2 = c(0.009025271, 0, 0.001805054, 0.005415162,
0, 0.003610108, 0.19133574, 0.088447653, 0, 0.001805054, 0.012635379,
0.007220217, 0, 0, 0, 0, 0.028880866, 0, 0, 0.048736462, 0, 0.019855596,
0.027075812, 0.066787004, 0, 0.084837545, 0.241877256, 0.09566787,
0, 0.028880866, 0, 0.036101083), HAP1_P7964.1 = c(0.010040907,
0, 0.007437709, 0.017106731, 0.002975084, 0.003346969, 0.211230941,
0.040535515, 0.002603198, 0.005950167, 0.023056898, 0.00818148,
0.001115656, 0.002231313, 0.000743771, 0.005950167, 0.014503533,
0, 0.000743771, 0.065451841, 0.001115656, 0.023056898, 0.018966158,
0.031610264, 0, 0.065451841, 0.223875046, 0.105243585, 0.002603198,
0.051692079, 0.001487542, 0.051692079), MDS_P7246 = c(0.008080031,
0.000384763, 0.005386687, 0.012889573, 0.002885725, 0.002500962,
0.204116968, 0.035013467, 0.002116199, 0.00461716, 0.030973451,
0.008272412, 0.001539053, 0.001539053, 0.000192382, 0.003270489,
0.01250481, 0.000192382, 0.000961908, 0.082724125, 0.000577145,
0.025971528, 0.018661023, 0.030011543, 0.013851481, 0.065217391,
0.214313197, 0.108310889, 0.002116199, 0.048095421, 0.000577145,
0.052135437), MDS.L_P7246.1 = c(0.008308003, 0.000202634, 0.006079027,
0.013373858, 0.003039513, 0.002228976, 0.207294805, 0.036068891,
0.002026342, 0.004660587, 0.030800401, 0.008308003, 0.001621074,
0.001621074, 0.000202634, 0.003039513, 0.012563322, 0.000202634,
0.001013171, 0.081458956, 0.000405268, 0.026950351, 0.018034445,
0.030395133, 1.34e-07, 0.065450852, 0.218642321, 0.109017209,
0.002228976, 0.050050652, 0.000810537, 0.053900702), A673_P6591 = c(0.01081944,
0.000354736, 0.008158922, 0.013125222, 0.003015254, 0.003015254,
0.202554097, 0.035118836, 0.002128414, 0.006207875, 0.036183044,
0.006917347, 0.000886839, 0.001596311, 0.000709471, 0.004788932,
0.013657325, 0.000177368, 0.001064207, 0.069882937, 0.000709471,
0.025186236, 0.015253636, 0.029265697, 0.013125222, 0.06385243,
0.207875133, 0.106598084, 0.002305782, 0.056580348, 0.000354736,
0.058531394), A673_P6591.1 = c(0.011204482, 0.000186741, 0.008403361,
0.01363212, 0.003174603, 0.002614379, 0.203361345, 0.036414566,
0.002054155, 0.006162465, 0.036788049, 0.006722689, 0.000933707,
0.001680672, 0.000746965, 0.004668534, 0.01363212, 0.000186741,
0.001120448, 0.069467787, 0.000560224, 0.025957049, 0.014752568,
0.029505135, 0, 0.064239029, 0.212885154, 0.108496732, 0.002427638,
0.05751634, 0.000373483, 0.060130719), K562_P535 = c(0.008616975,
0.000143616, 0.007755278, 0.011202068, 0.002441476, 0.003303174,
0.278471923, 0.038776389, 0.00229786, 0.006031883, 0.033031739,
0.00689358, 0.003159558, 0.00229786, 0.000287233, 0.004164871,
0.012638231, 0.000287233, 0.000574465, 0.090621858, 0.000574465,
0.015941405, 0.009478673, 0.021255206, 0.009909522, 0.047536981,
0.181243717, 0.083871894, 0.002441476, 0.055292259, 0.00114893,
0.0583082), K562_P5494.1 = c(0.008692853, 0.000321957, 0.008692853,
0.012395364, 0.002736639, 0.002736639, 0.212813909, 0.032356729,
0.001448809, 0.004990341, 0.033000644, 0.007405023, 0.001448809,
0.001448809, 0.000160979, 0.004990341, 0.013039279, 0, 0.001126851,
0.074050225, 0.000643915, 0.027849324, 0.01545396, 0.029459111,
0, 0.065035415, 0.216355441, 0.111719253, 0.002092724, 0.051996137,
0.000804894, 0.054732775), K562_P5464.1 = c(0.009412153, 0.000495376,
0.008256275, 0.013705416, 0.002476882, 0.002476882, 0.20673712,
0.032529723, 0.001486129, 0.004788639, 0.034180978, 0.007595773,
0.001155878, 0.001321004, 0.000330251, 0.005284016, 0.012714663,
0.000330251, 0.000990753, 0.073811096, 0.000660502, 0.02823646,
0.016017173, 0.029722589, 0, 0.06489432, 0.217635403, 0.110634082,
0.002146631, 0.052179657, 0.000825627, 0.056968296), K562_P5359.1 = c(0.00740349,
0, 0.005288207, 0.005288207, 0.001057641, 0.003172924, 0.225806452,
0.063987308, 0.003172924, 0.004230566, 0.022739291, 0.005817028,
0.002644104, 0.002644104, 0, 0.003701745, 0.013749339, 0, 0.000528821,
0.099947118, 0, 0.015864622, 0.020095188, 0.037546272, 0, 0.080909572,
0.196192491, 0.090957166, 0.002115283, 0.040719196, 0.000528821,
0.043892121), K562_P5359.2 = c(0.007903056, 0, 0.004741834, 0.006322445,
0.001580611, 0.002107482, 0.223393045, 0.062170706, 0.002634352,
0.004741834, 0.023709168, 0.005795574, 0.002634352, 0.002634352,
0, 0.003688093, 0.014752371, 0, 0, 0.103266596, 0, 0.017386723,
0.021601686, 0.036354057, 0, 0.079030558, 0.192834563, 0.090621707,
0.002107482, 0.042676502, 0.00052687, 0.044783983), K562_P5358.1 = c(0.007462687,
0, 0.00533049, 0.005863539, 0.001599147, 0.003731343, 0.229744136,
0.064498934, 0.003198294, 0.004264392, 0.024520256, 0.005863539,
0.003198294, 0.002132196, 0, 0.003731343, 0.015458422, 0, 0,
0.101812367, 0, 0.015991471, 0.019189765, 0.036247335, 0, 0.077292111,
0.191364606, 0.087953092, 0.002132196, 0.041577825, 0.000533049,
0.045309168), K562_P5358.2 = c(0.006546645, 0, 0.005455537, 0.007637752,
0.001636661, 0.003273322, 0.225859247, 0.063829787, 0.003273322,
0.003818876, 0.024549918, 0.007092199, 0.002182215, 0.002727769,
0, 0.003818876, 0.015275505, 0, 0, 0.106382979, 0, 0.016912166,
0.01745772, 0.038188762, 0, 0.074195308, 0.195853792, 0.089470813,
0.001636661, 0.040370977, 0.000545554, 0.042007638), K562_P5357.1 = c(0.007057546,
0, 0.004885993, 0.00597177, 0.001085776, 0.003257329, 0.231813246,
0.06514658, 0.003257329, 0.004343105, 0.024972856, 0.00597177,
0.003257329, 0.002171553, 0, 0.003800217, 0.014115092, 0, 0,
0.118892508, 0, 0.01194354, 0.016829533, 0.030944625, 0, 0.07383279,
0.184039088, 0.086862106, 0.002171553, 0.049402823, 0.000542888,
0.043431053), K562_P5357.2 = c(0.008086253, 0, 0.003773585, 0.006469003,
0.001617251, 0.003234501, 0.23180593, 0.063072776, 0.003773585,
0.003234501, 0.023180593, 0.005929919, 0.003234501, 0.002695418,
0, 0.003773585, 0.014555256, 0, 0, 0.116442049, 0, 0.01509434,
0.017789757, 0.035579515, 0, 0.071698113, 0.189757412, 0.085714286,
0.002156334, 0.044743935, 0.000539084, 0.042048518), K562_P5356.1 = c(0.006292906,
0, 0.005148741, 0.004576659, 0.001716247, 0.002860412, 0.215675057,
0.070366133, 0.003432494, 0.003432494, 0.025743707, 0.005720824,
0.003432494, 0.002860412, 0, 0.004576659, 0.016018307, 0, 0,
0.127002288, 0, 0.01201373, 0.016590389, 0.03375286, 0, 0.076659039,
0.183638444, 0.086956522, 0.001716247, 0.044622426, 0.000572082,
0.044622426), K562_P5356.2 = c(0.00755814, 0, 0.004069767, 0.004651163,
0.001744186, 0.002325581, 0.21627907, 0.070930233, 0.002906977,
0.004069767, 0.025, 0.005813953, 0.003488372, 0.002906977, 0,
0.004069767, 0.015697674, 0, 0, 0.125581395, 0, 0.013953488,
0.015697674, 0.035465116, 0, 0.073837209, 0.190697674, 0.08372093,
0.001744186, 0.045348837, 0.000581395, 0.041860465), K562_P5355.1 = c(0.009320175,
0, 0.003289474, 0.007675439, 0.001096491, 0.002741228, 0.285087719,
0.059210526, 0.003837719, 0.006030702, 0.023026316, 0.003837719,
0.003837719, 0.003289474, 0, 0.003289474, 0.016995614, 0.000548246,
0, 0.094298246, 0, 0.014254386, 0.012061404, 0.026315789, 0,
0.052631579, 0.175438596, 0.08497807, 0.001096491, 0.057017544,
0.000548246, 0.048245614), K562_P5355.2 = c(0.008210181, 0, 0.004378763,
0.009304871, 0.001094691, 0.002189382, 0.280788177, 0.056376574,
0.003284072, 0.005473454, 0.024630542, 0.004378763, 0.003284072,
0.003284072, 0, 0.004378763, 0.016967707, 0, 0, 0.100164204,
0, 0.014778325, 0.012588944, 0.028461959, 0, 0.053639847, 0.172961138,
0.084838533, 0.001642036, 0.054187192, 0.000547345, 0.048166393
), K562_P5269.1 = c(0.007308161, 0, 0.003045067, 0.007917174,
0.001218027, 0.00365408, 0.228989038, 0.071863581, 0.00365408,
0.004263094, 0.017661389, 0.007308161, 0.002436054, 0.003045067,
0, 0.002436054, 0.017052375, 0, 0, 0.107186358, 0, 0.015834348,
0.020097442, 0.033495737, 0, 0.085261876, 0.18453106, 0.091961023,
0.002436054, 0.040194884, 0.001218027, 0.03593179), K562_P5269.2 = c(0.006234414,
0, 0.00436409, 0.006234414, 0.002493766, 0.002493766, 0.224438903,
0.073566085, 0.003117207, 0.002493766, 0.018703242, 0.006857855,
0.002493766, 0.003117207, 0, 0.001246883, 0.015586035, 0, 0,
0.109725686, 0, 0.015586035, 0.018703242, 0.034289277, 0, 0.082294264,
0.195760598, 0.092892768, 0.003117207, 0.039276808, 0.000623441,
0.034289277), K562_P5268.1 = c(0.004635762, 0, 0.00397351, 0.007284768,
0.001986755, 0.002649007, 0.214569536, 0.071523179, 0.00397351,
0.002649007, 0.01986755, 0.007284768, 0.003311258, 0.003311258,
0, 0.003311258, 0.016556291, 0, 0, 0.104635762, 0, 0.017880795,
0.018543046, 0.039735099, 0, 0.090066225, 0.195364238, 0.091390728,
0.001986755, 0.039735099, 0.000662252, 0.033112583), K562_P5268.2 = c(0.005242464,
0, 0.002621232, 0.00655308, 0.002621232, 0.00327654, 0.216251638,
0.070117955, 0.00327654, 0.00327654, 0.020969856, 0.008519004,
0.002621232, 0.001965924, 0, 0.002621232, 0.018348624, 0, 0,
0.108781127, 0, 0.015727392, 0.020314548, 0.040629096, 0, 0.087811271,
0.190039319, 0.090432503, 0.001965924, 0.040629096, 0.000655308,
0.034731324)), .Names = c("subcellular_location", "HAP1_P5242",
"HAP1.wt_P8255.1", "HAP1.wt_P8255.2", "HAP1.wt_P8254.1", "HAP1.wt_P8254.2",
"HAP1.kd_P8253.1", "HAP1.kd_P8253.2", "HAP1.kd_P8252.1", "HAP1.kd_P8252.2",
"HAP1.kd_P8249.1", "HAP1.kd_P8249.2", "HAP1.kd_P8248.1", "HAP1.kd_P8248.2",
"HAP1.wt_P8247.1", "HAP1.wt_P8247.2", "HAP1.wt_P8246.1", "HAP1.wt_P8246.2",
"HAP1_P7964.1", "MDS_P7246", "MDS.L_P7246.1", "A673_P6591", "A673_P6591.1",
"K562_P535", "K562_P5494.1", "K562_P5464.1", "K562_P5359.1",
"K562_P5359.2", "K562_P5358.1", "K562_P5358.2", "K562_P5357.1",
"K562_P5357.2", "K562_P5356.1", "K562_P5356.2", "K562_P5355.1",
"K562_P5355.2", "K562_P5269.1", "K562_P5269.2", "K562_P5268.1",
"K562_P5268.2"), class = "data.frame", row.names = c(NA, -32L
))
Related
For loop to get rowmeans of each 8 columns in a large dataframe
I have a large data.frame with 8 columns per sample with 200 samples. I need to get row-means of each 8.
rowMeans(mat[j,1:8]), rowMeans(mat[j,9:16]), rowMeans(mat[j,17:24])...
rownames are gene names.
I used the following:
for(j in 1:nrow(mat)){
for (i in 1:ncol(mat)/8) {
row_m[j, i]<- rowMeans(mat[j,c(i:i+7)])
}
}
Dataframe sample data, here I have shown 9 columns, should get the mean from first 8 (AM) and then repeat for other samples....
dput(head(deconv3[1:9], 20))
structure(list(AM.amplifying.intestine = c(0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), AM43.5.epithelial.of.mammary = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4.76506, 0, 0, 1406.48, 0, 196.401,
0, 1996.5, 0), AM.epithelium.of.bronchus = c(549.649, 1647.63,
0, 0, 0, 0, 0, 0, 699.868, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
AM.epithelium.of.intestine = c(0, 0, 0, 0, 0, 0, 572.85,
59.2414, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), AM.epithelium.of.trachea = c(0,
0, 0, 0, 199.549, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0), AM.kidney.epithelial.cell = c(0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 1.32926, 0, 0, 333.592, 0), AM.medullary.thymic.epithelial.cell = c(126.847,
0, 0, 0, 0, 0, 0, 0, 0, 63.1822, 0, 0, 0, 0, 0, 0, 0, 26.0598,
0, 11.117), AM.myoepithelial.cell = c(0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), AK.amplifying.intestine = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), row.names = c("A1BG",
"A2M", "NAT2", "SERPINA3", "AANAT", "ABAT", "ABCA2", "ABCA3",
"ABCB7", "ABCA4", "ABO", "ACACA", "ACADL", "ACADS", "ACADSB",
"ACAT1", "ACLY", "ACR", "ACP1", "ACRV1"), class = "data.frame")
But it does not work. I am wondering if you could help me with this. Thanks in advance!
sample_length <- 8
row_m <- matrix(nrow=dim(mat)[1], ncol = ncol(mat)/sample_length)
for (j in 1:nrow(mat)) {
for (i in seq(from = 1, to = ncol(mat), by = sample_length)) {
row_m[j, (sample_length - 1 + i)/sample_length] <- mean(as.numeric(mat[j, i:(i + (sample_length-1))]))
}
}
Try:
row_m <- do.call(cbind, lapply(1:(NCOL(mat) %/% 8 + 1), function(i){
rowMeans(d[, ((1:NCOL(mat) - 1) %/% 8 + 1) == i, drop=F])}))
How can I calculate jaccard vertex similarity with weights in igraph
I have a square matrix that represents directed interactions, with values representing the magnitude of the "flow" from row i to column j.
mat <- structure(c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.59734154600838,
0.962276996464401, 0.996554553573577, 0.988150008522967, 0.581536975261071,
0.280105566896129, 0.0520717823071291, 0.0443864046117343, 0.0162858335588474,
0, 0, 0, 0, 0, 0, 0, 0.111900863185923, 0.289483837277475, 0.338036619790556,
0.973201117894343, 0.876145758734938, 0.280105566896129, 0.245172586054694,
0.101440228047504, 0.0136022221272776, 0, 0, 0, 0, 0, 0, 0.073088274682518,
0.21588462733217, 0.258134862678946, 0.93528472971792, 0.921844796228768,
0.318790697187933, 0.280105566896129, 0.117928032625428, 0.016073037487081,
0, 0, 0, 0, 0, 0, 0, 0.0119602547215087, 0.0174757225504163,
0.443466799224191, 0.941024455005652, 0.632609306727839, 0.57418820480725,
0.280105566896129, 0.043827579210664, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0.0547471528159807, 0.884304818335752, 0.937495721370637,
0.925118019265575, 0.280105566896129, 0.055967839940851, 0.0122649398400715,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0.0679263578760456, 0.104884821422108,
0.569814755335506, 0.853130344409379, 0.280105566896129, 0.0728699300735904,
0.0339371561178606, 0.012188886551821, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0.0219303360220489, 0.843994038605239, 0.759918325154657,
0.280105566896129, 0.143508732965731, 0.0556400089034765, 0.0296286033644999,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0.421151438381493, 0.977746695038157,
0.499880491267235, 0.280105566896129, 0.116686808742586, 0.0639605586005988,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0.0495967410949283, 0.841406989124245,
0.85505217514437, 0.578265483357174, 0.280105566896129, 0.163154497800251,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.499941945587477, 0.993657104473566,
0.807475685951474, 0.45318772928331, 0.280105566896129), .Dim = c(15L,
15L))
I am interested in calculating the weighted linkage similarity (both in and out flows) of all vertices in the network, so taking magnitude into account.
Using igraph, I can calculate the Jaccard similarity but without considering weights
library(igraph)
bin <- mat
bin[bin > 0] <- 1
similarity(graph_from_adjacency_matrix(bin),
mode = "all",
method = "jaccard")
# this gives the same result as the one above
similarity(graph_from_adjacency_matrix(mat, weighted = T),
mode = "all",
method = "jaccard")
Using the code from this blogpost, I was able to calculate the Jaccard similarity of outflows and inflows and combine them.
# outflow similarity
sim.jac.out <- matrix(0, nrow=nrow(mat), ncol=nrow(mat))
pairs <- t(combn(1:nrow(mat), 2))
for (i in 1:nrow(pairs)) {
num <- sum(sapply(1:ncol(mat), function(x) (min(mat[pairs[i,1],x], mat[pairs[i,2],x]))))
den <- sum(sapply(1:ncol(mat), function(x) (max(mat[pairs[i,1],x], mat[pairs[i,2],x]))))
sim.jac.out[pairs[i,1],pairs[i,2]] <- num/den
sim.jac.out[pairs[i,2],pairs[i,1]] <- num/den
}
sim.jac.out[which(is.na(sim.jac.out))] <- 0
diag(sim.jac.out) <- 1
# inflow similarity
sim.jac.in <- matrix(0, nrow=nrow(mat), ncol=nrow(mat))
pairs <- t(combn(1:nrow(t(mat)), 2))
for (i in 1:nrow(pairs)) {
num <- sum(sapply(1:ncol(t(mat)), function(x) (min(t(mat)[pairs[i,1],x], t(mat)[pairs[i,2],x]))))
den <- sum(sapply(1:ncol(t(mat)), function(x) (max(t(mat)[pairs[i,1],x], t(mat)[pairs[i,2],x]))))
sim.jac.in[pairs[i,1],pairs[i,2]] <- num/den
sim.jac.in[pairs[i,2],pairs[i,1]] <- num/den
}
sim.jac.in[which(is.na(sim.jac.in))] <- 0
diag(sim.jac.in) <- 1
# total similariry
sim.jac.all <- (sim.jac.in + sim.jac.out)/2
So the general question is, does this make sense?
But more specifically, I would be interested to know if there is a way to incorporate link weights in the calculation of similarity with igraph.
In my real dataset, I need to do this several times iteratively (swapping individuals), for a large number of networks, so my method would take forever. I believe igraph uses C++ under the hood.
Filtering dummy-variables to create an index
i'm trying to create an index in R and i have no idea where to start. I've been looking around but i just can't seem to find a way to do what i want to. I have several dummy-variables (1,0) and they refer to whether someone is a member in an organization (1) or not (0). I would like to create an index indicating to how many organizations a person is a member of. That means, i should somehow be able to filter and add this information to create such an index. I've never done anything like it. I've heard there are some easy ways to do it in SPSS but i want to learn how to do it in R. Does anyone have a tip, how can i do this? If it is of any use, here is an example of my data: dput(SK[1:10,]) structure(list(Woeltaetigkeit = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0), Menschenrechte = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0), Naturschutz = c(0, 0, 0, 0, 0, 1, 0, 0, 0, 0), Buergerinitiative = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0), Gewerkschaft = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0), ehem.Gewerkschaft = c(0, 1, 0, 1, 1, 0, 0, 0, 0, 1), Partei = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0), Sport = c(1, 0, 0, 1, 0, 1, 0, 0, 1, 1), Hobby = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0), Gesundheit = c(0, 1, 0, 0, 0, 0, 0, 0, 0, 0), Eltern = c(0, 0, 0, 0, 0, 1, 1, 0, 1, 0), Senioren = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), row.names = c(NA, 10L), class = "data.frame")
I think all you need is (desired output would help us understand exactly what you want): rowSums(my_data) output > rowSums(my_data) 1 2 3 4 5 6 7 8 9 10 1 2 0 2 1 3 1 0 2 2 Edit: its unclear to me if the organisations or people are on the rows or columns, If I've made the wrong assumption you can use colSums(my_data) to get the opposite.
I am dealing with a DTM and I want to do k-means, heirarchical, and k-medoids clustering. Am I suppose to normalize the DTM first?
The data, AllBooks has 590 observations of 8266 variables. Here is the code I have:
AllBooks = read_csv("AllBooks_baseline_DTM_Unlabelled.csv")
dtms = as.matrix(AllBooks)
dtms_freq = as.matrix(rowSums(dtms) / 8266)
dtms_freq1 = dtms_freq[order(dtms_freq),]
sd = sd(dtms_freq)
mean = mean(dtms_freq)
This tells me that my mean is: 0.01242767
and my std. dev. is: 0.01305608
So since my standard deviation is low this means the data has low variability in terms of size of documents. So I do not need to normalize the DTM? And by normalize I mean using the scale function in R which subtracts the mean of the data and divides by the standard deviation.
In other words my big questions is: When am I suppose to standardize data (specifically a Document Term Matrix) for clustering purposes?
Here is a little output of data:
dput(head(AllBooks,10))
budding = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0), enjoyer = c(0, 0, 0, 0, 0, 0,
0, 0, 0, 0), needs = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0), sittest = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0), eclipsed = c(0, 0, 0, 0, 0, 0,
0, 0, 0, 0), engagement = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
exuberant = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0), abandons = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0), well = c(0, 0, 0, 0, 0, 0, 0,
0, 0, 0), cheerfulness = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
hatest = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0), state = c(0, 0,
0, 0, 0, 0, 0, 0, 0, 0), stained = c(0, 0, 0, 0, 0, 0, 0,
0, 0, 0), production = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0), whitened = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0), revered = c(0, 0, 0, 0, 0, 0,
0, 0, 0, 0), developed = c(0, 0, 0, 2, 0, 0, 0, 0, 0, 0),
regarded = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0), enactments = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0), aromatical = c(0, 0, 0, 0, 0,
0, 0, 0, 0, 0), admireth = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0
), foothold = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0), shots = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0), turner = c(0, 0, 0, 0, 0, 0,
0, 0, 0, 0), inversion = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
lifeless = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0), postponement = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0), stout = c(0, 0, 0, 0, 0, 0, 0,
0, 0, 0), taketh = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0), kettle = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0), erred = c(0, 0, 0, 0, 0, 0, 0,
0, 0, 0), thinkest = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0), modern = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0), reigned = c(0, 0, 0, 0, 0, 0,
0, 0, 0, 0), sparingly = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
visual = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0), thoughts = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0), illumines = c(0, 0, 0, 0, 0,
0, 0, 0, 0, 0), attire = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
explains = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), class = c("tbl_df",
"tbl", "data.frame"), row.names = c(NA, -10L))
You can view full data from link: https://www.dropbox.com/s/p9v1y6oxith1prh/AllBooks_baseline_DTM_Unlabelled.csv?dl=0
You have a sparse dataset, where most of it is dominated by zeros, hence standard deviation is very low. You can scale it if some of your non-zero counts are extremely large, eg some are 100s while others are 1s and 2s.
It might not be such a good idea to use kmeans on sparse data, because it is unlikely you can find meaningful centers. There might be a few options available, check this link on dimension reduction.There are also graph based approaches, such as this used in biology.
Below is a simplistic way to clust and visualize:
x = read.csv("AllBooks_baseline_DTM_Unlabelled.csv")
# remove singleton columns
x = x[rowMeans(x)>0,colSums(x>0)>1]
Treat it as binary and hierachical on a binary distance:
hc=hclust(dist(x,method="binary"),method="ward.D")
clus = cutree(hc,5)
Calculate PCA and visualize:
library(Rtsne)
library(ggplo2)
pca = prcomp(x,scale=TRUE,center=TRUE)
TS = Rtsne(pca$x[,1:30])
ggplot(data.frame(Dim1=TS$Y[,1],Dim2=TS$Y[,2],C=factor(clus)),
aes(x=Dim1,y=Dim2,col=C))+geom_point()
Cluster 5 seems to be very different, and they differ in these words:
names(tail(sort(colMeans(x[clus==5,]) - colMeans(x[clus!=5,])),10))
[1] "wisdom" "thee" "lord" "things" "god" "hath" "thou" "man"
[9] "thy" "shall"
plot a very large data with many zeros
This is a small portion of a vey big data
df<- structure(list(A = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0.68906, 0, 0, 0, 0, 0, 0, 0, 0, 0.13597, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0), B = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0.40001, 0, 0, 0, 0, 0.69718, 0, 0, 0, 0, 0, 0, 0,
0, 0.090752, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), C = c(0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0.84068, 0, 0, 0, 0.34713, 0, 0, 0, 0, 0.65201,
0, 0, 0.25725, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
), D = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.86419, 0, 0, 0, 0.3845,
0, 0, 0, 0, 0.67091, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0), E = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 1.1083, 0.8324,
0, 0, 0, 0.38499, 0, 0, 0, 0, 0.69064, 0, 0, 0.14596, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), F = c(0, 0, 0, 0, 0,
0, 0, 0, 0, 1.0954, 0.74426, 0, 0, 0, 0.37715, 0, 0, 0, 0, 0.68884,
0, 0, 0.20826, 0, 0.38782, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0), G = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 1.0985, 0.66651, 0, 0,
0, 0, 0, 0, 0, 0, 0.68861, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1.1812,
0, 0, 0, 0, 0, 0, 0, 0)), .Names = c("A", "B", "C", "D", "E",
"F", "G"), class = "data.frame", row.names = c(NA, -39L))
What I want is to show the values in a more stressed way when there are a lot of zeros in a data
How I plot it is like this
eucl_dist=dist(df,method = 'euclidean')
hie_clust=hclust(eucl_dist,method = 'complete')
my_palette <- colorRampPalette(c( "green", "yellow", "red"))(n = 1000)
heatmap.2(mydata, scale = c("none"), Colv=F, Rowv=as.dendrogram(hie_clust),
xlab = "X", ylab = "Y", key=TRUE, keysize=1.1, trace="none",
density.info=c("none"), margins=c(4, 4), col=my_palette, dendrogram="row")
But as you see, in this small example, the zero dominate my plot and when it is very large then it is impossible to see anything. also I cannot change the position of the values
You are asking a lot of questions here, I'll try to answer those I see.
Zero dominates plot
Zeros dominate you data but, what do the zeros mean? Without some insight into what the zeros actually mean its hard to prescribe one best way to deal with it.
Colormap
The colorful colormap that you chose is not the best way to describe quantitative data. I would suggest a simple white to blue (or color of your choice) so that your zeros are shown as white and get hidden with the nonzero data emphasized. Example (only changing my_palette <- colorRampPalette(c("white", "cornflowerblue"))(n = 1000)):
Changing the position of the values
I'm not certain what you mean here but the layout is fixed by the dendrogram you defined.