rm(list = ls())
data(iris)
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.1 ✔ tibble 3.2.1
## ✔ lubridate 1.9.3 ✔ tidyr 1.3.1
## ✔ purrr 1.0.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(grid)
library(gridExtra)
##
## Attaching package: 'gridExtra'
##
## The following object is masked from 'package:dplyr':
##
## combine
library(RColorBrewer)
library(MASS)
##
## Attaching package: 'MASS'
##
## The following object is masked from 'package:dplyr':
##
## select
plot(iris)
#flower data experiment
n <- iris %>% ncol() #counting the number of columns
angle <- 360 / n #using the number of columns to figure out what angle is needed to make it symmetrical
updated_angle <- angle
distance <- 0.9 #distance from the center
rise <- sin(angle) * distance
run <- cos(angle) * distance
size <- 0.3
x_position <- 0.5
y_position <- 0.5
grid.newpage() #creating a page for the plots to go on
#initalialzing the viewport
#mostly specifying it's size
viewport(x = x_position, y = y_position,
width = size, height = size) %>%
pushViewport()
palette_name <- "Set1"
color_scheme <- brewer.pal(n, palette_name)
i <- 1
for(name in names(iris)) {
#viewport for angle
viewport(angle = updated_angle - angle,
#x = x_position, #+ run,
#y = y_position, #+ rise,
just = c("center", "bottom")
) %>%
pushViewport()
p <- ggplot(data = iris, aes_string(x = name)) +
geom_bar(width = 0.01,
fill = color_scheme[i]
) +
#geom_point(fill = color_scheme[i]) +
theme_void() +
geom_hline(yintercept = 0,
color = color_scheme[i])
#viewport for distance
viewport(#angle = updated_angle,
#x = x_position, #+ run,
#y = y_position, #+ rise,
y = 0.7,
just = c("center", "bottom")
) %>%
pushViewport()
g <- ggplotGrob(p)
#grid.rect(gp = gpar(fill = NA))
#grid.points(x = 0.5, y = 0)
grid.draw(g)
popViewport(2)
updated_angle <- (updated_angle + angle) %% 360
rise <- -rise #+ sin(updated_angle) * distance
run <- -run #+ cos(updated_angle) * distance
i <- i + 1
#if(i==3) break
}
## Warning: `aes_string()` was deprecated in ggplot2 3.0.0.
## ℹ Please use tidy evaluation idioms with `aes()`.
## ℹ See also `vignette("ggplot2-in-packages")` for more information.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
## Warning in grid.Call.graphics(C_setviewport, vp, TRUE): cannot clip to rotated
## viewport
## Warning in grid.Call.graphics(C_setviewport, vp, TRUE): cannot clip to rotated
## viewport
## Warning in grid.Call.graphics(C_setviewport, vp, TRUE): cannot clip to rotated
## viewport
## Warning in grid.Call.graphics(C_setviewport, vp, TRUE): cannot clip to rotated
## viewport
vector_rotation <- function(x, y, theta) {
x_prime <- 6
}
opacity <- 0.50
size <- 0.3
ggplot() +
geom_bar(data = tibble(x = iris$Petal.Width), aes(x = x),
alpha = opacity, fill = "blue1") +
geom_bar(data = tibble(x = iris$Petal.Length), aes(x = x),
alpha = opacity, fill = "blue4") +
geom_bar(data = tibble(x = iris$Sepal.Width), aes(x = x),
alpha = opacity) +
geom_bar(data = tibble(x = iris$Sepal.Length), aes(x = x),
alpha = opacity) +
theme_void() #+
#coord_polar()
opacity <- 0.50
size <- 0.3
grid.newpage()
p <- ggplot(iris, aes(x = Petal.Length, y = Petal.Width)) +
geom_point(alpha = opacity, color = "blue4", size = 1) +
geom_smooth(method = "lm", se = F, size = 0.3, linetype = 1, color = "blue4") +
theme_void()
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
g <- ggplotGrob(p)
## `geom_smooth()` using formula = 'y ~ x'
viewport(
width = size, height = size
) %>% pushViewport()
grid.draw(g)
grid.newpage()
grid.rect(gp = gpar(fill = "grey20"))
model <- lm(Sepal.Width ~ Sepal.Length, data = iris)
size <- summary(model)$adj.r.squared * 100
summary(model)$adj.r.squared %>% print()
## [1] 0.007159294
size %>% print()
## [1] 0.7159294
iris$resid_lm <- resid(model)
p <- ggplot(iris, aes(x = Sepal.Length, y = resid_lm)) +
geom_point(alpha = opacity, color = "blue1", size = 1) +
#geom_vline(xintercept = 0) +
geom_hline(yintercept = 0, linetype = 1, color = "blue1", alpha = 0.5, size = 0.5) +
geom_smooth(method = "lm", formula = y ~ poly(x, 5),
se = F, linetype = 1, color = "blue1", size = 0.3) +
geom_smooth(method = "lm", formula = y ~ poly(x, 10),
se = F, linetype = 1, color = "blue1", size = 0.1) +
coord_polar() +
theme_void()
viewport(
x = 0.25,
width = size, height = size,
) %>% pushViewport()
g <- ggplotGrob(p)
grid.draw(g)
model <- lm(Sepal.Width ~ Petal.Length, data = iris)
size <- summary(model)$adj.r.squared * 100 / 17
summary(model)$adj.r.squared %>% print()
## [1] 0.1780444
size %>% print()
## [1] 1.04732
iris$resid_lm <- resid(model)
p <- ggplot(iris, aes(x = Sepal.Length, y = resid_lm)) +
geom_point(alpha = opacity, color = "red4", size = 1) +
#geom_vline(xintercept = 0) +
geom_hline(yintercept = 0, linetype = 1, color = "red4", alpha = 0.5, size = 0.5) +
geom_smooth(method = "lm", formula = y ~ poly(x, 5),
se = F, linetype = 1, color = "red4", size = 0.3) +
geom_smooth(method = "lm", formula = y ~ poly(x, 10),
se = F, linetype = 1, color = "red4", size = 0.1) +
coord_polar() +
theme_void()
popViewport(1)
viewport(
x = 0.75,
width = size, height = size,
) %>% pushViewport()
g <- ggplotGrob(p)
grid.draw(g)
#systematic way of making what's above
for(col in names(iris)) {
col %>% print()
ggplot()
}
## [1] "Sepal.Length"
## [1] "Sepal.Width"
## [1] "Petal.Length"
## [1] "Petal.Width"
## [1] "Species"
## [1] "resid_lm"
#colors()
grid.newpage()
p <- ggplot(iris, aes(x = Sepal.Length, y = resid_lm)) +
geom_point(color = "grey20") +
#theme_void() +
#coord_cartesian(ylim = c(-0.5, 0.5)) +
coord_polar() +
scale_y_continuous(limits = c(-0.5, 0.5))
g <- ggplotGrob(p)
## Warning: Removed 29 rows containing missing values or values outside the scale range
## (`geom_point()`).
viewport() %>% pushViewport()
grid.draw(g)
model_lm <- lm(Sepal.Width ~ Sepal.Length, data = iris)
iris$resid_lm <- model_lm %>% resid()
model3 <- lm(Sepal.Width ~ poly(Sepal.Length, 3), data = iris)
iris$resid3 <- model3 %>% resid()
model9 <- lm(Sepal.Width ~ poly(Sepal.Length, 9), data = iris)
iris$resid9 <- model9 %>% resid()
model12 <- lm(Sepal.Width ~ poly(Sepal.Length, 12), data = iris)
iris$resid12 <- model12 %>% resid()
model16 <- lm(Sepal.Width ~ poly(Sepal.Length, 16), data = iris)
iris$resid16 <- model16 %>% resid()
#for safe keeping, maybe I'll use it later
#model.complexities <- list(model_lm, model3, model9, model12, model16)
iris.resids <- iris %>% dplyr::select(contains("resid"))
grid.newpage()
grid.rect(gp = gpar(fill = "grey20"))
opacity <- 0.8
opac_drop <- 1 / (length(iris.resids) + 1)
#color_scheme <- c("blue", "lightsteelblue", "bisque1", "orange2", "red3")
i <- 1
first <- T
for(res in names(iris.resids)) {
print(res)
if(first) {
"first" %>% print()
p <- ggplot(iris, aes(x = Sepal.Length, y = .data[[res]])) +
geom_point(color = "grey90", alpha = opacity) +
theme_void() +
coord_polar()
built <- ggplot_build(p)
y.low <- built$layout$panel_params[[1]]$y.range[1]
y.high <- built$layout$panel_params[[1]]$y.range[2]
first <- F
} else {
"else" %>% print()
p <- ggplot(iris, aes(x = Sepal.Length, y = .data[[res]])) +
geom_point(color = "grey90", alpha = opacity) +
theme_void() +
coord_polar() +
scale_y_continuous(limits = c(y.low, y.high))
}
g <- ggplotGrob(p)
viewport() %>% pushViewport()
grid.draw(g)
opacity <- opacity - opac_drop
i <- i + 1
#break()
}
## [1] "resid_lm"
## [1] "first"
## [1] "resid3"
## [1] "else"
## [1] "resid9"
## [1] "else"
## [1] "resid12"
## [1] "else"
## [1] "resid16"
## [1] "else"
data(iris)
iris
## Sepal.Length Sepal.Width Petal.Length Petal.Width Species
## 1 5.1 3.5 1.4 0.2 setosa
## 2 4.9 3.0 1.4 0.2 setosa
## 3 4.7 3.2 1.3 0.2 setosa
## 4 4.6 3.1 1.5 0.2 setosa
## 5 5.0 3.6 1.4 0.2 setosa
## 6 5.4 3.9 1.7 0.4 setosa
## 7 4.6 3.4 1.4 0.3 setosa
## 8 5.0 3.4 1.5 0.2 setosa
## 9 4.4 2.9 1.4 0.2 setosa
## 10 4.9 3.1 1.5 0.1 setosa
## 11 5.4 3.7 1.5 0.2 setosa
## 12 4.8 3.4 1.6 0.2 setosa
## 13 4.8 3.0 1.4 0.1 setosa
## 14 4.3 3.0 1.1 0.1 setosa
## 15 5.8 4.0 1.2 0.2 setosa
## 16 5.7 4.4 1.5 0.4 setosa
## 17 5.4 3.9 1.3 0.4 setosa
## 18 5.1 3.5 1.4 0.3 setosa
## 19 5.7 3.8 1.7 0.3 setosa
## 20 5.1 3.8 1.5 0.3 setosa
## 21 5.4 3.4 1.7 0.2 setosa
## 22 5.1 3.7 1.5 0.4 setosa
## 23 4.6 3.6 1.0 0.2 setosa
## 24 5.1 3.3 1.7 0.5 setosa
## 25 4.8 3.4 1.9 0.2 setosa
## 26 5.0 3.0 1.6 0.2 setosa
## 27 5.0 3.4 1.6 0.4 setosa
## 28 5.2 3.5 1.5 0.2 setosa
## 29 5.2 3.4 1.4 0.2 setosa
## 30 4.7 3.2 1.6 0.2 setosa
## 31 4.8 3.1 1.6 0.2 setosa
## 32 5.4 3.4 1.5 0.4 setosa
## 33 5.2 4.1 1.5 0.1 setosa
## 34 5.5 4.2 1.4 0.2 setosa
## 35 4.9 3.1 1.5 0.2 setosa
## 36 5.0 3.2 1.2 0.2 setosa
## 37 5.5 3.5 1.3 0.2 setosa
## 38 4.9 3.6 1.4 0.1 setosa
## 39 4.4 3.0 1.3 0.2 setosa
## 40 5.1 3.4 1.5 0.2 setosa
## 41 5.0 3.5 1.3 0.3 setosa
## 42 4.5 2.3 1.3 0.3 setosa
## 43 4.4 3.2 1.3 0.2 setosa
## 44 5.0 3.5 1.6 0.6 setosa
## 45 5.1 3.8 1.9 0.4 setosa
## 46 4.8 3.0 1.4 0.3 setosa
## 47 5.1 3.8 1.6 0.2 setosa
## 48 4.6 3.2 1.4 0.2 setosa
## 49 5.3 3.7 1.5 0.2 setosa
## 50 5.0 3.3 1.4 0.2 setosa
## 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
## 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
circle_dot_reg <- function(df, predictor, degrees = c(1, 3, 9, 12, 16)) {
#pulling the vector
if(predictor %>% is.character() && length(predictor) == 1 && predictor %in% names(df)) {
predictor.vec <- df[[predictor]]
df[[predictor]] <- NULL
predictor <- predictor.vec
}
init_len <- length(df)
n <- init_len - (init_len %% 2)
nf <- n %>% sqrt() %>% floor()
nc <- n %>% sqrt() %>% ceiling()
size_each <- min(1/(nc + (init_len %% 2)), 1/nf) #size of each plot
j <- 1
grid.newpage()
grid.rect(gp = gpar(fill = "grey20"))
#iterating through the columns
for(col_name in names(df)) {
col_name %>% print()
viewport(
width = size_each, height = size_each,
x = size_each*j - 1, y = 1,
just = c("left", "top")
) %>% pushViewport()
response <- df[[col_name]]
if(predictor %>% is.character()){
for(num in degrees) {
model <- glm(response ~ predictor, family = binomial)
df[[paste0("resid", num)]] <- model %>% resid()
}
}
if(predictor %>% is.numeric()) {
for(num in degrees) {
model <- lm(response ~ poly(predictor, num))
df[[paste0("resid", num)]] <- model %>% resid()
}
}
df.resids <- df %>% dplyr::select(init_len:length(df))
df.resids$predictor <- predictor
opacity <- 0.8
opac_drop <- opacity / (length(df.resids) + 1)
#iterating through residuals
i <- 1
first <- T
for(res in names(df.resids)) {
if(first) {
p <- ggplot(df.resids, aes(x = predictor, y = .data[[res]])) +
geom_point(color = "grey90", alpha = opacity) +
theme_void() +
coord_polar()
built <- ggplot_build(p)
y.low <- built$layout$panel_params[[1]]$y.range[1]
y.high <- built$layout$panel_params[[1]]$y.range[2]
first <- F
} else {
"else" %>% print()
p <- ggplot(df.resids, aes(x = predictor, y = .data[[res]])) +
geom_point(color = "grey90", alpha = opacity) +
theme_void() +
coord_polar() +
scale_y_continuous(limits = c(y.low, y.high))
}
g <- ggplotGrob(p)
grid.draw(g)
opacity <- opacity - opac_drop
i <- i + 1
if(i > 1) break()
}
j <- j + 1
popViewport(1)
#break()
}
}
iris %>% circle_dot_reg("Petal.Width")
## [1] "Sepal.Length"
## Warning: Using an external vector in selections was deprecated in tidyselect 1.1.0.
## ℹ Please use `all_of()` or `any_of()` instead.
## # Was:
## data %>% select(init_len)
##
## # Now:
## data %>% select(all_of(init_len))
##
## See <https://tidyselect.r-lib.org/reference/faq-external-vector.html>.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
## [1] "Sepal.Width"
## [1] "Petal.Length"
## [1] "Species"
## Warning in model.response(mf, "numeric"): using type = "numeric" with a factor
## response will be ignored
## Warning in Ops.factor(y, z$residuals): '-' not meaningful for factors
## Warning in model.response(mf, "numeric"): using type = "numeric" with a factor
## response will be ignored
## Warning in Ops.factor(y, z$residuals): '-' not meaningful for factors
## Warning in model.response(mf, "numeric"): using type = "numeric" with a factor
## response will be ignored
## Warning in Ops.factor(y, z$residuals): '-' not meaningful for factors
## Warning in model.response(mf, "numeric"): using type = "numeric" with a factor
## response will be ignored
## Warning in Ops.factor(y, z$residuals): '-' not meaningful for factors
## Warning in model.response(mf, "numeric"): using type = "numeric" with a factor
## response will be ignored
## Warning in Ops.factor(y, z$residuals): '-' not meaningful for factors
#lets just see if we can draw a box or something like that next to each other
grid.newpage()
p <- ggplot()
g <- ggplotGrob(p)
viewport(
width = 0.5, height = 0.5,
just = c("left", "top"),
x = 0, y = 1
#gp = gpar(fill = "black")
) %>% pushViewport()
grid.draw(g)
popViewport(1)
viewport(
width = 0.5, height = 0.5,
just = c("left", "top"),
x = 0.5, y = 1
#gp = gpar(fill = "black")
) %>% pushViewport()
grid.draw(g)
