intersect y and x axis 0

ggplot(mtcars, aes(cyl, mpg))+
  geom_col() +
  scale_y_continuous(expand=c(0,0))

Overlapping histogram

library(ggplot2)
set.seed(97531)                                                     
data1 <- data <- data.frame(values = c(rnorm(1000, 5, 3),                    
                              rnorm(1000, 7, 2),
                              runif(1000, 8, 11)),
                   group = c(rep("A", 1000),
                             rep("B", 1000),
                             rep("C", 1000)))
ggplot(data1, aes(x = values, y=100*(..count..)/sum(..count..), fill = group)) +                       
  geom_histogram(position = "identity", alpha = 0.3, bins = 50)+
  ylab("percent")

ggplot(data,aes(x=values)) + 
  geom_histogram(data=subset(data,group == 'A'),fill = "red", alpha = 0.2) +
  geom_histogram(data=subset(data, group  == 'B'),fill = "blue", alpha = 0.2) +
  geom_histogram(data=subset(data, group == 'C'),fill = "green", alpha = 0.2)

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Remove space between stacked bars

geom_label

library(tidyverse)


df <- data.frame(E2A = c(1, 1, 2, 2, 1, 1, 2, 1, 2, NA),
                 E4A = c("P", "P", "P", NA, "G", "G", "H", "H", "H", "H"),
                 E5A = c("R", "R", "R", "R", "R", "O", "O", "O", "O", "O"),
                 Tooth = c(rep("P3", 9), NA))

ggplot(data = remove_missing(df, na.rm = TRUE, vars = c("E2A", "E4A", "E5A"))) + # remove NA's for cleaner plot
  aes(x = E4A, fill = E5A) +
  geom_bar(position = "fill") +
  theme(plot.title = element_text(hjust = 0.5)) +
  labs(x = "", y = "", fill = "Canal configurations") +
  theme_bw(base_size = 14) +
  theme(legend.position = "top") +
  theme(axis.text.y = element_text(size = 8)) +
  theme(axis.text.x = element_text(size = 10)) +
  guides(fill = guide_legend(nrow = 1, byrow = TRUE)) +
  facet_wrap(.~ E2A, scales = "free") +
  geom_label(data = . %>% 
              count(E2A, E4A, E5A, Tooth),
            aes(y = n, label = n),size=5,
            position = position_fill(0.5),
            show.legend = FALSE)

title 1

setosa

Sepal.Length	Sepal.Width	Petal.Length	Petal.Width	Species
5.1	3.5	1.4	0.2	setosa
4.9	3.0	1.4	0.2	setosa
4.7	3.2	1.3	0.2	setosa
4.6	3.1	1.5	0.2	setosa
5.0	3.6	1.4	0.2	setosa
5.4	3.9	1.7	0.4	setosa
4.6	3.4	1.4	0.3	setosa
5.0	3.4	1.5	0.2	setosa
4.4	2.9	1.4	0.2	setosa
4.9	3.1	1.5	0.1	setosa
5.4	3.7	1.5	0.2	setosa
4.8	3.4	1.6	0.2	setosa
4.8	3.0	1.4	0.1	setosa
4.3	3.0	1.1	0.1	setosa
5.8	4.0	1.2	0.2	setosa
5.7	4.4	1.5	0.4	setosa
5.4	3.9	1.3	0.4	setosa
5.1	3.5	1.4	0.3	setosa
5.7	3.8	1.7	0.3	setosa
5.1	3.8	1.5	0.3	setosa
5.4	3.4	1.7	0.2	setosa
5.1	3.7	1.5	0.4	setosa
4.6	3.6	1.0	0.2	setosa
5.1	3.3	1.7	0.5	setosa
4.8	3.4	1.9	0.2	setosa
5.0	3.0	1.6	0.2	setosa
5.0	3.4	1.6	0.4	setosa
5.2	3.5	1.5	0.2	setosa
5.2	3.4	1.4	0.2	setosa
4.7	3.2	1.6	0.2	setosa
4.8	3.1	1.6	0.2	setosa
5.4	3.4	1.5	0.4	setosa
5.2	4.1	1.5	0.1	setosa
5.5	4.2	1.4	0.2	setosa
4.9	3.1	1.5	0.2	setosa
5.0	3.2	1.2	0.2	setosa
5.5	3.5	1.3	0.2	setosa
4.9	3.6	1.4	0.1	setosa
4.4	3.0	1.3	0.2	setosa
5.1	3.4	1.5	0.2	setosa
5.0	3.5	1.3	0.3	setosa
4.5	2.3	1.3	0.3	setosa
4.4	3.2	1.3	0.2	setosa
5.0	3.5	1.6	0.6	setosa
5.1	3.8	1.9	0.4	setosa
4.8	3.0	1.4	0.3	setosa
5.1	3.8	1.6	0.2	setosa
4.6	3.2	1.4	0.2	setosa
5.3	3.7	1.5	0.2	setosa
5.0	3.3	1.4	0.2	setosa

versicolor

	Sepal.Length	Sepal.Width	Petal.Length	Petal.Width	Species
51	7.0	3.2	4.7	1.4	versicolor
52	6.4	3.2	4.5	1.5	versicolor
53	6.9	3.1	4.9	1.5	versicolor
54	5.5	2.3	4.0	1.3	versicolor
55	6.5	2.8	4.6	1.5	versicolor
56	5.7	2.8	4.5	1.3	versicolor
57	6.3	3.3	4.7	1.6	versicolor
58	4.9	2.4	3.3	1.0	versicolor
59	6.6	2.9	4.6	1.3	versicolor
60	5.2	2.7	3.9	1.4	versicolor
61	5.0	2.0	3.5	1.0	versicolor
62	5.9	3.0	4.2	1.5	versicolor
63	6.0	2.2	4.0	1.0	versicolor
64	6.1	2.9	4.7	1.4	versicolor
65	5.6	2.9	3.6	1.3	versicolor
66	6.7	3.1	4.4	1.4	versicolor
67	5.6	3.0	4.5	1.5	versicolor
68	5.8	2.7	4.1	1.0	versicolor
69	6.2	2.2	4.5	1.5	versicolor
70	5.6	2.5	3.9	1.1	versicolor
71	5.9	3.2	4.8	1.8	versicolor
72	6.1	2.8	4.0	1.3	versicolor
73	6.3	2.5	4.9	1.5	versicolor
74	6.1	2.8	4.7	1.2	versicolor
75	6.4	2.9	4.3	1.3	versicolor
76	6.6	3.0	4.4	1.4	versicolor
77	6.8	2.8	4.8	1.4	versicolor
78	6.7	3.0	5.0	1.7	versicolor
79	6.0	2.9	4.5	1.5	versicolor
80	5.7	2.6	3.5	1.0	versicolor
81	5.5	2.4	3.8	1.1	versicolor
82	5.5	2.4	3.7	1.0	versicolor
83	5.8	2.7	3.9	1.2	versicolor
84	6.0	2.7	5.1	1.6	versicolor
85	5.4	3.0	4.5	1.5	versicolor
86	6.0	3.4	4.5	1.6	versicolor
87	6.7	3.1	4.7	1.5	versicolor
88	6.3	2.3	4.4	1.3	versicolor
89	5.6	3.0	4.1	1.3	versicolor
90	5.5	2.5	4.0	1.3	versicolor
91	5.5	2.6	4.4	1.2	versicolor
92	6.1	3.0	4.6	1.4	versicolor
93	5.8	2.6	4.0	1.2	versicolor
94	5.0	2.3	3.3	1.0	versicolor
95	5.6	2.7	4.2	1.3	versicolor
96	5.7	3.0	4.2	1.2	versicolor
97	5.7	2.9	4.2	1.3	versicolor
98	6.2	2.9	4.3	1.3	versicolor
99	5.1	2.5	3.0	1.1	versicolor
100	5.7	2.8	4.1	1.3	versicolor

