Aim: R markdown: To construct one DinA4 pdf page with a rectangle on the top left side and two plots.
Problem: After drawing the rectangle, the next plot is far away with a large white space in between.
Desired Output: Heatmap should appear immediately after the rectangle may with one or two white lines.
I guess the problem is the drawing of the rectangle. Here I need some help. Thank you.
---
output:
pdf_document
documentclass: article
classoption: a4paper
geometry: margin=1cm
subparagraph: yes
header-includes: |
\usepackage{titlesec}
\titlespacing{\title}{0pt}{\parskip}{-\parskip}
title: "Example of Title to Body Text"
subtitle: Subtitle Places Here
---
\vspace{-5truemm}
\pagenumbering{gobble}
#``` {r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE)
library(draw)
library(ggplot2)
library(dplyr)
# ```
#```{r rectangle}
drawBox(x =2, y = 3.5, width = 2.5, height = 1)
#```
#```{r heatmap}
df <- data.frame(
test_id = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4),
test_nr = c(1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4, 5, 5, 5, 5,
1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 1, 1, 1, 1, 2, 2, 2, 2),
region = c("A", "B", "C", "D", "A", "B", "C", "D", "A", "B", "C", "D", "A",
"B", "C", "D", "A", "B", "C", "D", "A", "B", "C", "D", "A", "B",
"C", "D", "A", "B", "C", "D", "A", "B", "C", "D", "A", "B", "C", "D"),
test_value = c(3, 1, 2, 2, 2, 1, 2, 2, 3, 2, 2, 3, 2, 1, 2, 2, 1, 2, 3,
4, 2, 1, 1, 2, 1, 1, 1, 1, 2, 2, 3, 2, 2, 2, 99, 99, 3, 3, 3, 3)
)
# named vector for heatmap
cols <- c("1" = "green",
"2" = "darkgreen",
"3" = "orange",
"4" = "red",
"99" = "black")
labels_legend <- c("1" = "very good",
"2" = "good",
"3" = "not so good",
"4" = "bad",
"99" = "NA")
df <- df %>%
filter(test_id==1)
ggplot(
df,
aes(region, test_nr)) +
geom_tile(aes(fill= factor (test_value))) +
geom_text(aes(label = test_value), size = 10, color = "white") + # text in tiles
scale_colour_manual(
values = cols,
breaks = c("1", "2", "3", "4", "99"),
labels = labels_legend,
aesthetics = c("colour", "fill")
) +
theme(text = element_text(size = 14)) + # this will change all text size
labs(title = "Test (Individual heatmap)", x = "Region", y = "Event") +
labs(fill = "Test") +
coord_fixed(ratio=1, clip="on") +
theme(axis.text.y = element_text(face = "bold", size = 12)) +
theme(axis.text.x = element_text(angle = 0, face = "bold", size = 12)) +
theme(axis.line = element_line(colour = "darkblue",
size = 1, linetype = "solid")
)
# ```
## Information
You can use the subfigure environment to display multiple plots side by side, though you may not want to place the rectangle under the same main caption as the heatmap.
---
output:
pdf_document:
extra_dependencies: "subfig"
documentclass: article
classoption: a4paper
geometry: margin=1cm
subparagraph: yes
header-includes: |
\usepackage{titlesec}
\titlespacing{\title}{0pt}{\parskip}{-\parskip}
title: "Example of Title to Body Text"
subtitle: Subtitle Places Here
---
\vspace{-5truemm}
\pagenumbering{gobble}
``` {r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE)
library(draw)
library(ggplot2)
library(dplyr)
```
```{r rectangle}
drawBox(x =2, y = 3.5, width = 2.5, height = 1)
```
```{r heatmap-data}
df <- data.frame(
test_id = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4),
test_nr = c(1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4, 5, 5, 5, 5,
1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 1, 1, 1, 1, 2, 2, 2, 2),
region = c("A", "B", "C", "D", "A", "B", "C", "D", "A", "B", "C", "D", "A",
"B", "C", "D", "A", "B", "C", "D", "A", "B", "C", "D", "A", "B",
"C", "D", "A", "B", "C", "D", "A", "B", "C", "D", "A", "B", "C", "D"),
test_value = c(3, 1, 2, 2, 2, 1, 2, 2, 3, 2, 2, 3, 2, 1, 2, 2, 1, 2, 3,
4, 2, 1, 1, 2, 1, 1, 1, 1, 2, 2, 3, 2, 2, 2, 99, 99, 3, 3, 3, 3)
)
# named vector for heatmap
cols <- c("1" = "green",
"2" = "darkgreen",
"3" = "orange",
"4" = "red",
"99" = "black")
labels_legend <- c("1" = "very good",
"2" = "good",
"3" = "not so good",
"4" = "bad",
"99" = "NA")
df <- df %>%
filter(test_id==1)
```
```{r heatmap, fig.show="hold", fig.cap='Rectangle and Heatmap', fig.subcap=c('LEFT', 'RIGHT'), out.width='50%', fig.align = "center"}
drawBox(x =2, y = 3.5, width = 2.5, height = 1)
ggplot(
df,
aes(region, test_nr)
) +
geom_tile(aes(fill= factor (test_value))) +
geom_text(aes(label = test_value), size = 10, color = "white") + # text in tiles
scale_colour_manual(
values = cols,
breaks = c("1", "2", "3", "4", "99"),
labels = labels_legend,
aesthetics = c("colour", "fill")
) +
theme(text = element_text(size = 14)) + # this will change all text size
labs(title = "Test (Individual heatmap)", x = "Region", y = "Event") +
labs(fill = "Test") +
coord_fixed(ratio=1, clip="on") +
theme(axis.text.y = element_text(face = "bold", size = 12)) +
theme(axis.text.x = element_text(angle = 0, face = "bold", size = 12)) +
theme(
axis.line = element_line(
colour = "darkblue",
size = 1, linetype = "solid"
)
)
```
## Information
Related
I want to calculate the sum of y along the x-axis. The range for summation is contained in the separate columns xmin and xmax.
df <- data.frame (group = c("A","A","A","A","A","B","B","B","B","B" ),
x = c(1,2,3,4,5,1,2,3,4,5),
y= c(1,2,3,2,1,4,5,6,5,4),
xmin=c(2,2,2,2,2,1,1,1,1,1),
xmax=c(4,4,4,4,4,5,5,5,5,5))
For group A that is a range x from 2 to 4, sum{2+3+2}=7
For group B, range x from 1 to 5 sum{4+5+6+5+4}=24
Is there a way to do it?
I have tried around a bit but I'm not sure if the following goes in the right direction
df %>% rowwise() %>% mutate(sumX=sum(df$y[df$x>=df$min & df$x<=df$max]))
Using between to subset, then just sum in tapply.
subset(df, do.call(data.table::between, c(list(x), list(xmin, xmax)))) |>
with(tapply(y, group, sum))
# A B
# 7 24
Note: R >= 4.1 used.
Data:
df <- structure(list(group = c("A", "A", "A", "A", "A", "B", "B", "B",
"B", "B"), x = c(1, 2, 3, 4, 5, 1, 2, 3, 4, 5), y = c(1, 2, 3,
2, 1, 4, 5, 6, 5, 4), xmin = c(2, 2, 2, 2, 2, 1, 1, 1, 1, 1),
xmax = c(4, 4, 4, 4, 4, 5, 5, 5, 5, 5)), class = "data.frame", row.names = c(NA,
-10L))
I am new to R.
I want to plot 4 box plots for 4 continuous variables and present them in the same plot. I am trying to present the boxplot for each variable in 2 study groups while using facet_wrap in ggplot.
dividing variable is: cognitive_groups (has two values 0, 1)
the 4 variables are: memory (presented here), attention, exeuctive and language domains.
here is the code,
cogdb_bl%>%
filter(!is.na(cognitive_groups))%>%
ggplot(aes(x=memory))+
geom_boxplot(aes(y=""))+
facet_wrap(~cognitive_groups)+
theme_bw()+
coord_flip()+
labs(title="Cognitive domains in baseline groups",
x="Z score")
Here is the output,
How do I present the other variables alongside the memory?
THANKS!
Do you mean like this? A tribble by the way is a nice way to create a minimal sample of data.
library(tidyverse)
tribble(
~participant, ~memory, ~attention, ~language, ~executive, ~cognitive,
"A", 2, 5, 2, 2, 0,
"B", 2, 2, 5, 2, 1,
"C", 2, 2, 2, 2, 0,
"D", 2, 3, 2, 6, 1,
"E", 2, 2, 2, 2, 0,
"F", 2, 2, 8, 2, 0,
"G", 2, 4, 2, 2, 1,
"H", 2, 2, 7, 2, 1
) |>
pivot_longer(c(memory, attention, language, executive),
names_to = "domain", values_to = "score") |>
ggplot(aes(domain, score)) +
geom_boxplot() +
facet_wrap(~cognitive) +
theme_bw() +
coord_flip() +
labs(
title = "Cognitive domains in baseline groups",
y = "Z score"
)
Created on 2022-04-20 by the reprex package (v2.0.1)
This might have been asked before but I cannot find it after searching for a while.
I have the following data.frame.
structure(list(genotype = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
4, 4, 4, 4, 4, 4), treatment = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2,
2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2,
2, 2, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2,
2, 2, 2, 2, 2, 2, 2), group_val = c(1.57837321136062, 1.76334487045417,
1.73586017158848, 2.04109599956349, 1.80010448171344, 2.07090618591467,
1.07574792716769, 1.18397923178828, 1.21889101529495, 1.20248500773822,
1.3808338457315, 1.42210495550068, 1.64573799027085, 1.55264650622629,
1.70883543195709, 1.50659245289343, 0.90200663935181, 0.881584819347461,
0.954018876774318, 0.930280832877143, 1.85156683945601, 1.84753564786241,
1.96298425756247, 1.97329138022375, 1.89502726316024, 1.88250460242058,
1.12763625255165, 0.849376374224505, 1.04073813233643, 1.00903241221572,
1.58053330474755, 1.60670456352336, 2.02389070564365, 1.88873097588837,
2.05477131909231, 1.9945072156688, 1.25082256791521, 1.19811638234775,
1.06975634816231, 1.20976663827858, 2.10380372095596, 2.14921911265538,
2.18892848376085, 2.15381486434453, 1.82607480270083, 1.98677173426624,
0.954242509439325, 1.26717172840301, 1.02118929906994, 0.8750612633917,
0.602059991327962, 0.751757501701102, 1.62038696281561, 1.20836885846782,
1.32651612490137, 1.13698195289592, 1.6421025338509, 1.41206291695827,
1.6101194399672, 1.6712113404111, 2.11429641123473, 1.84505371972817,
2.27595666174897, 2.2231986751043, 2.24564757180665, 2.24707729700922,
1.47310327692139, 1.1447387331723, 1.24550565752405, 1.07766801873253,
1.85452622982568, 1.87613186339641, 2.09397999968991, 1.96262712830201,
2.2095435542086, 2.10814923581137, 1.00067107824743, 0.983971241990881,
1.24468845794328, 1.15181012595794)), row.names = c(NA, -80L), groups = structure(list(
genotype = c(1, 1, 2, 2, 3, 3, 4, 4), treatment = c(1, 2,
1, 2, 1, 2, 1, 2), .rows = structure(list(1:10, 11:20, 21:30,
31:40, 41:50, 51:60, 61:70, 71:80), ptype = integer(0), class = c("vctrs_list_of",
"vctrs_vctr", "list"))), row.names = c(NA, 8L), class = c("tbl_df",
"tbl", "data.frame"), .drop = TRUE), class = c("grouped_df",
"tbl_df", "tbl", "data.frame"))
My aim is to have the following plot
But with the levels on the interaction(genotype, treatment) collapsed. The only relevant information here is that "light" colors equals treatment level 1 and "dark" colors equals treatment level "2".
I would like a legend to reflect that, meaning only two points, could be "#CFCFCF" and "gray50" to reflect that the values of treatment are 1 and 2 respectively.
Here's the code to make the plot as shown in the image
library(tidyverse)
target_colors <- c("#FF9BB4", "#FA234C", "#A2D3FF", "#2987FA", "#47C947", "darkgreen",
"#CFCFCF", "gray50")
color_order <- interaction(df$genotype, df$treatment) %>% levels() %>% sort
df %>%
ggplot(aes(genotype, group_val,
color=interaction(genotype, treatment)))+
ggbeeswarm::geom_quasirandom(dodge.width = 1,
show.legend = T) +
# if flipping, the levels of the factor must be modified
#coord_flip()+
geom_boxplot(
position=position_dodge(1),
width=0.1, fill='black', show.legend = F)+
scale_color_manual(values = setNames(target_colors,
color_order))
One option would be to use only four colors, map genotype on color and treatment on alpha:
library(tidyverse)
target_colors <- c("#FA234C", "#2987FA", "darkgreen", "gray50")
df %>%
ggplot(aes(genotype, group_val,
color = factor(genotype),
alpha = factor(treatment),
group = interaction(genotype, treatment)))+
ggbeeswarm::geom_quasirandom(dodge.width = 1,
show.legend = T) +
geom_boxplot(
position=position_dodge(1),
width=0.1, fill='black', show.legend = F)+
scale_color_manual(values = target_colors) +
scale_alpha_manual(values = c(.6, 1))
In my shiny app I filter the heatmaps with a selectinput to show them in tab1.
Everything is working fine. But, I have tried to get a uniform size a.) of the different heatmaps (all should have the same overall size and all should have same tile size), and b.) to align the heatmaps on the left side (actually it is centered).
I am not able to get behind the issue, although I went through the online explanations. Thanks for your help.
My code:
global.R
# global.R
library(shiny)
library(ggplot2)
library(dplyr)
# construct the dataframe
df <- data.frame(
test_id = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4),
test_nr = c(1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4, 5, 5, 5, 5,
1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 1, 1, 1, 1, 2, 2, 2, 2),
region = c("A", "B", "C", "D", "A", "B", "C", "D", "A", "B", "C", "D", "A",
"B", "C", "D", "A", "B", "C", "D", "A", "B", "C", "D", "A", "B",
"C", "D", "A", "B", "C", "D", "A", "B", "C", "D", "A", "B", "C", "D"),
test_value = c(3, 1, 2, 2, 2, 1, 2, 2, 3, 2, 2, 3, 2, 1, 2, 2, 1, 2, 3,
4, 2, 1, 1, 2, 1, 1, 1, 1, 2, 2, 3, 2, 2, 2, 99, 99, 3, 3, 3, 3)
)
# named vector for heatmap
cols <- c("1" = "green",
"2" = "darkgreen",
"3" = "orange",
"4" = "red",
"99" = "black")
labels_legend <- c("1" = "Complete response",
"2" = "Major response",
"3" = "Minor response",
"4" = "No response",
"99" = "NA")
ui.R
# Define UI ----
ui <- fluidPage(
tags$style(HTML("
.tabbable > .nav > li > a {background-color: aqua; color:black; width: 300PX;}
")),
# App title ----
titlePanel("TEST HEATMAP"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(width = 2,
# Input: Select the id ----
selectInput(inputId = "test_id",
label = "Test ID",
choices = df$test_id,
selected = NULL)
),
# Main panel for displaying outputs ----
mainPanel(width = 10,
# Output: Tabset plot, ----
tabsetPanel(type = "tabs",
tabPanel("tab1",
plotOutput("test_plot")
),
tabPanel("tab2",
),
tabPanel("tab3",
)
)
)
)
)
server.R
shinyServer(function(input, output,session) {
var_testid <- reactive({input$test_id})
output$test_plot <- renderPlot({
req(var_testid())
df <- df %>%
filter(test_id == as.integer(var_testid())) # filter testid
ggplot(
df,
aes(region, test_nr)) +
geom_tile(aes(fill= factor (test_value))) +
geom_text(aes(label = test_value), size = 10, color = "white") + # text in tiles
scale_colour_manual(
values = cols,
breaks = c("1", "2", "3", "4", "99"),
labels = labels_legend,
aesthetics = c("colour", "fill")
) +
theme(text = element_text(size = 14)) + # this will change all text size
labs(title = "Test (Individual heatmap)", x = "Region", y = "Event") +
labs(fill = "Test") +
coord_fixed(ratio=1, clip="on") +
theme(axis.text.y = element_text(face = "bold", size = 12)) +
theme(axis.text.x = element_text(angle = 0, face = "bold", size = 12)) +
theme(axis.line = element_line(colour = "darkblue",
size = 1, linetype = "solid")
)
})
})
I wish to add points directly on top of the curved spline.
The code here does not work because geom_point places the dots as if the lines were straight. See points #2, #3. I've tried using stat_bspline2 with geom = "point" without success.
Help is much appreciated.
library(tidyverse)
library(ggforce)
data <- tibble (
x = c(10, 15, 17, 17, 20, 22, 22, 23, 25, 25, 27, 29),
y = c(5, 7, 4, 4, 0, 5, 5, 6, 5, 5, 4, 5.5),
g = c("A", "A", "A", "B", "B", "B", "C", "C", "C", "D","D","D"),
pt = c(1, 1, 0, 0, 1, 1, 0, 0, 1, 0, 0, 1)
)
data <- data %>%
mutate(pt_x = ifelse(pt == 1, x, NA),
pt_y = ifelse(pt == 1, y, NA))
ggplot(data) +
stat_bspline2(aes(x=x, y=y, color = ..group.., group = g), size = 4, n = 300, geom = "bspline0") +
scale_color_gradientn(colours = c("red", "pink", "green", "white"), guide = F) +
geom_point(aes(pt_x, pt_y), size = 7)