function(x) : {x+tan(exp(sin(x)*cos(x-1)))}

R artsy package

VOLKAN OBAN aRtsy

aRtsy

VOLKAN OBAN aRtsy pckage

sin(x/tan(cos(x)))-exp(-sin(x))

ref: https://github.com/marcusvolz

{tan(cos(x/x^3+3)/sin(x/x^3+1)-x^4)}

z^5+(-0.2+0.11*1i)/z^10

z^5+(-0.2+0.11*1i)/z^3

z^5+(-0.2+0.11*1i)/z^9

z^3+(-0.2+0.11*1i)/z^3

1+ z+z^2-0.8/z^3

18,350,0.43,120,0.45,0.817,-0,12

sin(cos(tan(exp(2-x))))

12,250,0.41,110,0.25,1.817,-0.025 function(x) {cos(1/1+sin(x)+1/1+sin(x)*sin(x))}

sin(sin(cos((exp(1/x)/1+x^2)))/1+x^exp(-x^1/x^2))

sin(cos(sin(x/1+x^4))/x+x^exp(-x^2/x))

sin(sin(cos(x))/1+x^exp(-x^1/x))

sin(x/1+x^exp(-x^1/x)) 2.75 -0.25

sin(1/1+x^exp(-x^1/x))

sin(exp(-1/cos(x/x^7+3)/x^9))

sin(exp(-1/cos(x/x^7+3)/x^7))

12 205 0.22 102 # 0.87 0.15 -0.28 {sin(cos(x/x^3+3)/sin(x/x^3+1)-x^4)}

sin(cos(x+5*x*x/x^4+3)/sin(x/x^4+1)-x^3)

8 210 0.22 105 0.45 0.12 {sin(cos(x+5*x*x/3)/sin(x/x+1)-x^3)}

sin(cos(2*sin(exp(x^sin(1/x^4)))))

cos(2*sin(exp(x^sin(1/x^4))))

cos(x*sin(exp(x^sin(1/x^2))))

cos(x*sin(exp(x^sin(1/x^2)))

cos(2*sin(exp(x^sin(x))))

12 300 0.32 400 0.4 0.75 line_color <- "white" back_color <- "black" {sinh(log(x+1)*cos(x)*sin(1/x))}

{cos(sin(exp(-x^2))/x^3)}

{cos(sin(exp(-x^2))/x^4)}

cos(sin(exp(-x^2))/x^4)

cos(x^4*x-sin(cos(1/x^4)))

{sin(cos(1/x^4))}

{sin(cos(1/x^4))}

sin(x^sin(cos(x)))

x^sin(cos(x))

1/x^4*sin(x)

{tan(sin(cos(exp(x/x^2+1))))}

tan(sin(cos(exp(x/x^2+1))))

Elif

Dr. VOLKAN OBAN

sin(cos(sin(x*x)))

cos(exp(-x)*sin(exp(-x)))

cos(exp(-x)*sin(exp(-x)))

12,100,0.41,105,2,0.2,-0.05, {sin(x/(-cos(x)))}

{sin(2*x*x)^x*x-x/cos(x+tan(x+1))}

{sin(2*x*x)^x*x-x/cos(x+tan(x+1))}

{sin(x)^x*x-1/cos(x^9)}

{sin(x)^x*x-1/cos(x^9)}

{sin(x)^x*x-1/cos(x^9)}

{sin(x)^x-1/cos(x^9)}

{sin(x)^2/cos(x*x)}

{sin(cos(log(4^x*2)))/x^4-1}

sin(cos(log(2^x*x+1)))/x^2-1

{sin(cos(x/log(2^x*x+1)))+1}

sin(cos(log(2^2*x+1)))/x^2-1)

{{sin(cos(x+5*x*x/3)/sin(x/x+1)-x^3)}}

{{sin(cos(x+5*x*x/3)/sin(x/x+1)-x^3)}}

Dr. Volkan OBAN

{{cos(x/3)/sin(x/x*x+1)-x^5}}

{cos(x/4)/1-x^5}

{cos(x/2)/1-x^5}

{cos(x/2)/1-x^3}

{x^x-sin(x^3)^tan(x/cos(x))}

cos(x/x+x^(exp(-x*x)))

{cos(x/x+x^2*(exp(-x*x)))}

12 300 - 0.43 110 0.65 0.817 - -0.09 {cos(3*x/x+sin(exp(-x*x)))}

{cos(2*x/x+sin(exp(-x*x)))}

{cos(2*x/x+sin(exp(-x*x)))}

sin(x+x^5/cos(sin(x)/x+2*sin(exp(-x))))

{cos(x/2)/1-x^3}

{sin(-cos(1/1x*x)*x/x^11+2)}

{sin(cos(x)*x/x^5+2)}

sin(cos(x)*1/x^3+2)

AÇI<- 2.15 cos(x/x^2^x/x^6+2)

{cos(x/x^2^x/x^6+2)} 6 # 300 0.43 110 0.65 0.67 -0.09

function(x) {cos(x/x^2^x/x^4+2)}

math volkan oban

sin(tan(abs(2*x)/x+1))

{cos(x)^3*x/x^2+1}

{cos(2*sin(x/exp(-x))^1/x^2+1)}

tan(x)*x+cos(x^7)

log(cos(x^5))

cos(exp(-x))^sin(x^2)/x^7-1

cos(exp(-x))^x/x^5-1

cos(exp(-x))^x/x^3-1

cos(2*sin(1/1+tan(exp(-*x))))

cos(2*sin(x/exp(-x))^1/x+1)

{sin(x*x+2/cos(exp(-x))^-x/x+1)}