virginica

	Sepal.Length	Sepal.Width	Petal.Length	Petal.Width	Species
101	6.3	3.3	6.0	2.5	virginica
102	5.8	2.7	5.1	1.9	virginica
103	7.1	3.0	5.9	2.1	virginica
104	6.3	2.9	5.6	1.8	virginica
105	6.5	3.0	5.8	2.2	virginica
106	7.6	3.0	6.6	2.1	virginica
107	4.9	2.5	4.5	1.7	virginica
108	7.3	2.9	6.3	1.8	virginica
109	6.7	2.5	5.8	1.8	virginica
110	7.2	3.6	6.1	2.5	virginica
111	6.5	3.2	5.1	2.0	virginica
112	6.4	2.7	5.3	1.9	virginica
113	6.8	3.0	5.5	2.1	virginica
114	5.7	2.5	5.0	2.0	virginica
115	5.8	2.8	5.1	2.4	virginica
116	6.4	3.2	5.3	2.3	virginica
117	6.5	3.0	5.5	1.8	virginica
118	7.7	3.8	6.7	2.2	virginica
119	7.7	2.6	6.9	2.3	virginica
120	6.0	2.2	5.0	1.5	virginica
121	6.9	3.2	5.7	2.3	virginica
122	5.6	2.8	4.9	2.0	virginica
123	7.7	2.8	6.7	2.0	virginica
124	6.3	2.7	4.9	1.8	virginica
125	6.7	3.3	5.7	2.1	virginica
126	7.2	3.2	6.0	1.8	virginica
127	6.2	2.8	4.8	1.8	virginica
128	6.1	3.0	4.9	1.8	virginica
129	6.4	2.8	5.6	2.1	virginica
130	7.2	3.0	5.8	1.6	virginica
131	7.4	2.8	6.1	1.9	virginica
132	7.9	3.8	6.4	2.0	virginica
133	6.4	2.8	5.6	2.2	virginica
134	6.3	2.8	5.1	1.5	virginica
135	6.1	2.6	5.6	1.4	virginica
136	7.7	3.0	6.1	2.3	virginica
137	6.3	3.4	5.6	2.4	virginica
138	6.4	3.1	5.5	1.8	virginica
139	6.0	3.0	4.8	1.8	virginica
140	6.9	3.1	5.4	2.1	virginica
141	6.7	3.1	5.6	2.4	virginica
142	6.9	3.1	5.1	2.3	virginica
143	5.8	2.7	5.1	1.9	virginica
144	6.8	3.2	5.9	2.3	virginica
145	6.7	3.3	5.7	2.5	virginica
146	6.7	3.0	5.2	2.3	virginica
147	6.3	2.5	5.0	1.9	virginica
148	6.5	3.0	5.2	2.0	virginica
149	6.2	3.4	5.4	2.3	virginica
150	5.9	3.0	5.1	1.8	virginica

Waffleplot

library(packcircles)

## Warning: Paket 'packcircles' wurde unter R Version 4.1.3 erstellt

#install.packages("packcircles")
library(ggplot2)
library(ggforce)

names <- c("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", 
"O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "AA", "AB", "AC", "AD", 
"AE", "AF", "AG", "AH", "AI", "AJ", "AK", "AL", "AM", "AN", "AO", "AP", "AQ", "AR", 
"AS", "AT", "AU", "AV", "AW", "AX", "AY", "AZ", "BA", "BB", "BC", "BD", "BE", "BF", 
"BG", "BH", "BI", "BJ", "BK", "BL", "BM", "BN", "BO", "BP", "BQ", "BR", "BS", "BT", 
"BU", "BV", "BW", "BX", "BY", "BZ", "CA", "CB", "CC", "CD", "CE", "CF", "CG", "CH", 
"CI", "CJ", "CK", "CL", "CM", "CN", "CO", "CP", "CQ", "CR", "CS")

cts <- c(620, 343, 165, 121, 107, 106, 104, 88, 83, 59, 57, 56, 49, 45, 44, 37, 37, 
37, 37, 35, 31, 31, 29, 27, 24, 23, 23, 22, 21, 21, 20, 20, 17, 17, 16, 16, 15, 15, 
15, 14, 14, 13, 13, 12, 12, 12, 11, 11, 10, 10, 10, 9, 9, 8, 8, 7, 6, 5, 5, 5, 5, 5, 
4, 4, 4, 3, 3, 3, 3, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 
1, 1, 1, 1, 1, 1, 1)

testdat <- data.frame(names, cts)

testdat %>%
  mutate(x = rep(1:10, each = 10)[seq(nrow(.))],
         y = rep(1:10, 10)[seq(nrow(.))]) %>%
  ggplot(aes(x, y, fill = log(cts))) +
  geom_tile(width = 0.8, height = 0.8) +
  geom_text(aes(label = names), color = "white") +
  scale_fill_viridis_c(option = "E") +
  coord_equal() +
  theme_void()

testdat <- cbind(testdat, circleRepelLayout(testdat$cts)$layout)

ggplot(testdat, aes(x0 = x, y0 = y, fill = radius)) +
  geom_circle(aes(r = radius)) +
  geom_text(aes(x, y, label = names, size = order(radius))) +
  coord_equal() +
  theme_void() +
  scale_fill_distiller(palette = "Pastel1") +
  theme(legend.position = "none")

ggVennDiagram

# https://stackoverflow.com/questions/71504649/ggvenndiagram-values-inside-circles-by-changing-data-do-not-change

dd<-read.table (text=" Out1 Out2
Yes NO
Yes NO
Yes NO
Yes NO
Yes NO
Yes NO
Yes NO
Yes NO
Yes NO
Yes NO
Yes NO
Yes NO
Yes NO
Yes Yes
Yes Yes
Yes NO
Yes NO
Yes NO
Yes NO
Yes NO
Yes NO
Yes NO
Yes NO
Yes NO
Yes NO
Yes NO
Yes Yes
Yes Yes
Yes Yes

", header=TRUE)

library(ggVennDiagram)

## Warning: Paket 'ggVennDiagram' wurde unter R Version 4.1.3 erstellt

my_list <- list(Out1 = which(dd$Out1 == "Yes"), 
                Out2 = which(dd$Out2 == "Yes")) 

ggVennDiagram(my_list, label_alpha = 0) + 
  ggplot2::scale_fill_gradient(low = "white", high = "green")

Lineplot

df <- data.frame(concentratie_G6P = c(0, 1.88, 3.75, 7.5, 15, 30),
                 Inhibitor_Cu_ionen = c(0.0019, 0.0448, 0.0134, 0.047, 0.0285, 0.0324),
                 Inhibitor_glucosamine = c(0, 0.0362, 0.0467, 0.0397, 0.0532, 0.0433),
                 Zonder_inhibitor = c(0, 0.0185, 0.0175, 0.0796, 0.0541, 0.0217))

df %>%
  ggplot() +
  geom_line(aes(x = concentratie_G6P, y = Inhibitor_Cu_ionen, color = "blue")) +
  geom_line(aes(x = concentratie_G6P, y = Inhibitor_glucosamine, color = "red")) +
  geom_line(aes(x = concentratie_G6P, y = Zonder_inhibitor, color = "green")) +
  scale_color_manual(labels = c("Inhibitor Cu-ionen", "Inhibtor glucosamine", "Zonder inhibtor"), values=c("blue", "red", "green")) +
  xlab("Concetratie") +
  ylab("Value") +
  ggtitle("Your plot") +
  theme_minimal()

Lineplot 2

Date = c("2010-01", "2010-02", "2010-03","2010-04", "2011-01", "2011-02", "2011-03", "2011-04")
year = c(2010, 2010, 2010, 2010, 2011, 2011, 2011, 2011)
month = c(01, 02, 03, 04, 01, 02, 03, 04)
tmean = c(15, 20, 30, 25, 18, 23, 33, 28)
df = data.frame(tmean, Date, year, month)

ggplot(df, aes(month, tmean, color = as.character(year))) + 
  geom_line() +
  labs(color = "Year")

Barplot geom_text

# https://stackoverflow.com/questions/71803504/how-to-reduce-space-when-using-geom-text-paste-and-n

library(tidyverse)

Plot_DF.2.2 <- structure(list(V = structure(c(1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L
), .Label = c("Unvaccinated", "Vaccinated"), class = "factor"), 
SN = structure(c(1L, 2L, 3L, 4L, 1L, 2L, 3L, 4L), .Label = c("0", 
"1", "2", "3"), class = "factor"), Freq = c(323L, 221L, 144L, 
84L, 101L, 222L, 398L, 976L), Total = c(772L, 772L, 772L, 
772L, 1697L, 1697L, 1697L, 1697L), Percent = c(41.839378238342, 
28.6269430051813, 18.6528497409326, 10.880829015544, 5.95167943429582, 
13.0819092516205, 23.4531526222746, 57.5132586918091), Proportion = c(0.41839378238342, 
0.286269430051813, 0.186528497409326, 0.10880829015544, 0.0595167943429582, 
0.130819092516205, 0.234531526222746, 0.575132586918091), 
SE = c(0.0177540926189768, 0.0162684428410836, 0.0140195836873372, 
0.0112074784287869, 0.00574320564141126, 0.00818558521265792, 
0.0102854512025968, 0.0119996831224857), margin.error = c(0.0348520936473382, 
0.0319356953668124, 0.0275210822684065, 0.0220007913743278, 
0.0112645151307286, 0.0160549097906227, 0.0201735107415641, 
0.023535743021727), lower = c(0.383541688736081, 0.254333734685001, 
0.15900741514092, 0.0868074987811126, 0.0482522792122296, 
0.114764182725582, 0.214358015481182, 0.551596843896364), 
upper = c(0.453245876030758, 0.318205125418626, 0.214049579677733, 
0.130809081529768, 0.0707813094736867, 0.146874002306828, 
0.25470503696431, 0.598668329939818)), row.names = c(NA, 
8L), class = "data.frame")




ggplot(Plot_DF.2.2, aes(x = SN, y = Proportion, fill = SN)) +
  facet_wrap(V ~ .) +
  geom_col() +
  labs(x = "Number of Vaccinated Discussants in Respondents' Social Network",
       title = "Distribution of Vaccination in Social Networks",
       subtitle = "Conditional on Vaccination Status",
       caption = paste("Note: Numbers represent estimated percentage with",
                       "estimates' standard errors in parentheses.",
                       "\nError bar represents confidence interval",
                       "around the estimate.")) +
  theme_minimal() +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  theme(legend.position = "none",
        plot.title = element_text(hjust = 0.5),
        plot.subtitle = element_text(hjust = 0.5),
        plot.caption= element_text(hjust = 0),
        axis.title.y=element_blank()) +
  geom_text(aes(label = paste0(round(Percent,0), "%", "\n(", round(SE*100, 2), ")")), 
            position = position_dodge(width = 0.9), vjust = -0.25,
            lineheight = 0.9)

ggarange ggpubr ggexport

library(tidyverse)
library(ggpubr)


df <- structure(list(Gender = c("male", "male", "male", "male", "female", 
"female", "female", "female"), Season = c("fall", "spring", "summer", 
"winter", "fall", "spring", "winter", "summer"), count = c(300L, 
350L, 320L, 305L, 120L, 350L, 320L, 500L)), class = "data.frame", row.names = c(NA, 
-8L))

stack <- ggplot(df, aes(x = factor(Season), y=count, fill=Gender))+
  geom_col()+
  geom_text(aes(x = Season, y = count, label = count, group = Gender),
            position = position_stack(vjust = .5), size=4, color="yellow")+
  xlab('Season') +
  scale_fill_manual(values = c("maroon", "blue"))+
  theme_pubr()

dodge <- ggplot(df) +
  geom_col(aes(x = factor(Season), y=count, fill=Gender), 
           position =  'dodge') +
  geom_text(aes(x = Season, y = count, label = count, group = Gender),
            position = position_dodge(width = 0.9), 
            vjust=1.5, size=4, color="yellow")+
  xlab('Season') +
  scale_fill_manual(values = c("maroon", "blue"))+
  theme_pubr()

figure <- ggarrange(stack, dodge,
                    labels = c("A", "B"),
                    common.legend = TRUE, 
                    legend = "bottom")

figure

#ggexport(figure, filename = "figure1.png")

barchart positiv negativ

library(ggplot2)
library(ggpubr)
data.test <- data.frame(x = LETTERS[1:5],    
                        y = c(-4, 2, 7, 3, -5),
                        z = c("Negative","Positive","Positive","Positive","Negative"))
data.test

##   x  y        z
## 1 A -4 Negative
## 2 B  2 Positive
## 3 C  7 Positive
## 4 D  3 Positive
## 5 E -5 Negative

ggplot(data.test, aes(x, y, fill = y)) + 
  geom_col() + 
  scale_fill_gradient(low = "red", high = "green")+
  theme_pubr()

Vierfelder scatterplot coefficients

table to pdf saving multiple pages

#https://stackoverflow.com/questions/71915599/grid-table-export-multiple-tables-into-one-pdf

tbl <- matrix(1:100,nrow=10)

tbl2 <- matrix(100:1,nrow=10)

require("gridExtra")

## Lade nötiges Paket: gridExtra

## 
## Attache Paket: 'gridExtra'

## Das folgende Objekt ist maskiert 'package:dplyr':
## 
##     combine

pdf("test.pdf")

grid.table(tbl)
grid::grid.newpage()
grid.table(tbl2)

dev.off()

## png 
##   2

group_split modify_at

#https://stackoverflow.com/questions/34096162/dplyr-mutate-replace-several-columns-on-a-subset-of-rows
set.seed(1)
library(data.table)

## 
## Attache Paket: 'data.table'

## Die folgenden Objekte sind maskiert von 'package:dplyr':
## 
##     between, first, last

## Das folgende Objekt ist maskiert 'package:purrr':
## 
##     transpose

dt <- data.table(site = sample(1:6, 50, replace=T),
                 space = sample(1:4, 50, replace=T),
                 measure = sample(c('cfl', 'led', 'linear', 'exit'), 50, 
                                  replace=T),
                 qty = round(runif(50) * 30),
                 qty.exit = 0,
                 delta.watts = sample(10.5:100.5, 50, replace=T),
                 cf = runif(50))
dt

##     site space measure qty qty.exit delta.watts         cf
##  1:    1     2  linear  27        0        44.5 0.22130593
##  2:    4     2  linear  13        0        55.5 0.22638080
##  3:    1     4     led  23        0        28.5 0.13141653
##  4:    2     4     led  26        0        84.5 0.98156346
##  5:    5     2     led  12        0        25.5 0.32701373
##  6:    3     2    exit   2        0        49.5 0.50693950
##  7:    6     1  linear  10        0        18.5 0.68144251
##  8:    2     2    exit  22        0        59.5 0.09916910
##  9:    3     2     led  10        0        33.5 0.11890256
## 10:    3     2     led  19        0        19.5 0.05043966
## 11:    1     2    exit  25        0        88.5 0.92925392
## 12:    5     1  linear  26        0        41.5 0.67371223
## 13:    5     3  linear  12        0        48.5 0.09485786
## 14:    2     3    exit  11        0        46.5 0.49259612
## 15:    6     4  linear  27        0        21.5 0.46155184
## 16:    6     2     cfl  19        0        23.5 0.37521653
## 17:    2     3     led  22        0        25.5 0.99109922
## 18:    1     3     led  18        0        24.5 0.17635071
## 19:    5     4     cfl  27        0        11.5 0.81343521
## 20:    5     2  linear   9        0        74.5 0.06844664
## 21:    1     4  linear   6        0        76.5 0.40044975
## 22:    1     3     led  27        0        82.5 0.14114433
## 23:    6     3  linear  15        0        26.5 0.19330986
## 24:    5     1     led  26        0        93.5 0.84135172
## 25:    5     4     cfl   6        0        14.5 0.71991399
## 26:    2     1    exit  23        0        50.5 0.26721208
## 27:    2     4     led  22        0       100.5 0.49500164
## 28:    6     1    exit  28        0        40.5 0.08311390
## 29:    1     4     cfl  16        0        81.5 0.35388424
## 30:    4     1    exit  21        0        45.5 0.96920881
## 31:    1     3  linear  12        0        58.5 0.62471419
## 32:    4     2  linear   3        0        50.5 0.66461825
## 33:    3     4    exit  28        0        38.5 0.31248966
## 34:    6     3     cfl   8        0        94.5 0.40568961
## 35:    2     1    exit  18        0        73.5 0.99607737
## 36:    2     1     led   3        0        10.5 0.85508236
## 37:    6     4    exit  25        0        62.5 0.95354840
## 38:    4     2     cfl  10        0        93.5 0.81230509
## 39:    4     1  linear  23        0        66.5 0.78218212
## 40:    4     4     led   8        0        97.5 0.26787813
## 41:    2     4  linear   7        0        62.5 0.76215153
## 42:    4     4  linear  16        0        95.5 0.98631159
## 43:    1     1     cfl   8        0        59.5 0.29360555
## 44:    6     1     cfl   5        0        89.5 0.39935111
## 45:    1     1     led  16        0        39.5 0.81213152
## 46:    4     3     led  17        0        11.5 0.07715167
## 47:    1     2     led   4        0        81.5 0.36369681
## 48:    6     1    exit   8        0        87.5 0.44259247
## 49:    2     1    exit  22        0        45.5 0.15671413
## 50:    3     3     cfl  29        0        99.5 0.58220527
##     site space measure qty qty.exit delta.watts         cf

library(tidyverse)
dt %>%
  as_tibble() %>% 
  group_split(measure == "exit", keep=FALSE) %>% # or `split(.$measure == "exit")`
  modify_at(2,~mutate(.,qty.exit = qty, cf = 0, delta.watts = 13)) %>%
  bind_rows()

## Warning: The `keep` argument of `group_split()` is deprecated as of dplyr 1.0.0.
## Please use the `.keep` argument instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was generated.

## # A tibble: 50 x 7
##     site space measure   qty qty.exit delta.watts     cf
##    <int> <int> <chr>   <dbl>    <dbl>       <dbl>  <dbl>
##  1     1     2 linear     27        0        44.5 0.221 
##  2     4     2 linear     13        0        55.5 0.226 
##  3     1     4 led        23        0        28.5 0.131 
##  4     2     4 led        26        0        84.5 0.982 
##  5     5     2 led        12        0        25.5 0.327 
##  6     6     1 linear     10        0        18.5 0.681 
##  7     3     2 led        10        0        33.5 0.119 
##  8     3     2 led        19        0        19.5 0.0504
##  9     5     1 linear     26        0        41.5 0.674 
## 10     5     3 linear     12        0        48.5 0.0949
## # ... with 40 more rows

ggplot function

library(tidyverse)

d <- sample_n(diamonds, 500)

plot_something <- function(data, x, y, x_axis_name = NULL) {
  x_lab <- if (!is.null(x_axis_name)) xlab(x_axis_name)
  
  p <- ggplot(d, aes_string(x = x, y = y)) +
    geom_point() +
    x_lab
  
  return(p)
}

plot_something(data = d, x = "depth", y = "price", x_axis_name = "random_name")

time series ggplot date seq

#https://stackoverflow.com/questions/71929949/how-can-i-make-time-series-plot

library(tidyverse)
library(lubridate)

## 
## Attache Paket: 'lubridate'

## Die folgenden Objekte sind maskiert von 'package:data.table':
## 
##     hour, isoweek, mday, minute, month, quarter, second, wday, week,
##     yday, year

## Die folgenden Objekte sind maskiert von 'package:base':
## 
##     date, intersect, setdiff, union

a <- 1
b <- 3
c <- 0

Date <- c(1:128)
Wheat <- rnorm(128, mean = a, sd = b)
Hazelnut <- runif(128, a ,b)
Corn <- rnorm(128, mean = c, sd = b)
Date <- seq(ymd("2022-01-01"), ymd("2022-01-01")+127, by=1)
df <- as.data.frame(cbind(Date, Wheat, Hazelnut, Corn))


df <- df %>% 
  pivot_longer(c("Wheat", "Hazelnut", "Corn"), 
               names_to="crop",
               values_to="vals") 
  
df %>% ggplot(aes(x=Date, y=vals)) + 
  geom_line() + 
  facet_wrap(~crop, ncol=1) + 
  theme_classic()

df %>% filter(Date <= ymd("2022-02-28")) %>% 
  ggplot(aes(x=Date, y=vals)) + 
  geom_line() + 
  facet_wrap(~crop, ncol=1) + 
  theme_classic()

ggpubr tukey test

library(ggplot2)
library(tidyverse)
library(dplyr)
library(rstatix)

## 
## Attache Paket: 'rstatix'

## Das folgende Objekt ist maskiert 'package:stats':
## 
##     filter

library(ggpubr)


test <- iris
test$Species <- as.factor(test$Species)
test.aov <- test %>% anova_test(Sepal.Width ~ Species)

## Coefficient covariances computed by hccm()

test.tukey <- test %>% tukey_hsd(Sepal.Width ~ Species)
test.tukey <- test.tukey %>% add_xy_position(x = "Species")

ggboxplot(test, x = "Species", y = "Sepal.Width", outlier.shape = NA) +
  stat_pvalue_manual(test.tukey, hide.ns = TRUE, y.position = c(5,4.5,4), 
                     label = "p = {scales::pvalue(p.adj)}") +
  geom_jitter(shape=16, alpha = 0.4, size = 2, position=position_jitter(0.1)) +
  labs(subtitle = get_test_label(test.aov, detailed = T)) +
  scale_y_continuous(breaks = seq(0,5,1), limits = c(0,5)) +
  xlab("Species") +
  ylab("Sepal Length") +
  theme_bw() +
  theme(panel.grid = element_blank(),
        plot.subtitle = element_text(vjust = -105, hjust = 0.05),
        text = element_text(size = 14),
        axis.text.x = element_text(size = 16, color = "black"),
        axis.text.y = element_text(size = 16, color = "black"))

Likert ggplot

# https://stackoverflow.com/questions/71969071/right-order-in-levels-likert-with-negative-and-positive-values-but-wrong-colo#71969327

likert_palette = c("#F58C7B","#F9B8AD","#A0DCB3","#67C785") 

fivelevels <- c("Substantially less often",
                "Somewhat less often",
                "Unchanged",
                "Somewhat more often",
                "Substantially more often"
)

df <- cbind("activities"=c("Online lectures"), 
      "x"=c("Substantially less often",
            "Somewhat less often",
            "Somewhat more often",
            "Substantially more often"), 
      "prosent" = c(-0.02,-0.05, 0.32,0.42)) %>% 
  as_tibble() %>% 
  mutate(prosent = as.double(prosent),
         x = factor(x, levels = fivelevels[c(1:3, 5:4)]))

df %>%  
ggplot(aes(y = activities, x = prosent, fill = x)) +
  geom_col() +
  geom_text(aes(x = prosent, label = scales::percent(prosent, accuracy = 1L)), 
            position = position_stack( reverse = T, vjust = 0.5), size = 2) + 
  scale_fill_manual(limits = fivelevels[c(1:2, 4:5)],
                    values = setNames(likert_palette, fivelevels[-3]))

fill y= …prop…

# https://stackoverflow.com/questions/50063362/how-to-color-bar-plots-when-using-prop-in-ggplot-

ggplot(diamonds, aes(x = color, y = ..prop.., fill = factor(..x..), group = 1)) +
  geom_bar() +
  facet_grid(~cut)+ 
  scale_fill_manual(values = c("red", "green", "yellow", "blue", "pink", "purple", "black")) + 
  theme(axis.text.x = element_text(angle=90))

stacked bar_chart

positive <- c("21", "22", "33", "21", "27") ##Percentage
negative<- c("71", "77", "67", "79", "73")  ##Precentage 
sample <- c("Hr", "Fi", "We", "Pa", "Ki")
mydata <- data.frame(positive , negative, sample)

mydata %>% 
  pivot_longer(
    cols = -sample,
    names_to = "status",
    values_to = "percentage", 
    values_transform = list(percentage = as.integer)
  ) %>% 
  ggplot(aes(x = sample, y=percentage, fill=status))+
  geom_col(position = position_fill()) +
  scale_y_continuous(labels = scales::percent) +
  geom_text(aes(label = percentage),
            position = position_fill(vjust = .5))

second y axis

Phonotactic_Probability <-structure(list(Word = c("Baby", "Bagel", "Bandage", "Banjo", 
"Carriage", "Carrot", "Chicken", "Chipmunk", "City", "Cobra", 
"Cocoa", "Fairy", "Ferret", "Garbage", "Garlic", "Letter", "Lettuce", 
"Lobster", "Locker", "Marble", "Marker", "Muffin", "Mushroom", 
"Pasta", "Peacock", "Peanut", "Possum", "Puppet", "Puppy", "Raccoon", 
"Racket", "Rooster", "Ruler", "Sandal", "Sandwich", "Scissors", 
"Turkey", "Turtle", "Whistle", "Wizard"), `Biphone Probability...5` = c(0.0029, 
0.0023, 0.0274, 0.012, 0.025, 0.02, 0.0048, 0.0019, 0.0029, 0.0057, 
4e-04, 2e-04, 0.0085, 0.0209, 0.0199, 0.0061, 0.0044, 0.0168, 
0.0014, 0.0222, 0.0202, 0.0033, 0.004, 0.0265, 4e-04, 0.0044, 
0.0045, 0.009, 0.0025, 0.0023, 0.0079, 0.0153, 0.0031, 0.0278, 
0.0265, 0.008, 0.0042, 0.0107, 0.0163, 0.0064), `Biphone Probability` = c(0.0029, 
0.0023, 0.0274, 0.012, 0.025, 0.02, 0.0048, 0.0019, 0.0029, 0.0057, 
4e-04, 2e-04, 0.0085, 0.0209, 0.0199, 0.0061, 0.0044, 0.0168, 
0.0014, 0.0222, 0.0202, 0.0033, 0.004, 0.0265, 4e-04, 0.0044, 
0.0045, 0.009, 0.0025, 0.0023, 0.0079, 0.0153, 0.0031, 0.0278, 
0.0265, 0.008, 0.0042, 0.0107, 0.0163, 0.0064)), class = c("grouped_df", 
"tbl_df", "tbl", "data.frame"), row.names = c(NA, -40L), groups = structure(list(
Word = c("Baby", "Bagel", "Bandage", "Banjo", "Carriage", 
"Carrot", "Chicken", "Chipmunk", "City", "Cobra", "Cocoa", 
"Fairy", "Ferret", "Garbage", "Garlic", "Letter", "Lettuce", 
"Lobster", "Locker", "Marble", "Marker", "Muffin", "Mushroom", 
"Pasta", "Peacock", "Peanut", "Possum", "Puppet", "Puppy", 
"Raccoon", "Racket", "Rooster", "Ruler", "Sandal", "Sandwich", 
"Scissors", "Turkey", "Turtle", "Whistle", "Wizard"), .rows = structure(list(
1L, 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), ptype = integer(0), class = c("vctrs_list_of", 
                                  "vctrs_vctr", "list"))), class = c("tbl_df", "tbl", "data.frame"
                                  ), row.names = c(NA, -40L), .drop = TRUE))

###Word Frequency df
Word_Frequency <- structure(list(Word = c("Baby", "Bagel", "Bandage", "Banjo", 
"Carriage", "Carrot", "Chicken", "Chipmunk", "City", "Cobra", 
"Cocoa", "Fairy", "Ferret", "Garbage", "Garlic", "Letter", "Lettuce", 
"Lobster", "Locker", "Marble", "Marker", "Muffin", "Mushroom", 
"Pasta", "Peacock", "Peanut", "Possum", "Puppet", "Puppy", "Raccoon", 
"Racket", "Rooster", "Ruler", "Sandal", "Sandwich", "Scissors", 
"Turkey", "Turtle", "Whistle", "Wizard"), `Frequency (Google Books)` = c(6127799, 
29335, 428865, 125242, 2505730, 215525, 1724136, 30591, 30586130, 
69450, 382604, 1082454, 115446, 674079, 651590, 20168453, 353798, 
256454, 271988, 1996235, 769873, 81982, 270867, 238173, 149644, 
277100, 76104, 384574, 316058, 73050, 268584, 136815, 1659585, 
81154, 430627, 511265, 1763068, 396105, 778168, 309233), Freq10k = c(612.7799, 
2.9335, 42.8865, 12.5242, 250.573, 21.5525, 172.4136, 3.0591, 
3058.613, 6.945, 38.2604, 108.2454, 11.5446, 67.4079, 65.159, 
2016.8453, 35.3798, 25.6454, 27.1988, 199.6235, 76.9873, 8.1982, 
27.0867, 23.8173, 14.9644, 27.71, 7.6104, 38.4574, 31.6058, 7.305, 
26.8584, 13.6815, 165.9585, 8.1154, 43.0627, 51.1265, 176.3068, 
39.6105, 77.8168, 30.9233)), class = c("grouped_df", "tbl_df", 
"tbl", "data.frame"), row.names = c(NA, -40L), groups = structure(list(
Word = c("Baby", "Bagel", "Bandage", "Banjo", "Carriage", 
"Carrot", "Chicken", "Chipmunk", "City", "Cobra", "Cocoa", 
"Fairy", "Ferret", "Garbage", "Garlic", "Letter", "Lettuce", 
"Lobster", "Locker", "Marble", "Marker", "Muffin", "Mushroom", 
"Pasta", "Peacock", "Peanut", "Possum", "Puppet", "Puppy", 
"Raccoon", "Racket", "Rooster", "Ruler", "Sandal", "Sandwich", 
"Scissors", "Turkey", "Turtle", "Whistle", "Wizard"), .rows = structure(list(
1L, 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), ptype = integer(0), class = c("vctrs_list_of", 
  "vctrs_vctr", "list"))), class = c("tbl_df", "tbl", "data.frame"
  ), row.names = c(NA, -40L), .drop = TRUE))


library(tidyverse)

df <- left_join(Phonotactic_Probability, Word_Frequency, by="Word")

coeff <- 100000

ggplot(df, aes(x = reorder(Word,`Biphone Probability`))) +
  geom_point(aes(y = `Biphone Probability`), size = 4, color = "red")+
  geom_point(aes(y = Freq10k / coeff), shape=23, fill="blue", size=4) +
  scale_y_continuous(
    name = "Biphone Probability",
    sec.axis = sec_axis(~.*coeff, name = "Word frequency per 10k")
  ) +
  xlab("\nTarget word")+
  theme_bw(14)+
  theme(
    axis.title.y = element_text(color = "red", size=13, face="bold"),
    axis.title.y.right = element_text(color = "blue", size=13, face="bold"),
    axis.text.x = element_text(angle = 45, vjust = 0.5, hjust=1)
  ) +
  ggtitle("Biphone Probability and Word frequency per 10k")

geom_point 2 y variables legend

library(ggplot2)

ggplot(mtcars, aes(mpg)) +
  geom_point(aes(y = hp, color = "hp")) +
  geom_point(aes(y = cyl, color = "cyl")) +
  scale_color_manual(values = c(hp = "blue", cyl = "green"), labels = c(hp = "Horse Power", cyl = "Cylinders"))

scale_fill_manual bar plot

df2 <- data.frame(supp=rep(c("VC", "OJ"), each=3),
                  dose=rep(c("D0.5", "D1", "D2"),2),
                  len=c(6.8, 15, 33, 4.2, 10, 29.5))

myPalette <- c("#05eb92", "#119da4", "#ffc857")

myPalette_with_black <- setNames(c(myPalette, "black"), 
                                 c(as.character(seq_along(myPalette)), "-999"))

df2 <- df2 %>% 
  group_by(supp) %>% 
  mutate(dummy = ifelse(supp == "VC", as.character(row_number()), "-999"))

ggplot(data=df2, aes(x=dose, y=len, fill = dummy)) +
  geom_bar(stat="identity", position=position_dodge()) +
  scale_fill_manual(values = myPalette_with_black) +
  theme(legend.position = "none")

Arrow axis ggplot

library(ggplot2)
dat <- mtcars

ggplot(data = dat) +
  geom_point(aes(x = wt, y = mpg)) + 
  theme(axis.line = element_line(color = "black", arrow = arrow(length = unit(0.3, "lines"), type = "closed")))

free scales facet_grid2

library(magrittr) # for %>%

## Warning: Paket 'magrittr' wurde unter R Version 4.1.3 erstellt

## 
## Attache Paket: 'magrittr'

## Das folgende Objekt ist maskiert 'package:purrr':
## 
##     set_names

## Das folgende Objekt ist maskiert 'package:tidyr':
## 
##     extract

library(tidyr) # for pivot longer
library(ggplot2)

df <- CO2 %>% pivot_longer(cols = c("conc", "uptake"))

ggplot(data = df, aes(x = Type, y = value)) +
  geom_boxplot() +
  ggh4x::facet_grid2(Treatment ~ name, scales = "free_y", independent = "y")

ggsave

library(tidyverse)

p <- ggplot(mtcars, aes(x=cyl, y=mpg, fill=am))+
  geom_col(position = position_dodge())+
  facet_wrap(.~gear)+
  labs(fill="Land type", x="year", y="meff")+
  theme_bw()

ggsave(filename = "test_ggsave.png",    
       plot = p,
       #plot = last_plot(),
       width = 6, height = 3, device = "png", dpi = 300 )

library(magick)

## Linking to ImageMagick 6.9.12.3
## Enabled features: cairo, freetype, fftw, ghostscript, heic, lcms, pango, raw, rsvg, webp
## Disabled features: fontconfig, x11

#> Linking to ImageMagick 7.0.10.26
#> Enabled features: cairo, fontconfig, freetype, lcms, pango, rsvg, webp, x11
#> Disabled features: fftw, ghostscript
#> Using 4 threads
# Assuming png package is installed.
filename <- "test_ggsave.png"
image_read(filename)

data column not recognized in the ggplot geom_hline

# https://stackoverflow.com/questions/69305420/data-column-not-recognized-in-the-ggplot-geom-hline
set.seed(20)
n_groups <- 2
n_in_group <- 20
sd_e = 2
groups <- gl(n_groups, n_in_group, labels = c("T","C"))
age <-rnorm(length(groups), 25, 3)
betas <- c(5,0,0,2)
dat <- data.frame(groups=groups,age=age)

X <- model.matrix(~ groups * age, data = dat)

lin_pred <- as.vector(X %*% betas)

dat$y <- rnorm(nrow(X), lin_pred, sd_e)


dat %>% group_by(groups) %>%  mutate(mean_y = mean(y)) %>%
  ungroup() %>%
  ggplot()+aes(x = age, y = y) +
  geom_point(aes(color=groups)) +
  geom_hline(aes(yintercept = mean_y))

plotly earth

#https://stackoverflow.com/a/72234744/13321647

TOUR <- structure(list(ISO3 = c("ARG", "AUS", "AUT", "BEL", "BRA", "CAN", 
"CHE", "CHL", "CHN", "COK", "DEU", "DNK", "ESP", "FIN", "FJI", 
"FRA", "GBR", "HKG", "IDN", "IND", "ITA", "JPN", "KOR", "LUX", 
"MEX", "MYS", "NCL", "NLD", "NOR", "NZL", "PHL", "PRT", "RUS", 
"SGP", "SWE", "THA", "TON", "USA", "WSM"), Total = c(1073L, 8204L, 
818L, 1502L, 1871L, 7958L, 3524L, 2456L, 3345L, 456L, 5010L, 
569L, 2775L, 184L, 75L, 60382L, 4424L, 415L, 146L, 405L, 8369L, 
8176L, 1034L, 235L, 961L, 137L, 6522L, 667L, 309L, 7960L, 238L, 
316L, 486L, 404L, 480L, 200L, 41L, 85225L, 46L), Size = c(16, 
30, 14, 18, 19, 30, 24, 21, 23, 12, 26, 13, 22, 8, 5, 50, 25, 
11, 7, 11, 30, 30, 16, 9, 15, 7, 28, 13, 10, 30, 9, 10, 12, 11, 
12, 8, 3, 54, 4), Color = c(3, 4, 3, 3, 3, 4, 4, 3, 4, 3, 4, 
3, 3, 2, 2, 5, 4, 3, 2, 3, 4, 4, 3, 2, 3, 2, 4, 3, 2, 4, 2, 2, 
3, 3, 3, 2, 2, 5, 2), ISO2 = c("AR", "AU", "AT", "BE", "BR", 
"CA", "CH", "CL", "CN", "CK", "DE", "DK", "ES", "FI", "FJ", "FR", 
"GB", "HK", "ID", "IN", "IT", "JP", "KR", "LU", "MX", "MY", "NC", 
"NL", "NO", "NZ", "PH", "PT", "RU", "SG", "SE", "TH", "TO", "US", 
"WS"), LABELFR = c("Argentine", "Australie", "Autriche", "Belgique", 
"Brésil", "Canada", "Suisse", "Chili", "Chine", "Iles Cook", 
"Allemagne", "Danemark", "Espagne", "Finlande", "Fidji", "France", 
"Royaume-Uni", "Hong-kong, Chine", "Indonésie", "Inde", "Italie", 
"Japon", "Corée, République de", "Luxembourg", "Mexique", "Malaisie", 
"Nouvelle-Calédonie", "Pays-Bas", "Norvège", "Nouvelle-Zélande", 
"Philippines", "Portugal", "Russie, Fédération de", "Singapour", 
"Suède", "Thaïlande", "Tonga", "Etats-Unis", "Samoa"), LABELEN = c("Argentina", 
"Australia", "Austria", "Belgium", "Brazil", "Canada", "Switzerland", 
"Chile", "China", "Cook Islands", "Germany", "Denmark", "Spain", 
"Finland", "Fiji", "France", "United Kingdom", "Hong Kong", "Indonesia", 
"India", "Italy", "Japan", "South Korea", "Luxembourg", "Mexico", 
"Malaysia", "New Caledonia", "Netherlands", "Norway", "New Zealand", 
"Philippines", "Portugal", "Russia", "Singapore", "Sweden", "Thailand", 
"Tonga", "United States", "Samoa"), CAPITAL = c("Buenos Aires", 
"Canberra", "Vienna", "Brussels", "Brasilia", "Ottawa", "Bern", 
"Santiago", "Beijing", "Avarua", "Berlin", "Copenhagen", "Madrid", 
"Helsinki", "Suva", "Paris", "London", "N/A", "Jakarta", "New Delhi", 
"Rome", "Tokyo", "Seoul", "Luxembourg", "Mexico City", "Kuala Lumpur", 
"Noumea", "Amsterdam", "Oslo", "Wellington", "Manila", "Lisbon", 
"Moscow", "Singapore", "Stockholm", "Bangkok", "Nuku'alofa", 
"Washington", "Apia"), LATITUDE = c("-34.583333333333336", "-35.266666666666666", 
"48.2", "50.833333333333336", "-15.783333333333333", "45.416666666666664", 
"46.916666666666664", "-33.45", "39.916666666666664", "-21.2", 
"52.516666666666666", "55.666666666666664", "40.4", "60.166666666666664", 
"-18.133333333333333", "48.86666666666667", "51.5", "0", "-6.166666666666667", 
"28.6", "41.9", "35.68333333333333", "37.55", "49.6", "19.433333333333334", 
"3.1666666666666665", "-22.266666666666666", "52.35", "59.916666666666664", 
"-41.3", "14.6", "38.71666666666667", "55.75", "1.2833333333333332", 
"59.333333333333336", "13.75", "-21.133333333333333", "38.883333", 
"-13.816666666666666"), LONGITUDE = c("-58.666667", "149.133333", 
"16.366667", "4.333333", "-47.916667", "-75.700000", "7.466667", 
"-70.666667", "116.383333", "-159.766667", "13.400000", "12.583333", 
"-3.683333", "24.933333", "178.416667", "2.333333", "-0.083333", 
"0.000000", "106.816667", "77.200000", "12.483333", "139.750000", 
"126.983333", "6.116667", "-99.133333", "101.700000", "166.450000", 
"4.916667", "10.750000", "174.783333", "120.966667", "-9.133333", 
"37.600000", "103.850000", "18.050000", "100.516667", "-175.200000", 
"-77.000000", "-171.766667"), CONTINENT = c("South America", 
"Australia", "Europe", "Europe", "South America", "Central America", 
"Europe", "South America", "Asia", "Australia", "Europe", "Europe", 
"Europe", "Europe", "Australia", "Europe", "Europe", "Asia", 
"Asia", "Asia", "Europe", "Asia", "Asia", "Europe", "Central America", 
"Asia", "Australia", "Europe", "Europe", "Australia", "Asia", 
"Europe", "Europe", "Asia", "Europe", "Asia", "Australia", "Central America", 
"Australia")), class = c("data.table", "data.frame"), row.names = c(NA, 
-39L), sorted = "ISO3")

library(plotly)

## 
## Attache Paket: 'plotly'

## Das folgende Objekt ist maskiert 'package:ggplot2':
## 
##     last_plot

## Das folgende Objekt ist maskiert 'package:stats':
## 
##     filter

## Das folgende Objekt ist maskiert 'package:graphics':
## 
##     layout

fig <- plot_ly(
  type = 'scattergeo',
  showlegend=F,
  mode='markers',
  data=TOUR,
  y=~LATITUDE,
  x=~LONGITUDE,
  text=sprintf("%s : %s",TOUR$LABELFR,TOUR$Total),
  hovertemplate = "%{text}<extra></extra>",
  colors = c("#1B98E0","black"),
 # colors="YlOrRd",
  color=~Color,
  marker=list(
    showscale=F,
    size=~Size,
    reversescale=F
  ) 
)
fig

plotly color bar ggplot

# https://stackoverflow.com/a/54142976/13321647

library(tidyverse)
library(plotly)
library(RColorBrewer)

## Warning: Paket 'RColorBrewer' wurde unter R Version 4.1.3 erstellt

sPalette <- c("Blues", "Greens", "Reds", "Purples", "Greys") %>% 
  sapply(., function(x) brewer.pal(8, name = x)) %>% 
  as.vector

diamonds %>% 
  count(cut, clarity) %>% 
  ggplot(., aes(x = cut, y = n, fill = interaction(clarity, cut, sep = " - "))) + 
  geom_bar(stat = "identity", position = "dodge") + 
  scale_fill_manual(values = sPalette, guide = "none") + 
  theme_minimal()

p <- diamonds %>% 
  count(cut, clarity) %>% 
  ggplot(., aes(x = cut, y = n, fill = interaction(clarity, cut, sep = " - "))) + 
  geom_bar(stat = "identity", position = "dodge") + 
  # scale_fill_manual(values = sPalette, guide = "none") + 
  scale_fill_manual(values = sPalette) + 
  theme_minimal()

ggplotly(p) %>% 
  hide_legend()

after_scale change color and fill

d <- data.frame(x = 1:3, y = 1:3, category = letters[1:3], p = c(TRUE, TRUE, FALSE))

ggplot(d, aes(x, y, color = category)) +
  geom_point(aes(fill = after_scale(ifelse(d$p, color, "white"))),
             shape = "circle filled", size = 10)

windows ggplot

cv<- rep(c("cv1","cv2"), each=5)
value<- c(50,40,30,20,10,45,38,26,22,17)
index<- rep(c(5,15,27,36,45), each=2)
dataA<- data.frame(cv, value, index)



ggplot(data=dataA, aes(x=index, y=value))+
  geom_smooth(aes(fill=cv), method=lm, level=0.95, se=FALSE, linetype=1, size=0.5,
              color="Black", formula=y~x) +
  geom_point (aes(shape=cv, fill=cv), col="Black", size=3) +
  scale_x_reverse(limits = c(60,0), breaks = seq(0, 60, 10)) +
  scale_y_continuous(breaks = seq(0,70,10), limits = c(0,70)) +
  labs(x="Environmental Index", y="Kernel number") +
  theme_grey(base_size=15, base_family="serif")+
  theme(legend.position= 'none',
        axis.line= element_line(size=0.5, colour="black")) +
  windows(width=5.5, height=5)

ggh4

library(ggplot2)
library(ggh4x)

## Warning: Paket 'ggh4x' wurde unter R Version 4.1.2 erstellt

df <- structure(list(Exposure = c("Organic Carbon", "Organic Carbon", 
"Organic Carbon", "Organic Carbon", "Black Carbon", "Black Carbon", 
"Black Carbon", "Black Carbon", "Carbon Monoxide", "Carbon Monoxide", 
"Carbon Monoxide", "Carbon Monoxide"), `Unit Increase` = c("1 µg/m3", 
"1 µg/m3", "1 µg/m3", "1 µg/m3", "1 µg/m3", "1 µg/m3", "1 µg/m3", 
"1 µg/m3", "10 ppbv", "10 ppbv", "10 ppbv", "10 ppbv"), Models = c("Model 1", 
"Model 2", "Model 3", "Model 4", "Model 1", "Model 2", "Model 3", 
"Model 4", "Model 1", "Model 2", "Model 3", "Model 4"), mean = c(1.00227974541066, 
0.985112091974051, 0.983374917346068, 0.981911815085857, 1.05170784539884, 
0.866397662179956, 0.852380008027597, 0.843141476496602, 1.0285956205419, 
1.01469851838101, 1.01167376733896, 1.01112354142356), sd = c(0.009168606994035, 
0.00941380294243673, 0.00930958569680644, 0.00931923969816641, 
0.0923351388901415, 0.0926479017865309, 0.0923142930597128, 0.0916749212837342, 
0.000753411222911813, 0.000758915467329065, 0.000747152757518728, 
0.000748722745120326), lci = c(0.984429504585927, 0.967102723558839, 
0.96559452133446, 0.964139630281724, 0.877605428442938, 0.722528919823888, 
0.711303894242616, 0.704476676931527, 1.01351836592852, 0.999717112334597, 
0.996966839004107, 0.996393951145291), uci = c(1.02045365704779, 
1.00345683050333, 1.0014827204373, 1.00001159824068, 1.26034930530902, 
1.03891330635438, 1.02143638459725, 1.00910019120188, 1.04389716670672, 
1.02990443046443, 1.02659764746465, 1.02607087773444), estimates = c("1.002 (0.984 - 1.020)", 
"0.985 (0.967 - 1.003)", "0.983 (0.966 - 1.001)", "0.982 (0.964 - 1.000)", 
"1.052 (0.878 - 1.260)", "0.866 (0.723 - 1.039)", "0.852 (0.711 - 1.021)", 
"0.843 (0.704 - 1.009)", "1.029 (1.014 - 1.044)", "1.015 (1.000 - 1.030)", 
"1.012 (0.997 - 1.027)", "1.011 (0.996 - 1.026)")), class = c("tbl_df", 
"tbl", "data.frame"), row.names = c(NA, -12L))


ggplot(df, aes(x=mean, y = interaction(`Unit Increase`, Exposure, sep = "&"), 
               colour=Models)) + 
  scale_color_brewer(palette="Set1",
                     breaks=c("Model 1","Model 2","Model 3", "Model 4")) + 
  geom_vline(xintercept = 1) + 
  geom_point(position = position_dodge(width=.75)) + 
  geom_errorbarh(aes(xmin = lci, xmax=uci), position=position_dodge(width=.75), height=0) + 
  labs(x="Odds Ratio", y="Exposures (Unit of Increase)", colour="Models") +
  guides(
    y = guide_axis_nested(delim = "&", n.dodge = 1),
    y.sec = guide_axis_manual(
      breaks = as.vector(outer(c(-0.28125, -0.09375, 0.09375, 0.28125), 1:3, "+")),
      labels = df$estimates
    )
  ) +
  theme_classic() +
  theme(
    axis.text.y.left = element_text(margin = margin(r = 5, l = 5)),
    ggh4x.axis.nesttext.y = element_text(margin = margin(r = 6, l = 6)),
    ggh4x.axis.nestline.y = element_blank())

Stackoverflow_Code

T Jäger

31 3 2022

intersect y and x axis 0

Overlapping histogram

Remove space between stacked bars

geom_label

title 1

setosa

versicolor

virginica

Waffleplot

ggVennDiagram

Lineplot

Lineplot 2

Barplot geom_text

ggarange ggpubr ggexport

barchart positiv negativ

Vierfelder scatterplot coefficients

table to pdf saving multiple pages

group_split modify_at

ggplot function

time series ggplot date seq

ggpubr tukey test

Likert ggplot

fill y= …prop…

stacked bar_chart

second y axis

geom_point 2 y variables legend

scale_fill_manual bar plot

Arrow axis ggplot

free scales facet_grid2

facet function ggplot

ggsave

data column not recognized in the ggplot geom_hline

plotly earth

plotly color bar ggplot

after_scale change color and fill

windows ggplot

ggh4