sin(cos

exp(-sin(exp(cos(x/1-x^5)/x*x*x)))

{exp(-sin(exp(cos(x)/x*x)))}

5,250,0.43, 110,0.32,8.9-0.0002 {exp(-sin(exp(1/x*x)))}

exp(-sin(exp(1/x*x)))

12,101,0.43, 110,0.84,8.817,-0.0002 {exp(-sin(exp(1/x*x)))}

sin(-exp(cos(-1/x*x*x)))

cos(exp(sin(cos(exp(sin(cos(x)))))))

cos(exp(sin(cos(exp(sin(cos(x)))))))

exp(exp(exp(exp(-x))))

exp(sin(x))

exp(x+log(sin(cos(sin(-exp(x*x))))))

exp(-x)^log(sin(cos(sin(-exp(x*x)))))

x^log(sin(cos(sin(-exp(x*x)))))

cos(sin(exp(x)))

{cos(sin(exp(-x)))}

8,1000,0.32,500,0.4,0.75,-0,27 cos(x)*sin(1/x)*log(x+1)

sin(cos(sin(cos(x*x))))

12 > niter <- 200 # > p <- 0.43 # > st <- 48 >a lf <- 0.78 e > aci <-2.817 > cv <- -0.05 > line_color<- "white" > back_color <- "black" function(x) {cos(exp(-x)*sin(2*x))}

cos(2*tan(sin(-4*x*x*cos(tan(1/x*x*x*x)))))

tan(1/exp(cos(4*x)))

tan(exp(-cos(4*x)))

tan(-exp(cos(x)))

tan(2*x)+cos(2*x)+sin(2*x)

abs(sin(cos(1/x*x))*exp(1/x*x))

abs(sin(cos(1/x*x))*exp(-1/x))

abs(sin(cos(1/x)))

tan(exp(2*-cos(factorial(sin(x)))))

x-factorial(sin(x))/x^2

factorial(cos(x))

tan(exp(2*-cos(factorial(sin(x)))))

exp(sin(1/x)) 12 250 0.4 101 0.25 -1.52

exp(cos((sin(-x*x))))

cos(x*x)*tan(x*x)*sin(x*x)*(sin(x))^2

log(x+1)*tan(2*x)*sin(2*x)*(sin(x))^2

sin(cos(exp(cos(1-x*x))))

tan(x*x*exp(-sin(x)*cos(1/x/x)))

x+tan(2*sin(exp(-sin(x))))

{tan(2*sin(exp(-sin(x))))}

tan(exp(sin(x)*cos(x)))

ref: Chinchón

Trigonometric functions

sin(exp(x)+cos(x))

ref: A.S. Chinchón

ref:https://joachim-gassen.github.io/

{sin(1/cos(1+x))}

{sin(-exp(cos(-1/x*x*x)))}

{sin(-exp(cos(-1/x*x*x)))}

{cos(sinh(tan(-1/x)))+cosh(sin(x))}

{tan(sinh(x))}

Volkan OBAN

cos(sinh(tan(1/x)))

function(x) {sinh((-cos(sin((1/x)+(1/x*x)+(1/x^3)+(1/x^4)+1))))}

{sinh(cos((1/x)+(1/x*x)+(1/x^3)+(1/x^4)+1))}

sinh((1/x)+(1/x*x)+(1/x^3)+(1/x^4))

{1-cos(sinh(tan(sin(x))))/1-x}

{x*cos(sinh(tan(sin(x))))/1-x}

{cos(sinh(tan(sin(1-x))))}

{cos(sinh(tan(sin(1-x))))}

1-sinh(tan(sin(1-x)))

{1-sinh(exp(-x))}

{x+sinh(exp(-x))}

sinh(cos(sin(exp(tan(cosh(x)/x*x)))))

sinh(cos(sin(exp(tan(cosh(x)/x*x)))))

{sin(exp(tan(-1/x*x)))

{exp(tan(-1/x*x))}

{2*tan(1/x)-x}

{2*x-x/cos(x)}

semPaths(fit, + sizeLat = 4, label.prop = 0.5, curve = 0.5, bg = "lightgreen", groups = "latents", + intercepts = FALSE, borders = FALSE, label.norm = "O") > semPaths(fit, + sizeLat = 4, label.prop = 0.5, curve = 0.5, bg = "gold", groups = "latents", + intercepts = FALSE, borders = FALSE, label.norm = "O")

Structural Equation Modeling

cos(1/x-exp(-4/x))

{sin(sinh(x))}

{cos(sin(x)-2*x)/x-log(x^5)}

{cos(sin(x)-4*x)/x-log(x^5)}

{cos(x)/x-log(x^5)}

{1/x-log(x^3)

{sin(tan(exp(sin(x)*cos(x-1))))}

> edges <- 5 # Number of edges of the original polygon > niter <- 300 # Number of iterations > pond <- 0.43 # Weight to calculate the point on the middle of each edge > step <- 101 # Number of times to draw mid-segments before connect ending points > alph <- 0.25 # transparency of curves in geom_curve > angle <- 0.817 # angle of mid-segment with the edge > curv <- 0.197 # Curvature of curves > line_color <- "white" # Color of curves in geom_curve > back_color <- "black" # Background of the ggplot > ratio_f <- function(x) {x+tan(exp(sin(x)*cos(x-1)))}

{x*(x+tan(exp(sin(x)*cos(x-1))))}

{1/tan(1/exp(sin(cos(x))))+tan(cos(exp(-sin(x))))}

VOLKAN OBAN

tan(cos(exp(sin(x))))

{sin(cos(exp(tan(x))))}

function(x) {tan(sin(cos(1/x)))}

{tan(sin(cos(x)))}

function(x) {x+tan(exp(sin(x)*cos(x-1)))}

function(x) {sin(x/4)}

sin(x)/x-(cosh(exp(-sin(x))))}

{sin(x)/x-(cosh(exp(-sin(x))))}

{1/x-(cosh(exp(-cos(x))))}

{1/x-(cosh(exp(-cos(x))))}

1/x-(-sinh(exp(-cos(x))))

{x-(-sinh(exp(-cos(x))))}

1-(sinh(exp(cos(x))))

{1-(-tan(exp(cos(x))))}

{x/1-x-cos(x)*sin(tan(exp(cos(x/2))))}

log(x+1)*cos(x)*sin(1/x)

-sin(x)*cos(x)*tan(x)

function(x) {x/1-x-cos(x)*sin(-tan(exp(cos(x))))}

> library(tidyverse) > > # This function creates the segments of the original polygon > polygon <- function(n) { + tibble( + x = accumulate(1:(n-1), ~.x+cos(.y*2*pi/n), .init = 0), + y = accumulate(1:(n-1), ~.x+sin(.y*2*pi/n), .init = 0), + xend = accumulate(2:n, ~.x+cos(.y*2*pi/n), .init = cos(2*pi/n)), + yend = accumulate(2:n, ~.x+sin(.y*2*pi/n), .init = sin(2*pi/n))) + } > > # This function creates segments from some mid-point of the edges > mid_points <- function(d, p, a, i, FUN = ratio_f) { + d %>% mutate( + angle=atan2(yend-y, xend-x) + a, + radius=FUN(i), + x=p*x+(1-p)*xend, + y=p*y+(1-p)*yend, + xend=x+radius*cos(angle), + yend=y+radius*sin(angle)) %>% + select(x, y, xend, yend) + } > > # This function connect the ending points of mid-segments > con_points <- function(d) { + d %>% mutate( + x=xend, + y=yend, + xend=lead(x, default=first(x)), + yend=lead(y, default=first(y))) %>% + select(x, y, xend, yend) + } > > edges <- 5 # Number of edges of the original polygon > niter <-300 # Number of iterations > pond <- 0.24 # Weight to calculate the point on the middle of each edge > step <- 32 # Number of times to draw mid-segments before connect ending points > alph <- 0.25 # transparency of curves in geom_curve > angle <- 0.6 # angle of mid-segment with the edge > curv <- 0.119 # Curvature of curves > line_color <- "black" # Color of curves in geom_curve > back_color <- "white" # Background of the ggplot > ratio_f <- function(x) {1/sin(x)} # To calculate the longitude of mid-segments > > # Generation on the fly of the dataset > accumulate(.f = function(old, y) { + if (y%%step!=0) mid_points(old, pond, angle, y) else con_points(old) + }, 1:niter, + .init=polygon(edges)) %>% bind_rows() -> df > > # Plot > ggplot(df)+ + geom_curve(aes(x=x, y=y, xend=xend, yend=yend), + curvature = curv, + color=line_color, + alpha=alph)+ + coord_equal()+ + theme(legend.position = "none", + panel.background = element_rect(fill=back_color), + plot.background = element_rect(fill=back_color), + axis.ticks = element_blank(), + panel.grid = element_blank(), + axis.title = element_blank(), + axis.text = element_blank())

> angle <- 6.2 > points <- 1000 > > t <- (1:points)*2*angle > x <- sin(-2*t) > y <- cos(2*t) > > df <- data.frame(t, x, y)

> angle <- 4.2 > points <- 1000 > > t <- (1:points)*2*angle > x <-cos(t) > y <-sin(t) > > df <- data.frame(t, x, y) >

> angle <- 4.2 > points <- 1000 > > t <- (1:points)*angle > x <-sin(t) > y <- cos(t)*(-1/t) > > df <- data.frame(t, x, y)

> angle <- 4.2 > points <- 1000 > > t <- (1:points)*angle > x <- t-exp(-1/t) > y <- cos(1/t)-sin(t) > > df <- data.frame(t, x, y) > > p <- ggplot(df, aes(x*t, y*t)) > p + geom_point(aes(size = t), alpha = 0.72, color = "red", shape = 17) +theme( + plot.title = element_text(color = "black", size = 7, face = "bold"), + panel.grid = element_blank(), + legend.position = "none", + panel.background = element_rect(fill = "black"))

> angle <- 4.2 > points <- 1000 > > t <- (1:points)*angle > x <- t > y <- cos(1/t-t) > > df <- data.frame(t, x, y) >

> angle <- 3.2 > points <- 1000 > > t <- (1:points)*angle > x <- sin(t^3-t^2+t) > y <- cos(1/t-t) > > df <- data.frame(t, x, y)

> angle <- 3.2 > points <- 600 > > t <- (1:points)*angle > x <- sin(t^3-t) > y <- cos(1/t) > > df <- data.frame(t, x, y)

> angle <- 4.2 > points <- 1000 > > t <- (1:points)*2*angle > x <- sin(tan(2*t)) > y <- cos(tan(2*t)) >

> angle <- 4.2 > points <- 1000 > > t <- (1:points)*2*angle > x <- sin(2*t) > y <- cos(2*t) > > df <- data.frame(t, x, y)

function(x) {cos(x+x^3+x^7)-sin(x)}

exp > library(manipulate) > plotFun(A *exp(-1/t)* cos(k*pi * t/P) * sin(2 * pi * t/P) ~ t + k, t.lim = range(0, 10),k.lim = range(-0.3,0), A = 10, P = 4, surface = TRUE)

x*sin(x)-log(x)*cos(x)+1

1-log(x)*[cos(x)*sin(x)*tan(x)/exp(x*x*x)]

sin(x)+tan(x)/exp(x)

1+cos(2*x)*log(x)*sin(x)

1+x*log(x)*sin(x)

1-tan(2x)

function(x) {x^2 -1 /x*sin(cos(sin(x)))*log(x+1)}

function(x) {sin(x)/x*x}

function(x) {(log(x+(x^2))*cos(sqrt(x))/exp((x^2)-1))+sin(1+x^3)+1-1/1-x}

function(x) {(log(x+sqrt(x^5))*cos(sqrt(x))/exp((x^2)-1))+sin(1+x)+1+cos(x)

• function(x) {(log(x+sqrt(x))*cos(x)/exp((x^3)-1))+sin(1+x)+1}

• function(x) {(log(x)*cos(x)/exp((x^3)-1))+sin(1+x)+1}

function(x) {(log(x)/exp((x^3)-1))+sin(1+x)}

function(x) {(1/exp((x^3)-1))+sin(1+x)}

function(x) {x^3+sin(2*x)*cos(3/x)*log(2*x)+1/x-5*x} ref:aschinchon

function(x) {x+cos(x*x-1)*sin(x*x-1)+(x-1)}

function(x) {exp(cos(x*x-1))*sin(x*x*x)}

function(x) {exp(cos(x*x-1))}

function(x) {cos(x+1)*sin(x-1)-1/x-log(x)}

function(x) {cos(x)*sin(x-1)-x*tan(1/x)+log(x)}

function(x) {cos(x)*sin(x-1)-x}

function(x) {1/tan(-cos(sin(log(x*x/exp(-x^2)))))}

{tan(cos(sin(log(x*x/exp(-x^2))))}

function(x) {cos(sin(log10(x*x/500))/x}

function(x) {sin(log10(x*x/500))}

log(5*x+1)*cos(3*x)*sin(1/x)

ref: https://cran.r-project.org/web/packages/ggparty/vignettes/ggparty-graphic-partying.html

ref:https://cran.r-project.org/web/packages/ggparty/vignettes/ggparty-graphic-partying.html

ref:Antonio Sánchez Chinchón

ref: r-blogger

ref: r- blogger

ref : r blogger

Network visualization in R. library(igraph) library(ggraph) library(igraphdata) library(smglr) data: yeast yeast protein interactions from igraphdata (only biggest component) ref:https://lnkd.in/gasiqWz

ref: fronkonstin

ref:fronkonstin.com/category/chaos/

ggstatsplot

Package ‘ggstatsplot in R. it supports only the most common types of statistical tests: parametric, nonparametric, robust, and bayesian versions of t-test/anova, correlation analyses, contingency table analysis ,and regression analyses. #R #volkanoban #statisticaltests #datascience #analytics #datavisualization ref: cran.r-project.org

library(tidyverse) > seq(from=-10, to=10, by = 0.05) %>% + expand.grid(x=., y=.) %>% + ggplot(aes(x=(x^2+0.5*pi*cos(y)^2), y=(y+0.5*pi*sin(x)))) + + geom_point(alpha=.1, shape=20, size=1, color="white")+ + theme_void()+coord_fixed()

> theme <- theme(plot.title = element_text(hjust = 0.5), # Centered title + plot.background = element_rect(fill="blueviolet"), # Black background + panel.background = element_rect(fill="purple"), # Dark grey panel background + panel.grid.minor = element_line(color="blueviolet"), # Hide grid lines + panel.grid.major = element_line(color="blueviolet"), # Hide grid lines + axis.text = element_text(color="white"), # Make axis text white + title = element_text(color="white", face="bold"), # Make title white and bold. + legend.background = element_rect(fill="blueviolet"), # Make legend background black + legend.text = element_text(color="white"), # Make legend text white + legend.key = element_rect(fill="blueviolet", color="blueviolet"), #Squares/borders of legend black + legend.position = c(.9,.4)) # Coordinates. Top right = (1,1) > ggplot(diamonds, aes(x=cut, y=price)) + + geom_boxplot(aes(color=clarity), fill=NA) + + scale_color_discrete(guide=F) + + facet_wrap(~clarity, ncol=2) + theme

thm <- theme(plot.title = element_text(hjust = 0.5), # Centered title + plot.background = element_rect(fill="black"), # Black background + panel.background = element_rect(fill="purple"), # + panel.grid.minor = element_line(color="black"), # Hide grid lines + panel.grid.major = element_line(color="black"), # Hide grid lines + axis.text = element_text(color="white"), # Make axis text white + title = element_text(color="white", face="bold"), # Make title white and bold. + legend.background = element_rect(fill="black"), # Make legend background black + legend.text = element_text(color="white"), # Make legend text white + legend.key = element_rect(fill="black", color="black")

breakDown::HR_data

fviz_silhouett

factoextra and clustering packages grid,gridextra ref:https://uc-r.github.io/kmeans_clustering

ggplot(surveys_complete, aes(x = species_id, y = hindfoot_length)) + + geom_boxplot() + + theme_wsj()

> ggplot(data = surveys_complete, mapping = aes(x = species_id, y = weight)) + + geom_boxplot(alpha = 0) + + geom_jitter(alpha = 0.3, color = "red")

ref: r-graph-gallery

ref: r-graph-gallery.com

ref: r-graph-gallery

ref:r-graph-gallery

wordcloud2(d, size =1 , minRotation = -pi/8, maxRotation = -pi/3, rotateRatio = 1)

Happy new years

love….AŞK

ref: data-to-viz.com

ref: data-to-viz.com

library(network) library(sna) library(maps) library(ggplot2)

ref:fronkonstin.com

ref : fronkonstin.com

,ref: r-bloggers.com/cannibus-curve-with-ggplot2/

ref:www.data-imaginist.com

ref : http://www.sthda.com

ref :http://www.sthda.com

ref: http://www.sthda.com

> par(bg='lavender') > anova.model <- rpart(Mileage ~ ., data = cu.summary) > rpart.plot(anova.model, box.palette = "GnYlRd", + shadow.col = "black", )

ref : shinyapps. Michael Lee

> par(bg='springgreen4') > x <- seq(-10, 10, length = 80) > y <- x > f <- function(x, y) {r <- sqrt(x^2 + y^2); 10 * cos(2*r) / 2*r} > z <- outer(x, y, f) > persp(x, y, z,col='royalblue1')

facet_wrap

v=2*pi*(3-sqrt(5)) > i=500 > ggplot(data.frame(r=sqrt(1:i),t=(1:n)*v), + aes(x=r*cos(t),y=r*sin(t)))+ + geom_point(aes(x=0,y=0), + size=240, + colour="violetred")+ + geom_point(aes(size=(n-r)), + shape=21,fill="black", + colour="purple")+ + theme_void()+theme(legend.position="none")

ggplot(df, aes(x,y)) + + geom_polygon()+ + theme_void() + ggtitle("by VOLKAN OBAN using R \n Data Scientist") > d <- data.frame(x=3, y=3) > for (i in 2:1000){ + d[i,1] <- d[i-1,1]+((0.88)^i)*2*cos(2*i) + d[i,2] <- d[i-1,2]+((0.88)^i)*2*sin(2*i) + } > ggplot(df, aes(x,y)) + + geom_polygon()

library(ggplot2) library(grid) # get data download.file(url="http://www.naturalearthdata.com/http//www.naturalearthdata.com/download/110m/cultural/ne_110m_admin_0_countries.zip", "ne_110m_admin_0_countries.zip", "auto") unzip("ne_110m_admin_0_countries.zip") file.remove("ne_110m_admin_0_countries.zip") # read shape file using rgdal library library(rgdal) ogrInfo(".", "ne_110m_admin_0_countries") world <- readOGR(".", "ne_110m_admin_0_countries") summary(world) plot(world, col = "firebrick1")

ref: https://github.com/aschinchon

> seq(-3,3,by=.01) %>% + expand.grid(x=., y=.) %>% + ggplot(aes(x=(x^5-sin(y^2)), y=(y^5-cos(x^2)))) + + geom_point(alpha=.05, shape=20, size=0, color="white")+ + theme_void()+ + coord_fixed()+ + theme(panel.background = element_rect(fill="darkred"))+ + coord_polar()

library(tidyverse) > seq(-3,3,by=.01) %>% + expand.grid(x=., y=.) %>% + ggplot(aes(x=(x^3-sin(y^2)), y=(y^3-cos(x^2)))) + + geom_point(alpha=.1, shape=20, size=0, color="white")+ + theme_void()+ + coord_fixed()+ + theme(panel.background = element_rect(fill="purple"))+ + coord_polar() ref: https://fronkonstin.com/

ref:https://fronkonstin.com/

df <- data.frame(x=0, y=0) > for (i in 2:500){ + df[i,1] <- df[i-1,1]+((0.98)^i)*cos(3*i) + df[i,2] <- df[i-1,2]+((0.98)^i)*sin(3*i)

ref: https://fronkonstin.com/2017/12/23/tiny-art-in-less-than-280-characters/

> t=seq(1, 80, by=.001) > plot(exp(-0.005*t)*sin(t*3.019+2.677)+ + exp(-0.001*t)*sin(t*2.959+2.719), + exp(-0.005*t)*sin(t*2.964+0.229)+ + exp(-0.008*t)*sin(t*2.984+1.284), + type="l", axes=FALSE," , ylab="")

ggdonutchart

theme(plot.background = element_rect(fill = "palegoldenrod"))

ref:r-graph-gallery.com

> ggplot(dt.long,aes(factor(variable), value))+ + geom_violin(aes(fill=factor(variable)))+ + geom_boxplot(alpha=0.2, color="purple", width=.2)+ + labs(x = "", y = "")+ + theme_bw()+ + theme(legend.title = element_blank())+ + facet_wrap(~variable, scales="free") ref: aledemogr.com

ggplot(diamonds, aes(cut)) + + geom_bar(aes(fill = clarity), position = "dodge") + + scale_fill_brewer(palette="PuOr") + + geom_hline(yintercept = 2710, color="black") + + annotate("text", x = 1.5, y=2250, label = "Threshold value", color= "darkred")

Plotrix Test color legends

clock24.plot ref:https://cran.r-project.org/web/packages/plotrix/plotrix.pdf

ref:https://cran.r-project.org/web/packages/plotrix/plotrix.pdf

ref:https://cran.r-project.org/web/packages/plotrix/plotrix.pdf

ref:https://github.com/aschinchon/

delaunay

iter=5 > points=12 # Number of points > radius=2.4 > angles=seq(0, 5*pi*(3-1/points), length.out = points)+pi/2 > > df=data.frame(x=4, y=4) > for (k in 1:iter) + { + temp=data.frame() + for (i in 1:nrow(df)) + { data.frame(x=df[i,"x"]+radius^(k-1)*cos(3*angles), + y=df[i,"y"]+radius^(k-1)*sin(3*angles)) %>% rbind(temp) -> temp + + } + df=temp + } > df %>% + select(x,y) %>% + deldir(sort=TRUE) %>% + .$dirsgs -> data > > # Plot regions with geom_segmen > data %>% + ggplot() + + geom_segment(aes(x = x1, y = y1, xend = x2, yend = y2), color="black") + + scale_x_continuous(expand=c(0,0))+ + scale_y_continuous(expand=c(0,0))+ + coord_fixed() + + theme(legend.position = "none", + panel.background = element_rect(fill="white"), + panel.border = element_rect(colour = "black", fill=NA), + axis.ticks = element_blank(), + panel.grid = element_blank(), + axis.title = element_blank(), + axis.text = element_blank())->plot > > plot

delaunay

dirichlet

data:happy

NHANES ggplot(data = NHANES) + + geom_mosaic(aes(weight = Weight, x = product(Age), fill=factor(SleepHrsNight)), na.rm=TRUE) + theme(axis.text.x=element_text(angle=0, hjust= .5))+labs(x="Age", y=" ggmosaic") + guides(fill=guide_legend(title = "SleepHrsNight", reverse = TRUE))

> library(ggplot2) > library(dplyr) > library(deldir) > > iter=4 # Number of iterations (depth) > points=4# Number of points > radius=2.4 > angles=seq(0, 4*pi*(5-1/points), length.out = points)+pi/2 > > # Initial center > df=data.frame(x=4, y=4) > for (k in 1:iter) + { + temp=data.frame() + for (i in 1:nrow(df)) + { + data.frame(x=df[i,"x"]+radius^(2*k-2)*cos(5*angles), + y=2*df[i,"y"]+radius^(2*k-2)*sin(angles)) %>% rbind(temp) -> temp + } + df=temp + } > df %>% + select(x,y) %>% + deldir(sort=TRUE) %>% + .$dirsgs -> data > > data %>% + ggplot() ++ + geom_segment(aes(x = x1, y = y1, xend = x2, yend = y2), color="darkblue") + + scale_x_continuous(expand=c(0,0))+ + scale_y_continuous(expand=c(0,0))+ + coord_fixed() + + theme(legend.position = "none", + panel.background = element_rect(fill="magenta"), + panel.border = element_rect(colour = "black", fill=NA), + axis.ticks = element_blank(), + panel.grid = element_blank(), + axis.title = element_blank(), + axis.text = element_blank())->plot > > plot

z <- mandelbrot(iter=15) > par(pty="s") > image(z,col=c(topo.colors(n+6),"black"), las=3)

z <- mandelbrot(iter=400) > par(pty="s") > image(z,col=c(topo.colors(n+3),"black"), las=3)

z <- mandelbrot(iter=100) > par(pty="s") > image(z, col=c(topo.colors(n+1),"black"), las=3) ref:https://github.com/mariodosreis/fractal

library(fractal) > z <- mandelbrot(iter=100) > par(pty="s") > image(z, col=c(topo.colors(n),"red"), las=1)

iter=4 > points=16 > radius=4 > angles=seq(0, 18*pi*(3-1/points), length.out = points)+pi/2 > df=data.frame(x=7, y=7) > for (k in 1:iter) + { + temp=data.frame() + for (i in 1:nrow(df)) + { + data.frame(x=df[i,"x"]+2*radius^(k-4)*cos(5*angles), + y=df[i,"y"]+2*radius^(k-4)*sin(5*angles)) %>% rbind(temp) -> temp + } + df=temp + } > df %>% + select(x,y) %>% + deldir(sort=TRUE) %>% + .$dirsgs -> data > data %>% + geom_segment(aes(x = x1, y = y1, xend = x2, yend = y2), color="magenta4") + + scale_x_continuous(expand=c(0,0))+ + scale_y_continuous(expand=c(0,0))+ + coord_fixed() + + theme(legend.position = "none", + panel.background = element_rect(fill="midnightblue"), + panel.border = element_rect(colour = "black", fill=NA), + axis.ticks = element_blank(), + panel.grid = element_blank(), + axis.title = element_blank(), + axis.text = element_blank())->plot >

iter=4 > points=8 > radius=4 > angles=seq(0, 18*pi*(5-1/points), length.out = points)+pi/2 > df=data.frame(x=4, y=4) > for (k in 1:iter) + { + temp=data.frame() + for (i in 1:nrow(df)) + { + data.frame(x=df[i,"x"]+2*radius^(k-3)*cos(3*angles), + y=df[i,"y"]+2*radius^(k-3)*sin(3*angles)) %>% rbind(temp) -> temp + } + df=temp + } >

iter=4 > points=8 > radius=4 > > angles=seq(0, 18*pi*(5-1/points), length.out = points)+pi/2 > df=data.frame(x=2, y=2) > for (k in 1:iter) + { + temp=data.frame() + for (i in 1:nrow(df)) + { + data.frame(x=df[i,"x"]+2*radius^(k-3)*cos(2*angles), + y=df[i,"y"]+2*radius^(k-3)*sin(2*angles)) %>% rbind(temp) -> temp + } + df=temp + }

iter=4 > points=8 > radius=4 > angles=seq(0, 18*pi*(5-1/points), length.out = points)+pi/2 > > df=data.frame(x=1, y=1)

> g <- graph.star(40) > V(g)$color <- c("red", "white") > > E(g)$color <- "black" > plot(g)

nnodes <- 300 > nnedges <- 1500 > nodes <- data.frame(id = 1:nnodes) > edges <- data.frame(from = sample(1:nnodes, nnedges, replace = T), + to = sample(1:nnodes, nnedges, replace = T)) > # with defaut layout > visNetwork(nodes,edges) %>% + visIgraphLayout() > # use full space > visNetwork(nodes, edges") %>% + visIgraphLayout(type = "full")

............... > iter=5 # Number of iterations (depth) > points=10 # Number of points > radius=4 # Factor of expansion/compression > > # Angles of points from center > angles=seq(0, 12*pi*(5-1/points), length.out = points)+pi/2 > > # Initial center > df=data.frame(x=0, y=0) > > # Iterate over centers again and again > for (k in 1:iter) + { + temp=data.frame() + for (i in 1:nrow(df)) + { + data.frame(x=df[i,"x"]+6*radius^(k-2)*cos(angles), + y=df[i,"y"]+4*radius^(k-2)*sin(2*angles)) %>% rbind(temp) -> temp + } + df=temp + } > > # Obtain Voronoi regions > df %>% + select(x,y) %>% + deldir(sort=TRUE) %>% + .$dirsgs -> data > > # Plot regions with geom_segmen > data %>% + ggplot() + ggtitle("by Volkan OBAN using R ") + + geom_segment(aes(x = x1, y = y1, xend = x2, yend = y2), color="white") + + scale_x_continuous(expand=c(0,0))+ + scale_y_continuous(expand=c(0,0))+ + coord_fixed() + + theme(legend.position = "none", + panel.background = element_rect(fill="black"), + panel.border = element_rect(colour = "black", fill=NA), + axis.ticks = element_blank(), + panel.grid = element_blank(), + axis.title = element_blank(), + axis.text = element_blank())->plot ................

............................................ > iter=5 > points=16 # Number of points > radius=2.5 # Factor of expansion/compression > > # Angles of points from center > angles=seq(0, 2*pi*(8-1/points), length.out = points)+pi/2 > > # Initial center > df=data.frame(x=0, y=0) > > # Iterate over centers again and again > for (k in 1:iter) + { + temp=data.frame() + for (i in 1:nrow(df)) + { + data.frame(x=df[i,"x"]+3*radius^(k-1)*cos(angles), + y=df[i,"y"]+2*radius^(k-1)*sin(2*angles)) %>% rbind(temp) -> temp + } + df=temp + } ........................... .........

data.frame(x=df[i,"x"]+radius^(k-1)*cos(angles^2), + y=df[i,"y"]+radius^(k-1)*sin(angles^2)) %>% rbind(temp) -> temp colors: midnightblue and mediumpurple1

code: ref:https://github.com/aschinchon/mandalas library(dplyr) > library(deldir) > > # Parameters to change as you like > iter=5 # Number of iterations (depth) > points=9 # Number of points > radius=3.9 # Factor of expansion/compression > > # Angles of points from center > angles=seq(0, 3*pi*(4-1/points), length.out = points)+pi/2 > > # Initial center > df=data.frame(x=0, y=0) > > # Iterate over centers again and again > for (k in 1:iter) + { + temp=data.frame() + for (i in 1:nrow(df)) + { + data.frame(x=df[i,"x"]+radius^(k-1)*cos(angles), + y=df[i,"y"]+radius^(k-1)*sin(angles)) %>% rbind(temp) -> temp + } + df=temp + } > > # Obtain Voronoi regions > df %>% + select(x,y) %>% + deldir(sort=TRUE) %>% + .$dirsgs -> data > > # Plot regions with geom_segmen > data %>% + ggplot() + geom_segment(aes(x = x1, y = y1, xend = x2, yend = y2), color="white") + + scale_x_continuous(expand=c(0,0))+ + scale_y_continuous(expand=c(0,0))+ + coord_fixed() + + theme(legend.position = "none", + panel.background = element_rect(fill="black"), + panel.border = element_rect(colour = "white", fill=NA), + axis.ticks = element_blank(), + panel.grid = element_blank(), + axis.title = element_blank(), + axis.text = element_blank())->plot > > plot

> iter=4 # Number of iterations (depth) > points=8 # Number of points > radius=4 # Factor of expansion/compression > > # Angles of points from center > angles=seq(0, 2*pi*(30-1/points), length.out = points)+pi/2 > > # Initial center > df=data.frame(x=0, y=0) > > # Iterate over centers again and again > for (k in 1:iter) + { + temp=data.frame() + for (i in 1:nrow(df)) + { + data.frame(x=df[i,"x"]+radius^(k-1)*cos(angles/4), + y=df[i,"y"]+radius^(k-1)*sin(angles/4)) %>% rbind(temp) -> temp + } + df=temp + }

> library(ggplot2) > library(dplyr) > library(deldir) > > # Parameters to change as you like > iter=4 # Number of iterations (depth) > points=8 # Number of points > radius=4 # Factor of expansion/compression > > # Angles of points from center > angles=seq(0, 2*pi*(20-1/points), length.out = points)+pi/2 > > # Initial center > df=data.frame(x=0, y=0) > > # Iterate over centers again and again > for (k in 1:iter) + { + temp=data.frame() + for (i in 1:nrow(df)) + { + data.frame(x=df[i,"x"]+radius^(k-1)*cos(angles/2), + y=df[i,"y"]+radius^(k-1)*sin(angles/2)) %>% rbind(temp) -> temp + } + df=temp + } > > # Obtain Voronoi regions > df %>% + select(x,y) %>% + deldir(sort=TRUE) %>% + .$dirsgs -> data > > # Plot regions with geom_segmen > data %>% + ggplot() + geom_segment(aes(x = x1, y = y1, xend = x2, yend = y2), color="purple4") + + scale_x_continuous(expand=c(0,0))+ + scale_y_continuous(expand=c(0,0))+ + coord_fixed() + + theme(legend.position = "none", + panel.background = element_rect(fill="plum2"), + panel.border = element_rect(colour = "black", fill=NA), + axis.ticks = element_blank(), + panel.grid = element_blank(), + axis.title = element_blank(), + axis.text = element_blank())->plot > > plot

> library(ggplot2) > library(dplyr) > library(deldir) > > # Parameters to change as you like > iter=4 # Number of iterations (depth) > points=8 # Number of points > radius=4 # Factor of expansion/compression > > # Angles of points from center > angles=seq(0, 2*pi*(20-1/points), length.out = points)+pi/2 > > # Initial center > df=data.frame(x=0, y=0) > > # Iterate over centers again and again > for (k in 1:iter) + { + temp=data.frame() + for (i in 1:nrow(df)) + { + data.frame(x=df[i,"x"]+radius^(k-1)*cos(angles)*sin(4*angles), + y=df[i,"y"]+radius^(k-1)*sin(angles)*sin(2*angles)) %>% rbind(temp) -> temp + } + df=temp + } > > # Obtain Voronoi regions > df %>% + select(x,y) %>% + deldir(sort=TRUE) %>% + .$dirsgs -> data > > # Plot regions with geom_segmen > data %>% + ggplot() + geom_segment(aes(x = x1, y = y1, xend = x2, yend = y2), color="black") + + scale_x_continuous(expand=c(0,0))+ + scale_y_continuous(expand=c(0,0))+ + coord_fixed() + + theme(legend.position = "none", + panel.background = element_rect(fill="seagreen"), + panel.border = element_rect(colour = "black", fill=NA), + axis.ticks = element_blank(), + panel.grid = element_blank(), + axis.title = element_blank(), + axis.text = element_blank())->plot > > plot

> library(ggplot2) > library(dplyr) > library(deldir) > > # Parameters to change as you like > iter=4 # Number of iterations (depth) > points=7 # Number of points > radius=3.5 # Factor of expansion/compression > > # Angles of points from center > angles=seq(0, 2*pi*(10-1/points), length.out = points)+pi/2 > > # Initial center > df=data.frame(x=0, y=0) > > # Iterate over centers again and again > for (k in 1:iter) + { + temp=data.frame() + for (i in 1:nrow(df)) + { + data.frame(x=df[i,"x"]+radius^(k-1)*cos(angles)*sin(4*angles), + y=df[i,"y"]+radius^(k-1)*sin(angles)*sin(2*angles)) %>% rbind(temp) -> temp + } + df=temp + } > > # Obtain Voronoi regions > df %>% + select(x,y) %>% + deldir(sort=TRUE) %>% + .$dirsgs -> data > > # Plot regions with geom_segmen > data %>% + ggplot() + ggtitle("by Volkan OBAN using R - mandalas") + + geom_segment(aes(x = x1, y = y1, xend = x2, yend = y2), color="black") + + scale_x_continuous(expand=c(0,0))+ + scale_y_continuous(expand=c(0,0))+ + coord_fixed() + + theme(legend.position = "none", + panel.background = element_rect(fill="plum2"), + panel.border = element_rect(colour = "black", fill=NA), + axis.ticks = element_blank(), + panel.grid = element_blank(), + axis.title = element_blank(), + axis.text = element_blank())->plot > > plot

> library(ggplot2) > library(dplyr) > library(deldir) > # Parameters to change as you like > iter=5 # Number of iterations (depth) > points=7 # Number of points > radius=4 # Factor of expansion/compression > # Angles of points from center > angles=seq(0, 2*pi*(2-1/points), length.out = points)+pi*pi/8 > # Initial center > df=data.frame(x=0, y=0) > # Iterate over centers again and again > for (k in 1:iter) + { + temp=data.frame() + for (i in 1:nrow(df)) + { + data.frame(x=df[i,"x"]+radius^(k-1)*cos(angles)*pi, + y=df[i,"y"]+radius^(k-1)*sin(angles)*pi) %>% rbind(temp) -> temp + } + df=temp + } > # Obtain Voronoi regions > df %>% + select(x,y) %>% + deldir(sort=TRUE) %>% + .$dirsgs -> data > # Plot regions with geom_segmen > data %>% geom_segment(aes(x = x1, y = y1, xend = x2, yend = y2), color="black") + + scale_x_continuous(expand=c(0,0))+ + scale_y_continuous(expand=c(0,0))+ + coord_fixed() + + theme(legend.position = "none", + panel.background = element_rect(fill="red"), + panel.border = element_rect(colour = "black", fill=NA), + axis.ticks = element_blank(), + panel.grid = element_blank(), + axis.title = element_blank(), + axis.text = element_blank())->plot > plot

> library(ggplot2) > library(dplyr) > library(deldir) > # Parameters to change as you like > iter=5 # Number of iterations (depth) > points=7 # Number of points > radius=4 # Factor of expansion/compression > # Angles of points from center > angles=seq(0, 2*pi*(4-1/points), length.out = points)+pi/4 > # Initial center > df=data.frame(x=0, y=0) > # Iterate over centers again and again > for (k in 1:iter) + { + temp=data.frame() + for (i in 1:nrow(df)) + { + data.frame(x=df[i,"x"]+radius^(k-1)*cos(angles)*pi*k-2, + y=df[i,"y"]+radius^(k-1)*sin(angles)*pi*k) %>% rbind(temp) -> temp + } + df=temp + } > # Obtain Voronoi regions > df %>% + select(x,y) %>% + deldir(sort=TRUE) %>% + .$dirsgs -> data > # Plot regions with geom_segmen > data %>% + geom_segment(aes(x = x1, y = y1, xend = x2, yend = y2), color="black") + + scale_x_continuous(expand=c(0,0))+ + scale_y_continuous(expand=c(0,0))+ + coord_fixed() + + theme(legend.position = "none", + panel.background = element_rect(fill="blue"), + panel.border = element_rect(colour = "black", fill=NA), + axis.ticks = element_blank(), + panel.grid = element_blank(), + axis.title = element_blank(), + axis.text = element_blank())->plot > plot

> library(ggplot2) > library(dplyr) > library(deldir) > iter=5 # Number of iterations (depth) > points=7 # Number of points > radius=4 # F > angles=seq(0, 2*pi*(1-1/points), length.out = points)+pi/2 > # Initial center > df=data.frame(x=0, y=0) > for (k in 1:iter) + { + temp=data.frame() + for (i in 1:nrow(df)) + { + data.frame(x=df[i,"x"]+radius^(k-1)*cos(angles)*4*k, + y=df[i,"y"]+radius^(k-1)*sin(angles)*2*k) %>% rbind(temp) -> temp + } + df=temp + } > # Obtain Voronoi regions > df %>% + select(x,y) %>% + deldir(sort=TRUE) %>% + .$dirsgs -> data > # Plot regions with geom_segmen > data %>% + geom_segment(aes(x = x1, y = y1, xend = x2, yend = y2), color="black") + + scale_x_continuous(expand=c(0,0))+ + scale_y_continuous(expand=c(0,0))+ + coord_fixed() + + theme(legend.position = "none", + panel.background = element_rect(fill="green"), + panel.border = element_rect(colour = "black", fill=NA), + axis.ticks = element_blank(), + panel.grid = element_blank(), + axis.title = element_blank(), + axis.text = element_blank())->plot > plot

data.frame(x=df[i,"x"]+2*pi*radius^(k-1)*cos(angles)*sin(angles) , + y=df[i,"y"]+2*pi*radius^(k-2)*sin(angles))

+ for (i in 1:nrow(df)) + { + data.frame(x=df[i,"x"]+2*pi*radius^(k-1)*cos(angles)+ sin(angles) , + y=df[i,"y"]+2*pi*radius^(k-2)*sin(angles)) %>% rbind(temp) -> temp + } + df=temp

library(ggplot2) > library(dplyr) > library(deldir) > > iter=5 # Number of iterations (depth) > points=7 # Number of points > radius=3.6 # Factor of expansion/compression > > # Angles of points from center > angles=seq(0, 2*pi*(1-1/points), length.out = points)+pi/2 > df=data.frame(x=0, y=0) > for (k in 1:iter) + { + temp=data.frame() + for (i in 1:nrow(df)) + { + data.frame(x=df[i,"x"]+4*pi*radius^(k-3)*cos(angles)+ sin(angles) , + y=df[i,"y"]+2*pi*radius^(k-2)*sin(angles)) %>% rbind(temp) -> temp + } + df=temp + } > df %>% + select(x,y) %>% + deldir(sort=TRUE) %>% + .$dirsgs -> data > data %>% + ggplot() + + geom_segment(aes(x = x1, y = y1, xend = x2, yend = y2), color="black") + + scale_x_continuous(expand=c(0,0))+ + scale_y_continuous(expand=c(0,0))+ + coord_fixed() + + theme(legend.position = "none", + panel.background = element_rect(fill="firebrick1"), + panel.border = element_rect(colour = "black", fill=NA), + axis.ticks = element_blank(), + panel.grid = element_blank(), + axis.title = element_blank(), + axis.text = element_blank())->plot > > plot

> library(ggplot2) > library(dplyr) > library(deldir) > > iter=3 # Number of iterations (depth) > points=6 # Number of points > radius=3.8 # Factor of expansion/compression > > angles=seq(0, 2*pi*(1-1/points), length.out = points)+pi/2 > > df=data.frame(x=0, y=0) > for (k in 1:iter) + { + temp=data.frame() + for (i in 1:nrow(df)) + { + data.frame(x=df[i,"x"]+4*pi*radius^(k-3)*cos(angles)+ sin(angles) , + y=df[i,"y"]+2*pi*radius^(k-2)*sin(angles)) %>% rbind(temp) -> temp + } + df=temp + } > s > df %>% + select(x,y) %>% + deldir(sort=TRUE) %>% + .$dirsgs -> data > > data %>% + ggplot() + ggtitle((" Mandalas")) + + geom_segment(aes(x = x1, y = y1, xend = x2, yend = y2), color="black") + + scale_x_continuous(expand=c(0,0))+ + scale_y_continuous(expand=c(0,0))+ + coord_fixed() + + theme(legend.position = "none", + panel.background = element_rect(fill="seagreen3"), + panel.border = element_rect(colour = "black", fill=NA), + axis.ticks = element_blank(), + panel.grid = element_blank(), + axis.title = element_blank(), + axis.text = element_blank())->plot > > plot ref:https://github.com/aschinchon/mandalas/blob/master/mandala.R

..... data.frame(x=df[i,"x"]+4*pi*radius^(k-1)*cos(angles) + sin(angles) , + y=df[i,"y"]+2*pi*radius^(k-1)*sin(angles)) %>% rbind(temp) -> temp..............

> library(ggplot2) > library(dplyr) > library(deldir) > > # Parameters to change as you like > iter=3 # Number of iterations (depth) > points=6 # Number of points > radius=3.8 # Factor of expansion/compression > > # Angles of points from center > angles=seq(0, 2*pi*(1-1/points), length.out = points)+pi/2 > > # Initial center > df=data.frame(x=0, y=0) > > # Iterate over centers again and again > for (k in 1:iter) + { + temp=data.frame() + for (i in 1:nrow(df)) + { + data.frame(x=df[i,"x"]+4*radius^(k-1)*cos(angles), + y=df[i,"y"]+2*radius^(k-1)*sin(angles)) %>% rbind(temp) -> temp + } + df=temp + } > > # Obtain Voronoi regions > df %>% + select(x,y) %>% + deldir(sort=TRUE) %>% + .$dirsgs -> data > > # Plot regions with geom_segmen > data %>% + ggplot() + ggtitle((" Mandalas")) + + geom_segment(aes(x = x1, y = y1, xend = x2, yend = y2), color="black") + + scale_x_continuous(expand=c(0,0))+ + scale_y_continuous(expand=c(0,0))+ + coord_fixed() + + theme(legend.position = "none", + panel.background = element_rect(fill="violetred4"), + panel.border = element_rect(colour = "black", fill=NA), + axis.ticks = element_blank(), + panel.grid = element_blank(), + axis.title = element_blank(), + axis.text = element_blank())->plot > > plot

> library(ggplot2) > library(dplyr) > library(deldir) > > # Parameters to change as you like > iter=3 # Number of iterations (depth) > points=6 # Number of points > radius=3.8 # Factor of expansion/compression > > # Angles of points from center > angles=seq(0, 2*pi*(1-1/points), length.out = points)+pi/2 > > # Initial center > df=data.frame(x=0, y=0) > > # Iterate over centers again and again > for (k in 1:iter) + { + temp=data.frame() + for (i in 1:nrow(df)) + { + data.frame(x=df[i,"x"]+radius^(k-1)*cos(angles), + y=df[i,"y"]+2*radius^(k-1)*sin(angles)) %>% rbind(temp) -> temp + } + df=temp + } > > # Obtain Voronoi regions > df %>% + select(x,y) %>% + deldir(sort=TRUE) %>% + .$dirsgs -> data > > # Plot regions with geom_segmen > data %>% + ggplot() + ggtitle((" by Volkan OBAN using R - Mandalas")) + + geom_segment(aes(x = x1, y = y1, xend = x2, yend = y2), color="black") + + scale_x_continuous(expand=c(0,0))+ + scale_y_continuous(expand=c(0,0))+ + coord_fixed() + + theme(legend.position = "none", + panel.background = element_rect(fill="royalblue1"), + panel.border = element_rect(colour = "black", fill=NA), + axis.ticks = element_blank(), + panel.grid = element_blank(), + axis.title = element_blank(), + axis.text = element_blank())->plot > > plot

library(ggplot2) library(dplyr) library(deldir) # Parameters to change as you like iter=5 # Number of iterations (depth) points=7 # Number of points radius=3.8 # Factor of expansion/compression # Angles of points from center angles=seq(0, 2*pi*(1-1/points), length.out = points)+pi/2 # Initial center df=data.frame(x=0, y=0) # Iterate over centers again and again for (k in 1:iter) { temp=data.frame() for (i in 1:nrow(df)) { data.frame(x=df[i,"x"]+radius^(k-1)*sin(angles)*cos(angles), y=df[i,"y"]+radius^(k-1)*sin(angles)) %>% rbind(temp) -> temp } df=temp } # Obtain Voronoi regions df %>% select(x,y) %>% deldir(sort=TRUE) %>% .$dirsgs -> data # Plot regions with geom_segmen data %>% ggplot() + ggtitle("Mandalas") + geom_segment(aes(x = x1, y = y1, xend = x2, yend = y2), color="black") + scale_x_continuous(expand=c(0,0))+ scale_y_continuous(expand=c(0,0))+ coord_fixed() + theme(legend.position = "none", panel.background = element_rect(fill="lightsteelblue"), panel.border = element_rect(colour = "black", fill=NA), axis.ticks = element_blank(), panel.grid = element_blank(), axis.title = element_blank(), axis.text = element_blank())->plot plot

> ggthemr('chalk') > library(ggthemes) > g <- ggplot(mpg, aes(class, cty)) > g + geom_boxplot(aes(fill=factor(cyl))) + + theme(axis.text.x = element_text(angle=65, vjust=0.6)) + + labs(title=" - ggtherm and ggplot2", + subtitle="City Mileage grouped by Class of vehicle", + caption="Source: mpg", + x="Class of Vehicle", + y="City Mileage")

ggthemr('earth') > library(ggthemes) > g <- ggplot(mpg, aes(class, cty)) > g + geom_boxplot(aes(fill=factor(cyl))) + + theme(axis.text.x = element_text(angle=65, vjust=0.6)) + + labs(title=" ggtherm and ggplot2", + subtitle="City Mileage grouped by Class of vehicle", + caption="Source: mpg", + x="Class of Vehicle", + y="City Mileage")

ggthemr('grass') > library(ggthemes) > g <- ggplot(mpg, aes(class, cty)) > g + geom_boxplot(aes(fill=factor(cyl))) + + theme(axis.text.x = element_text(angle=65, vjust=0.6)) + + labs(title=" ggtherm and ggplot2", + subtitle="City Mileage grouped by Class of vehicle", + caption="Source: mpg", + x="Class of Vehicle", + y="City Mileage")

library(ggthemes) ggthemr('sea) > g <- ggplot(mpg, aes(class, cty)) > g + geom_boxplot(aes(fill=factor(cyl))) + + theme(axis.text.x = element_text(angle=65, vjust=0.6)) + + labs(title="ggtherm and ggplot2", + subtitle="City Mileage grouped by Class of vehicle", + caption="Source: mpg", + x="Class of Vehicle", + y="City Mileage")

> x <- rnorm(10000) > y <- rnorm(10000) > bin <- hexbin(x,y) > ## Plot method for hexbin ! > ## ---- ------ -------- > plot(bin) > # nested lattice > plot(bin,, style= "nested.lattice")

> set.seed(153) > x <- rnorm(100000) > y <- rnorm(100000) > bin <- hexbin(x,y) > smbin <- smooth.hexbin(bin) > erodebin <- erode.hexbin(smbin, cdfcut=.4) > plot(erodebin,main = "")

Show in New WindowClear OutputExpand/Collapse Output shiny.tag shiny.tag shiny.tag shiny.tag shiny.tag shiny.tag shiny.tag shiny.tag Show in New WindowClear OutputExpand/Collapse Output Error: unexpected symbol in: " print(p)Show" Modify Chunk OptionsRun All Chunks AboveRun Current ChunkModify Chunk OptionsRun All Chunks AboveRun Current ChunkModify Chunk OptionsRun All Chunks AboveRun Current Chunk Console~/ > pirateplot(formula = budget ~ creative.type, + data = subset(movies, budget > 0 & + creative.type %in% c("Multiple Creative Types", "Factual") == FALSE), + point.o = .02, + xlab = "", + main = " Data visualization with R - yarrr ", + gl.col = "gray", + pal = "black") > > mtext("Movie budgets (in millions) by rating -- pirateplot", + side = 3, + font = 3) > > mtext("*movies tend to have the highest budgets\n...by far!", + side = 1, adj = 1, line = 3, + cex = .8, font = 3)

pirateplot(formula = weight ~ Time, data = ChickWeight, main = "Weights of chickens by Time", pal = "xmen", gl.col = "gray") mtext(text = "Using the xmen palette!", side = 3, font = 3) mtext(text = "*The mean and variance of chicken\nweights tend to increase over time.", side = 1, adj = 1, line = 3.5, font = 3, cex = .7)

ref: https://www.r-bloggers.com/new-package-swatches-is-now-on-cran/ library(swatches) library(hrbrthemes) library(tidyverse) download.file("https://www.pantone.com/images/pages/21348/adobe-ase/Pantone-COY18-Palette-ASE-files.zip", "ultra_violet.zip") unique(dirname((unzip("ultra_violet.zip")))) ## [1] "./Pantone COY18 Palette ASE files" ## [2] "./__MACOSX/Pantone COY18 Palette ASE files" dir("./Pantone COY18 Palette ASE files") par(mfrow=c(8,1)) dir("./Pantone COY18 Palette ASE files", full.names=TRUE) %>% walk(~{ pal_name <- gsub("(^[[:alnum:]]+-|\\.ase$)", "", basename(.x)) show_palette(read_palette(.x)) title(pal_name) }) par(mfrow=c(1,1)) (intrigue <- read_palette("./Pantone COY18 Palette ASE files/PantoneCOY18-Intrigue.ase")) (intrigue <- read_palette("./Pantone COY18 Palette ASE files/PantoneCOY18-Intrigue.ase", use_names=FALSE)) ggplot(economics_long, aes(date, value)) + geom_area(aes(fill=variable)) + scale_y_comma() + scale_fill_manual(values=intrigue) + facet_wrap(~variable, scales = "free", nrow = 2, strip.position = "bottom") + theme_ipsum_rc(grid="XY", strip_text_face="bold") + theme(strip.placement = "outside") + theme(legend.position=c(0.85, 0.2))

#Select a subset of data for toy example comorbidity_data = comorbidity_data[c(1:10),] survival_data = survival_data[c(1:10),] # Find date cuts k1 = datecut(comorbidity_data,survival_data[,1],survival_data[,2]) # Build networks a = buildnetworks(comorbidity_data,k1) # Graph individual patients datark = t(apply(comorbidity_data,1,rank)) dak = sort(datark[1,]) # draw PDN for the first patient draw.PDN.circle(a[1,],dak) # draw PDN for the whole comorbidity data set par(mfrow=c(2,5)) for(i in 1 : nrow(a)){ dak = apply(datark,2,sort) draw.PDN.circle(a[i,],dak[i,]) title(main=paste("Patient",i)) }

library(ggplot2) library(ggthemes) > theme_set(theme_bw()) > g <- ggplot(mpg, aes(manufacturer, cty)) > g + geom_boxplot() + + geom_dotplot(binaxis='y', + stackdir='center', + dotsize = .5, + fill="yellow") + + theme(axis.text.x = element_text(angle=65, vjust=0.6)) + + labs(title=" ", + caption="Data visualization with R", + x="Class of Vehicle", + y="City Mileage") +theme_hc(bgcolor = "darkunica") + + scale_fill_hc("darkunica"

sunflowerplot(rnorm(1000), rnorm(1000), number = rpois(n = 1000, lambda = 2),rotate = TRUE, col = "purple")

> library(ggplot2) > library(dplyr) > library(tidyr) > library(purrr) > library(animation) > library(gganimate) > > ## Function to evaluate Beta pdf for a vector of values ## > calc_beta = function(alpha, beta){ + x = seq(0.01, 0.99, 0.01) + densityf = dbeta(x, shape = alpha, shape2 = beta) + return(data_frame(x, densityf)) + } > > ## Create data frame with evaluation of Beta pdf for different combinations of alpha and beta ## > alpha = c(0.1, 0.5, 1:5, 10) > beta = c(0.5, 1, 2, 5) > > ## Create data frame ## > # Couldn't get the pipe operator to properly show up in WordPress :-( > df = expand.grid(alpha = alpha, beta = beta) > df = group_by(df, alpha, beta) > df = unnest(mutate(df, plotdata = map2(alpha, beta, calc_beta))) > > ## Create plot ## > p = ggplot(df, aes(x = x, y = densityf, colour = factor(alpha), group = factor(alpha))) + ggtitle("by Volkan OBAN using R ")+ + geom_path(aes(frame = alpha, cumulative = TRUE), size = 0.5) + + facet_wrap(~beta, + labeller = label_bquote(cols = beta == .(beta))) + + ylim(c(0, 6)) + + labs(y = expression(paste("f(x; ", alpha, ", ", beta, ")")), + title = "Changing parameters in Beta density function") + + scale_colour_discrete(name = expression(alpha)) + + theme(plot.title = element_text(hjust = 0.5)) Warning: Ignoring unknown aesthetics: frame, cumulative > > ani.options(interval = 0.8) > gganimate(p, title_frame = FALSE, width = 4, height = 4) reference: http://www.masterdataanalysis.com/r/creating-animations-ggplot2-plots/

> library(ggplot2) > library(gganimate) > library(ggforce) > library(tweenr) > > # Making up data > d <- data.frame(x = rnorm(20), y = rnorm(20), time = sample(100, 20), alpha = 0, + size = 1, ease = 'elastic-out', id = 1:20, + stringsAsFactors = FALSE) > d2 <- d > d2$time <- d$time + 10 > d2$alpha <- 1 > d2$size <- 3 > d2$ease <- 'linear' > d3 <- d2 > d3$time <- d2$time + sample(50:100, 20) > d3$size = 10 > d3$ease <- 'bounce-out' > d4 <- d3 > d4$y <- min(d$y) - 0.5 > d4$size <- 2 > d4$time <- d3$time + 10 > d5 <- d4 > d5$time <- max(d5$time) > df <- rbind(d, d2, d3, d4, d5) > > # Using tweenr > dt <- tween_elements(df, 'time', 'id', 'ease', nframes = 500) > > # Animate with gganimate > p <- ggplot(data = dt) + + geom_point(aes(x=x, y=y, size=size, alpha=alpha, frame = .frame)) + + scale_size(range = c(0.1, 20), guide = 'none') + + scale_alpha(range = c(0, 1), guide = 'none') + + ggforce::theme_no_axes() Warning: Ignoring unknown aesthetics: frame > animation::ani.options(interval = 1/24) > gganimate(p, 'dropping balls.gif', title_frame = F)

library(ggplot2) > library(gganimate) > library(ggforce) > library(tweenr) > > # Making up data > t <- data.frame(x=0, y=0, colour = 'forestgreen', size=1, alpha = 1, + stringsAsFactors = FALSE) > t <- t[rep(1, 12),] > t$alpha[2:12] <- 0 > t2 <- t > t2$y <- 1 > t2$colour <- 'firebrick' > t3 <- t2 > t3$x <- 1 > t3$colour <- 'steelblue' > t4 <- t3 > t4$y <- 0 > t4$colour <- 'goldenrod' > t5 <- t4 > c <- ggforce::radial_trans(c(1,1), c(1, 12))$transform(rep(1, 12), 1:12) > t5$x <- (c$x + 1) / 2 > t5$y <- (c$y + 1) / 2 > t5$alpha <- 1 > t5$size <- 0.5 > t6 <- t5 > t6 <- rbind(t5[12,], t5[1:11, ]) > t6$colour <- 'firebrick' > t7 <- rbind(t6[12,], t6[1:11, ]) > t7$colour <- 'steelblue' > t8 <- t7 > t8$x <- 0.5 > t8$y <- 0.5 > t8$size <- 2 > t9 <- t > ts <- list(t, t2, t3, t4, t5, t6, t7, t8, t9) > > tweenlogo <- data.frame(x=0.5, y=0.5, label = 'tweenr', stringsAsFactors = F) > tweenlogo <- tweenlogo[rep(1, 60),] > tweenlogo$.frame <- 316:375 > > # Using tweenr > tf <- tween_states(ts, tweenlength = 2, statelength = 1, + ease = c('cubic-in-out', 'elastic-out', 'bounce-out', + 'cubic-out', 'sine-in-out', 'sine-in-out', + 'circular-in', 'back-out'), + nframes = 375) > > # Animate with gganimate > p <- ggplot(data=tf, aes(x=x, y=y)) + + geom_text(aes(label = label, frame = .frame), data=tweenlogo, size = 13) + + geom_point(aes(frame = .frame, size=size, alpha = alpha, colour = colour)) + + scale_colour_identity() + + scale_alpha(range = c(0, 1), guide = 'none') + + scale_size(range = c(4, 60), guide = 'none') + + expand_limits(x=c(-0.36, 1.36), y=c(-0.36, 1.36)) + + theme_bw() Warning: Ignoring unknown aesthetics: frame Warning: Ignoring unknown aesthetics: frame > animation::ani.options(interval = 1/15) > gganimate(p, "dancing ball.gif", title_frame = F, ani.width = 400, + ani.height = 400)

d3 = D3partitionR() %>% add_data(data_plot,count = 'N',tooltip=c('name','Location'),steps=c('Sex','Embarked','Pclass','Survived')) %>% add_nodes_data(list('Embarked S'=list('Location'='<a href="https://fr.wikipedia.org/wiki/Southampton">Southampton</a>'), 'Embarked C'=list('Location'='<a href="https://fr.wikipedia.org/wiki/Cherbourg-Octeville">Cherbourg</a>'), 'Embarked Q'=list('Location'='<a href="https://fr.wikipedia.org/wiki/Cobh">Queenstown</a>') ) ) d3 %>% set_legend_parameters(zoom_subset = TRUE) %>% set_chart_type('circle_treemap') %>% set_tooltip_parameters(visible=TRUE, style='background-color:lightblue;',builder='basic') %>% plot()

library(ggplot2) > data.diamonds=ggplot2::diamonds > library(plotly) > gg=ggplot(data.diamonds,aes(x=carat,y=price,color=color))+geom_point(alpha=0.3) > ggplotly(gg)

dataset = data.frame( x1 = c(1, 5, 1, 3, 0), + x2 = c(2, 4, 0, 4, 5), + y1 = c( 1, 8, 0, 1, 3), + y2 = c( 2, 2, 5, 3, 4), + t = c( 'O', 'O', 'O', 'V', 'V'), + r = c( 1, 2, 3, 4, 5), + tooltip = c("ID 1", "ID 2", "ID 3", "ID 4", "ID 5"), + uid = c("ID 1", "ID 2", "ID 3", "ID 4", "ID 5"), + oc = rep("alert(this.getAttribute(\"data-id\"))", 5) + ) > > gg_rect = ggplot() + + scale_x_continuous(name="x ") + + scale_y_continuous(name="y") + + geom_rect_interactive(data=dataset, + mapping = aes(xmin = x1, xmax = x2, + ymin = y1, ymax = y2, fill = t, + tooltip = tooltip, onclick = oc, data_id = uid ), + color="purple", alpha=0.6) + + geom_text(data=dataset, + aes(x = x1 + ( x2 - x1 ) / 2, y = y1 + ( y2 - y1 ) / 2, + label = r ), + size = 4 ) > > > ggiraph(code = {print(gg_rect)})

p <- ggplot(mpg, aes(x = drv, y = hwy, tooltip = class, fill = class)) + + geom_boxplot_interactive(outlier.colour = "blue") + guides(fill = "none") + theme_minimal() > ggiraph(code = print(p))

ggplot(train, aes(Outlet_Identifier, Item_Type))+ + geom_raster(aes(fill = Item_MRP))+ + labs(title =" Heat Map", x = "Outlet Identifier", y = "Item Type")+ + scale_fill_continuous(name = "Item MRP")

> ggplot(train, aes(Outlet_Identifier, Item_Outlet_Sales)) + geom_boxplot(fill = "yellow")+ + scale_y_continuous("Item Outlet Sales", breaks= seq(0,15000, by=500))+ + labs(title = "", x = "Outlet Identifier") data<-https://docs.google.com/spreadsheets/d/1PR5StHxg2jlMCb4IUilGSEwhylXn-3q3EJucSaVolCU/edit#gid=0

> yearly_weight <- surveys_complete %>% + group_by(year, species_id, sex) %>% + summarise(avg_weight = mean(weight, na.rm = TRUE)) > ggplot(yearly_weight, aes(x=year, y=avg_weight, color = sex, group = sex)) + + geom_line() + + facet_wrap(~ species_id) + theme_solarized() + + scale_colour_solarized("blue")

> ggplot(surveys_complete, aes(x = species_id, y = hindfoot_length)) + + geom_boxplot(alpha = 0) + + geom_jitter(alpha = 0.3, color = "yellow")+ theme_solarized_2(light = FALSE) + + scale_colour_solarized("blue")

ref https://cran.r-project.org/web/packages/plot3D/vignettes/plot3D.pdf

ref: https://cran.r-project.org/web/packages/plot3D/vignettes/plot3D.pdf

> x <- (3 + cos(2*v)*sin(2*u) - sin(3*v)*sin(2*u))*cos(v) > y <- (3 + cos(v)*sin(u) - sin(v)*sin(3*u))*sin(v);z <- sin(v)*sin(2*u) + cos(v)*sin(u) > surf3D(x, y, z,,colvar = z, colkey = FALSE, facets = FALSE)

> x <- (3 + cos(v/2)*sin(u) - sin(v/2)*sin(2*u))*cos(v) > y <- (3 + cos(v/2)*sin(u) - sin(v/2)*sin(2*u))*sin(v) > z <- sin(2*v)*sin(u) + cos(2*v)*sin(2*u) > surf3D(x, y, z, colvar = z, colkey = FALSE, facets = FALSE)

> M <- mesh(seq(0, 6*pi, length.out = 80), seq(pi/3, pi, length.out = 80)) > u <- M$x ; v <- M$y > x <- u/2 * cos(2*v) > y <- u/2 * sin(v) * sin(2*u) > z <- u/2 * sin(2*v) > surf3D(x, y, z, colvar = z,colkey = FALSE, box = FALSE)

library(tidyverse) library(viridis) library(OECD) # search by keyword search_dataset("unemployment") %>% View # download the selected dataset df_oecd <- get_dataset("AVD_DUR") # turn variable names to lowercase names(df_oecd) <- names(df_oecd) %>% tolower() df_oecd %>% filter(country %in% c("EU16", "EU28", "USA"), sex == "MEN", ! age == "1524") %>% ggplot(aes(obstime, age, fill = obsvalue))+ geom_tile()+ scale_fill_viridis("Months", option = "B")+ scale_x_discrete(breaks = seq(1970, 2015, 5) %>% paste)+ facet_wrap(~ country, ncol = 1)+ labs(x = NULL, y = "Age groups", title = "Average duration of unemployment in months, males")+ theme_minimal()

> library("compiler") > > mapxy <- function(x, y, xmin, xmax, ymin=xmin, ymax=xmax) { + sx <- (width - 1) / (xmax - xmin) + sy <- (height - 1) / (ymax - ymin) + row0 <- round( sx * (x - xmin) ) + col0 <- round( sy * (y - ymin) ) + col0 * height + row0 + 1 + } > > dejong <- function(x, y) { + nidxs <- length(mat) + counts <- integer(length=nidxs) + for (i in 1:npoints) { + xt <- sin(a * y) - cos(b * x) + y <- sin(c * x) - cos(d * y) + x <- xt + idxs <- mapxy(x, y, -2, 2) + counts <- counts + tabulate(idxs, nbins=nidxs) + } + mat <<- mat + counts + } > > clifford <- function(x, y) { + ac <- abs(c)+1 + ad <- abs(d)+1 + nidxs <- length(mat) + counts <- integer(length=nidxs) + for (i in 1:npoints) { + xt <- sin(a * y) + c * cos(a * x) + y <- sin(b * x) + d * cos(b * y) + x <- xt + idxs <- mapxy(x, y, -ac, ac, -ad, ad) + counts <- counts + tabulate(idxs, nbins=nidxs) + } + mat <<- mat + counts + } > > #color vector > cvec <- grey(seq(0, 1, length=10)) > #can also try other colours, see help(rainbow) > #cvec <- heat.colors(10) > > #we end up with npoints * n points > npoints <- 8 > n <- 100000 > width <- 600 > height <- 600 > > #make some random points > rsamp <- matrix(runif(n * 2, min=-2, max=2), nr=n) > > #compile the functions > setCompilerOptions(suppressAll=TRUE) > mapxy <- cmpfun(mapxy) > dejong <- cmpfun(dejong) > clifford <- cmpfun(clifford) > > #dejong > a <- 1.4 > b <- -2.3 > c <- 2.4 > d <- -2.1 > > mat <- matrix(0, nr=height, nc=width) > dejong(rsamp[,1], rsamp[,2]) > > #this applies some smoothing of low valued points, from A.N. Spiess > #QUANT <- quantile(mat, 0.5) > #mat[mat <= QUANT] <- 0 > > dens <- log(mat + 1)/log(max(mat)) > par(mar=c(0, 0, 0, 0)) > image(t(dens), col=cvec, useRaster=T, xaxt='n', yaxt='n') > > #clifford > a <- -1.4 > b <- 1.6 > c <- 1.0 > d <- 0.7 > > mat <- matrix(0, nr=height, nc=width) > #QUANT <- quantile(mat, 0.5) > #mat[mat <= QUANT] <- 0 > clifford(rsamp[,1], rsamp[,2]) > > dens <- log(mat + 1)/log(max(mat)) > par(mar=c(0, 0, 0, 0)) > image(t(dens), col=cvec, useRaster=T, xaxt='n', yaxt='n')

library("compiler") > > mapxy <- function(x, y, xmin, xmax, ymin=xmin, ymax=xmax) { + sx <- (width - 1) / (xmax - xmin) + sy <- (height - 1) / (ymax - ymin) + row0 <- round( sx * (x - xmin) ) + col0 <- round( sy * (y - ymin) ) + col0 * height + row0 + 1 + } > > dejong <- function(x, y) { + nidxs <- length(mat) + counts <- integer(length=nidxs) + for (i in 1:npoints) { + xt <- sin(a * y) - cos(b * x) + y <- sin(c * x) - cos(d * y) + x <- xt + idxs <- mapxy(x, y, -2, 2) + counts <- counts + tabulate(idxs, nbins=nidxs) + } + mat <<- mat + counts + } > > clifford <- function(x, y) { + ac <- abs(c)+1 + ad <- abs(d)+1 + nidxs <- length(mat) + counts <- integer(length=nidxs) + for (i in 1:npoints) { + xt <- sin(a * y) + c * cos(a * x) + y <- sin(b * x) + d * cos(b * y) + x <- xt + idxs <- mapxy(x, y, -ac, ac, -ad, ad) + counts <- counts + tabulate(idxs, nbins=nidxs) + } + mat <<- mat + counts + } > > #color vector > cvec <- grey(seq(0, 1, length=10)) > #can also try other colours, see help(rainbow) > #cvec <- heat.colors(10) > > #we end up with npoints * n points > npoints <- 8 > n <- 100000 > width <- 600 > height <- 600 > > #make some random points > rsamp <- matrix(runif(n * 2, min=-2, max=2), nr=n) > > #compile the functions > setCompilerOptions(suppressAll=TRUE) > mapxy <- cmpfun(mapxy) > dejong <- cmpfun(dejong) > clifford <- cmpfun(clifford) > > #dejong > a <- 1.4 > b <- -2.3 > c <- 2.4 > d <- -2.1 > > mat <- matrix(0, nr=height, nc=width) > dejong(rsamp[,1], rsamp[,2]) > > #this applies some smoothing of low valued points, from A.N. Spiess > #QUANT <- quantile(mat, 0.5) > #mat[mat <= QUANT] <- 0 > > dens <- log(mat + 1)/log(max(mat)) > par(mar=c(0, 0, 0, 0)) > image(t(dens), col=cvec, useRaster=T, xaxt='n', yaxt='n') > > #clifford > a <- -1.4 > b <- 1.6 > c <- 1.0 > d <- 0.7 > > mat <- matrix(0, nr=height, nc=width) > #QUANT <- quantile(mat, 0.5) > #mat[mat <= QUANT] <- 0 > clifford(rsamp[,1], rsamp[,2]) > > dens <- log(mat + 1)/log(max(mat)) > par(mar=c(0, 0, 0, 0)) > image(t(dens), col=cvec, useRaster=T, xaxt='n', yaxt='n') ref:https://github.com/petewerner/misc/blob/master/attractor.R

plot( SolidRectangle( a=c(1,3), b=c(2,7), + breaks=list( seq(1,3,by=0.25), seq(2,7,by=1) ) ), show.labels=TRUE

> p <- pslg(P=rbind(c(0, 0), c(0, 1), c(0.5, 0.5), c(1, 1), c(1, 0)), + S=rbind(c(1, 2), c(2, 3), c(3, 4), c(4, 5), c(5, 1))) > ## Plot it > plot(p) > ## Triangulate it > tp <- triangulate(p) > > ## Triangulate it subject to minimum area constraint > tp <- triangulate(p, a=0.01) > plot(tp)

if (require(gbm)) { n <- 100 # toy model for quick demo x1 <- 3 * runif(n) x2 <- 3 * runif(n) x3 <- sample(1:4, n, replace=TRUE) y <- x1 + x2 + x3 + rnorm(n, 0, .3) data <- data.frame(y=y, x1=x1, x2=x2, x3=x3) mod <- gbm(y~., data=data, distribution="gaussian", n.trees=300, shrinkage=.1, interaction.depth=3, train.fraction=.8, verbose=FALSE) plot_gbm(mod) # plotres(mod) # plot residuals # plotmo(mod) # plot regression surfaces }

tree1 <- rpart(survived~., data=ptitanic) par(mfrow=c(4,3)) for(iframe in 1:nrow(tree1$frame)) { cols <- ifelse(1:nrow(tree1$frame) <= iframe, "black", "gray") prp(tree1, col=cols, branch.col=cols, split.col=cols) }

data(ptitanic) tree <- rpart(age ~ ., data=ptitanic) rpart.plot(tree, type=4, extra=0, branch.lty=3, box.palette="RdYlGn")

>t <- 0:100 # time > sig2 <- 0.01 > nsim <- 1000 > ## we'll simulate the steps from a uniform distribution with limits set to > ## have the same variance (0.01) as before > X <- matrix(runif(n = nsim * (length(t) - 1), min = -sqrt(3 * sig2), max = sqrt(3 * sig2)), nsim, length(t) - 1) > X <- cbind(rep(0, nsim), t(apply(X, 1, cumsum))) > plot(t, X[1, ],xlab = "time", ylab = "y",col="red", ylim = c(-2, 2), type = "l") > apply(X[2:nsim, ], 1, function(x, t) lines(t, x), t = t)

> x <- seq(-10, 10, length= 30) > y <- x > f <- function(x, y) { r <- sqrt(5*x^(-2)+exp(y^2)); 10 * sin(sin(r))/r } > z <- outer(x, y, f) > z[is.na(z)] <- 1 > op <- par(bg = "purple") > persp(x, y, z, theta =70 , phi = 40, expand = 0.5, col = "yellow")

op <- par(bg = "black") > persp(x, y, z, theta =70 , phi = 40, expand = 0.5, col = "red")

> x <- seq(-10, 10, length= 30) > y <- x > f <- function(x, y) { r <- sqrt(5*x^(-2)+exp(y^2)); 10 * sin(sin(r))/r } > z <- outer(x, y, f) > z[is.na(z)] <- 1 > op <- par(bg = "gray") > persp(x, y, z, theta =60 , phi = 30, expand = 0.5, col = "red")

> x <- seq(-10, 10, length= 30) > y <- x > f <- function(x, y) { r <- sqrt(x^(-2)+y^2); 10 * sin(cos(r))/r } > z <- outer(x, y, f) > z[is.na(z)] <- 1 > op <- par(bg = "white") persp(x, y, z , theta =60 , phi = 30, expand = 0.5, col = "purple")

x <- seq(-10, 10, length= 30) y <- x > f <- function(x, y) { r <- sqrt(x^(-2)+y^2); 10 * sin(cos(r))/r } > z <- outer(x, y, f) > z[is.na(z)] <- 1 > op <- par(bg = "white") > persp(x, y, z, theta = 30, phi = 30, expand = 0.5, col = "red")

> g <- function(x, y) {(1 + y * 2) ^ (-x^2 / y^3) * (1 + y * 1) ^ (x / y)} > > require(lattice) > myRange = seq(0.01, 2, len = 30) > grid <- expand.grid(x = myRange , y = myRange) > grid$z <- g(grid$x, grid$y) > print(wireframe(z ~ x * y",col="purple", grid))

> g <- function(x, y) {(1 + y * 2) ^ (-x / y) * (1 + y * 1) ^ (x / y)} > require(lattice) > myRange = seq(0.01, 2, len = 80) > grid <- expand.grid(x = myRange , y = myRange) > grid$z <- g(grid$x, grid$y) > print(wireframe(z ~ x * y,col="purple", grid))

> a <- 2 > b <- 3 > theta <- seq(0,10*pi,0.01) > r <- a + b*theta > data<- data.frame(x=r*cos(theta), y=r*sin(theta)) # Cartesian coords > library(ggplot2) > ggplot(data, aes(x,y)) + geom_point(col='green')

> golden.ratio = (sqrt(5) + 1)/2 > fibonacci.angle=360/(golden.ratio^2) > c=1 > num_points=630 > x=rep(0,num_points) > y=rep(0,num_points) > > for (n in 1:num_points) { + r=c*sqrt(n) + theta=fibonacci.angle*(n) + x[n]=r*cos(theta) + y[n]=r*sin(theta) + } > plot(x,y,axes=FALSE,ann=FALSE,pch=19,cex=1)

> data (euro123) > par(mfrow = c(2,2)) > triangle.plot(euro123$in78, clab = 0, cpoi = 2, addmean = TRUE, + show = FALSE) > triangle.plot(euro123$in86, label = row.names(euro123$in78), clab = 0.8) > triangle.biplot(euro123$in78, euro123$in86) > triangle.plot(rbind.data.frame(euro123$in78, euro123$in86), clab = 1, addaxes = TRUE, sub = "Principal axis", csub = 2, possub = "topright") > par(mfrow = c(1,1))

data(NHANES) hexplom(NHANES[,9:13], xbins = 20,colramp = BTY, upper.panel = panel.hexboxplot)

> x <- seq(-pi, pi, len = 20) > y <- seq(-pi, pi, len = 20) > g <- expand.grid(x = x, y = y) > g$z <- cos(sqrt(g$x^2 + g$y^2)) > wireframe(z ~ x * y, g, drape = TRUE, + aspect = c(3,1), colorkey = TRUE

> x <- y <- seq(-5, 5, length= 20) > f <- function(x,y){ z <- x^4 + y^3 -3 } > z <- outer(x,y,f) > persp(x, y, z,theta = 60, phi = 45, expand = 0.5, col = "purple") >

> x <- y <- seq(-5, 5, length= 20) > f <- function(x,y){ z <- x*2 + y^3 -3 } > z <- outer(x,y,f) > persp(x, y, z,theta = 60, phi = 45, expand = 0.5, col = "red")

> x <- y <- seq(-5, 5, length= 20) > f <- function(x,y){ z <- x*2 + y -3 } > z <- outer(x,y,f) > persp(x, y, z, theta = 30, phi = 30, expand = 0.5, col = "red")

time <- seq(0, 50, by = 0.01) # parameters: a named vector parameters <- c(r = 2, k = 0.5, e = 0.1, d = 1) # initial condition: a named vector state <- c(V = 1, P = 3) # R function to calculate the value of the derivatives at each time value # Use the names of the variables as defined in the vectors above lotkaVolterra <- function(t, state, parameters){ with(as.list(c(state, parameters)), { dV = r * V - k * V * P dP = e * k * V * P - d * P return(list(c(dV, dP))) }) } ## Integration with 'ode' out <- ode(y = state, times = time, func = lotkaVolterra, parms = parameters) ## Ploting out.df = as.data.frame(out) # required by ggplot: data object must be a data frame library(reshape2) out.m = melt(out.df, id.vars='time') # this makes plotting easier by puting all variables in a single column p <- ggplot(out.m, aes(time, value, color = variable)) + geom_point() p

g <‐ make_lattice(dimvector = c(5,5), + circular = FALSE) plot(g,vertex.color=c("red", "darkslateblue","gold","lightblue","pink"))

> g<- make_tree(60, children=3) > plot(g,vertex.color=c("red", "darkslateblue","gold","lightblue","pink"))

library(dplyr) library(ggplot2) library(reshape2) # creating a data samples # content df.content <- data.frame(content = c('main', 'ad landing', 'product 1', 'product 2', 'product 3', 'product 4', 'shopping cart', 'thank you page'), step = c('awareness', 'awareness', 'interest', 'interest', 'interest', 'interest', 'desire', 'action'), number = c(150000, 80000, 80000, 40000, 35000, 25000, 130000, 120000)) # customers df.customers <- data.frame(content = c('new', 'engaged', 'loyal'), step = c('new', 'engaged', 'loyal'), number = c(25000, 40000, 55000)) # combining two data sets df.all <- rbind(df.content, df.customers) # calculating dummies, max and min values of X for plotting df.all <- df.all %>% group_by(step) %>% mutate(totnum = sum(number)) %>% ungroup() %>% mutate(dum = (max(totnum) - totnum)/2, maxx = totnum + dum, minx = dum) # data frame for plotting funnel lines df.lines <- df.all %>% select(step, maxx, minx) %>% group_by(step) %>% unique() # data frame with dummies df.dum <- df.all %>% select(step, dum) %>% unique() %>% mutate(content = 'dummy', number = dum) %>% select(content, step, number) # data frame with rates conv <- df.all$totnum[df.all$step == 'action'] df.rates <- df.all %>% select(step, totnum) %>% group_by(step) %>% unique() %>% ungroup() %>% mutate(prevnum = lag(totnum), rate = ifelse(step == 'new' | step == 'engaged' | step == 'loyal', round(totnum / conv, 3), round(totnum / prevnum, 3))) %>% select(step, rate) df.rates <- na.omit(df.rates) # creting final data frame df.all <- df.all %>% select(content, step, number) df.all <- rbind(df.all, df.dum) df.all <- df.all %>% group_by(step) %>% arrange(desc(content)) %>% ungroup() # calculating position of labels df.all <- df.all %>% group_by(step) %>% mutate(pos = cumsum(number) - 0.5*number) # defining order of steps df.all$step <- factor(df.all$step, levels = c('loyal', 'engaged', 'new', 'action', 'desire', 'interest', 'awareness')) list <- c(unique(as.character(df.all$content))) df.all$content <- factor(df.all$content, levels = c('dummy', c(list))) # creating custom palette with 'white' color for dummies cols <- c("#ffffff", "#fec44f", "#fc9272", "#a1d99b", "#fee0d2", "#2ca25f", "#8856a7", "#43a2ca", "#fdbb84", "#e34a33", "#a6bddb", "#dd1c77", "#ffeda0", "#756bb1") # plotting chart ggplot() + theme_minimal() + coord_flip() + scale_fill_manual(values=cols) + geom_bar(data=df.all, aes(x=step, y=number, fill=content), stat="identity", width=1) + geom_text(data=df.all[df.all$content!='dummy', ], aes(x=step, y=pos, label=paste0(content, '-', number/1000, 'K')), size=4, color='white', fontface="bold") + geom_ribbon(data=df.lines, aes(x=step, ymax=max(maxx), ymin=maxx, group=1), fill='white') + geom_line(data=df.lines, aes(x=step, y=maxx, group=1), color='darkred', size=4) + geom_ribbon(data=df.lines, aes(x=step, ymax=minx, ymin=min(minx), group=1), fill='white') + geom_line(data=df.lines, aes(x=step, y=minx, group=1), color='darkred', size=4) + geom_text(data=df.rates, aes(x=step, y=(df.lines$minx[-1]), label=paste0(rate*100, '%')), hjust=1.2, color='darkblue', fontface="bold") + theme(legend.position='none', axis.ticks=element_blank(), axis.text.x=element_blank(), axis.title.x=element_blank())

library(tidyverse) library(purrrlyr) library(reshape2) ##### simulating the "real" data ##### set.seed(454) df_raw <- data.frame(customer_id = paste0('id', sample(c(1:5000), replace = TRUE)), date = as.POSIXct(rbeta(10000, 0.7, 10) * 10000000, origin = '2017-01-01', tz = "UTC"), channel = paste0('channel_', sample(c(0:7), 10000, replace = TRUE, prob = c(0.2, 0.12, 0.03, 0.07, 0.15, 0.25, 0.1, 0.08))), site_visit = 1) %>% mutate(two_pages_visit = sample(c(0,1), 10000, replace = TRUE, prob = c(0.8, 0.2)), product_page_visit = ifelse(two_pages_visit == 1, sample(c(0, 1), length(two_pages_visit[which(two_pages_visit == 1)]), replace = TRUE, prob = c(0.75, 0.25)), 0), add_to_cart = ifelse(product_page_visit == 1, sample(c(0, 1), length(product_page_visit[which(product_page_visit == 1)]), replace = TRUE, prob = c(0.1, 0.9)), 0), purchase = ifelse(add_to_cart == 1, sample(c(0, 1), length(add_to_cart[which(add_to_cart == 1)]), replace = TRUE, prob = c(0.02, 0.98)), 0)) %>% dmap_at(c('customer_id', 'channel'), as.character) %>% arrange(date) %>% mutate(session_id = row_number()) %>% arrange(customer_id, session_id) df_raw <- melt(df_raw, id.vars = c('customer_id', 'date', 'channel', 'session_id'), value.name = 'trigger', variable.name = 'event') %>% filter(trigger == 1) %>% select(-trigger) %>% arrange(customer_id, date) df_customers <- df_raw %>% group_by(customer_id, event) %>% filter(date == min(date)) %>% ungroup() sf_probs <- df_customers %>% group_by(event) %>% summarise(customers_on_step = n()) %>% ungroup() %>% mutate(sf_probs = round(customers_on_step / customers_on_step[event == 'site_visit'], 3), sf_probs_step = round(customers_on_step / lag(customers_on_step), 3), sf_probs_step = ifelse(is.na(sf_probs_step) == TRUE, 1, sf_probs_step), sf_importance = 1 - sf_probs_step, sf_importance_weighted = sf_importance / sum(sf_importance) ) df_customers_plot <- df_customers %>% group_by(event) %>% arrange(channel) %>% mutate(pl = row_number()) %>% ungroup() %>% mutate(pl_new = case_when( event == 'two_pages_visit' ~ round((max(pl[event == 'site_visit']) - max(pl[event == 'two_pages_visit'])) / 2), event == 'product_page_visit' ~ round((max(pl[event == 'site_visit']) - max(pl[event == 'product_page_visit'])) / 2), event == 'add_to_cart' ~ round((max(pl[event == 'site_visit']) - max(pl[event == 'add_to_cart'])) / 2), event == 'purchase' ~ round((max(pl[event == 'site_visit']) - max(pl[event == 'purchase'])) / 2), TRUE ~ 0 ), pl = pl + pl_new) df_customers_plot$event <- factor(df_customers_plot$event, levels = c('purchase', 'add_to_cart', 'product_page_visit', 'two_pages_visit', 'site_visit' )) # color palette cols <- c('#4e79a7', '#f28e2b', '#e15759', '#76b7b2', '#59a14f', '#edc948', '#b07aa1', '#ff9da7', '#9c755f', '#bab0ac') ggplot(df_customers_plot, aes(x = event, y = pl)) + theme_minimal() + scale_colour_manual(values = cols) + coord_flip() + geom_line(aes(group = customer_id, color = as.factor(channel)), size = 0.05) + geom_text(data = sf_probs, aes(x = event, y = 1, label = paste0(sf_probs*100, '%')), size = 4, fontface = 'bold') + guides(color = guide_legend(override.aes = list(size = 2))) + theme(legend.position = 'bottom', legend.direction = "horizontal", panel.grid.major.x = element_blank(), panel.grid.minor = element_blank(), plot.title = element_text(size = 20, face = "bold", vjust = 2, color = 'black', lineheight = 0.8), axis.title.y = element_text(size = 16, face = "bold"), axis.title.x = element_blank(), axis.text.x = element_blank(), axis.text.y = element_text(size = 8, angle = 90, hjust = 0.5, vjust = 0.5, face = "plain")) + ggtitle("Sales Funnel visualization - all customers journeys") ref:https://www.r-bloggers.com/marketing-multi-channel-attribution-model-based-on-sales-funnel-with-r/

gg_miss_case(airquality)

GN1 <- GN1000[!grepl("^ICG", GN1000$DonorID), ] GN1$DonorID <- NULL GN2 <- GN1000[grepl("^ICG", GN1000$DonorID), ] GN2 <- GN2[!grepl("S", GN2$DonorID), ] GN2$NationalID <- NULL GN1$SourceCountry <- toupper(GN1$SourceCountry) GN2$SourceCountry <- toupper(GN2$SourceCountry) GN1$SourceCountry <- gsub("UNITED STATES OF AMERICA", "USA", GN1$SourceCountry) GN2$SourceCountry <- gsub("UNITED STATES OF AMERICA", "USA", GN2$SourceCountry) # Specify as a vector the database fields to be used GN1fields <- c("NationalID", "CollNo", "OtherID1", "OtherID2") GN2fields <- c("DonorID", "CollNo", "OtherID1", "OtherID2") # Clean the data GN1[GN1fields] <- lapply(GN1[GN1fields], function(x) DataClean(x)) GN2[GN2fields] <- lapply(GN2[GN2fields], function(x) DataClean(x)) y1 <- list(c("Gujarat", "Dwarf"), c("Castle", "Cary"), c("Small", "Japan"), c("Big", "Japan"), c("Mani", "Blanco"), c("Uganda", "Erect"), c("Mota", "Company")) y2 <- c("Dark", "Light", "Small", "Improved", "Punjab", "SAM") y3 <- c("Local", "Bold", "Cary", "Mutant", "Runner", "Giant", "No.", "Bunch", "Peanut") GN1[GN1fields] <- lapply(GN1[GN1fields], function(x) MergeKW(x, y1, delim = c("space", "dash"))) GN1[GN1fields] <- lapply(GN1[GN1fields], function(x) MergePrefix(x, y2, delim = c("space", "dash"))) GN1[GN1fields] <- lapply(GN1[GN1fields], function(x) MergeSuffix(x, y3, delim = c("space", "dash"))) GN2[GN2fields] <- lapply(GN2[GN2fields], function(x) MergeKW(x, y1, delim = c("space", "dash"))) GN2[GN2fields] <- lapply(GN2[GN2fields], function(x) MergePrefix(x, y2, delim = c("space", "dash"))) GN2[GN2fields] <- lapply(GN2[GN2fields], function(x) MergeSuffix(x, y3, delim = c("space", "dash"))) # Remove duplicated DonorID records in GN2 GN2 <- GN2[!duplicated(GN2$DonorID), ] # Generate KWIC index GN1KWIC <- KWIC(GN1, GN1fields) GN2KWIC <- KWIC(GN2, GN2fields) # Specify the exceptions as a vector exep <- c("A", "B", "BIG", "BOLD", "BUNCH", "C", "COMPANY", "CULTURE", "DARK", "E", "EARLY", "EC", "ERECT", "EXOTIC", "FLESH", "GROUNDNUT", "GUTHUKAI", "IMPROVED", "K", "KUTHUKADAL", "KUTHUKAI", "LARGE", "LIGHT", "LOCAL", "OF", "OVERO", "P", "PEANUT", "PURPLE", "R", "RED", "RUNNER", "S1", "SAM", "SMALL", "SPANISH", "TAN", "TYPE", "U", "VALENCIA", "VIRGINIA", "WHITE") # Specify the synsets as a list syn <- list(c("CHANDRA", "AH114"), c("TG1", "VIKRAM")) GNdupc <- ProbDup(kwic1 = GN1KWIC, kwic2 = GN2KWIC, method = "c", excep = exep, fuzzy = TRUE, phonetic = TRUE, encoding = "primary", semantic = TRUE, syn = syn) GNdupcView <- ViewProbDup(GNdupc, GN1, GN2, "SourceCountry", "SourceCountry", max.count = 30, select = c("INDIA", "USA"), order = "type", main = "Groundnut Probable Duplicates") library(gridExtra) grid.arrange(GNdupcView$SummaryGrob) ref:https://cran.r-project.org/web/packages/PGRdup/PGRdup.pdf

layout(matrix(1:9, ncol = 3, byrow = T)) > par(mar = c(0,0,0,0)) > > for(i in seq(0, 360, length.out = 9)) { + persp(x = axis.vector, + y = axis.vector, + z = z.axis.vector.2,main=""+ theta = i, phi = 15,col = "springgreen", expand = 0.6, shade = 0.3) }

> f.sugakuart.com <- function(a, b, x, y) { + a * exp(- (x - y)^2 / b) + } > > z.axis.vector.2 <- outer(X = axis.vector, Y = axis.vector, function(X,Y) f.sugakuart.com(a = 1, b = 1, x = X, y = Y)) > > persp(x = axis.vector, + y = axis.vector, + z = z.axis.vector.2,main="", + theta = 100, phi = 30,col = "springgreen", expand = 0.6, shade = 0.3)

> f.sugakuart.com <- function(a, b, x, y) { + a * exp(- (x - y)^2 / b) + } > > z.axis.vector.2 <- outer(X = axis.vector, Y = axis.vector, function(X,Y) f.sugakuart.com(a = 1, b = 1, x = X, y = Y)) > > persp(x = axis.vector, + y = axis.vector, + z = z.axis.vector.2,main="", + theta = 120, phi = 15,col = "springgreen", expand = 0.6, shade = 0.3) >

persp function F<-function(x, y){ + sqrt(cos(x)+sin(y)) > x <- y <- seq(-1, 1, length= 20) > z <- outer(x, y, F) > persp(x, y, zn", + zlab = "z", + theta = 30, phi = 15, + col = "springgreen", shade = 0.5)

my.settings <- list( + par.main.text = list(font = 2, # make it bold + just = "left", + x = grid::unit(5, "mm"))) > > xyplot(sin(1:200) ~ cos(1:200), + par.settings=my.settings, + main=" ", sub=" ", + type="l")

ref: http://www.rforscience.com/portfolio/solving-differential-equations-in-r-chapter-5/

require(shape) par (mar = c(1, 1, 1, 1)) emptyplot() mid <- c(0.5, 0.9) r <- 0.8 dpi <- 0.18 GE <- getellipse (mid = mid, from = (3/2-dpi)*pi, to = (3/2 + dpi)*pi, rx = r, ry = r) plotcircle(mid = mid, from = (3/2-dpi)*pi, to = (3/2 + dpi)*pi, lty = 1, lcol = "pink", r = r) segments(mid[1], mid[2], mid[1], mid[2] - r, lty = 2) nr <- nrow(GE) * 0.8 bob <- GE[nr, ] segments(mid[1], mid[2], bob[1], bob[2], lty = 1, lwd = 2) plotcircle(mid = mid, from = 3/2*pi, to = (3/2 + dpi*0.5)*pi, lty = 1, lcol = "purple", r = r, arrow = TRUE, arr.adj = 1, arr.type = "triangle", arr.length = 0.3) filledellipse( mid = bob, col = greycol(100), rx1 = 0.035) filledellipse( mid = mid - c(0, r), col = greycol(100, interval = c(0, 0.4)), rx1 = 0.035) filledellipse( mid = mid, col = "black", rx1 = 0.01) xa <- 0.75 ya <- 0.7 dd <- 0.15 Arrows(xa, ya, xa, ya+dd, arr.type = "triangle", arr.length = 0.2) Arrows(xa, ya, xa+dd, ya, arr.type = "triangle", arr.length = 0.2) text(xa + dd/2, ya - dd/4, "x") text(xa - dd/4, ya + dd/2, "y") text(0.68, 0.45, " length L", adj = 0) text(bob[1] + dd/3, bob[2], "m = 2", adj = 0) ref:http://www.rforscience.com/portfolio/solving-differential-equations-in-r-chapter-4/

require(OceanView) > require(shape) > cols <- ramp.col(c( "lightblue1", "green"), n = 50) > par(mar = c(0, 0, 0, 1)) > image2D(Hypsometry, col = cols, shade = 0.08, rasterImage = TRUE, + contour = list(levels = 0, draw = F), axes = FALSE, main="", xlab = ", ylab = "", + colkey = list(width = 0.3, length = 0.3, cex.axis = 0.5)) >

> url <- "http://seamap.env.duke.edu/species/180524" > > require(plot3D) > # terms of use: citation of OBIS-SEAMAP > > Mink <- read.csv("species_180524_points.csv") [, c > > # project on a grid > nbins <- 200 > xm <- seq(-180, 180, length.out = nbins) > ym <- seq(-90, 90, length.out = nbins) > xy <- table(cut(Mink$longitude, xm), + cut(Mink$latitude, ym)) > xy [xy == 0] <- NA > xmid <- 0.5*(xm[-1] + xm[-nbins]) > ymid <- 0.5*(ym[-1] + ym[-nbins]) > > par(oma = c(2, 0, 0, 0)) > ImageOcean(col = ramp.col (c("lightblue", "darkblue")), shade = 0.1, + contour = list(levels = 0), NAcol = "grey", colkey = list (plot = FALSE), + main = " Minkwhale - OBIS seamap") > > image2D(x = xmid, y = ymid, z = xy, log = "c", add = TRUE, + col = jet2.col(100), NAcol = "transparent", clab = "count")

y <- x <- seq(-10, 10, length=60) > f <- function(x,y) { r <- sqrt(x^2+y^4); 10 * 2*sin(2*r)/r } > z <- outer(x, y, f) > persp3D(x, y, z, theta = 45,main="by Volkan OBAN using R - GA ", phi = 30, expand = 0.5

> library(HistData) Warning message: package ‘HistData’ was built under R version 3.4.1 > library(plotrix) > data = Nightingale[13:24,] radial.pie

vioplot.singmann <- function(x, ..., range = 1.5, h = NULL, ylim = NULL, names = NULL, horizontal = FALSE, col = NULL, border = "black", lty = 1, lwd = 1, rectCol = "black", colMed = "white", pchMed = 19, at, add = FALSE, wex = 1, mark.outlier = TRUE, pch.mean = 4, ids = NULL, drawRect = TRUE, yaxt = "s") { # process multiple datas datas <- list(x, ...) n <- length(datas) if (missing(at)) at <- 1:n # pass 1 - calculate base range - estimate density setup parameters for # density estimation upper <- vector(mode = "numeric", length = n) lower <- vector(mode = "numeric", length = n) q1 <- vector(mode = "numeric", length = n) q3 <- vector(mode = "numeric", length = n) med <- vector(mode = "numeric", length = n) base <- vector(mode = "list", length = n) height <- vector(mode = "list", length = n) outliers <- vector(mode = "list", length = n) baserange <- c(Inf, -Inf) # global args for sm.density function-call args <- list(display = "none") if (!(is.null(h))) args <- c(args, h = h) for (i in 1:n) { data <- datas[[i]] if (!is.null(ids)) names(data) <- ids if (is.null(names(data))) names(data) <- as.character(1:(length(data))) # calculate plot parameters 1- and 3-quantile, median, IQR, upper- and # lower-adjacent data.min <- min(data) data.max <- max(data) q1[i] <- quantile(data, 0.25) q3[i] <- quantile(data, 0.75) med[i] <- median(data) iqd <- q3[i] - q1[i] upper[i] <- min(q3[i] + range * iqd, data.max) lower[i] <- max(q1[i] - range * iqd, data.min) # strategy: xmin = min(lower, data.min)) ymax = max(upper, data.max)) est.xlim <- c(min(lower[i], data.min), max(upper[i], data.max)) # estimate density curve smout <- do.call("sm.density", c(list(data, xlim = est.xlim), args)) # calculate stretch factor the plots density heights is defined in range 0.0 # ... 0.5 we scale maximum estimated point to 0.4 per data hscale <- 0.4/max(smout$estimate) * wex # add density curve x,y pair to lists base[[i]] <- smout$eval.points height[[i]] <- smout$estimate * hscale t <- range(base[[i]]) baserange[1] <- min(baserange[1], t[1]) baserange[2] <- max(baserange[2], t[2]) min.d <- boxplot.stats(data)[["stats"]][1] max.d <- boxplot.stats(data)[["stats"]][5] height[[i]] <- height[[i]][(base[[i]] > min.d) & (base[[i]] < max.d)] height[[i]] <- c(height[[i]][1], height[[i]], height[[i]][length(height[[i]])]) base[[i]] <- base[[i]][(base[[i]] > min.d) & (base[[i]] < max.d)] base[[i]] <- c(min.d, base[[i]], max.d) outliers[[i]] <- list(data[(data < min.d) | (data > max.d)], names(data[(data < min.d) | (data > max.d)])) # calculate min,max base ranges } # pass 2 - plot graphics setup parameters for plot if (!add) { xlim <- if (n == 1) at + c(-0.5, 0.5) else range(at) + min(diff(at))/2 * c(-1, 1) if (is.null(ylim)) { ylim <- baserange } } if (is.null(names)) { label <- 1:n } else { label <- names } boxwidth <- 0.05 * wex # setup plot if (!add) plot.new() if (!horizontal) { if (!add) { plot.window(xlim = xlim, ylim = ylim) axis(2) axis(1, at = at, label = label) } box() for (i in 1:n) { # plot left/right density curve polygon(c(at[i] - height[[i]], rev(at[i] + height[[i]])), c(base[[i]], rev(base[[i]])), col = col, border = border, lty = lty, lwd = lwd) if (drawRect) { # browser() plot IQR boxplot(datas[[i]], at = at[i], add = TRUE, yaxt = yaxt, pars = list(boxwex = 0.6 * wex, outpch = if (mark.outlier) "" else 1)) if ((length(outliers[[i]][[1]]) > 0) & mark.outlier) text(rep(at[i], length(outliers[[i]][[1]])), outliers[[i]][[1]], labels = outliers[[i]][[2]]) # lines( at[c( i, i)], c(lower[i], upper[i]) ,lwd=lwd, lty=lty) plot 50% KI # box rect( at[i]-boxwidth/2, q1[i], at[i]+boxwidth/2, q3[i], col=rectCol) # plot median point points( at[i], med[i], pch=pchMed, col=colMed ) } points(at[i], mean(datas[[i]]), pch = pch.mean, cex = 1.3) } } else { if (!add) { plot.window(xlim = ylim, ylim = xlim) axis(1) axis(2, at = at, label = label) } box() for (i in 1:n) { # plot left/right density curve polygon(c(base[[i]], rev(base[[i]])), c(at[i] - height[[i]], rev(at[i] + height[[i]])), col = col, border = border, lty = lty, lwd = lwd) if (drawRect) { # plot IQR boxplot(datas[[i]], yaxt = yaxt, at = at[i], add = TRUE, pars = list(boxwex = 0.8 * wex, outpch = if (mark.outlier) "" else 1)) if ((length(outliers[[i]][[1]]) > 0) & mark.outlier) text(rep(at[i], length(outliers[[i]][[1]])), outliers[[i]][[1]], labels = outliers[[i]][[2]]) # lines( at[c( i, i)], c(lower[i], upper[i]) ,lwd=lwd, lty=lty) } points(at[i], mean(datas[[i]]), pch = pch.mean, cex = 1.3) } } invisible(list(upper = upper, lower = lower, median = med, q1 = q1, q3 = q3)) } # plot par(cex.main = 1.5, mar = c(5, 6, 4, 5) + 0.1, mgp = c(3.5, 1, 0), cex.lab = 1.5, font.lab = 2, cex.axis = 1.3, bty = "n", las = 1) x <- c(1, 2, 3, 4) plot(x, c(-10, -10, -10, -10), type = "p", ylab = " ", xlab = " ", cex = 1.5, ylim = c(0.3, 0.6), xlim = c(1, 4), lwd = 2, pch = 5, axes = F, main = " ") axis(1, at = c(1.5, 2.5, 3.5), labels = c("HF", "LF", "VLF")) axis(2, pos = 1.1) mtext("Word Frequency", side = 1, line = 3, cex = 1.5, font = 2) par(las = 0) mtext("Group Mean M", side = 2, line = 2.9, cex = 1.5, font = 2) x <- c(1.5, 2.5, 3.5) vioplot.singmann(RT.hf.sp, RT.lf.sp, RT.vlf.sp, add = TRUE, mark.outlier = FALSE, at = c(1.5, 2.5, 3.5), wex = 0.4, yaxt = "n") vioplot.singmann(RT.hf.ac, RT.lf.ac, RT.vlf.ac, add = TRUE, mark.outlier = FALSE, at = c(1.5, 2.5, 3.5), wex = 0.4, col = "grey", border = "grey", rectCol = "grey", colMed = "grey", yaxt = "n") text(2.5, 0.35, "Speed", cex = 1.4, font = 1, adj = 0.5) text(2.5, 0.58, "Accuracy", cex = 1.4, font = 1, col = "grey", adj = 0.5) ref:http://shinyapps.org/apps/RGraphCompendium/index.php

> data(Groceries) > rules <- apriori(Groceries, parameter=list(support=0.005, confidence=0.5)) > plot(rules, method="grouped") ref:http://www.ekonlab.com/?p=835

gf_point(price~carat| color ~ clarity, data=diamonds, alpha=0.2) %>% gf_lm()

ggplot(data = iris, aes(sample = Sepal.Length)) + + geom_qq() + + stat_qqline( alpha = 0.7, color = "red", linetype = "dashed") + + facet_wrap(~Species)

> D <- expand.grid(x = 1:10, y=1:10) > D$angle <- runif(100, 0, 2*pi) > D$speed <- runif(100, 0, sqrt(0.1 * D$x)) > gf_point(y ~ x, data = D) %>% + gf_spoke(y ~ x, angle = ~angle, radius = 0.5) > gf_point(y ~ x, data = D) %>% + gf_spoke(y ~ x, angle = ~angle, radius = ~speed)

if (require(weatherData) & require(dplyr)) { + Temps <- NewYork2013 %>% mutate(city = "NYC") %>% + bind_rows(Mumbai2013 %>% mutate(city = "Mumbai")) %>% + bind_rows(London2013 %>% mutate(city = "London")) %>% + mutate(date = lubridate::date(Time), + month = lubridate::month(Time)) %>% + group_by(city, date) %>% + summarise( + hi = max(Temperature, na.rm = TRUE), + lo = min(Temperature, na.rm = TRUE), + mid = (hi + lo)/2 + ) + gf_ribbon(lo + hi ~ date, data = Temps, fill = ~city, alpha = 0.4) %>% + gf_theme(theme = theme_minimal()) + gf_linerange(lo + hi ~ date | city ~ ., color = ~mid, data = Temps) %>% + gf_refine(scale_colour_gradientn(colors = rev(rainbow(5)))) + gf_ribbon(lo + hi ~ date | city ~ ., data = Temps) + # Chaining in the data + Temps %>% gf_ribbon(lo + hi ~ date, alpha = 0.4) %>% gf_facet_grid(city ~ .) + }

gf_dotplot(~ Sepal.Length, fill = ~Species, data = iris)

> ggplot(eu_gdp, aes(year, gdp_pc)) + + geom_line(color = "steelblue") + + geom_hline(yintercept = 100, linetype = 2) + + facet_geo(~ name, grid = "eu_grid1") + + scale_x_continuous(labels = function(x) paste0("'", substr(x, 3, 4))) + + ylab("GDP Per Capita") + + theme_bw()

> library(geofacet) Warning message: package ‘geofacet’ was built under R version 3.4.1 > library(ggplot2) > # barchart of state rankings in various categories > ggplot(state_ranks, aes(variable, rank, fill = variable)) + + geom_col() + + coord_flip() + + facet_geo(~ state) + + theme_bw()

> set.seed(105) > long<-rnorm(30,-100,18) > lat<-rnorm(30,49,12) > df <- data.frame(lat,long) > > library(deldir) > library(ggplot2) > > #This creates the voronoi line segments > voronoi <- deldir(df$long, df$lat) > > #Now we can make a plot > ggplot(data=df, aes(x=long,y=lat)) + + #Plot the voronoi lines + geom_segment( + aes(x = x1, y = y1, xend = x2, yend = y2), + size = 2, + data = voronoi$dirsgs, + linetype = 1, + color= "pink") + + #Plot the points + geom_point( + fill=rgb(70,130,180,255,maxColorValue=255), + pch=21, + size = 4, + color="purple")

> library(maptools) > library(cartogram) > library(rgdal) > data(wrld_simpl) > afr <- spTransform(wrld_simpl[wrld_simpl$REGION==2 & wrld_simpl$POP2005 > 0,], + CRS("+init=epsg:3395")) > par(mfcol=c(1,2)) > plot(afr) > plot(cartogram(afr, "POP2005", 3))

set.seed(1) pts <- cbind(X=rnorm(500,rep(seq(1,9,by=2)/10,100),.022),Y=rnorm(500,.5,.15)) km1 <- kmeans(pts, centers=5, nstart = 1, algorithm = "Lloyd") There were 19 warnings (use warnings() to see them) > library(tripack) > library(RColorBrewer) > CL5 <- brewer.pal(5, "Pastel1") > V <- voronoi.mosaic(km1$centers[,1],km1$centers[,2]) > P <- voronoi.polygons(V) > plot(pts,pch=19,xlim=0:1,ylim=0:1,xlab="",ylab="",col=CL5[km1$cluster]) > points(km1$centers[,1],km1$centers[,2],pch=3,cex=1.5,lwd=2) > plot(V,add=TRUE) ref:http://freakonometrics.hypotheses.org

data(Mishkin ) ref: ref: Visualizing Complex Data Using R by N.D. Lewis

data(SOTU)# contains the text of the Presidential addresses. > # we only want the words so we remove punctuation > text <- tm_map(SOTU, removePunctuation) > text <- tm_map(text, function(x)removeWords (x,stopwords())) > # put cleaned data in appropriate format > tdm <- TermDocumentMatrix(text) > m <- as.matrix(tdm) > v <- sort(rowSums(m),decreasing=TRUE) > d <- data.frame(word = names(v),freq=v) > par(bg="purple4")# set background color > wordcloud(d$word,d$freq, random.order=FALSE,min.freq=6 , color="navajowhite") ref:Visualizing Complex Data Using R by N.D. Lewis

ref: Visualizing Complex Data Using R by N.D. Lewis

> library(datasets) > library(mvtsplot) >D <- diff(EuStockMarkets ,90) >mvtsplot(D,,norm ="internal", levels = 4,margin=FALSE)

> r1 = c (7.9, 67.6, 28.3, 53.6) > r2 = c (4.4, 54.5, 29.9, 57.6) > r3 = c (10.2, 50, 27.7, 53.4) > r4 = c (2.5, 35.3, 22.2, 47) > r5 = c (8.5, 46.3, 32.2, 50) > data <- as.table(rbind(r1,r2,r3,r4,r5)) > dimnames(data) <- list(x = c("volkan","oban", "V","O","VO"), R_spineplot = c("A (< 10)","B (<10)", "A (> 10)","B(> 10)")) > spineplot(data)

> set.seed(345) > Sector <- rep(c("S01","S02","S03","S04","S05","S06","S07"),times=7) > Year <- as.numeric(rep(c("1950","1960","1970","1980","1990","2000","2010"),each=7)) > Value <- runif(49, 10, 100) > data <- data.frame(Sector,Year,Value) > ggplot(data, aes(x=Year, y=Value, fill=Sector)) + + geom_area(colour="black", size=.25, alpha=.4) + scale_fill_brewer(palette="Spectral", breaks=rev(levels(data$Sector))

rect3D(x0 = 0.02, y0 = 0.25, z0 = 0.03, x1 = 1, z1 = 5, + ylim = c(0, 1), bty = "g", facets = TRUE", + border = "purple", col ="#7570B3", alpha=0.5, + lwd = 2, phi = 20)

> data(iris) > x <- sep.l <- iris$Sepal.Length > y <- pet.l <- iris$Petal.Length > z <- sep.w <- iris$Sepal.Width > library(plot3D) scatter3D(x, y, z, phi = 0, bty = "g", pch = 20, cex = 0.5) > text3D(x, y, z, labels = rownames(iris), add = TRUE, colkey = FALSE, cex = 0.5) ref: http://www.sthda.com

> data(iris) > x <- sep.l <- iris$Sepal.Length > y <- pet.l <- iris$Petal.Length > z <- sep.w <- iris$Sepal.Width > library(plot3D) Warning message: package ‘plot3D’ was built under R version 3.4.1 > scatter3D(x, y, z, phi = 0, bty = "g", type = "b", + ticktype = "detailed", pch = 20, + cex = c(0.5, 1, 1.5)) ref:http://www.sthda.com

> y <- matrix(rnorm(500), 100, 5, dimnames=list(paste("g", 1:100, sep=""), paste("VO", 1:5, sep=""))) > y <- data.frame(Position=1:length(y[,1]), y) > > df <- melt(y, id.vars=c("Position"), variable.name = "VO", value.name="Values") > p <- ggplot(df, aes(Position, Values)) + geom_line(aes(color=VO)) + facet_wrap(~VO, ncol=1) > print(p) > ggplot(df, aes(VO, Values, fill=VO)) + geom_boxplot() >

> p <- ggplot(iris, aes(Sepal.Length, Sepal.Width)) + + geom_line(aes(color=Species), size=1) + + facet_wrap(~Species, ncol=1) > p > p

> theta = seq(0, 2*pi, length = 300) > x = cos(theta) > y = sin(theta) > > # set graphical parameters > op = par(bg = "black", mar = rep(0.5, 4)) > > # plot > plot(x, y, type = 'n') > segments(rep(0, 299), rep(0, 299), x[1:299] * runif(299, 0.5), + y[1:299] * runif(299, 0.7), + col = hsv(runif(95, 0.75, 0.85), 1, 1, runif(299, 0.5)), + lwd = 4*runif(299)) > > # signature > legend("topright", legend = "", bty = "n", text.col = "white")

> dat <- read.table(text = "A B C D E F G + 1 480 780 431 295 670 360 190 + 2 720 350 377 255 340 615 345 + 3 460 480 179 560 60 735 1260 + 4 220 240 876 789 820 100 75", header = TRUE) > > library(reshape2) > > dat$row <- seq_len(nrow(dat)) > dat2 <- melt(dat, id.vars = "row") > > library(ggplot2) Attaching package: ‘ggplot2’ The following objects are masked _by_ ‘.GlobalEnv’: is.facet, midwest > > ggplot(dat2, aes(x=variable, y=value, fill=row)) + + geom_bar(stat="identity") + + xlab("\nType") + + ylab("Time\n") + + guides(fill=FALSE) + + theme_bw()

set.seed(1); A <- sample(0:10, 100, replace = TRUE) stripchart(A, method = "stack", offset = .5, at = .15, pch = 19, main = "Dotplot of Random Values", xlab = "Random Values")

- ref:Graphing Data with R.

# Create FFTrees of the heart disease data heart.fft <- FFTrees(formula = diagnosis ~., data = heartdisease) # Visualise the tree plot(heart.fft, main = "Heart Disease Diagnosis", decision.labels = c("Absent", "Present"))

> heart.fft <- FFTrees(formula = diagnosis ~., data = heartdisease) heart.fft # Plot the best tree plot(heart.fft)

> library(hrbrthemes) > library(ggalt) > library(tidyverse) > sports <- read_tsv("https://github.com/halhen/viz-pub/raw/master/sports-time-of-day/activity.tsv") Parsed with column specification: cols( activity = col_character(), time = col_double(), p = col_double() ) > > sports %>% + group_by(activity) %>% + filter(max(p) > 3e-04, + !grepl('n\\.e\\.c', activity)) %>% + arrange(time) %>% + mutate(p_peak = p / max(p), + p_smooth = (lag(p_peak) + p_peak + lead(p_peak)) / 3, + p_smooth = coalesce(p_smooth, p_peak)) %>% + ungroup() %>% + do({ + rbind(., + filter(., time == 0) %>% + mutate(time = 24*60)) + }) %>% + mutate(time = ifelse(time < 3 * 60, time + 24 * 60, time)) %>% + mutate(activity = reorder(activity, p_peak, FUN=which.max)) %>% + arrange(activity) %>% + mutate(activity.f = reorder(as.character(activity), desc(activity))) -> sports > > sports <- mutate(sports, time2 = time/60) > > ggplot(sports, aes(time2, p_smooth)) + + geom_horizon(bandwidth=0.1) + + facet_grid(activity.f~.) + + scale_x_continuous(expand=c(0,0), breaks=seq(from = 3, to = 27, by = 3), labels = function(x) {sprintf("%02d:00", as.integer(x %% 24))}) + + viridis::scale_fill_viridis(name = "Activity relative to peak", discrete=TRUE, + labels=scales::percent(seq(0, 1, 0.1)+0.1)) + + labs(x=NULL, y=NULL, title="by Volkan OBAN using R - ggalt and hrbrthemes \n \n Peak time of day for sports and leisure", + subtitle="Number of participants throughout the day compared to peak popularity.") + + theme_ipsum_rc(grid="") + + theme(panel.spacing.y=unit(-0.05, "lines")) + + theme(strip.text.y = element_text(hjust=0, angle=360)) + + theme(axis.text.y=element_blank())

library(ggplot2) # devtools::install_github("hadley/ggplot2") library(ggalt) # devtools::install_github("hrbrmstr/ggalt") library(dplyr) # for data_frame() & arrange() # I'm not crazy enough to input all the data; this will have to do for the example df <- data_frame(country=c("Germany", "France", "Vietnam", "Japan", "Poland", "Lebanon", "Australia", "SouthnKorea", "Canada", "Spain", "Italy", "Peru", "U.S.", "UK", "Mexico", "Chile", "China", "India"), ages_35=c(0.39, 0.42, 0.49, 0.43, 0.51, 0.57, 0.60, 0.45, 0.65, 0.57, 0.57, 0.65, 0.63, 0.59, 0.67, 0.75, 0.52, 0.48), ages_18_to_34=c(0.81, 0.83, 0.86, 0.78, 0.86, 0.90, 0.91, 0.75, 0.93, 0.85, 0.83, 0.91, 0.89, 0.84, 0.90, 0.96, 0.73, 0.69), diff=sprintf("+%d", as.integer((ages_18_to_34-ages_35)*100))) # we want to keep the order in the plot, so we use a factor for country df <- arrange(df, desc(diff)) df$country <- factor(df$country, levels=rev(df$country)) # we only want the first line values with "%" symbols (to avoid chart junk) # quick hack; there is a more efficient way to do this percent_first <- function(x) { x <- sprintf("%d%%", round(x*100)) x[2:length(x)] <- sub("%$", "", x[2:length(x)]) x } gg <- ggplot() # doing this vs y axis major grid line gg <- gg + geom_segment(data=df, aes(y=country, yend=country, x=0, xend=1), color="#b2b2b2", size=0.15) # dum…dum…dum!bell gg <- gg + geom_dumbbell(data=df, aes(y=country, x=ages_35, xend=ages_18_to_34), size=1.5, color="#b2b2b2", point.size.l=3, point.size.r=3, point.colour.l="#9fb059", point.colour.r="#edae52") # text below points gg <- gg + geom_text(data=filter(df, country=="Germany"), aes(x=ages_35, y=country, label="Ages 35+"), color="#9fb059", size=3, vjust=-2, fontface="bold", family="Calibri") gg <- gg + geom_text(data=filter(df, country=="Germany"), aes(x=ages_18_to_34, y=country, label="Ages 18-34"), color="#edae52", size=3, vjust=-2, fontface="bold", family="Calibri") # text above points gg <- gg + geom_text(data=df, aes(x=ages_35, y=country, label=percent_first(ages_35)), color="#9fb059", size=2.75, vjust=2.5, family="Calibri") gg <- gg + geom_text(data=df, color="#edae52", size=2.75, vjust=2.5, family="Calibri", aes(x=ages_18_to_34, y=country, label=percent_first(ages_18_to_34))) # difference column gg <- gg + geom_rect(data=df, aes(xmin=1.05, xmax=1.175, ymin=-Inf, ymax=Inf), fill="#efefe3") gg <- gg + geom_text(data=df, aes(label=diff, y=country, x=1.1125), fontface="bold", size=3, family="Calibri") gg <- gg + geom_text(data=filter(df, country=="Germany"), aes(x=1.1125, y=country, label="DIFF"), color="#7a7d7e", size=3.1, vjust=-2, fontface="bold", family="Calibri") gg <- gg + scale_x_continuous(expand=c(0,0), limits=c(0, 1.175)) gg <- gg + scale_y_discrete(expand=c(0.075,0)) gg <- gg + labs(x=NULL, y=NULL, title="The social media age gap", subtitle="Adult internet users or reported smartphone owners whonuse social networking sites", caption="Source: Pew Research Center, Spring 2015 Global Attitudes Survey. Q74") gg <- gg + theme_bw(base_family="Calibri") gg <- gg + theme(panel.grid.major=element_blank()) gg <- gg + theme(panel.grid.minor=element_blank()) gg <- gg + theme(panel.border=element_blank()) gg <- gg + theme(axis.ticks=element_blank()) gg <- gg + theme(axis.text.x=element_blank()) gg <- gg + theme(plot.title=element_text(face="bold")) gg <- gg + theme(plot.subtitle=element_text(face="italic", size=9, margin=margin(b=12))) gg <- gg + theme(plot.caption=element_text(size=7, margin=margin(t=12), color="#7a7d7e")) gg

ref :http://lenkiefer.com/2017/08/03/joyswarm

set.seed(123) dt<- data.frame('label'=rep(letters[1:10], each=100), 'value'=as.vector(mapply(rnorm, rep(100, 10), rnorm(10), SIMPLIFY=TRUE)), 'rank'=rep(1:5, each=100, times=20)) ggplot(dt, aes(x=value, y=label, fill=label)) + + geom_joy(scale=3, rel_min_height=0.01) + + scale_fill_manual(values=rep(c('pink4', 'darkviolet'), length(unique(joy$label))/2)) + + scale_y_discrete(expand = c(0.01, 0)) + + xlab('Value') + + theme_joy() + + theme(axis.title.y = element_blank(), + legend.position='none')

> p1 = ggtree(tr) %<+% d1 + + geom_tippoint(aes(color=location), size=5) + + geom_tiplab(offset=-0.01, hjust=0.5, colour="white", size=3, fontface="bold") + ggtitle("by Volkan OBAN using R - ggjoy") + + scale_colour_manual(values = c("purple", "pink", "yellow")) + + scale_fill_manual(values = c("purple", "pink", "yellow")) > > facet_plot(p1, panel="Joy Plot", data=d4, geom_joy, + mapping = aes(x=val, group=label, fill=location), colour="grey40", lwd=0.3) ref:https://stackoverflow.com/questions/45384281/ggjoy-facet-with-ggtree

> require(ggtree) > require(ggstance) > # generate tree > tr <- rtree(30) > > # create simple ggtree object with tip labels > p <- ggtree(tr) + geom_tiplab(offset = 0.02) > > # Generate categorical data for each "species" > d1 <- data.frame(id=tr$tip.label, location=sample(c("GZ", "HK", "CZ"), 30, replace=TRUE)) > > #Plot the categorical data as colored points on the tree tips > p1 <- p %<+% d1 + geom_tippoint(aes(color=location)) > > # Generate distribution of points for each species > d4 = data.frame(id=rep(tr$tip.label, each=20), + val=as.vector(sapply(1:30, function(i) + rnorm(20, mean=i))) + ) > > require(ggjoy) > > ggplot(d4, aes(x = val, y = id)) + + geom_joy(scale = 2, rel_min_height=0.03) + + scale_y_discrete(expand = c(0.01, 0)) + theme_joy() + ggtitle("by Volkan OBAN using R - ggjoy") Picking joint bandwidth of 0.439 > p <- ggtree(tr) + geom_tiplab(offset = 0.02);p1 <- p %<+% d1 + geom_tippoint(aes(color=location));facet_plot(p1, panel="Joy Plot", data=d4, geom_joy, + mapping = aes(x=val, group=label, fill=location), colour="grey50", lwd=0.3)

> set.seed(1234) > pois_data <- data.frame(mean = rep(1:5, each = 10)) > pois_data$group <- factor(pois_data$mean, levels=5:1) > pois_data$value <- rpois(nrow(pois_data), pois_data$mean) > > # make plot > ggplot(pois_data, aes(x = value, y = group, group = group)) + + geom_joy2(aes(fill = group), stat = "binline", binwidth = 1, scale = 0.95) + + geom_text(stat = "bin", + aes(y = group + 0.95*(..count../max(..count..)), + label = ifelse(..count..>0, ..count.., "")), + vjust = 1.4, size = 3, color = "white", binwidth = 1) + + scale_x_continuous(breaks = c(0:12), limits = c(-.5, 13), expand = c(0, 0), + name = "random value") + + scale_y_discrete(expand = c(0.01, 0), name = "Poisson mean", + labels = c("5.0", "4.0", "3.0", "2.0", "1.0")) + + scale_fill_cyclical(values = c("#0000B0", "#7070D0")) + + labs(title = " Poisson random samples with different means", + subtitle = "sample size n=10") + + guides(y = "none") + + theme_joy(grid = FALSE) + + theme(axis.title.x = element_text(hjust = 0.5), + axis.title.y = element_text(hjust = 0.5)) ref: https://cran.r-project.org/web/packages/ggjoy/vignettes/gallery.html

> library(ggplot2movies) > ggplot(movies[movies$year>1912,], aes(x = length, y = year, group = year)) + + geom_joy(scale = 10, size = 0.25, rel_min_height = 0.03) + + theme_joy() + + scale_x_continuous(limits=c(1, 200), expand = c(0.01, 0)) + + scale_y_reverse(breaks=c(2000, 1980, 1960, 1940, 1920, 1900), expand = c(0.01, 0))

ggplot(diamonds, aes(x = price, y = cut, fill = cut)) + + geom_joy(scale = 4) + + scale_fill_cyclical(values = c("purple", "pink"))

> library(ggjoy) Warning message: package ‘ggjoy’ was built under R version 3.4.1 > > ggplot(diamonds, aes(x = price, y = cut)) + + geom_joy(scale = 4) + theme_joy() + + scale_y_discrete(expand = c(0.01, 0)) + # will generally have to set the `expand` option + scale_x_continuous(expand = c(0, 0))

a<- qplot(color, price/carat, data = diamonds, geom = "jitter", alpha = I(1/15)) ggdraw(a) + + draw_plot_label("R - Data Visualization-data(diamonds)", size = 12) + + draw_label("", angle = 25, size = 50, alpha = .7)

a<-ggplot(data=diamonds,aes(x=price, group=cut, fill=cut)) + geom_density(adjust=1.5, position="fill") ggdraw(a) + + draw_plot_label("Data Science & Analytics", size = 8) + + draw_label("", angle = 45, size = 40, alpha = .6)

ggdraw