# volkanoban

## Recently Published

##### aRt with mathematics
function(x) : {x+tan(exp(sin(x)*cos(x-1)))}
R artsy package
##### R
VOLKAN OBAN aRtsy
aRtsy
##### R
VOLKAN OBAN aRtsy pckage
##### R
sin(x/tan(cos(x)))-exp(-sin(x))
##### R
ref: https://github.com/marcusvolz
##### aRt with mathematics
{tan(cos(x/x^3+3)/sin(x/x^3+1)-x^4)}
##### Plotting using complex functions
z^5+(-0.2+0.11*1i)/z^10
##### Plotting using complex functions
z^5+(-0.2+0.11*1i)/z^3
##### Plotting using complex functions
z^5+(-0.2+0.11*1i)/z^9
##### Plotting using complex functions
z^3+(-0.2+0.11*1i)/z^3
1+ z+z^2-0.8/z^3
##### VOLKAN OBAN
18,350,0.43,120,0.45,0.817,-0,12
##### art with mathematical functions
sin(cos(tan(exp(2-x))))
##### art with mathematical functions
12,250,0.41,110,0.25,1.817,-0.025 function(x) {cos(1/1+sin(x)+1/1+sin(x)*sin(x))}
##### aRt
sin(sin(cos((exp(1/x)/1+x^2)))/1+x^exp(-x^1/x^2))
##### art with mathematical functions
sin(cos(sin(x/1+x^4))/x+x^exp(-x^2/x))
##### aRt with mathematics
sin(sin(cos(x))/1+x^exp(-x^1/x))
##### aRt with mathematics
sin(x/1+x^exp(-x^1/x)) 2.75 -0.25
##### aRt with mathematics
sin(1/1+x^exp(-x^1/x))
##### aRt
sin(exp(-1/cos(x/x^7+3)/x^9))
##### aRt with mathematics
sin(exp(-1/cos(x/x^7+3)/x^7))
##### aRt with mathematics
12 205 0.22 102 # 0.87 0.15 -0.28 {sin(cos(x/x^3+3)/sin(x/x^3+1)-x^4)}
##### aRt with mathematics
sin(cos(x+5*x*x/x^4+3)/sin(x/x^4+1)-x^3)
##### Plot
8 210 0.22 105 0.45 0.12 {sin(cos(x+5*x*x/3)/sin(x/x+1)-x^3)}
##### aRt with mathematics
sin(cos(2*sin(exp(x^sin(1/x^4)))))
##### art with mathematical functions
cos(2*sin(exp(x^sin(1/x^4))))
##### aRt with mathematics
cos(x*sin(exp(x^sin(1/x^2))))
##### art with mathematical functions
cos(x*sin(exp(x^sin(1/x^2)))
##### aRt with mathematics
cos(2*sin(exp(x^sin(x))))
##### Roses-art with mathematical functions
12 300 0.32 400 0.4 0.75 line_color <- "white" back_color <- "black" {sinh(log(x+1)*cos(x)*sin(1/x))}
##### R
{cos(sin(exp(-x^2))/x^3)}
##### aRt with mathematics
{cos(sin(exp(-x^2))/x^4)}
##### aRt with mathematics
cos(sin(exp(-x^2))/x^4)
##### aRt with mathematics
cos(x^4*x-sin(cos(1/x^4)))
##### art with mathematical functions
{sin(cos(1/x^4))}
##### aRt with mathematics
{sin(cos(1/x^4))}
##### R
sin(x^sin(cos(x)))
x^sin(cos(x))
1/x^4*sin(x)
##### R
{tan(sin(cos(exp(x/x^2+1))))}
##### R aRT
tan(sin(cos(exp(x/x^2+1))))
Elif
Dr. VOLKAN OBAN
##### art with mathematical functions
sin(cos(sin(x*x)))
##### aRt with mathematics
cos(exp(-x)*sin(exp(-x)))
##### R
cos(exp(-x)*sin(exp(-x)))
##### art with mathematical functions
12,100,0.41,105,2,0.2,-0.05, {sin(x/(-cos(x)))}
##### R
{sin(2*x*x)^x*x-x/cos(x+tan(x+1))}
##### R aRT
{sin(2*x*x)^x*x-x/cos(x+tan(x+1))}
##### art with mathematical functions
{sin(x)^x*x-1/cos(x^9)}
##### aRt with mathematics
{sin(x)^x*x-1/cos(x^9)}
##### mathematics
{sin(x)^x*x-1/cos(x^9)}
##### art with mathematical functions
{sin(x)^x-1/cos(x^9)}
##### VOLKAN OBAN
{sin(x)^2/cos(x*x)}
##### aRt with mathematics
{sin(cos(log(4^x*2)))/x^4-1}
##### aRt with mathematics
sin(cos(log(2^x*x+1)))/x^2-1
##### art with mathematical functions
{sin(cos(x/log(2^x*x+1)))+1}
##### art with mathematical functions
sin(cos(log(2^2*x+1)))/x^2-1)
##### art with mathematical functions
{{sin(cos(x+5*x*x/3)/sin(x/x+1)-x^3)}}
##### aRt with mathematics
{{sin(cos(x+5*x*x/3)/sin(x/x+1)-x^3)}}
Dr. Volkan OBAN
##### aRt with mathematics
{{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}
##### R
{x^x-sin(x^3)^tan(x/cos(x))}
##### VOLKAN OBAN
cos(x/x+x^(exp(-x*x)))
##### VOLKAN OBAN
{cos(x/x+x^2*(exp(-x*x)))}
##### aRt with mathematics
12 300 - 0.43 110 0.65 0.817 - -0.09 {cos(3*x/x+sin(exp(-x*x)))}
##### mathematical functions
{cos(2*x/x+sin(exp(-x*x)))}
##### aRt with mathematics
{cos(2*x/x+sin(exp(-x*x)))}
##### mathematical functions
sin(x+x^5/cos(sin(x)/x+2*sin(exp(-x))))
{cos(x/2)/1-x^3}
##### aRt with mathematics
{sin(-cos(1/1x*x)*x/x^11+2)}
##### aRt with mathematics
{sin(cos(x)*x/x^5+2)}
##### aRt with mathematics
sin(cos(x)*1/x^3+2)
##### Plot
AÇI<- 2.15 cos(x/x^2^x/x^6+2)
##### aRt with mathematics
{cos(x/x^2^x/x^6+2)} 6 # 300 0.43 110 0.65 0.67 -0.09
##### mathematical functions
function(x) {cos(x/x^2^x/x^4+2)}
math volkan oban
##### mathematics
sin(tan(abs(2*x)/x+1))
##### volkan oban
{cos(x)^3*x/x^2+1}
##### mathematics
{cos(2*sin(x/exp(-x))^1/x^2+1)}
##### aRt with mathematics
tan(x)*x+cos(x^7)
log(cos(x^5))
##### volkan oban
cos(exp(-x))^sin(x^2)/x^7-1
##### aRt with mathematics
cos(exp(-x))^x/x^5-1
##### aRt with mathematics
cos(exp(-x))^x/x^3-1
##### art with mathematical functions
cos(2*sin(1/1+tan(exp(-*x))))
##### art with mathematical functions
cos(2*sin(x/exp(-x))^1/x+1)
##### mathematical functions
{sin(x*x+2/cos(exp(-x))^-x/x+1)}
sin(cos
##### art with mathematical functions
exp(-sin(exp(cos(x/1-x^5)/x*x*x)))
##### art with mathematical functions
{exp(-sin(exp(cos(x)/x*x)))}
##### aRt with mathematics
5,250,0.43, 110,0.32,8.9-0.0002 {exp(-sin(exp(1/x*x)))}
##### aRt with mathematics
exp(-sin(exp(1/x*x)))
##### aRt with mathematics
12,101,0.43, 110,0.84,8.817,-0.0002 {exp(-sin(exp(1/x*x)))}
##### art with mathematical functions
sin(-exp(cos(-1/x*x*x)))
##### mathematical functions
cos(exp(sin(cos(exp(sin(cos(x)))))))
##### volkan oban
cos(exp(sin(cos(exp(sin(cos(x)))))))
##### math and graph
exp(exp(exp(exp(-x))))
exp(sin(x))
##### mathematics
exp(x+log(sin(cos(sin(-exp(x*x))))))
##### mathematical functions
exp(-x)^log(sin(cos(sin(-exp(x*x)))))
##### volkan oban
x^log(sin(cos(sin(-exp(x*x)))))
cos(sin(exp(x)))
##### aRt with mathematics
{cos(sin(exp(-x)))}
##### aRt with mathematics
8,1000,0.32,500,0.4,0.75,-0,27 cos(x)*sin(1/x)*log(x+1)
##### art with mathematical functions
sin(cos(sin(cos(x*x))))
##### Plot
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))}
##### art with mathematical functions
cos(2*tan(sin(-4*x*x*cos(tan(1/x*x*x*x)))))
##### aRt with mathematics
tan(1/exp(cos(4*x)))
##### aRt with mathematics
tan(exp(-cos(4*x)))
##### aRt with mathematics
tan(-exp(cos(x)))
##### Plot
tan(2*x)+cos(2*x)+sin(2*x)
##### volkan oban
abs(sin(cos(1/x*x))*exp(1/x*x))
##### aRt with mathematics
abs(sin(cos(1/x*x))*exp(-1/x))
##### art with mathematical functions
abs(sin(cos(1/x)))
##### art with mathematical functions
tan(exp(2*-cos(factorial(sin(x)))))
##### mathematics
x-factorial(sin(x))/x^2
##### mathematics
factorial(cos(x))
##### mathematics
tan(exp(2*-cos(factorial(sin(x)))))
##### aRt with mathematics
exp(sin(1/x)) 12 250 0.4 101 0.25 -1.52
##### art with mathematical functions
exp(cos((sin(-x*x))))
##### aRt with mathematics
cos(x*x)*tan(x*x)*sin(x*x)*(sin(x))^2
##### aRt with mathematics
log(x+1)*tan(2*x)*sin(2*x)*(sin(x))^2
##### math and graph
sin(cos(exp(cos(1-x*x))))
##### aRt with mathematics
tan(x*x*exp(-sin(x)*cos(1/x/x)))
##### aRt with mathematics
x+tan(2*sin(exp(-sin(x))))
##### aRt with mathematics
{tan(2*sin(exp(-sin(x))))}
##### aRt with mathematics
tan(exp(sin(x)*cos(x)))
ref: Chinchón
##### aRt with mathematics
Trigonometric functions
##### aRt with mathematics
sin(exp(x)+cos(x))
##### aRt with mathematics
ref: A.S. Chinchón
##### Johns Hopkins Covid-19 data
ref:https://joachim-gassen.github.io/
##### aRt with mathematics
{sin(1/cos(1+x))}
##### R volkan oban
{sin(-exp(cos(-1/x*x*x)))}
##### R
{sin(-exp(cos(-1/x*x*x)))}
##### aRt with mathematics
{cos(sinh(tan(-1/x)))+cosh(sin(x))}
{tan(sinh(x))}
Volkan OBAN
##### aRt with mathematics
cos(sinh(tan(1/x)))
##### r volkan oban
function(x) {sinh((-cos(sin((1/x)+(1/x*x)+(1/x^3)+(1/x^4)+1))))}
##### R volkan oban
{sinh(cos((1/x)+(1/x*x)+(1/x^3)+(1/x^4)+1))}
##### R volkan oban
sinh((1/x)+(1/x*x)+(1/x^3)+(1/x^4))
##### aRt with mathematics
{1-cos(sinh(tan(sin(x))))/1-x}
##### R volkan oban
{x*cos(sinh(tan(sin(x))))/1-x}
##### aRt with mathematics
{cos(sinh(tan(sin(1-x))))}
##### aRt with mathematics
{cos(sinh(tan(sin(1-x))))}
##### aRt with mathematics
1-sinh(tan(sin(1-x)))
##### aRt with mathematics
{1-sinh(exp(-x))}
##### aRt with mathematics
{x+sinh(exp(-x))}
##### R volkan oban
sinh(cos(sin(exp(tan(cosh(x)/x*x)))))
##### R volkan oban
sinh(cos(sin(exp(tan(cosh(x)/x*x)))))
##### R volkan oban
{sin(exp(tan(-1/x*x)))
##### R volkan oban
{exp(tan(-1/x*x))}
{2*tan(1/x)-x}
{2*x-x/cos(x)}
##### sem path
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")
##### sem path
Structural Equation Modeling
##### aRt with mathematics
cos(1/x-exp(-4/x))
{sin(sinh(x))}
##### aRt with mathematics
{cos(sin(x)-2*x)/x-log(x^5)}
##### R volkan oban
{cos(sin(x)-4*x)/x-log(x^5)}
##### aRt with mathematics
{cos(x)/x-log(x^5)}
{1/x-log(x^3)
##### aRt with mathematics
{sin(tan(exp(sin(x)*cos(x-1))))}
##### aRt with mathematics
> 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)))}
##### aRt
{x*(x+tan(exp(sin(x)*cos(x-1))))}
##### aRt with mathematics
{1/tan(1/exp(sin(cos(x))))+tan(cos(exp(-sin(x))))}
VOLKAN OBAN
##### aRt with mathematics
tan(cos(exp(sin(x))))
##### aRt with mathematics
{sin(cos(exp(tan(x))))}
##### aRt with mathematics
function(x) {tan(sin(cos(1/x)))}
##### aRt with mathematics
{tan(sin(cos(x)))}
##### aRt with mathematics
function(x) {x+tan(exp(sin(x)*cos(x-1)))}
##### aRt with mathematics
function(x) {sin(x/4)}
##### aRt with mathematics
sin(x)/x-(cosh(exp(-sin(x))))}
##### aRt with mathematics
{sin(x)/x-(cosh(exp(-sin(x))))}
##### aRt with mathematics
{1/x-(cosh(exp(-cos(x))))}
##### aRt with mathematics
{1/x-(cosh(exp(-cos(x))))}
##### aRt with mathematics
1/x-(-sinh(exp(-cos(x))))
##### aRt with mathematics
{x-(-sinh(exp(-cos(x))))}
##### aRt with mathematics
1-(sinh(exp(cos(x))))
##### aRt with mathematics
{1-(-tan(exp(cos(x))))}
##### aRt with mathematics
{x/1-x-cos(x)*sin(tan(exp(cos(x/2))))}
##### flowers
log(x+1)*cos(x)*sin(1/x)
##### aRt with mathematics
-sin(x)*cos(x)*tan(x)
##### aRt with mathematics
function(x) {x/1-x-cos(x)*sin(-tan(exp(cos(x))))}
##### R
> 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())
##### aRt
> angle <- 6.2 > points <- 1000 > > t <- (1:points)*2*angle > x <- sin(-2*t) > y <- cos(2*t) > > df <- data.frame(t, x, y)
##### R
> angle <- 4.2 > points <- 1000 > > t <- (1:points)*2*angle > x <-cos(t) > y <-sin(t) > > df <- data.frame(t, x, y) >
##### R
> angle <- 4.2 > points <- 1000 > > t <- (1:points)*angle > x <-sin(t) > y <- cos(t)*(-1/t) > > df <- data.frame(t, x, y)
##### R
> 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"))
##### R
> angle <- 4.2 > points <- 1000 > > t <- (1:points)*angle > x <- t > y <- cos(1/t-t) > > df <- data.frame(t, x, y) >
##### R DataViz
> 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)
##### R
> angle <- 3.2 > points <- 600 > > t <- (1:points)*angle > x <- sin(t^3-t) > y <- cos(1/t) > > df <- data.frame(t, x, y)
##### R DataViz
> angle <- 4.2 > points <- 1000 > > t <- (1:points)*2*angle > x <- sin(tan(2*t)) > y <- cos(tan(2*t)) >
##### R
> angle <- 4.2 > points <- 1000 > > t <- (1:points)*2*angle > x <- sin(2*t) > y <- cos(2*t) > > df <- data.frame(t, x, y)
##### aRt with mathematics
function(x) {cos(x+x^3+x^7)-sin(x)}
##### mosaic
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)
##### aRt with mathematics
x*sin(x)-log(x)*cos(x)+1
##### aRt with mathematics
1-log(x)*[cos(x)*sin(x)*tan(x)/exp(x*x*x)]
##### aRt with mathematics
sin(x)+tan(x)/exp(x)
##### aRt with mathematics
1+cos(2*x)*log(x)*sin(x)
##### aRt with mathematics
1+x*log(x)*sin(x)
1-tan(2x)
##### aRt with mathematics
function(x) {x^2 -1 /x*sin(cos(sin(x)))*log(x+1)}
##### aRt with mathematics
function(x) {sin(x)/x*x}
##### aRt with mathematics
function(x) {(log(x+(x^2))*cos(sqrt(x))/exp((x^2)-1))+sin(1+x^3)+1-1/1-x}
##### aRt with mathematics
function(x) {(log(x+sqrt(x^5))*cos(sqrt(x))/exp((x^2)-1))+sin(1+x)+1+cos(x)
##### aRt with mathematics
• function(x) {(log(x+sqrt(x))*cos(x)/exp((x^3)-1))+sin(1+x)+1}
##### aRt with mathematics
• function(x) {(log(x)*cos(x)/exp((x^3)-1))+sin(1+x)+1}
##### aRt with mathematics
function(x) {(log(x)/exp((x^3)-1))+sin(1+x)}
##### aRt with mathematics
function(x) {(1/exp((x^3)-1))+sin(1+x)}
##### R
function(x) {x^3+sin(2*x)*cos(3/x)*log(2*x)+1/x-5*x} ref:aschinchon
##### aRt
function(x) {x+cos(x*x-1)*sin(x*x-1)+(x-1)}
##### aRt with mathematics
function(x) {exp(cos(x*x-1))*sin(x*x*x)}
##### aRt with mathematics
function(x) {exp(cos(x*x-1))}
##### aRt with mathematics
function(x) {cos(x+1)*sin(x-1)-1/x-log(x)}
##### aRt with mathematics
function(x) {cos(x)*sin(x-1)-x*tan(1/x)+log(x)}
##### aRt with mathematics
function(x) {cos(x)*sin(x-1)-x}
##### R
function(x) {1/tan(-cos(sin(log(x*x/exp(-x^2)))))}
##### R
{tan(cos(sin(log(x*x/exp(-x^2))))}
##### R
function(x) {cos(sin(log10(x*x/500))/x}
##### R
function(x) {sin(log10(x*x/500))}
##### aRt with mathematics
log(5*x+1)*cos(3*x)*sin(1/x)
##### ggparty
ref: https://cran.r-project.org/web/packages/ggparty/vignettes/ggparty-graphic-partying.html
##### ggparty
ref:https://cran.r-project.org/web/packages/ggparty/vignettes/ggparty-graphic-partying.html
##### geometric shape
ref:Antonio Sánchez Chinchón
ref: r-blogger
ref: r- blogger
ref : r blogger
##### network visualization
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
##### chaos
ref:fronkonstin.com/category/chaos/
ggstatsplot
##### 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
##### ggplot2
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()
##### Plot
> 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
##### ggplot2
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")
##### DALEX
breakDown::HR_data
fviz_silhouett
##### k-means Clustering
factoextra and clustering packages grid,gridextra ref:https://uc-r.github.io/kmeans_clustering
##### Plot
ggplot(surveys_complete, aes(x = species_id, y = hindfoot_length)) + + geom_boxplot() + + theme_wsj()
##### ggplot2
> ggplot(data = surveys_complete, mapping = aes(x = species_id, y = weight)) + + geom_boxplot(alpha = 0) + + geom_jitter(alpha = 0.3, color = "red")
##### dygraphs
ref: r-graph-gallery
##### Calendar Heatmap
ref: r-graph-gallery.com
##### Calendar Heatmap
ref: r-graph-gallery
##### Calendar Heatmap
ref:r-graph-gallery
##### wordcloud2 package
wordcloud2(d, size =1 , minRotation = -pi/8, maxRotation = -pi/3, rotateRatio = 1)
Happy new years
love….AŞK
##### network visualization
ref: data-to-viz.com
##### network visualization
ref: data-to-viz.com
##### Plot
library(network) library(sna) library(maps) library(ggplot2)
##### aRt
ref:fronkonstin.com
##### aRt
ref : fronkonstin.com
##### Cannibus Curve
,ref: r-bloggers.com/cannibus-curve-with-ggplot2/
##### lime
ref:www.data-imaginist.com
##### factoextra NbClust
ref : http://www.sthda.com
##### factoextra NbClust
ref :http://www.sthda.com
##### factoextra NbClust
ref: http://www.sthda.com
##### rpart.plot
> par(bg='lavender') > anova.model <- rpart(Mileage ~ ., data = cu.summary) > rpart.plot(anova.model, box.palette = "GnYlRd", + shadow.col = "black", )
##### stacked densities plot
ref : shinyapps. Michael Lee
##### Plot
> 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
##### Plot
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")
##### Plot
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()
##### art
ref: https://github.com/aschinchon
##### aRt
> 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()
##### aRt
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/
##### aRt
ref:https://fronkonstin.com/
##### aRt
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)
##### aRt
ref: https://fronkonstin.com/2017/12/23/tiny-art-in-less-than-280-characters/
##### aRt
> 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
##### ggsci
theme(plot.background = element_rect(fill = "palegoldenrod"))
##### ggiraph
ref:r-graph-gallery.com
##### ggplot2 ggthemes pack.
> 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
##### ggplot2
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")
##### VOLKAN OBAN
Plotrix Test color legends
##### Plotrix
clock24.plot ref:https://cran.r-project.org/web/packages/plotrix/plotrix.pdf
##### Plotrix
ref:https://cran.r-project.org/web/packages/plotrix/plotrix.pdf
##### Plotrix
ref:https://cran.r-project.org/web/packages/plotrix/plotrix.pdf
##### "TSP" - The Travelling Salesman Problem (TSP).
ref:https://github.com/aschinchon/
delaunay
##### aRt with R
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
##### ggmosaic package
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))
##### Plot
> 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
##### fractal-mandelbrot
z <- mandelbrot(iter=15) > par(pty="s") > image(z,col=c(topo.colors(n+6),"black"), las=3)
##### Plot
z <- mandelbrot(iter=400) > par(pty="s") > image(z,col=c(topo.colors(n+3),"black"), las=3)
##### mandelbrot
z <- mandelbrot(iter=100) > par(pty="s") > image(z, col=c(topo.colors(n+1),"black"), las=3) ref:https://github.com/mariodosreis/fractal
##### fractal
library(fractal) > z <- mandelbrot(iter=100) > par(pty="s") > image(z, col=c(topo.colors(n),"red"), las=1)
##### art game with R
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 >
##### aRt with R
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 + } >
##### art game with R
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 + }
##### aRt with R
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)
##### igraph and visNetwork
> g <- graph.star(40) > V(g)\$color <- c("red", "white") > > E(g)\$color <- "black" > plot(g)
##### visNetwork
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")
##### data aRt with R
............... > 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 ................
##### 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 + } ........................... .........
##### Plot
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
##### data aRt with R -Mandalas
> 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 + }
##### data visulazition in R
> 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
##### DATA ART with R
> 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
##### data visulazition in R
> 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
##### 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
##### 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
##### data aRt with R -Mandalas
> 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
##### mandalas
+ 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
##### data-aRt
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
##### 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
##### mandalas
> 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
##### mandalas
> 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
##### mandalas
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
##### ggplot2 and ggthemr
> 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")
##### ggplot2 and ggthemr
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
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")
##### Plot
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")
##### hexbin
> x <- rnorm(10000) > y <- rnorm(10000) > bin <- hexbin(x,y) > ## Plot method for hexbin ! > ## ---- ------ -------- > plot(bin) > # nested lattice > plot(bin,, style= "nested.lattice")
##### hexbin
> 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 = "")
##### yarrr
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)
##### yarrr
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)
##### swatches
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))
##### PDN-Personalized Disease Network
#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)) }
##### Plot
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
sunflowerplot(rnorm(1000), rnorm(1000), number = rpois(n = 1000, lambda = 2),rotate = TRUE, col = "purple")
##### animation
> 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/
##### tweenr
> 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)
##### tweenr
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)
##### D3partitionR
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()
##### plotly
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)
##### ggiraph
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)})
##### ggiraph
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))
##### heatmap
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")
##### ggplot2
> 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
##### ggplot2 and ggthemes
> 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")
##### ggplot2 and ggthemes
> 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")
##### Plot3d
ref https://cran.r-project.org/web/packages/plot3D/vignettes/plot3D.pdf
##### Plot3d
ref: https://cran.r-project.org/web/packages/plot3D/vignettes/plot3D.pdf
##### plot3D
> 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)
##### plot3D
> 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)
##### plot3D
> 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)
##### ggplot2
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()
##### Clifford Attractors
> 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')
##### Clifford Attractors
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
##### mvmesh
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
##### RTriangle
> 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)
##### plotmo
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 }
##### rpart.plot
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) }
##### rpart.plot
data(ptitanic) tree <- rpart(age ~ ., data=ptitanic) rpart.plot(tree, type=4, extra=0, branch.lty=3, box.palette="RdYlGn")
##### brownian motion
>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)
##### persp
> 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")
##### persp
op <- par(bg = "black") > persp(x, y, z, theta =70 , phi = 40, expand = 0.5, col = "red")
##### persp-- Perspective Plots
> 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")
##### persp-- Perspective Plots
> 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")
##### persp-- Perspective Plots
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")
##### lattice - wireframe
> 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))
##### lattice - wireframe
> 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))
##### Plot
> 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')
##### Plot
> 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))
##### hexbin-hexplom
data(NHANES) hexplom(NHANES[,9:13], xbins = 20,colramp = BTY, upper.panel = panel.hexboxplot)
##### lattice - wireframe
> 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
##### Plot persp
> 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") >
##### Plot
> 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")
##### Plot- persp
> 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")
##### deSolve package
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
##### igraph
g <‐ make_lattice(dimvector = c(5,5), + circular = FALSE) plot(g,vertex.color=c("red", "darkslateblue","gold","lightblue","pink"))
##### igraph
> g<- make_tree(60, children=3) > plot(g,vertex.color=c("red", "darkslateblue","gold","lightblue","pink"))
##### Sales Funnel with R . by means of https://www.r-bloggers.com/
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())
##### Sales Funnel with R . by means of https://www.r-bloggers.com/
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/
##### naniar package
gg_miss_case(airquality)
##### PGRdup
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
##### persp-- Perspective Plots
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) }
##### persp
> 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)
##### persp-
> 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) >
##### grDevices
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)
##### lattice package
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")
##### diagram
ref: http://www.rforscience.com/portfolio/solving-differential-equations-in-r-chapter-5/
##### Plot
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/
##### Plot
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)) >
##### Plot3D package
> 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")
##### GA
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
##### arulesViz
> data(Groceries) > rules <- apriori(Groceries, parameter=list(support=0.005, confidence=0.5)) > plot(rules, method="grouped") ref:http://www.ekonlab.com/?p=835
##### ggformula
gf_point(price~carat| color ~ clarity, data=diamonds, alpha=0.2) %>% gf_lm()
##### ggformula
ggplot(data = iris, aes(sample = Sepal.Length)) + + geom_qq() + + stat_qqline( alpha = 0.7, color = "red", linetype = "dashed") + + facet_wrap(~Species)
##### ggformula
> 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)
##### ggformula
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 ~ .) + }
##### ggformula
gf_dotplot(~ Sepal.Length, fill = ~Species, data = iris)
##### geofacet
> 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()
##### geofacet
> 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()
##### Voronoi Diagrams
> 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")
##### cartogram
> 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))
##### tripack-k-means and voronoi diagrams
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
##### scatterplot3d
data(Mishkin ) ref: ref: Visualizing Complex Data Using R by N.D. Lewis
##### tm and wordcloud
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
##### mvtsplot
ref: Visualizing Complex Data Using R by N.D. Lewis
##### mvtsplot
> library(datasets) > library(mvtsplot) >D <- diff(EuStockMarkets ,90) >mvtsplot(D,,norm ="internal", levels = 4,margin=FALSE)
##### spineplot
> 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)
##### Plot
> 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))
##### plot3D
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)
##### Plot3D package
> 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
##### Plot3D package
> 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
##### ggplot2
> 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() >
##### ggplot2
> p <- ggplot(iris, aes(Sepal.Length, Sepal.Width)) + + geom_line(aes(color=Species), size=1) + + facet_wrap(~Species, ncol=1) > p > p
##### DATA ART with R
> 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")
##### Plot
> 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()
##### stripchart
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")
##### Plot
- ref:Graphing Data with R.
##### FFtree
# 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"))
##### FFtree
> heart.fft <- FFTrees(formula = diagnosis ~., data = heartdisease) heart.fft # Plot the best tree plot(heart.fft)
##### ggalt-hrbrthemes
> 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())
##### dumbbell plot
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
##### ggjoy
ref :http://lenkiefer.com/2017/08/03/joyswarm
##### ggjoy
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')
##### gjoy
> 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
##### gjoy
> 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)
##### ggjoy
> 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
##### ggjoy
> 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))
##### ggjoy
ggplot(diamonds, aes(x = price, y = cut, fill = cut)) + + geom_joy(scale = 4) + + scale_fill_cyclical(values = c("purple", "pink"))
##### ggjoy
> 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))
##### cowplot
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)
##### cowplot
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
##### lattice package
df <- data.frame(expand.grid(1:100,1:100),rep(10,1000)) ;colnames(df) <- c("x","y","z"); wireframe(z~x*y,df,colorkey=TRUE,drape=TRUE);wireframe(z~x*y,df,main="",color="",drape=TRUE, zlim=c(0,24))
##### ggjoy
> require(ggplot2movies) > require(viridis) > ggplot(movies[movies\$year>1989,], aes(x = length, y = year, fill = factor(year))) + + stat_binline(scale = 1.9, bins = 40) + + theme_joy() + theme(legend.position = "none") + + scale_x_continuous(limits = c(1, 180), expand = c(0.01, 0)) + + scale_y_reverse(expand = c(0.01, 0)) + + scale_fill_viridis(begin = 0.3, discrete = TRUE, option = "B") + + labs(title = " Movie lengths 1990 - 2005")
##### ggjoy
ggplot(iris, aes(x = Sepal.Length, y = Species, group = Species)) + + geom_joy(rel_min_height = 0.005) + + scale_y_discrete(expand = c(0.01, 0)) + + scale_x_continuous(expand = c(0.01, 0)) + + theme_joy()
##### persp-- Perspective Plots
cone <- function(x, y){ sqrt(x*cos(x^2)+sin(y)) } ;x <- y <- seq(-1, 1, length= 50); z <- outer(x, y, cone); persp(x, y, z, main="" ,col="pink")
##### GA
y <- x <- seq(-10, 10, length=60) f <- function(x,y) { r <- sqrt(x^2+y^2); 10 * sin(r)/r } z <- outer(x, y, f) persp3D(x, y, z, color.palette = heat.colors, phi = 30, theta = 225, box = TRUE, border = NA, shade = .4)
##### lattice package
df <- data.frame(expand.grid(1:10,1:10),rep(10,100)) ;colnames(df) <- c("x","y","z"); wireframe(z~x*y,df,colorkey=TRUE,drape=TRUE);wireframe(z~x*y,df,main="",colorkey=TRUE,drape=TRUE, zlim=c(0,24))
##### ggplot2
gplot(mtcars, aes(wt, mpg)) + + geom_point(shape = 21, colour = "purple", fill = "slateblue1", size = 5, stroke = 5) + theme_solarized() + + scale_colour_solarized("blue")
##### ggplot2
library("tidyverse") library("forcats") library(ggthemes) rincome_plot <- gss_cat %>% ggplot(aes(rincome)) + geom_bar() rincome_plot gss_cat %>% filter(!denom %in% c("No answer", "Other", "Don't know", "Not applicable", "No denomination")) %>% count(relig) gss_cat %>% count(relig, denom) %>% ggplot(aes(x = relig, y = denom, size = n)) + geom_point() + theme(axis.text.x = element_text(angle = 90) + theme_igray() ref:https://jrnold.github.io/e4qf/factors.html
##### ggplot2
> dataframe <- tibble( + x = rnorm(10000), + y = rnorm(10000) ) ggplot(dataframe , aes(x, y)) + + geom_hex() + + scale_fill_gradient(low = "thistle2", high = "purple") + + coord_fixed()
##### ggplot2
> ggplot(mpg, aes(displ, hwy, colour = class)) + + geom_point(aes(colour = class)) + + geom_smooth(method = "lm", se = FALSE) + + labs( + title = "Fuel efficiency generally decreases with engine size", + subtitle = "Subcompact cars show the greatest sensitivity to engine size", + caption = "Data from fueleconomy.gov" + )
##### ggplot2
> library(gapminder) Warning message: package ‘gapminder’ was built under R version 3.4.1 > lifeExp ~ poly(year, 2) lifeExp ~ poly(year, 2) > country_model <- function(df) { + lm(lifeExp ~ poly(year - median(year), 2), data = df) + } > > by_country <- gapminder %>% + group_by(country, continent) %>% + nest() > > by_country <- by_country %>% + mutate(model = map(data, country_model)) > by_country <- by_country %>% + mutate( + resids = map2(data, model, add_residuals) + ) > by_country unnest(by_country, resids) %>% + ggplot(aes(year, resid)) + + geom_line(aes(group = country), alpha = 1 / 3) + + geom_smooth(se = FALSE)
##### treemap
World population 2014
##### lattice package
> params.grid.length <- 20 > params.alpha.list <- seq(0.3, 0.6, length = params.grid.length) > params.beta.list <- seq(1,9, length = params.grid.length) > z <- matrix(ncol = params.grid.length, nrow = params.grid.length) > > # Loop through and calculate negative log likelihood at defined values in grid > for (i in 1:length(params.alpha.list )){ + for (ii in 1:length(params.beta.list)){ + alpha <- params.alpha.list[i] + beta <- params.beta.list[ii] + y <- 0.5 + (1 - 0.5 - 0.025)* pweibull(resp.frame\$x, beta, alpha) + negLog <- -sum(resp.frame\$ny * log(y) + (resp.frame\$num.tr - resp.frame\$ny) * log(1 - y) ) # Negative log likelihood + z[i,ii] <- negLog + } + } > > # Need to generate stacked list of values to pass to wireframe in lattice > params.alpha.wireList <- rep(unique(params.alpha.list),params.grid.length) > params.beta.wireList <- rep(unique(params.beta.list),params.grid.length) > > temp <- stack(data.frame(z)) > negLog <- subset(temp, select=c(values)) > df.wireFrame <- data.frame(params.alpha.wireList,params.beta.wireList,negLog) > > # Plot parameter space > wirePlot <- wireframe(values ~ params.alpha.wireList*params.beta.wireList, data=df.wireFrame, drape = TRUE, + col="purple",main="by Volkan OBAN using R - lattice", + col.regions = rainbow(100, s = 1, v = 1, start = 0, end = max(1,100-1)/100, alpha = 0.5), + xlab="Alpha", ylab="Beta", zlab="NLL", + screen = list (z = -140, x = -70, y = 3), + scales = list(arrows=FALSE,cex=.5,tick.number = 10)) > wirePlot >
##### ggplot2
ref:http://rgraphgallery.blogspot.com.tr/2013/04/rg28-contour-plot.html > require(ggplot2) Zorunlu paket yükleniyor: ggplot2 > plt <- ggplot(gdr, aes(xvar, yvar, z= zvar)) + ggtitle("by Volkan OBAN using R - lattice \n contourplot - data:gdr ") > plt + stat_contour() + theme_bw() > plt + geom_tile(aes(fill = zvar)) + stat_contour() + theme_bw() > plt + stat_contour(geom="polygon", aes(fill=..level..)) + theme_bw() > require(ggplot2) > plt <- ggplot(gdr, aes(xvar, yvar, z= zvar)) > plt + stat_contour() + theme_bw() > plt + geom_tile(aes(fill = zvar)) + stat_contour() + theme_bw() > plt + stat_contour(geom="polygon", aes(fill=..level..)) + theme_bw() >
##### ggplot2
> require(ggplot2) > plt <- ggplot(gdr, aes(xvar, yvar, z= zvar)) > plt + stat_contour() + theme_bw()
##### lattice package
> xvr <- seq(-5, 5, len = 50) > yvr <- seq(-5, 5, len = 50) > gdr <- expand.grid(xvar = xvr, yvar = yvr) > gdr\$zvar <- rnorm (nrow(gdr), 4, 1) > > > #plot > require(lattice) > contourplot(zvar ~ xvar * yvar, data = gdr,main="by Volkan OBAN using R - lattice", cuts = 10) > xvr <- seq(-5, 5, len = 50) > yvr <- seq(-5, 5, len = 50) > gdr <- expand.grid(xvar = xvr, yvar = yvr) > gdr\$zvar <- rnorm (nrow(gdr), 4, 1)
##### lattice package
> x <- seq(1,2,0.2); > y <- seq(0.5,1.5,0.1); > > data1 <- matrix(0,nrow=length(x)*length(y),ncol=3); > data2 <- matrix(0,nrow=length(x)*length(y),ncol=3); > > n <- 0; > j <- 1; > while(j<=length(x)){ + for (k in 1:length(y)){ + data1[k+n,1] <- x[j]; + data1[k+n,2] <- y[k]; + data1[k+n,3] <- x[j]^4 + y[k]; + + data2[k+n,1] <- x[j]; + data2[k+n,2] <- y[k]; + data2[k+n,3] <- x[j]^4 + y[k]^4 + 3; + } + n <- n+length(y); + j <- j+1; + } > rm(x,y,j,n,k) > > # Arranging data into a data frame > data1_2 <-as.data.frame(rbind(data1,data2)); > colnames(data1_2) <- c("x","y","z"); > data1_2\$group <- gl(2, nrow(data1_2)/2, labels=c("data1", "data2")) > rm(data1,data2) > > # Plotting data as a surface > wireframe(z~x*y,data=data1_2,groups=group, + + # Naming labels and Axis + main =list(label="by Volkan OBAN using R - lattice - wireframe ",cex=2,distance=5), + zlab=list(rot=90,label = "Z",cex=2), + xlab=list(label = "X",cex=2), + ylab=list(label = "Y",cex=2), + + # Coloring the groups + col.groups=c(rgb(red=200,green=100,blue=80, + alpha=200,maxColorValue=255), # Orange + rgb(red=150,green=200,blue=205, + alpha=200,maxColorValue=255)), # Blue + + # Coloring the grids + col=c(rgb(red=0,green=0,blue=0,alpha=50,maxColorValue=255), + rgb(red=0,green=0,blue=0,alpha=50,maxColorValue=255)), + + aspect=c(1,1), # y-size/x-size and z-size/x-size + screen = list(z=40,y=0,x=-80)); # axis rotation >
##### lattice package
> df <- data.frame(expand.grid(1:10,1:10),rep(10,100)) > colnames(df) <- c("x","y","z") > wireframe(z~x*y,df,colorkey=TRUE,drape=TRUE) >wireframe(z~x*y,df,main="",colorkey=TRUE,drape=TRUE, zlim=c(0,10))
##### lattice package
ref:http://zoonek.free.fr/blosxom/R/2006-08-10_R_Graphics.html # Minimum Spanning Tree (MST) panel.mst <- function (x, y, ...) { require(ape) # For mst() d <- dist(cbind(x,y)) m <- mst(d) i <- which(m == 1) panel.segments(x[row(m)[i]], y[row(m)[i]], x[col(m)[i]], y[col(m)[i]], ...) } # 2-dimensional Kernel Density Estimation panel.kde <- function (x, y, ...) { require(grid) # for convertX() and unit() require(MASS) # For kde2d() k <- kde2d( x, y, n = 500, # The limits of the current plot lims = c(as.numeric(convertX(unit(0,"npc"),"native")), as.numeric(convertX(unit(1,"npc"),"native")), as.numeric(convertY(unit(0,"npc"),"native")), as.numeric(convertY(unit(1,"npc"),"native")))) panel.levelplot(rep(k\$x, length(k\$y)), rep(k\$y, each = length(k\$x)), sqrt(k\$z), subscripts = 1:length(k\$z), ...) } # The same example as above library(RColorBrewer) xyplot(lat ~ long | Depth, data = quakes, panel = function (x, y, ...) { panel.kde(x, y, col.regions = brewer.pal(9, "YlOrRd")) panel.mst(x, y, col = "black", lwd = 2) }, strip = strip.custom(strip.names = TRUE, strip.levels = TRUE), par.strip.text = list(cex = 0.75), aspect = "iso")
##### Plot3D package
X <- seq(0, pi, length.out = 50) > > Y <- seq(0, 2*pi, length.out = 50) > > M <- mesh(X, Y) > > phi <- M\$x > > theta <- M\$y > > # x, y and z grids > x <- sin(phi) * cos(theta) > > y <- cos(phi) > > z <- sin(phi) * sin(theta) > > # these are the defaults > p <- list(ambient = 0.3, diffuse = 0.6, specular = 1.,exponent = 20, sr = 0, alpha = 1) > > par(mfrow = c(3, 3), mar = c(0, 0, 0, 0)) > > Col <- "magenta4" > > surf3D(x, y, z, box = FALSE, col = Col, lighting = TRUE) > surf3D(x, y, z, box = FALSE, col = Col, lighting = list(exponent = 5)) > surf3D(x, y, z, box = FALSE, col = Col, lighting = list(exponent = 50)) > surf3D(x, y, z, box = FALSE, col = Col, shade = 0.9) > surf3D(x, y, z, box = FALSE, col = Col, lighting = list(sr = 1)) > surf3D(x, y, z, box = FALSE, col = Col, lighting = list(diffuse = 0)) > surf3D(x, y, z, box = FALSE, col = Col, lighting = list(exponent = 50)) > surf3D(x, y, z, box = FALSE, col = Col, lighting = list(exponent = 20)) > surf3D(x, y, z, box = FALSE, col = Col, lighting = list(exponent = 1)) >
image2D
##### Plot3D package
box3D(x0 = runif(4), y0 = runif(4), z0 = runif(4), + x1 = runif(4), y1 = runif(4), z1 = runif(4), + col = c("purple", "pink", "lightpink4"), alpha = 0.5, + border = "black", lwd = 2)
##### Plot3D package
z <- seq(0, 10, 0.2) > x <- cos(z) > y <- sin(z)*z > scatter3D(x, y, z, phi = 0, bty = "g", type = "h", ticktype = "detailed")
##### Plot3D package
x <- y <- z <- seq(-1, 1, by = 0.1) > grid <- mesh(x, y, z) > colvar <- with(grid, x*exp(-x^2 - y^2 - z^2)) slice3D (x, y, z, colvar = colvar, theta = 60) > slicecont3D (x, y, z, ys = seq(-1, 1, by = 0.5), colvar = colvar, theta = 60, border = "purple")
##### Plot3D package
a <- volcano[seq(1, 87, 15), seq(1, 61, 15)] hist3D(z = a, scale = FALSE, expand = 0.01, bty = "g", phi = 20, + col = "#9932CC", border = "white", shade = 0.2, ltheta = 90, space = 0.3, ticktype = "detailed", d = 2)
##### Plot3D package
rect3D(x0 = seq(-0.8, -0.1, by = 0.1), + y0 = seq(-0.8, -0.1, by = 0.1), + z0 = seq(-0.8, -0.1, by = 0.1), + x1 = seq(0.8, 0.1, by = -0.1), + y1 = seq(0.8, 0.1, by = -0.1), + col = rainbow(8), border = "pink", + bty = "g", lwd = 2, phi = 20, main = " rect3D")
##### Plot3D package
box3D(x0 = seq(-0.8, -0.1, by = 0.1), + y0 = seq(-0.8, -0.1, by = 0.1), + z0 = seq(-0.8, -0.1, by = 0.1), + x1 = seq(0.8, 0.1, by = -0.1), + y1 = seq(0.8, 0.1, by = -0.1), + z1 = seq(0.8, 0.1, by = -0.1), + col = rainbow(n = 8, alpha = 0.1), + border = "purple", lwd = 2, phi = 20) ref: https://rpubs.com/yoshio/95844
##### Plot3D package
> border3D(x0 = seq(-0.8, -0.1, by = 0.1), + y0 = seq(-0.8, -0.1, by = 0.1), + z0 = seq(-0.8, -0.1, by = 0.1), + x1 = seq(0.8, 0.1, by = -0.1), + y1 = seq(0.8, 0.1, by = -0.1), + z1 = seq(0.8, 0.1, by = -0.1), + col = rainbow(8), lty = 2, + lwd = c(1, 4), phi = 20, main = "")
##### Plot3D package
with (mtcars, { # linear regression fit <- lm(mpg ~ wt + disp) # predict values on regular xy grid wt.pred <- seq(1.5, 5.5, length.out = 30) disp.pred <- seq(71, 472, length.out = 30) xy <- expand.grid(wt = wt.pred, disp = disp.pred) mpg.pred <- matrix (nrow = 30, ncol = 30, data = predict(fit, newdata = data.frame(xy), interval = "prediction")) # fitted points for droplines to surface fitpoints <- predict(fit) scatter3D(z = mpg, x = wt, y = disp, pch = 18, cex = 2, theta = 20, phi = 20, ticktype = "detailed", xlab = "wt", ylab = "disp", zlab = "mpg", surf = list(x = wt.pred, y = disp.pred, z = mpg.pred, facets = NA, fit = fitpoints), main = "") }) ref:https://rpubs.com/yoshio/95844
##### Plot3D package
reference:https://rpubs.com/yoshio/95844 > X <- seq(0, pi, length.out = 50) > Y <- seq(0, 2*pi, length.out = 50) > M <- mesh(X, Y) > phi <- M\$x > theta <- M\$y > r <- sin(4*phi)^3 + cos(2*phi)^3 + sin(6*theta)^2 + cos(6*theta)^4 > x <- r * sin(phi) * cos(theta) > y <- r * cos(phi) > z <- r * sin(phi) * sin(theta) > surf3D(x, y, z, colvar = y, colkey = FALSE, shade = 0.5,box = FALSE, theta = 60) > surf3D(x, y, z, colvar = y, colkey = FALSE, box = FALSE, theta = 60, facets = FALSE
##### Plot3D package
> x <- rchisq(1000, df = 5) > hs <- hist(x, breaks = 20) hist3D(x = hs\$mids, y = 1, z = matrix(ncol = 1, data = hs\$density), bty = "g", ylim = c(0., 2.0), scale = FALSE, expand = 20, border = "pink", col = "red", shade = 0.4, space = 0.1, theta = 20, phi = 20, main = "")
##### Plot3D package
volkan <- volcano[seq(1, 87, 15), seq(1, 61, 15)] ribbon3D(z = volkan, scale = FALSE, expand = 0.01, bty = "g", phi = 20, col = "pink", border = "purple", shade = 0.2, ltheta = 90,space = 0.3, ticktype = "detailed", d = 2, curtain = TRUE)
hist3D
##### Plot3D package
> x <- y <- z <- seq(-4, 4, by = 0.2) > M <- mesh(x, y, z) > R <- with (M, sqrt(x^2 + y^2 + z^2)) > p <- sin(2*R) /(R+1e-3) > slice3D(x, y, z, colvar = p, d = 2, theta = 60, border = "black", xs = c(-4, 0), ys = c(-4, 0, 4), zs = c(-4, 0))
##### geofacet
library(ggplot2) library(geofacet) ggplot(eu_imm, aes(year, persons)) + + geom_line() + + facet_geo(~ name, grid = "eu_grid1") + + scale_x_continuous(labels = function(x) paste0("'", substr(x, 3, 4))) + + scale_y_sqrt(minor_breaks = NULL) + + ylab("# Resettled Persons") + + theme_bw()
##### time series forecasting
# Load packages library(forecast) # Most popular forecasting pkg library(sweep) # Broom tidiers for forecast pkg library(timekit) # Working with time series in R library(tidyquant) # Get's data from FRED, loads tidyverse behind the scenes library(geofacet) > ne_gdp <- tq_get("NENGSP", get = "economic.data", from = "2007-01-01", to = "2017-06-01") %>% + rename(gdp = price) > states <- tibble(abbreviation = state.abb) %>% + mutate(fred_code = paste0(abbreviation, "NGSP")) %>% + select(2:1) > states_gdp <- states %>% + tq_get(get = "economic.data", from = "2007-01-01", to = "2017-06-01") > > # Group and rename > states_gdp <- states_gdp %>% + select(-fred_code) %>% + group_by(abbreviation) %>% + rename(gdp = price) > ne_gdp_ts <- ne_gdp %>% + tk_ts(start = 2017, freq = 1, silent = TRUE) > ne_fit_arima <- auto.arima(ne_gdp_ts) > sw_glance(ne_fit_arima) # A tibble: 1 x 12 model.desc sigma logLik AIC BIC <chr> <dbl> <dbl> <dbl> <dbl> 1 ARIMA(0,1,0) with drift 2149.529 -81.29672 166.5934 166.9879 # ... with 7 more variables: ME <dbl>, RMSE <dbl>, MAE <dbl>, # MPE <dbl>, MAPE <dbl>, MASE <dbl>, ACF1 <dbl> > ne_fcast <- forecast(ne_fit_arima, h = 3) > ne_sweep <- sw_sweep(ne_fcast, timekit_idx = TRUE, rename_index = "date") > ne_sweep # A tibble: 13 x 7 date key gdp lo.80 lo.95 hi.80 hi.95 <date> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> 1 2007-01-01 actual 81926.0 NA NA NA NA 2 2008-01-01 actual 84873.0 NA NA NA NA 3 2009-01-01 actual 86961.0 NA NA NA NA 4 2010-01-01 actual 92231.0 NA NA NA NA 5 2011-01-01 actual 99935.0 NA NA NA NA 6 2012-01-01 actual 101973.0 NA NA NA NA 7 2013-01-01 actual 106765.0 NA NA NA NA 8 2014-01-01 actual 112087.0 NA NA NA NA 9 2015-01-01 actual 113458.0 NA NA NA NA 10 2016-01-01 actual 115345.0 NA NA NA NA 11 2017-01-01 forecast 119058.2 116303.5 114845.2 121813.0 123271.2 12 2018-01-01 forecast 122771.4 118875.7 116813.4 126667.2 128729.5 13 2019-01-01 forecast 126484.7 121713.3 119187.5 131256.0 133781.8 > ne_sweep %>% + ggplot(aes(x = date, y = gdp, color = key)) + + # Prediction intervals + geom_ribbon(aes(ymin = lo.95, ymax = hi.95), + fill = "#D5DBFF", color = NA, size = 0) + + geom_ribbon(aes(ymin = lo.80, ymax = hi.80, fill = key), + fill = "#596DD5", color = NA, size = 0, alpha = 0.8) + + # Actual & Forecast + geom_line(size = 1) + + geom_point(size = 2) + + # Aesthetics + theme_tq(base_size = 16) + + scale_color_tq() + + labs(title = " by Volkan OBAN using R : forecast-sweep-geofacet-timelit-tidyquant packages \n Nebraska GDP, 3-Year Forecast", x = "", y = "GDP, USD Millions") > states_gdp <- states_gdp %>% + nest() > states_gdp # A tibble: 50 x 2 abbreviation data <chr> <list> 1 AL <tibble [10 x 2]> 2 AK <tibble [10 x 2]> 3 AZ <tibble [10 x 2]> 4 AR <tibble [10 x 2]> 5 CA <tibble [10 x 2]> 6 CO <tibble [10 x 2]> 7 CT <tibble [10 x 2]> 8 DE <tibble [10 x 2]> 9 FL <tibble [10 x 2]> 10 GA <tibble [10 x 2]> # ... with 40 more rows > states_gdp <- states_gdp %>% + mutate(data_ts = map(data, tk_ts, freq = 1, start = 2007, silent = TRUE)) > states_gdp # A tibble: 50 x 3 abbreviation data data_ts <chr> <list> <list> 1 AL <tibble [10 x 2]> <S3: ts> 2 AK <tibble [10 x 2]> <S3: ts> 3 AZ <tibble [10 x 2]> <S3: ts> 4 AR <tibble [10 x 2]> <S3: ts> 5 CA <tibble [10 x 2]> <S3: ts> 6 CO <tibble [10 x 2]> <S3: ts> 7 CT <tibble [10 x 2]> <S3: ts> 8 DE <tibble [10 x 2]> <S3: ts> 9 FL <tibble [10 x 2]> <S3: ts> 10 GA <tibble [10 x 2]> <S3: ts> # ... with 40 more rows > states_gdp <- states_gdp %>% + mutate(fit = map(data_ts, auto.arima)) > states_gdp # A tibble: 50 x 4 abbreviation data data_ts fit <chr> <list> <list> <list> 1 AL <tibble [10 x 2]> <S3: ts> <S3: ARIMA> 2 AK <tibble [10 x 2]> <S3: ts> <S3: ARIMA> 3 AZ <tibble [10 x 2]> <S3: ts> <S3: ARIMA> 4 AR <tibble [10 x 2]> <S3: ts> <S3: ARIMA> 5 CA <tibble [10 x 2]> <S3: ts> <S3: ARIMA> 6 CO <tibble [10 x 2]> <S3: ts> <S3: ARIMA> 7 CT <tibble [10 x 2]> <S3: ts> <S3: ARIMA> 8 DE <tibble [10 x 2]> <S3: ts> <S3: ARIMA> 9 FL <tibble [10 x 2]> <S3: ts> <S3: ARIMA> 10 GA <tibble [10 x 2]> <S3: ts> <S3: ARIMA> # ... with 40 more rows > states_gdp %>% + mutate(glance = map(fit, sw_glance)) %>% + unnest(glance, .drop = T) # A tibble: 50 x 13 abbreviation model.desc sigma logLik <chr> <chr> <dbl> <dbl> 1 AL ARIMA(0,1,0) with drift 3267.828 -85.06590 2 AK ARIMA(0,0,0) with non-zero mean 4199.313 -97.08934 3 AZ ARIMA(0,2,0) 7559.654 -82.79488 4 AR ARIMA(0,1,0) with drift 2231.839 -81.63464 5 CA ARIMA(0,2,0) 60035.965 -99.37208 6 CO ARIMA(0,1,0) with drift 7064.218 -92.00497 7 CT ARIMA(0,2,0) 5009.932 -79.50274 8 DE ARIMA(0,1,0) with drift 1865.871 -80.02328 9 FL ARIMA(0,2,0) 17001.163 -89.27758 10 GA ARIMA(0,2,0) 6369.686 -81.42147 # ... with 40 more rows, and 9 more variables: AIC <dbl>, # BIC <dbl>, ME <dbl>, RMSE <dbl>, MAE <dbl>, MPE <dbl>, # MAPE <dbl>, MASE <dbl>, ACF1 <dbl> > states_gdp <- states_gdp %>% + mutate(forecast = map(fit, forecast, h = 3)) > states_gdp # A tibble: 50 x 5 abbreviation data data_ts fit <chr> <list> <list> <list> 1 AL <tibble [10 x 2]> <S3: ts> <S3: ARIMA> 2 AK <tibble [10 x 2]> <S3: ts> <S3: ARIMA> 3 AZ <tibble [10 x 2]> <S3: ts> <S3: ARIMA> 4 AR <tibble [10 x 2]> <S3: ts> <S3: ARIMA> 5 CA <tibble [10 x 2]> <S3: ts> <S3: ARIMA> 6 CO <tibble [10 x 2]> <S3: ts> <S3: ARIMA> 7 CT <tibble [10 x 2]> <S3: ts> <S3: ARIMA> 8 DE <tibble [10 x 2]> <S3: ts> <S3: ARIMA> 9 FL <tibble [10 x 2]> <S3: ts> <S3: ARIMA> 10 GA <tibble [10 x 2]> <S3: ts> <S3: ARIMA> # ... with 40 more rows, and 1 more variables: forecast <list> > states_gdp_sweep <- states_gdp %>% + mutate(sweep = map(forecast, sw_sweep, timekit_idx = T, rename_index = "date")) %>% + select(abbreviation, sweep) %>% + unnest() > states_gdp_sweep # A tibble: 650 x 8 abbreviation date key gdp lo.80 lo.95 hi.80 hi.95 <chr> <date> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> 1 AL 2007-01-01 actual 169923 NA NA NA NA 2 AL 2008-01-01 actual 172646 NA NA NA NA 3 AL 2009-01-01 actual 168315 NA NA NA NA 4 AL 2010-01-01 actual 174710 NA NA NA NA 5 AL 2011-01-01 actual 180665 NA NA NA NA 6 AL 2012-01-01 actual 185878 NA NA NA NA 7 AL 2013-01-01 actual 190319 NA NA NA NA 8 AL 2014-01-01 actual 194404 NA NA NA NA 9 AL 2015-01-01 actual 199980 NA NA NA NA 10 AL 2016-01-01 actual 204861 NA NA NA NA # ... with 640 more rows > states_gdp_sweep %>% + ggplot(aes(x = date, y = gdp, color = key)) + + # Prediction intervals + geom_ribbon(aes(ymin = lo.95, ymax = hi.95), + fill = "#D5DBFF", color = NA, size = 0) + + geom_ribbon(aes(ymin = lo.80, ymax = hi.80, fill = key), + fill = "#596DD5", color = NA, size = 0, alpha = 0.8) + + # Actual & Forecast + geom_line() + + # Aesthetics + scale_y_continuous(label = function(x) x*1e-6) + + scale_x_date(date_breaks = "5 years", labels = scales::date_format("%Y")) + + facet_geo(~ abbreviation, scale = "free_y") + + theme_tq() + + scale_color_tq() + + theme(legend.position = "none", + axis.text.x = element_text(angle = 45, hjust = 1), + axis.text.y = element_blank() + ) + + ggtitle(" State GDP, 3-Year Forecast") + + xlab("") + + ylab("GDP, Free Scale") > states_gdp_sweep %>% + ggplot(aes(x = date, y = gdp, color = key)) + + # Prediction intervals + geom_ribbon(aes(ymin = lo.95, ymax = hi.95), + fill = "#D5DBFF", color = NA, size = 0) + + geom_ribbon(aes(ymin = lo.80, ymax = hi.80, fill = key), + fill = "#596DD5", color = NA, size = 0, alpha = 0.8) + + # Actual & Forecast + geom_line() + + # Aesthetics + scale_y_continuous(label = function(x) x*1e-6) + + scale_x_date(date_breaks = "5 years", labels = scales::date_format("%Y")) + + facet_geo(~ abbreviation, scale = "free_y") + + theme_tq() + + scale_color_tq() + + theme(legend.position = "none", + axis.text.x = element_text(angle = 45, hjust = 1), + axis.text.y = element_blank() + ) + + ggtitle(" by Volkan OBAN using R :TIME SERIES FORECASTING - forecast-sweep-geofacet-timelit-tidyquant packages \n State GDP, 3-Year Forecast") + + xlab("") + + ylab("GDP, Free Scale") > states_gdp_sweep %>% + ggplot(aes(x = date, y = gdp, color = key)) + + # Prediction intervals + geom_ribbon(aes(ymin = lo.95, ymax = hi.95), + fill = "#D5DBFF", color = NA, size = 0) + + geom_ribbon(aes(ymin = lo.80, ymax = hi.80, fill = key), + fill = "#596DD5", color = NA, size = 0, alpha = 0.8) + + # Actual & Forecast + geom_line() + + # Aesthetics + scale_y_continuous(label = function(x) x*1e-6) + + scale_x_date(date_breaks = "5 years", labels = scales::date_format("%Y")) + + facet_geo(~ abbreviation, scale = "free_y") + + theme_tq() + + scale_color_tq() + + theme(legend.position = "none", + axis.text.x = element_text(angle = 45, hjust = 1), + axis.text.y = element_blank() + ) + + ggtitle(" State GDP, 3-Year Forecast") + + xlab("") + + ylab("GDP, Free Scale") > states_gdp_sweep %>% + ggplot(aes(x = date, y = gdp, color = key)) + + # Prediction intervals + geom_ribbon(aes(ymin = lo.95, ymax = hi.95), + fill = "#D5DBFF", color = NA, size = 0) + + geom_ribbon(aes(ymin = lo.80, ymax = hi.80, fill = key), + fill = "#596DD5", color = NA, size = 0, alpha = 0.8) + + # Actual & Forecast + geom_line() + + # Aesthetics + scale_y_continuous(label = function(x) x*1e-6) + + scale_x_date(date_breaks = "5 years", labels = scales::date_format("%Y")) + + facet_geo(~ abbreviation, scale = "free_y") + + theme_tq() + + scale_color_tq() + + theme(legend.position = "none", + axis.text.x = element_text(angle = 45, hjust = 1), + axis.text.y = element_blank() + ) + + ggtitle(" State GDP, 3-Year Forecast") + + xlab("") + + ylab("GDP, Free Scale")
##### rms package
plot.xmean.ordinaly
##### rms package - nomogram
w <- upData(d, cens = 15 * runif(n), h = .02 * exp(.04 * (age - 50) + .8 * (sex == 'Female')), d.time = -log(runif(n)) / h, death = ifelse(d.time <= cens, 1, 0), d.time = pmin(d.time, cens)) f <- psm(Surv(d.time,death) ~ sex * age, data=w, dist='lognormal') med <- Quantile(f) surv <- Survival(f) # This would also work if f was from cph plot(nomogram(f, fun=function(x) med(lp=x), funlabel="Median Survival Time"))
##### rms package
> n <- 1000 # define sample size > set.seed(17) # so can reproduce the results > age <- rnorm(n, 50, 10) > blood.pressure <- rnorm(n, 120, 15) > cholesterol <- rnorm(n, 200, 25) > sex <- factor(sample(c('female','male'), n,TRUE)) > label(age) <- 'Age' # label is in Hmisc > label(cholesterol) <- 'Total Cholesterol' > label(blood.pressure) <- 'Systolic Blood Pressure' > label(sex) <- 'Sex' > units(cholesterol) <- 'mg/dl' # uses units.default in Hmisc > units(blood.pressure) <- 'mmHg' > # Specify population model for log odds that Y=1 > L <- .4*(sex=='male') + .045*(age-50) + + (log(cholesterol - 10)-5.2)*(-2*(sex=='female') + 2*(sex=='male')) > # Simulate binary y to have Prob(y=1) = 1/[1+exp(-L)] > y <- ifelse(runif(n) < plogis(L), 1, 0) > ddist <- datadist(age, blood.pressure, cholesterol, sex) > options(datadist='ddist') > fit <- lrm(y ~ blood.pressure + sex * (age + rcs(cholesterol,4)), + x=TRUE, y=TRUE) > p <- Predict(fit, age, cholesterol, sex, np=50) # vary sex last > bplot(p, main="by Volkan OBAN using R - rms package") > bplot(p,, main="by Volkan OBAN using R - rms package", lfun=wireframe)
##### quandl package
plot(stl(Quandl("WIKI/GOOG",type="ts",collapse="monthly")[,11],s.window="per"))
##### Doodling
doodle <- function( start=c(0,0), targets = rbind(c(0,10),c(10,10), c(10,0), c(0,0)) , tdist = .25, speed = c(0,0), accel = .1, resis = .005, jitter = .0005, chncStp = 0) { # start - We start with the starting position # targ - Points that will be pursued (initially just a square) # tdist - How close we need to get to each point before moving on # speed - Initial speed # accel - How fast does the drawer accelerate towards that point # resis - What percentage of speed is lost each round # jitter - A normal draw random jitter that moves the writing tool in an unexpected direction. # chncStp - There is some chance that the drawing tool will kill all momentum and stop. # First off I define a function uvect to convert any two sets of points # into a unit vector and measure the distance between the two points. uvect <- function(p1,p2=NULL) { if (is.null(p2)) { p2 <- p1[[2]] p1 <- p1[[1]] } list(vect=(p2-p1)/sqrt(sum((p1-p2)^2)), dist=sqrt(sum((p1-p2)^2))) } # Starup parameters i <- 1 plist <- position <- start # plist saves all of the points that the drawing tool has passed through vect <- uvect(position,targets[i,]) while(i<=nrow(targets)) { # Calculate the appropriate unit vector and distance from end point vect <- uvect(position,targets[i,]) # Remove some amount of speed from previous velocity speed <- speed*(1-resis) # IF drawer randomly stops remove all speed if (rbinom(1,1,chncStp)) speed<-0 # speed <- speed + accel*vect[[1]] + rnorm(2)*jitter position <- position + speed plist <- rbind(plist,position) vect <- uvect(position,targets[i,]) if (vect[[2]]<tdist) i <- i+1 } plist } plist <- doodle() shape <- doodle(cbind(c(0,-2,10,15,5,0),c(5,12,10,9,2,0)),resis=.2) > > plot(shape, type="l",lwd=1) >
##### tidygraph
plot(play_forestfire(40, 0.8))
##### persp-- Perspective Plots
> x.coord <- seq(-10, 10, length= 50) > y.coord <- x.coord > func <- function(x,y) { r <- sqrt(abs(x^3)+y^2); sin(r)/r } > z.coord <- outer(x.coord, y.coord, func) > persp(x.coord,y.coord,z.coord,theta=30,phi=30,expand=0.5,col="hotpink4", + ltheta=120,shade=0.75,ticktype="detailed",xlab="X",ylab="Y",zlab="Z")
##### Plot
> data("EuStockMarkets") > dax <- EuStockMarkets[, 1] > plot(dax, ylim = c(0, 6000), axes = FALSE) > axis(1) > axis(2, las = 1) > par(new = TRUE) > plot(diff(log(dax)), ylim = c(-0.1, 0.9), axes = FALSE, col = 2, ylab = "") > box() > axis(4, col = 2, col.axis = 2, las = 1)
##### persp-- Perspective Plots
> y <- x <- seq(-3,3,length=50) > f <- function(x,y){ + dnorm(x^4)*dnorm(y^2)} > z <- outer(x,y,f) > persp(x,y,z, theta = 60, phi = 30,col = "lightpink1",zlim=c(0,0.2))
##### persp-- Perspective Plots
> cone <- function(x, y){ + sqrt(x^4+y^4) + } > x <- y <- seq(-1, 1, length= 20) > z <- outer(x, y, cone) > persp(x, y, z)
##### treemap-- d3treeR
library(treemap) library(d3treeR) # dataset group=c(rep("group-1",4),rep("group-2",2),rep("group-3",3)) subgroup=paste("subgroup" , c(1,2,3,4,1,2,1,2,3), sep="-") value=c(13,5,22,12,11,7,3,1,23) data=data.frame(group,subgroup,value) # basic treemap p=treemap(data, index=c("group","subgroup"), vSize="value", type="index" ) # make it interactive ("rootname" becomes the title of the plot): inter=d3tree2( p , rootname = "General" )
##### cartography package
library(cartography) # Upload data attached with the package. data(nuts2006) # Now we have a spdf file (shape file) called nuts2.spdf with shape of european regions. We can plot it with the plot function. summary(nuts2.spdf) # We also have a dataframe with information concerning every region. head(nuts2.df) # Both object have a first column "id" that makes the link between them. # Create a grid mygrid <- getGridLayer(spdf = nuts2.spdf, cellsize = 2e+05) # You can plot the grid # plot(mygrid\$spdf) # Adapt grid to a numerical variable datagrid.df <- getGridData(x = mygrid, df = nuts2.df, var = "pop2008") datagrid.df\$densitykm <- datagrid.df\$pop2008_density * 1000 * 1000 # Plot background plot(nuts0.spdf, border = NA, col = NA, bg = "#A6CAE0") plot(world.spdf, col = "#E3DEBF", border = NA, add = TRUE) # Plot density of population choroLayer(spdf = mygrid\$spdf, df = datagrid.df, var = "densitykm", border = "grey80", col = carto.pal(pal1 = "wine.pal", n1 = 6), legend.pos = "topright", method = "q6", add = TRUE, legend.title.txt = "Population Density\n(inhabitant/km²)") # Title, legend.. layoutLayer(title = "Population Density", coltitle = "black", col = NA, sources = "Eurostat, 2011", scale = NULL, author = "cartography", frame = FALSE)
##### igraph
g <- barabasi.game(5000, power=1) > layout <- layout.fruchterman.reingold(g) > membership <- cut_at(eb, no = 10) > plot(g, + vertex.color= rainbow(10, .8, .8, alpha=.8)[membership], + vertex.size=5, layout=layout, vertex.label=NA, + edge.arrow.size=.2) > eb <- walktrap.community(g) > membership <- cut_at(eb, no = 10) > plot(g, + vertex.color= rainbow(10, .8, .8, alpha=.8)[membership], + vertex.size=5, layout=layout, vertex.label=NA, + edge.arrow.size=.2)
##### igraph
g <- barabasi.game(10000, power=1) > layout <- layout.fruchterman.reingold(g) > plot(g, layout=layout, vertex.size=2, vertex.label=NA, edge.arrow.size=.2)
##### wireframe
wireframe(z ~ x * y, data = g, groups = gr, scales = list(arrows = FALSE, x = list(at = c(2, 5, 10)), y = list(at = c(6, 10, 14), lab = c('A', 'BBB', 'CCCCC')) ))
##### lattice package
> g <- expand.grid(x = 1:50, y = 5:25, gr = 1:5) > g\$z <- log((g\$x^g\$gr + g\$y^2) * g\$gr) > wireframe(z ~ x * y, data = g, groups = gr, + scales = list(arrows = FALSE), + drape = TRUE, colorkey = TRUE,main="by Volkan OBAN using R - lattice package", + screen = list(z = 30, x = -60))
##### Plot
> U = numeric(1000); > n = 100; > average = numeric(n); > for (i in 1 : n) + {U = runif(1000); + X = tan(pi ∗ (U − 0.5)); + average[i] = mean(X); } > plot(1 : n, average[1 : n], type = "l", lwd = 2, col = "red",main="by Volkan OBAN using R") + theme_solarized(light = FALSE) + + scale_colour_solarized("red")
##### mandelbrot package
> par(mfrow = c(1, 2), pty = "s", mar = rep(0, 4)) > plot(mb,col = cols, transform = "inverse") > plot(mb, col = cols, transform = "log") ref:https://github.com/blmoore/
##### mandelbrot package
> library(ggplot2) > > mb <- mandelbrot(xlim = c(-0.8335, -0.8325), + ylim = c(0.205, 0.206), + resolution = 1200L, + iterations = 1000) > > > cols <- c( + colorRampPalette(c("#e7f0fa", "#c9e2f6", "#95cbee", + "#0099dc", "#4ab04a", "#ffd73e"))(10), + colorRampPalette(c("#eec73a", "#e29421", "#e29421", + "#f05336","#ce472e"), bias=2)(90), + "black") > > df <- as.data.frame(mb) > ggplot(df, aes(x = x, y = y, fill = value)) + + geom_raster(interpolate = TRUE) + theme_void() + + scale_fill_gradientn(colours = cols, guide = "none") + ggtitle("by Volkan OBAN using R-mandelbrot package ") > library(ggplot2) > > mb <- mandelbrot(xlim = c(-0.8335, -0.8325), + ylim = c(0.205, 0.206), + resolution = 1200L, + iterations = 1000) > > > cols <- c( + colorRampPalette(c("#e7f0fa", "#c9e2f6", "#95cbee", + "#0099dc", "#4ab04a", "#ffd73e"))(10), + colorRampPalette(c("#eec73a", "#e29421", "#e29421", + "#f05336","#ce472e"), bias=2)(90), + "black") > > df <- as.data.frame(mb) > ggplot(df, aes(x = x, y = y, fill = value)) + + geom_raster(interpolate = TRUE) + theme_void() + + scale_fill_gradientn(colours = cols, guide = "none")
##### sde package
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 = "phenotype", ylim = c(-2, 2), type = "l") > apply(X[2:nsim, ], 1, function(x, t) lines(t, x), t = t)
##### ggspectra pckg
library(photobiology) plot(sun.spct) + theme_solarized(light = FALSE) + + scale_colour_solarized("red")
##### ggspectra pckg
library(photobiology) plot(yellow_gel.spct) plot(yellow_gel.spct, pc.out = TRUE)
##### ggraph ggthemes
graph <- graph_from_data_frame(flare\$edges, vertices = flare\$vertices) set.seed(1) ggraph(graph, 'circlepack', weight = 'size') + geom_node_circle(aes(fill = depth), size = 0.25, n = 50) + coord_fixed() > ggraph(graph, 'circlepack', weight = 'size') + + geom_node_circle(aes(fill = depth), size = 0.25, n = 50) + + coord_fixed() + ggtitle("by Volkan OBAN using R-ggraph ") + theme_economist() + scale_colour_economist() + + scale_y_continuous(position = "right")
##### survminer package
ggsurvplot( + fit, # survfit object with calculated statistics. + data = lung, # data used to fit survival curves. + risk.table = TRUE, # show risk table. + pval = TRUE, # show p-value of log-rank test. + conf.int = TRUE, # show confidence intervals for + # point estimates of survival curves. + xlim = c(0,500), # present narrower X axis, but not affect + # survival estimates. + xlab = "Time in days", # customize X axis label. + break.time.by = 100, # break X axis in time intervals by 500. + ggtheme = theme_light(), # customize plot and risk table with a theme. + risk.table.y.text.col = T, # colour risk table text annotations. + risk.table.y.text = FALSE ,title="by Volkan OBAN using R - survminer" + ) >
calenda HeatMap
##### ggmosaic package
ggplot(data = happy) + + geom_mosaic(aes(weight = wtssall, x = product(health), fill = health)) + + facet_grid(happy~.)
##### ggmosaic package
ggplot(data = happy) + + geom_mosaic(aes(weight=wtssall, x=product(health, sex, degree), fill=happy), na.rm=TRUE)
##### ggplot2 maps ggthemes
wm <- map("world",fill=TRUE,col=0,xlim=c(-10,40),ylim=c(30,60)) ggplot(wm, aes(long, lat, group = group)) + + geom_polygon(fill = "white", colour = "purple") + theme_economist() + scale_colour_economist() + + scale_y_continuous(position = "right")
##### ggplot2 ggalt ggthemes
> library(dplyr) > library(tidyr) > library(scales) > library(ggplot2) > library(ggalt) # devtools::install_github("hrbrmstr/ggalt") > > health <- read.csv("https://rud.is/dl/zhealth.csv", stringsAsFactors=FALSE, + header=FALSE, col.names=c("pct", "area_id")) > > areas <- read.csv("https://rud.is/dl/zarea_trans.csv", stringsAsFactors=FALSE, header=TRUE) > > health %>% + mutate(area_id=trunc(area_id)) %>% + arrange(area_id, pct) %>% + mutate(year=rep(c("2014", "2013"), 26), + pct=pct/100) %>% + left_join(areas, "area_id") %>% + mutate(area_name=factor(area_name, levels=unique(area_name))) -> health > > setNames(bind_cols(filter(health, year==2014), filter(health, year==2013))[,c(4,1,5)], + c("area_name", "pct_2014", "pct_2013")) -> health > > gg <- ggplot(health, aes(x=pct_2014, xend=pct_2013, y=area_name, group=area_name)) + ggtitle("by Volkan OBAN using R ") > gg <- gg + geom_dumbbell(colour="#a3c4dc", size=1.5, colour_xend="#0e668b", + dot_guide=TRUE, dot_guide_size=0.15) > > gg > gg + theme_wsj() + scale_colour_wsj("colors6", "") > gg + theme_hc(bgcolor = "darkunica") + + scale_colour_hc("darkunica") >
##### ggstance package
> library("ggstance") > > # Horizontal with ggstance > ggplot(mpg, aes(hwy, class, fill = factor(cyl))) + + geom_boxploth()
##### ggplot2 and ggtech
ref: http://kbroman.org/datacarpentry_R_2016-06-01/04-ggplot2.html
##### ggplot2 and ggthemes
ref: http://kbroman.org/datacarpentry_R_2016-06-01/04-ggplot2.html
##### ggplot2 and ggthemes
ref: http://kbroman.org/datacarpentry_R_2016-06-01/04-ggplot2.html
##### ggplot2 and ggthe
ref: http://kbroman.org/datacarpentry_R_2016-06-01/04-ggplot2.html
##### ggplot2
ref: http://kbroman.org/datacarpentry_R_2016-06-01/04-ggplot2.html
##### ggplot2 and ggthemes
ref: http://kbroman.org/datacarpentry_R_2016-06-01/04-ggplot2.html
##### ggplot2
ref: http://kbroman.org/datacarpentry_R_2016-06-01/04-ggplot2.html
##### ggplot2
ref http://kbroman.org/datacarpentry_R_2016-06-01/04-ggplot2.html
##### ggplot2 and ggthemes
a<- ggplot(surveys_complete, aes(x = species_id, y = hindfoot_length)) + geom_boxplot() a + theme_economist() + scale_colour_economist() + + scale_y_continuous(position = "right"
> plotSparklineTable(Theoph, row.var = 'Subject', col.vars = 'conc')
> msr <- file.path( find.package("epanetReader"), "extdata","example.rpt") > #read the results into R > x <- read.msxrpt(msr) > names(x) [1] "Title" "nodeResults" "linkResults" > summary(x) plot(x)
##### sjplot--sjp.glm: plot probability curves (relationship between predictors and response)
> mydf <- data.frame(y = as.factor(y), + sex = to_factor(efc\$c161sex), + dep = to_factor(efc\$e42dep), + barthel = efc\$barthtot, + education = to_factor(efc\$c172code)) > # fit model > fit <- glm(y ~., data = mydf, family = binomial(link = "logit")) # plot probability curves (relationship between predictors and response) > sjp.glm(fit, title = " Negative impact with 7 items", type = "slope")
##### sjPlot and sjmisc package
airgrp <- sjc.qclus(airquality) sjc.qclus(airquality, groupcount = 3, groups = airgrp\$classification, title=" new k-means cluster analysis")
##### ggplot2
a<-ggplot(mtcars, aes(x = mpg^2, y = wt/cyl)) + geom_smooth(fill="purple",color="pink",size=2) + geom_jitter(color="darkgreen",shape=2) + geom_point(color="yellow") + ggtitle("by Volkan OBAN using R ") a
##### Plot
> day=as.Date("2017-06-14") - 0:364 > value=runif(365) + seq(-140, 224)^2 / 10000 > data=data.frame(day, value) > data %>% mutate(month = as.Date(cut(day, breaks = "month"))) %>% + ggplot(aes(x=day, y=value, fill=as.factor(month))) + + geom_line() + + geom_area() + + theme( + legend.position="none", + axis.text.x=element_blank(), + axis.ticks.x=element_blank(), + strip.background = element_rect(fill=alpha("slateblue",0.2)), + strip.placement="bottom" + ) + + xlab("by Volkan OBAN using R \n faceting for time series") + + facet_wrap(~as.Date(month), scales="free", ncol=3) + theme_tufte(ticks=FALSE) + + geom_tufteboxplot(median.type = "line", whisker.type = 'line', hoffset = 0, width = 3)
##### quantmod and plotly
library(plotly) library(quantmod) # get data getSymbols("AAPL",src='yahoo') df <- data.frame(Date=index(AAPL),coredata(AAPL)) # create Bollinger Bands bbands <- BBands(AAPL[,c("AAPL.High","AAPL.Low","AAPL.Close")]) # join and subset data df <- subset(cbind(df, data.frame(bbands[,1:3])), Date >= "2015-02-14") # colors column for increasing and decreasing for (i in 1:length(df[,1])) { if (df\$AAPL.Close[i] >= df\$AAPL.Open[i]) { df\$direction[i] = 'Increasing' } else { df\$direction[i] = 'Decreasing' } } i <- list(line = list(color = '#17BECF')) d <- list(line = list(color = '#7F7F7F')) # plot candlestick chart p <- df %>% plot_ly(x = ~Date, type="candlestick", open = ~AAPL.Open, close = ~AAPL.Close, high = ~AAPL.High, low = ~AAPL.Low, name = "AAPL", increasing = i, decreasing = d) %>% add_lines(y = ~up , name = "B Bands", line = list(color = '#ccc', width = 0.5), legendgroup = "Bollinger Bands", hoverinfo = "none") %>% add_lines(y = ~dn, name = "B Bands", line = list(color = '#ccc', width = 0.5), legendgroup = "Bollinger Bands", showlegend = FALSE, hoverinfo = "none") %>% add_lines(y = ~mavg, name = "Mv Avg", line = list(color = '#E377C2', width = 0.5), hoverinfo = "none") %>% layout(yaxis = list(title = "Price")) # plot volume bar chart pp <- df %>% plot_ly(x=~Date, y=~AAPL.Volume, type='bar', name = "AAPL Volume", color = ~direction, colors = c('#17BECF','#7F7F7F')) %>% layout(yaxis = list(title = "Volume")) # create rangeselector buttons rs <- list(visible = TRUE, x = 0.5, y = -0.055, xanchor = 'center', yref = 'paper', font = list(size = 9), buttons = list( list(count=1, label='RESET', step='all'), list(count=1, label='1 YR', step='year', stepmode='backward'), list(count=3, label='3 MO', step='month', stepmode='backward'), list(count=1, label='1 MO', step='month', stepmode='backward') )) # subplot with shared x axis p <- subplot(p, pp, heights = c(0.7,0.2), nrows=2, shareX = TRUE, titleY = TRUE) %>% layout(title = paste("Apple: 2015-02-14 -",Sys.Date()), xaxis = list(rangeselector = rs), legend = list(orientation = 'h', x = 0.5, y = 1, xanchor = 'center', yref = 'paper', font = list(size = 10), bgcolor = 'transparent'))
##### quantmod and plotly
library(plotly) library(quantmod) getSymbols("AAPL",src='yahoo') df <- data.frame(Date=index(AAPL),coredata(AAPL)) # annotation a <- list(text = "Stock Split", x = '2014-06-06', y = 1.02, xref = 'x', yref = 'paper', xanchor = 'left', showarrow = FALSE ) # use shapes to create a line l <- list(type = line, x0 = '2014-06-06', x1 = '2014-06-06', y0 = 0, y1 = 1, xref = 'x', yref = 'paper', line = list(color = 'black', width = 0.5) ) p <- df %>% plot_ly(x = ~Date, type="candlestick", open = ~AAPL.Open, close = ~AAPL.Close, high = ~AAPL.High, low = ~AAPL.Low) %>% layout(title = "Apple Stock", annotations = a, shapes = l)
##### quantmod
getSymbols("AAPL") chartSeries(AAPL) title(" quantmod ", sub = "", cex.main = 1, font.main= 2, col.main= "green", cex.sub = 0.75, font.sub =1, col.sub = "red")
##### GGally
a<- ggpairs(iris) a
##### psych package
pairs.panels(iris[1:4],bg=c("red","purple","blue")[iris\$Species],pch=21,main=" Fisher Iris data by Species",hist.col="purple")
##### igraph
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~/ > library(miniCRAN) > library(igraph) > > > pk <- c("igraph","agop","bc3net","BDgraph","c3net","camel", + "cccd", "CDVine", "CePa", "CINOEDV", "cooptrees","corclass", "cvxclustr", "dcGOR", + "ddepn","dils", "dnet", "dpa", "ebdbNet", "editrules", + "fanovaGraph", "fastclime", "FisHiCal", + "flare", "G1DBN", "gdistance", "GeneNet", "GeneReg", "genlasso", "ggm", "gRapfa", "hglasso", + "huge", "igraphtosonia", "InteractiveIGraph", "iRefR", "JGL", "lcd", "linkcomm", "locits", + "loe", "micropan", "mlDNA", "mRMRe", "nets", "netweavers", "optrees", "packdep", "PAGI", + "pathClass", "PBC", "phyloTop", "picasso", "PoMoS", "popgraph", "PROFANCY", "qtlnet", "RCA", + "ReliabilityTheory", "rEMM", "restlos", "rgexf", "RNetLogo", "ror", "RWBP", "sand", "SEMID", + "shp2graph", "SINGLE", "spacejam", "TDA", "timeordered", "tnet") > > > dg <- makeDepGraph(pk) > plot(dg,main=" Network of reverse depends for igraph",cex=.4,vertex.size=8)
##### Plot
> require(graphics) > > fr <- function(x) { ## Rosenbrock Banana function + x1 <- x[1] + x2 <- x[2] + 100 * (x2 - x1 * x1)^2 + (1 - x1)^2 + } > grr <- function(x) { ## Gradient of 'fr' + x1 <- x[1] + x2 <- x[2] + c(-400 * x1 * (x2 - x1 * x1) - 2 * (1 - x1), + 200 * (x2 - x1 * x1)) + } > optim(c(-1.2,1), fr) > (res <- optim(c(-1.2,1), fr, grr, method = "BFGS")) > optimHess(res\$par, fr, grr) > optim(c(-1.2,1), fr, NULL, method = "BFGS", hessian = TRUE) > ## These do not converge in the default number of steps > optim(c(-1.2,1), fr, grr, method = "CG") > optim(c(-1.2,1), fr, grr, method = "CG", control = list(type = 2)) > optim(c(-1.2,1), fr, grr, method = "L-BFGS-B") > > flb <- function(x) + { p <- length(x); sum(c(1, rep(4, p-1)) * (x - c(1, x[-p])^2)^2) } > ## 25-dimensional box constrained > optim(rep(3, 25), flb, NULL, method = "L-BFGS-B", + lower = rep(2, 25), upper = rep(4, 25)) # par[24] is *not* at boundary > > ## "wild" function , global minimum at about -15.81515 > fw <- function (x) + 10*sin(0.3*x)*sin(1.3*x^2) + 0.00001*x^4 + 0.2*x+80 > plot(fw, -50, 50, n = 1000, main = "optim() minimising 'wild function'") > > res <- optim(50, fw, method = "SANN", + control = list(maxit = 20000, temp = 20, parscale = 20)) > res > ## Now improve locally {typically only by a small bit}: > (r2 <- optim(res\$par, fw, method = "BFGS")) > points(r2\$par, r2\$value, pch = 8, col = "red", cex = 2) > > ## Combinatorial optimization: Traveling salesman problem > library(stats) # normally loaded > > eurodistmat <- as.matrix(eurodist) > > distance <- function(sq) { # Target function + sq2 <- embed(sq, 2) + sum(eurodistmat[cbind(sq2[,2], sq2[,1])]) + } > > genseq <- function(sq) { # Generate new candidate sequence + idx <- seq(2, NROW(eurodistmat)-1) + changepoints <- sample(idx, size = 2, replace = FALSE) + tmp <- sq[changepoints[1]] + sq[changepoints[1]] <- sq[changepoints[2]] + sq[changepoints[2]] <- tmp + sq + } > > sq <- c(1:nrow(eurodistmat), 1) # Initial sequence: alphabetic > distance(sq) [1] 29625 > # rotate for conventional orientation > loc <- -cmdscale(eurodist, add = TRUE)\$points > x <- loc[,1]; y <- loc[,2] > s <- seq_len(nrow(eurodistmat)) > tspinit <- loc[sq,] > > plot(x, y, type = "n", asp = 1, xlab = "", ylab = "", + main = "prepared by Volkan OBAN using R stats package + optim \n initial solution of traveling salesman problem", axes = FALSE) > arrows(tspinit[s,1], tspinit[s,2], tspinit[s+1,1], tspinit[s+1,2], + angle = 10, col = "green") > text(x, y, labels(eurodist), cex = 0.8) > > set.seed(123) # chosen to get a good soln relatively quickly > res <- optim(sq, distance, genseq, method = "SANN", + control = list(maxit = 30000, temp = 2000, trace = TRUE, + REPORT = 500)) > tspres <- loc[res\$par,] > plot(x, y, type = "n", asp = 1, xlab = "", ylab = "", + main = "prepared by Volkan OBAN using R stats package optim \n optim() 'solving' traveling salesman problem", axes = FALSE) > arrows(tspres[s,1], tspres[s,2], tspres[s+1,1], tspres[s+1,2], + angle = 10, col = "red") > text(x, y, labels(eurodist), cex = 0.8) >
##### ggfortify
http://www.sthda.com/english/wiki/ggfortify-extension-to-ggplot2-to-handle-some-popular-packages-r-software-and-data-visualization
##### ggfortify
http://www.sthda.com/english/wiki/ggfortify-extension-to-ggplot2-to-handle-some-popular-packages-r-software-and-data-visualization
##### sunshine
> par(mar=c(0,0,0,0)) > pie(abs(rnorm(150)) , radius=10 , border="transparent" , xlim=c(0,5) )
##### latticeExtra package
> xyplot(stl(log(co2), s.window=21), + main = "STL decomposition of CO2 data")
##### ggplot2 - waffle chart
library(ggplot2) # Here's some data I had lying around tb <- structure(list(region = c("Africa", "Asia", "Latin America", "Other", "US-born"), ncases = c(36L, 34L, 56L, 2L, 44L)), .Names = c("region", "ncases"), row.names = c(NA, -5L), class = "data.frame") # A bar chart of counts ggplot(tb, aes(x = region, weight = ncases, fill = region)) + geom_bar() # Bar chart of percentages ggplot(tb, aes(x = region, weight = ncases/sum(ncases), fill = region)) + geom_bar() + scale_y_continuous(formatter = 'percent') # Pie chart equivalents. Forgive me, Hadley, for I must sin. ggplot(tb, aes(x = factor(1), weight = ncases, fill = region)) + geom_bar(width = 1) + coord_polar(theta = "y") + labs(x = "", y = "") ggplot(tb, aes(x = factor(1), weight = ncases/sum(ncases), fill = region)) + geom_bar() + scale_y_continuous(formatter = 'percent') + coord_polar(theta = "y") + labs(x = "", y = "") # Waffles # How many rows do you want the y axis? ndeep <- 5 # I need to convert my data into a data.frame with a unique specified x # and y axis for each case # Note - it's actually important to specify y first for a # horizontally-accumulating waffle tb4waffles <- expand.grid(y = 1:ndeep, x = seq_len(ceiling(sum(tb\$ncases) / ndeep))) # Expand the counts into a full vector of region labels - i.e., de-aggregate regionvec <- rep(tb\$region, tb\$ncases) # Depending on the value of ndeep, there might be more spots on the x-y grid # than there are cases - so fill those with NA tb4waffles\$region <- c(regionvec, rep(NA, nrow(tb4waffles) - length(regionvec))) # Plot it ggplot(tb4waffles, aes(x = x, y = y, fill = region)) + geom_tile(color = "white") + # The color of the lines between tiles scale_fill_manual("Region of Birth", values = RColorBrewer::brewer.pal(5, "Dark2")) + opts(title = "TB Cases by Region of Birth")
##### waffle chart-waffle package
http://harrycaufield.net/severalog/2016/7/29/8jt1lrt7hd2vqh4heu7mcuqrdcg0od
##### waffle chart
ref. and code: http://harrycaufield.net/severalog/2016/7/29/8jt1lrt7hd2vqh4heu7mcuqrdcg0od
##### network package
> data(flo) > nflo<-network(flo) > #Display the network, indicating degree and flagging the Medicis > plot(nflo, vertex.cex=apply(flo,2,sum)+1, usearrows=FALSE,vertex.sides=3+apply(flo,2,sum),vertex.col=2+(network.vertex.names(nflo)=="Medici"))
##### plotly network viz.
> library(plotly) > library(igraph) > > data(karate, package="igraphdata") > G <- upgrade_graph(karate) > L <- layout.circle(G) > vs <- V(G) > es <- as.data.frame(get.edgelist(G)) > > Nv <- length(vs) > Ne <- length(es[1]\$V1) > Xn <- L[,1] > Yn <- L[,2] > > network <- plot_ly(x = ~Xn, y = ~Yn, mode = "markers", text = vs\$label, hoverinfo = "text") > edge_shapes <- list() > for(i in 1:Ne) { + v0 <- es[i,]\$V1 + v1 <- es[i,]\$V2 + + edge_shape = list( + type = "line", + line = list(color = "#030303", width = 0.3), + x0 = Xn[v0], + y0 = Yn[v0], + x1 = Xn[v1], + y1 = Yn[v1] + ) + + edge_shapes[[i]] <- edge_shape + } > axis <- list(title = "", showgrid = FALSE, showticklabels = FALSE, zeroline = FALSE) > > p <- layout( + network, + title = 'by Volkan OBAN using R - igraph \n Karate Network', + shapes = edge_shapes, + xaxis = axis, + yaxis = axis + ) > p
##### likert
require(likert) > data(pisaitems) > > ##### Item 24: Reading Attitudes > items24 <- pisaitems[,substr(names(pisaitems), 1,5) == 'ST24Q'] > > items24 <- rename(items24, c( + ST24Q01="I read only if I have to.", + ST24Q02="Reading is one of my favorite hobbies.", + ST24Q03="I like talking about books with other people.", + ST24Q04="I find it hard to finish books.", + ST24Q05="I feel happy if I receive a book as a present.", + ST24Q06="For me, reading is a waste of time.", + ST24Q07="I enjoy going to a bookstore or a library.", + ST24Q08="I read only to get information that I need.", + ST24Q09="I cannot sit still and read for more than a few minutes.", + ST24Q10="I like to express my opinions about books I have read.", + ST24Q11="I like to exchange books with my friends.")) > l24g <- likert(items24[,1:2], grouping=pisaitems\$CNT) > plot(l24g)
##### heart.
> dat<- data.frame(t=seq(0, 2*pi, by=0.1) ) > xhrt <- function(t) 16*sin(t)^3 > yhrt <- function(t) 13*cos(t)-5*cos(2*t)-2*cos(3*t)-cos(4*t) > dat\$y=yhrt(dat\$t) > dat\$x=xhrt(dat\$t) > with(dat, plot(x,y, type="l")) > with(dat, polygon(x,y, col="darkred"))
##### BAMMtools package
ixx <- rep(c(10, 30, 40), 2); plot.new() par(mfrow=c(2,3)); colschemes <- list(); colschemes[1:3] <- 'temperature' colschemes[4:6] <- list(c('blue', 'gray', 'red')) for (i in 1:length(ixx)) { par(mar=c(0,0,0,0)) index <- ixx[i] eventsub <- subsetEventData(edata_whales, index=index); plot.bammdata(eventsub, method='polar', pal= colschemes[[i]], par.reset=FALSE, lwd=3) addBAMMshifts(eventsub, method='polar', index=1, col='white', bg='black', cex=5, par.reset=FALSE) }
##### BAMMtools package
library(BAMMtools) data(whales, events.whales) edata_whales <- getEventData(whales, events.whales, burnin=0.1) plot.bammdata(edata_whales, lwd=3, method="polar", pal="temperature") data(primates, events.primates) ed <- getEventData(primates, events.primates, burnin=0.25, type = 'trait') par(mfrow=c(1,3), mar=c(1, 0.5, 0.5, 0.5), xpd=TRUE) q <- plot.bammdata(ed, tau=0.001, breaksmethod='linear', lwd=2) addBAMMshifts(ed, par.reset=FALSE, cex=2) title(sub='linear',cex.sub=2, line=-1) addBAMMlegend(q, location=c(0, 1, 140, 220)) q <- plot.bammdata(ed, tau=0.001, breaksmethod='linear', color.interval=c(NA,0.12), lwd=2) addBAMMshifts(ed, par.reset=FALSE, cex=2) title(sub='linear - color.interval',cex.sub=2, line=-1) addBAMMlegend(q, location=c(0, 1, 140, 220)) q <- plot.bammdata(ed, tau=0.001, breaksmethod='jenks', lwd=2) addBAMMshifts(ed, par.reset=FALSE, cex=2) title(sub='jenks',cex.sub=2, line=-1) addBAMMlegend(q, location=c(0, 1, 140, 220))
##### geomnet ggnetwork
> library(ggnetwork) > set.seed(10312016) > ggplot(ggnetwork(em.net, arrow.gap = 0.02, layout = "fruchtermanreingold"), + aes(x, y, xend = xend, yend = yend)) + + geom_edges( + aes(color = curr_empl_type), + alpha = 0.25, + arrow = arrow(length = unit(5, "pt"), + type = "closed"), + curvature = 0.05) + + geom_nodes(aes(color = curr_empl_type), + size = 4) + + scale_color_brewer("Employment Type", + palette = "Set1") + + theme_blank() + + theme(legend.position = "bottom")
##### Plot
library(tidyverse) library(rvest) library(magrittr) library(ggmap) library(stringr) ref:https://www.r-bloggers.com/how-to-make-a-global-map-in-r-step-by-step/
##### heatmap.2
library(gplots) > > #Build the matrix data to look like a correlation matrix > x <- matrix(rnorm(64), nrow=8) > x <- (x - min(x))/(max(x) - min(x)) #Scale the data to be between 0 and 1 > for (i in 1:8) x[i, i] <- 1.0 #Make the diagonal all 1's > > #Format the data for the plot > xval <- formatC(x, format="f", digits=2) > pal <- colorRampPalette(c(rgb(0.96,0.96,1), rgb(0.1,0.1,0.9)), space = "rgb") > > #Plot the matrix > x_hm <- heatmap.2(x, Rowv=FALSE, Colv=FALSE, dendrogram="none", main="by Volkan OBAN using R \n 8 X 8 Matrix Using Heatmap.2", xlab="Columns", ylab="Rows", col=pal, tracecol="#303030", trace="none", cellnote=xval, notecol="black", notecex=0.8, keysize = 1.3, margins=c(5, 5))
##### netdiffudeR package
set.seed(1231) # Random scale-free diffusion network x <- rdiffnet(1000, 4, seed.graph="scale-free", seed.p.adopt = .025, rewire = FALSE, seed.nodes = "central", rgraph.arg=list(self=FALSE, m=4), threshold.dist = function(id) runif(1,.2,.4)) # Diffusion map (no random toa) dm0 <- diffusionMap(x, kde2d.args=list(n=150, h=1), layout=igraph::layout_with_fr) # Random diffnet.toa(x) <- sample(x\$toa, size = nnodes(x)) # Diffusion map (random toa) dm1 <- diffusionMap(x, layout = dm0\$coords, kde2d.args=list(n=150, h=.5)) oldpar <- par(no.readonly = TRUE) col <- colorRampPalette(blues9)(100) par(mfrow=c(1,2), oma=c(1,0,0,0), cex=.8) image(dm0, col=col, main="Non-random Times of Adoption\nAdoption from the core.") image(dm1, col=col, main="Random Times of Adoption") par(mfrow=c(1,1)) mtext("Both networks have the same distribution on times of adoption", 1, outer = TRUE)
##### sna package in R
g<-matrix(0,50,50) g[1,]<-1; g[,1]<-1 #Create a star gplot(g) gplot(rewire.ws(g,0.05))
##### sna package in R
gplot(rgws(1,100,1,2,1))
##### arulesViz
library(arules) > rules.all <- apriori(titanic.raw) > load("titanic.raw.rdata") > library(arulesViz) > plot(rules.all) plot(rules.all,main=" ", method = "graph", control = list(type = "items"))
##### networks
> net.bg <- sample_pa(80) > > V(net.bg)\$size <- 8 > > V(net.bg)\$frame.color <- "firebrick3" > > V(net.bg)\$color <- "hotpink" > > V(net.bg)\$label <- "" > l <- layout_in_circle(net.bg) > > plot(net.bg)
##### geomnet -- ggmap
metro_map <- ggmap::get_map(location = c(left = -77.22257, bottom = 39.05721, right = -77.11271, top = 39.14247)) ggmap::ggmap(metro_map) + geom_net(data = tripnet, layout.alg = NULL, labelon = TRUE, vjust = -0.5, ealpha = 0.5, aes(from_id = from_id, to_id = to_id, x = long, y = lat, linewidth = n / 15, colour = Metro)) + scale_colour_manual("Metro Station", values = c("grey40", "darkorange")) + theme_net() %+replace% theme(aspect.ratio=NULL, legend.position = "bottom") + coord_map() ref:https://cran.r-project.org/web/packages/ggCompNet/vignettes/examples-from-paper.html
##### Plot
> data(bikes, package = 'geomnet') > # data step for geomnet > tripnet <- fortify(as.edgedf(bikes\$trips), bikes\$stations[,c(2,1,3:5)]) > tripnet\$Metro = FALSE > idx <- grep("Metro", tripnet\$from_id) > tripnet\$Metro[idx] <- TRUE > > # plot the bike sharing network shown in Figure 7b > set.seed(1232016) > ggplot(aes(from_id = from_id, to_id = to_id), data = tripnet) + + geom_net(aes(linewidth = n / 15, colour = Metro), + labelon = TRUE, repel = TRUE) + + theme_net() + + xlim(c(-0.1, 1.1)) + + scale_colour_manual("Metro Station", values = c("grey40", "darkorange")) + + theme(legend.position = "bottom")
##### geomnet and ggplot2
data(football, package = 'geomnet') rownames(football\$vertices) <- football\$vertices\$label # create network fb.net <- network::network(football\$edges[, 1:2], directed = TRUE) # create node attribute (what conference is team in?) fb.net %v% "conf" <- football\$vertices[ network.vertex.names(fb.net), "value" ] # create edge attribute (between teams in same conference?) network::set.edge.attribute( fb.net, "same.conf", football\$edges\$same.conf) set.seed(5232011) ggnet2(fb.net, mode = "fruchtermanreingold", color = "conf", palette = "Paired", color.legend = "Conference", edge.color = c("color", "grey75")) --- ftnet <- fortify(as.edgedf(football\$edges), football\$vertices) ftnet\$schools <- ifelse( ftnet\$value == "Independents", ftnet\$from_id, "") # create data plot set.seed(5232011) ggplot(data = ftnet, aes(from_id = from_id, to_id = to_id)) + geom_net(layout.alg = 'fruchtermanreingold', aes(colour = value, group = value, linetype = factor(same.conf != 1), label = schools), linewidth = 0.5, size = 5, vjust = -0.75, alpha = 0.3) + theme_net() + theme(legend.position = "bottom") + scale_colour_brewer("Conference", palette = "Paired") + guides(linetype = FALSE)
##### ggnet and ggplot2
> library(ggnet) > data(email, package = 'geomnet') > > # create node attribute data > em.cet <- as.character( + email\$nodes\$CurrentEmploymentType) > names(em.cet) = email\$nodes\$label > > # remove the emails sent to all employees > edges <- subset(email\$edges, nrecipients < 54) > # create network > em.net <- edges[, c("From", "to") ] > em.net <- network::network(em.net, directed = TRUE) > # create employee type node attribute > em.net %v% "curr_empl_type" <- + em.cet[ network.vertex.names(em.net) ] > set.seed(10312016) > ggnet2(em.net, color = "curr_empl_type", + size = 4, palette = "Set1", + arrow.size = 5, arrow.gap = 0.02, + edge.alpha = 0.25, mode = "fruchtermanreingold", + edge.color = c("color", "grey50"), + color.legend = "Employment Type") + ggtitle("by Volkan OBAN using R - ggnet") + + theme(legend.position = "bottom") > email\$edges <- email\$edges[, c(1,5,2:4,6:9)] > emailnet <- fortify( + as.edgedf(subset(email\$edges, nrecipients < 54)), + email\$nodes) > set.seed(10312016) > ggplot(data = emailnet, + aes(from_id = from_id, to_id = to_id)) + + geom_net(layout.alg = "fruchtermanreingold", + aes(colour = CurrentEmploymentType, + group = CurrentEmploymentType, + linewidth = 3 * (...samegroup.. / 8 + .125)), + ealpha = 0.25, + size = 4, curvature = 0.05, + directed = TRUE, arrowsize = 0.5) + + scale_colour_brewer("Employment Type", palette = "Set1") + + theme_net() + ggtitle("by Volkan OBAN using R - ggnet") + + theme(legend.position = "bottom") > set.seed(10312016) > ggplot(data = emailnet, + aes(from_id = from_id, to_id = to_id)) + + geom_net(layout.alg = "fruchtermanreingold", + aes(colour = CurrentEmploymentType, + group = CurrentEmploymentType, + linewidth = 3 * (...samegroup.. / 8 + .125)), + ealpha = 0.25, + size = 4, curvature = 0.05, + directed = TRUE, arrowsize = 0.5) + + scale_colour_brewer("Employment Type", palette = "Set1") + + theme_net() + + theme(legend.position = "bottom") >
##### geomnet
> library(geomnet) > data(madmen, package = "geomnet") > > # code for geom_net > # data step: merge edges and nodes by the "from" column > > MMnet <- fortify(as.edgedf(madmen\$edges), madmen\$vertices) set.seed(10052016) ggplot(data = MMnet, aes(from_id = from_id, to_id = to_id)) + geom_net(aes(colour = Gender), layout.alg = "kamadakawai", size = 2, labelon = TRUE, vjust = -0.6, ecolour = "grey60", directed =FALSE, fontsize = 3, ealpha = 0.5) + scale_colour_manual(values = c("#FF69B4", "#0099ff")) + xlim(c(-0.05, 1.05)) + theme_net() + theme(legend.position = "bottom")
##### Residuals
fit <- lm(mpg ~ hp, data = mtcars) d <- mtcars fit <- lm(mpg ~ hp, data = d) d\$predicted <- predict(fit) # Save the predicted values d\$residuals <- residuals(fit) # Save the residual values # Quick look at the actual, predicted, and residual values library(dplyr) d %>% select(mpg, predicted, residuals) %>% head() ggplot(d, aes(x = hp, y = mpg)) + geom_smooth(method = "lm", se = FALSE, color = "lightgrey") + geom_segment(aes(xend = hp, yend = predicted), alpha = .2) + # > Color adjustments made here... geom_point(aes(color = abs(residuals))) + # Color mapped to abs(residuals) scale_color_continuous(low = "black", high = "red") + # Colors to use here guides(color = FALSE) + # Color legend removed # < geom_point(aes(y = predicted), shape = 1) + theme_bw() and // another visualization ggplot(d, aes(x = hp, y = mpg)) + geom_smooth(method = "lm", se = FALSE, color = "lightgrey") + geom_segment(aes(xend = hp, yend = predicted), alpha = .2) + # > Color AND size adjustments made here... geom_point(aes(color = abs(residuals), size = abs(residuals))) + # size also mapped scale_color_continuous(low = "black", high = "red") + guides(color = FALSE, size = FALSE) + # Size legend also removed # < geom_point(aes(y = predicted), shape = 1) + theme_bw()
##### chorddiagram
library(dplyr) titanic_tbl <- dplyr::tbl_df(Titanic) titanic_tbl <- titanic_tbl %>% mutate_each(funs(factor), Class:Survived) by_class_survival <- titanic_tbl %>% group_by(Class, Survived) %>% summarize(Count = sum(n)) titanic.mat <- matrix(by_class_survival\$Count, nrow = 4, ncol = 2) dimnames(titanic.mat ) <- list(Class = levels(titanic_tbl\$Class), Survival = levels(titanic_tbl\$Survived)) print(titanic.mat) groupColors <- c("#2171b5", "#6baed6", "#bdd7e7", "#bababa", "#d7191c", "#1a9641") chorddiag(titanic.mat, type = "bipartite", groupColors = groupColors, tickInterval = 50)
##### circos
library(migest) demo(cfplot_nat, package = "migest", ask = FALSE)
##### circos
library("migest") demo(cfplot_reg2, package = "migest", ask = FALSE)
##### Plot
library(dplyr) > library(ggplot2) > > # Read data from the web > url = "https://gist.githubusercontent.com/stephenturner/806e31fce55a8b7175af/raw/1a507c4c3f9f1baaa3a69187223ff3d3050628d4/results.txt" > > results = read.table(url, header=TRUE) > results = mutate(results, sig=ifelse(results\$padj<0.05, "FDR<0.05", "Not Sig")) > > p = ggplot(results, aes(log2FoldChange, -log10(pvalue))) + + geom_point(aes(col=sig)) + ggtitle("by Volkan OBAN using R") + + scale_color_manual(values=c("darkblue", "purple")) > p > p+geom_text(data=filter(results, padj<0.05), aes(label=Gene)) > library(ggrepel) > > p+geom_text_repel(data=filter(results, padj<0.05), aes(label=Gene)) > library(ggthemes) > library(ggrepel) > > p+geom_text_repel(data=filter(results, padj<0.05), aes(label=Gene)) + theme_wsj() + scale_colour_wsj("colors6", "") or > p+geom_text_repel(data=filter(results, padj<0.05), aes(label=Gene)) + theme_solarized(light = FALSE) + + scale_colour_solarized("red")
##### ggplot2
library(dplyr) library(ggplot2) # Read data from the web url = "https://gist.githubusercontent.com/stephenturner/806e31fce55a8b7175af/raw/1a507c4c3f9f1baaa3a69187223ff3d3050628d4/results.txt" results = read.table(url, header=TRUE) results = mutate(results, sig=ifelse(results\$padj<0.05, "FDR<0.05", "Not Sig")) p = ggplot(results, aes(log2FoldChange, -log10(pvalue))) + geom_point(aes(col=sig)) + scale_color_manual(values=c("red", "black")) p p+geom_text(data=filter(results, padj<0.05), aes(label=Gene))
##### Boxplot for Time Series
code: library(RColorBrewer) # Create Data days=rep(c("monday","tuesday","wenesday","thursday","friday","saturday","sunday") , each=120) time=rep (rep( paste(seq(0,22,2),seq(2,24,2),sep="-") , each=10 ) , 7) value=rep ( rep(seq(0,22,2) , each=10 ) , 7)+rnorm(mean=10, sd=10 , length(time)) data=data.frame(days, time, value) # Create a color palette my_colors = brewer.pal(9, "Blues") my_colors = colorRampPalette(my_colors)(12) # Make the boxplot boxplot(data\$value ~ data\$time+data\$days , xaxt="n" , xlab="" , col=my_colors , pch=20 , cex=0.3 , ylab="value" ) abline(v= seq(0, 12*7, 12) +0.5 , col="grey") axis(1, labels=unique(days) , at=seq(6,12*7,12) ) # Add general trend a=aggregate(data\$value , by=list(data\$time, data\$days) , mean) lines(a[,3], type="l" , col="red" , lwd=2)
##### rcharts
ref. and codes: http://timelyportfolio.blogspot.com.tr/2013/06/r-plotting-financial-time-series.html
##### dygraphs
> library(dygraphs) > dygraph(ldeaths) %>% + dyRangeSelector() %>% + dyUnzoom() > library(xts) > data(sample_matrix) > library(dygraphs) > dygraph(sample_matrix) %>% + dyCandlestick() > library(xts) > data(sample_matrix) > library(dygraphs) > dygraph(sample_matrix, main = "by Volkan OBAN using R - dygraphs- Candlestick") %>% dyCandlestick()
##### dygraphs
library(quantmod) library(dygraphs) tickers <- c("AAPL", "MSFT") getSymbols(tickers) closePrices <- do.call(merge, lapply(tickers, function(x) Cl(get(x)))) dateWindow <- c("2008-01-01", "2009-01-01") dygraph(closePrices, main = "Value", group = "stock") %>% dyRebase(value = 100) %>% dyRangeSelector(dateWindow = dateWindow) dygraph(closePrices, main = "Percent", group = "stock") %>% dyRebase(percent = TRUE) %>% dyRangeSelector(dateWindow = dateWindow) dygraph(closePrices, main = "None", group = "stock") %>% dyRangeSelector(dateWindow = dateWindow)
##### heatmap.2
> data(USJudgeRatings) > symnum( cU <- cor(USJudgeRatings) ) hM <- format(round(cU, 2)) > hM heatmap.2(cU, Rowv=FALSE,main=" Volkan OBAN using R - gplots heatmap.2", symm=TRUE, col=rev(heat.colors(16)), + distfun=function(c) as.dist(1 - c), trace="none", + cellnote=hM)
##### harmonograph
f1=jitter(sample(c(2,3),1));f2=jitter(sample(c(2,3),1));f3=jitter(sample(c(2,3),1));f4=jitter(sample(c(2,3),1)) d1=runif(1,0,1e-02);d2=runif(1,0,1e-02);d3=runif(1,0,1e-02);d4=runif(1,0,1e-02) p1=runif(1,0,pi);p2=runif(1,0,pi);p3=runif(1,0,pi);p4=runif(1,0,pi) xt = function(t) exp(-d1*t)*sin(t*f1+p1)+exp(-d2*t)*sin(t*f2+p2) yt = function(t) exp(-d3*t)*sin(t*f3+p3)+exp(-d4*t)*sin(t*f4+p4) t=seq(1, 100, by=.001) dat=data.frame(t=t, x=xt(t), y=yt(t)) with(dat, plot(x,y, type="l", xlim =c(-2,2), ylim =c(-2,2), xlab = "", ylab = "", xaxt='n', yaxt='n'))
##### BoxPlot
> library(mvtnorm) > k <- 100 # Number of samples for each correlation > N <- 20 # Size of the samples > r <- seq(-1, 1, by=.2) # The true correlations > n <- length(r) > rr <- matrix(NA, nr=n, nc=k) > for (i in 1:n) { + for (j in 1:k) { + x <- rmvnorm(N, sigma=matrix(c(1, r[i], r[i], 1), nr=2, nc=2)) + rr[i,j] <- cor( x[,1], x[,2] ) + } + } > estimated.correlation <- as.vector(rr) > true.correlation <- r[row(rr)] > boxplot(estimated.correlation ~ true.correlation, + col = "purple", + xlab = "True correlation", main="y Volkan OBAN using R", + ylab = "Estimated correlation" ) > library(mvtnorm) > k <- 100 # Number of samples for each correlation > N <- 20 # Size of the samples > r <- seq(-1, 1, by=.2) # The true correlations > n <- length(r) > rr <- matrix(NA, nr=n, nc=k) > for (i in 1:n) { + for (j in 1:k) { + x <- rmvnorm(N, sigma=matrix(c(1, r[i], r[i], 1), nr=2, nc=2)) + rr[i,j] <- cor( x[,1], x[,2] ) + } + } > estimated.correlation <- as.vector(rr) > true.correlation <- r[row(rr)] > boxplot(estimated.correlation ~ true.correlation, + col = "lightpink3", + xlab = "True correlation", main="by Volkan OBAN using R", + ylab = "Estimated correlation" )
##### geom_boxplot() + facet_wrap(~ ) ggplot2
ggplot(diamonds, aes(x = cut, y = price, fill = clarity)) + + geom_boxplot() + + facet_wrap(~ clarity, scale = "free")
##### geom_boxplot() + facet_wrap(~ ) ggplot2
> library(ggplot2) > > # create fake dataset with additional attributes - sex, sample, and temperature > x <- data.frame(values = c(runif(100, min = 0), runif(100), runif(100, max = 3), runif(100)), letter = rep(c('o', 'v'), each = 100), sample = rep(c('VVV', 'OOO'), each = 200), s = sample(c('1984', '1990', '2000', '2019'), 400, replace = TRUE) ) > > > ggplot(x, aes(x = sample, y = values, fill = letter)) + + geom_boxplot() + + facet_wrap(~ s)
##### ggplot2 facet_wrap
> p<- ggplot(diamonds, aes(x=cut, y=price, fill=cut)) > p + geom_boxplot() + facet_wrap(~clarity, scales="free")
##### ggplot2
require (ggplot2) > require (plyr) > library(reshape2) > > set.seed(1234) > x<- rnorm(100) > y.1<-rnorm(80) > y.2<-rnorm(60) > y.3<-rnorm(75) > y.4<-rnorm(105) > y.5<-rnorm(80) > y.6<-rnorm(90) > df<- (as.data.frame(cbind(x,y.1,y.2,y.3,y.4,y.5,y.6))) ggplot(dfmelt, aes(value, x, group = round_any(x, 0.5), fill=variable))+ + geom_boxplot() + + geom_jitter() + + facet_wrap(~variable)
##### threejs
N <- 100 i <- sample(3, N, replace=TRUE) x <- matrix(rnorm(N*3),ncol=3) lab <- c("small", "bigger", "biggest") scatterplot3js(x, color=rainbow(N), labels=lab[i], size=i, renderer="canvas")
##### threejs
> data(flights) > # Approximate locations as factors > dest <- factor(sprintf("%.2f:%.2f",flights[,3], flights[,4])) > # A table of destination frequencies > freq <- sort(table(dest), decreasing=TRUE) > # The most frequent destinations in these data, possibly hub airports? > frequent_destinations <- names(freq)[1:10] > # Subset the flight data by destination frequency > idx <- dest %in% frequent_destinations > frequent_flights <- flights[idx, ] > # Lat/long and counts of frequent flights > ll <- unique(frequent_flights[,3:4]) > # Plot frequent destinations as bars, and the flights to and from > # them as arcs. Adjust arc width and color by frequency. > globejs(lat=ll[,1], long=ll[,2], arcs=frequent_flights, + arcsHeight=0.3, arcsLwd=2, arcsColor="#FFFFFF", arcsOpacity=0.15, + atmosphere=TRUE, color="#000080", pointsize=0.5) >
##### rbokeh
> library(maps) > data(world.cities) > caps <- subset(world.cities, capital == 1) > caps\$population <- prettyNum(caps\$pop, big.mark = ",") > figure(width = 800, height = 450,title="by Volkan OBAN using R - rbokeh -- data(world.cities)", padding_factor = 0) %>% + ly_map("world", col = "darkblue") %>% + ly_points(long, lat, data = caps, size = 5, + hover = c(name, country.etc, population))
##### wordcloud
library(wordcloud) > > #Create a list of words (Random words concerning my work) > a=c("VOLKAN OBAN","Mathematics","Data Science","Machine Learning","scikit-learn","solution","MLib","Apache Spark","Analysis","Big Data","Science","Statistics","Data", "Programming","ggplot2","matplotlib-seaborn","Volkan","VOLKAN","Istanbul","kNN","R", "R","Data-Viz","Python","kmeans","Programming","Graph Theory ","Operations Research", "Predictive Analytics","Clustering","Data Science","Prescriptive Analytics","Analytics","Classification") > > #I give a frequency to each word of this list > b=sample(seq(0,1,0.01) , length(a) , replace=TRUE) > par(bg="deeppink4") > wordcloud(a , b , col=terrain.colors(length(a) , alpha=0.9) , rot.per=0.3 )
##### art in R. ref: Gaston Sanchez
x = seq(-50, 50, by = 1) y = -(x^2) # set graphic parameters op = par(bg = 'black', mar = rep(0.5, 4)) # Plot plot(y, x, type = 'n') lines(y, x, lwd = 2*runif(1), col = hsv(0.08, 1, 1, alpha = runif(1, 0.5, 0.9))) for (i in seq(10, 2500, 10)) { lines(y-i, x, lwd = 2*runif(1), col = hsv(0.08, 1, 1, alpha = runif(1, 0.5, 0.9))) } for (i in seq(500, 600, 10)) { lines(y - i, x, lwd = 2*runif(1), col = hsv(0, 1, 1, alpha = runif(1, 0.5, 0.9))) } for (i in seq(2000, 2300, 10)) { lines(y - i, x, lwd = 2*runif(1), col = hsv(0, 1, 1, alpha = runif(1, 0 .5, 0.9))) } for (i in seq(100, 150, 10)) { lines(y - i, x, lwd = 2*runif(1), col = hsv(0, 1, 1, alpha = runif(1, 0.5, 0.9))) } # signature legend("bottomright", legend="© Gaston Sanchez", bty = "n", text.col="gray70")
##### Plot
library(RColorBrewer) > > # Classic palette BuPu, with 4 colors > coul = brewer.pal(4, "BuPu") > > # I can add more tones to this palette : > coul = colorRampPalette(coul)(25) > > # Plot it > pie(rep(1, length(coul)), col = coul , main=" R - piechart - RColorBrewer ")
##### Plot3D package
require(plot3D) Zorunlu paket yükleniyor: plot3D > lon <- seq(165.5, 188.5, length.out = 30) > lat <- seq(-38.5, -10, length.out = 30) > xy <- table(cut(quakes\$long, lon), + cut(quakes\$lat, lat)) > xmid <- 0.5*(lon[-1] + lon[-length(lon)]) > ymid <- 0.5*(lat[-1] + lat[-length(lat)]) > > par (mar = par("mar") + c(0, 0, 0, 2)) > hist3D(x = xmid, y = ymid, z = xy, + zlim = c(-20, 40), main = " Earth quakes", + ylab = "latitude", xlab = "longitude", + zlab = "counts", bty= "g", phi = 5, theta = 25, + shade = 0.2, col = "white", border = "black", + d = 1, ticktype = "detailed") > > with (quakes, scatter3D(x = long, y = lat, + z = rep(-20, length.out = length(long)), + colvar = quakes\$depth, col = gg.col(100), + add = TRUE, pch = 18, clab = c("depth", "m"), + colkey = list(length = 0.5, width = 0.5, + dist = 0.05, cex.axis = 0.8, cex.clab = 0.8) + ))
##### ggplot2
ggplot(train, aes(Outlet_Identifier, Item_Outlet_Sales)) + geom_boxplot(fill = "mediumpurple4")+ + scale_y_continuous("Item Outlet Sales", breaks= seq(0,15000, by=500))+ + labs(title = " R - ggplot2", x = "Outlet Identifier") data:https://docs.google.com/spreadsheets/d/1PR5StHxg2jlMCb4IUilGSEwhylXn-3q3EJucSaVolCU/edit#gid=0
##### ggplot2
ref: https://www.r-bloggers.com/improved-net-stacked-distribution-graphs-via-ggplot2-trickery/
##### ggplot2
library("ggplot2") > data <- read.csv("ggplot-data.csv", header=TRUE, nrows=200) > gg <- ggplot(data, aes(x=Keyword)) > gg <- gg + geom_bar(aes(weight=Traffic, fill=Country) + coord_flip() + ) > gg > data\$kw <- reorder(data\$Keyword, data\$Traffic) > gg <- ggplot(data, aes(x=kw)) > > gg <- gg + geom_bar(aes(weight=Traffic, fill=Country)) + coord_flip() > > gg > gg <- ggplot(data, aes(x=kw)) > > gg <- gg + geom_bar(aes(weight=Traffic, fill=Country)) + coord_flip() > > gg
##### ggplot2 facet_wrap
> c <- ggplot(diamonds, aes(clarity, fill=cut)) + geom_bar() > c + facet_wrap(~cut, scales = "free_y") + coord_flip(
##### ggplot2
library(ggplot2) > df <- structure(c(106487, 495681, 1597442, + 2452577, 2065141, 2271925, 4735484, 3555352, + 8056040, 4321887, 2463194, 347566, 621147, + 1325727, 1123492, 800368, 761550, 1359737, + 1073726, 36, 53, 141, 41538, 64759, 124160, + 69942, 74862, 323543, 247236, 112059, 16595, + 37028, 153249, 427642, 1588178, 2738157, + 2795672, 2265696, 11951, 33424, 62469, + 74720, 166607, 404044, 426967, 38972, 361888, + 1143671, 1516716, 160037, 354804, 996944, + 1716374, 1982735, 3615225, 4486806, 3037122, + 17, 54, 55, 210, 312, 358, 857, 350, 7368, + 8443, 6286, 1750, 7367, 14092, 28954, 80779, + 176893, 354939, 446792, 33333, 69911, 53144, + 29169, 18005, 11704, 13363, 18028, 46547, + 14574, 8954, 2483, 14693, 25467, 25215, + 41254, 46237, 98263, 185986), .Dim = c(19, + 5), .Dimnames = list(c("1820-30", "1831-40", + "1841-50", "1851-60", "1861-70", "1871-80", + "1881-90", "1891-00", "1901-10", "1911-20", + "1921-30", "1931-40", "1941-50", "1951-60", + "1961-70", "1971-80", "1981-90", "1991-00", + "2001-06"), c("Europe", "Asia", "Americas", + "Africa", "Oceania"))) > library(reshape) Attaching package: ‘reshape’ The following objects are masked from ‘package:plyr’: rename, round_any The following object is masked from ‘package:Matrix’: expand > df.m <- melt(df) > df.m <- rename(df.m, c(X1 = "Period", X2 = "Region")) a <- ggplot(df.m, aes(x = Period, y = value/1e+06, + fill = Region)) + options(title = "Migration to the United States by Source Region (1820-2006)") + + labs(x = NULL, y = "Number of People (in millions)n", + fill = NULL) > b <- a + geom_bar(stat = "identity", position = "stack") > b c <- b+ facet_grid(Region ~ .) + options(legend.position = "none") > c > total <- cast(df.m, Period ~ ., sum) > total <- rename(total, c(`(all)` = "value")) > total\$Region <- "Total" > df.m.t <- rbind(total, df.m) > c1 <- c %+% df.m > total <- cast(df.m, Period ~ ., sum) > total <- rename(total, c(`(all)` = "value")) > total\$Region <- "Total" > df.m.t <- rbind(total, df.m) > c1 <- c %+% df.m > c1 > c2 <- c1 + facet_grid(Region ~ ., scale = "free_y") > c2
##### ggplot2
ibrary(ggplot2) > library(ggthemes) > library(extrafont) Registering fonts with R > library(plyr) Attaching package: ‘plyr’ The following object is masked from ‘package:network’: is.discrete > library(scales) Attaching package: ‘scales’ The following object is masked _by_ ‘.GlobalEnv’: cscale > charts.data <- read.csv("data.csv") > p <- ggplot() + geom_bar(aes(y = percentage, x = year, fill = product), data = charts.data,stat="identity") p <- p + geom_text(data=charts.data, aes(x = year, y = percentage, + label = paste0(percentage,"%")), size=4) p
##### ggplot2
Year <- c(rep(c("1984-01", "1987-05", "1990-06", "2005-01"), each = 4)) Category <- c(rep(c("V", "O", "R", "D"), times = 4)) Frequency <- c(174, 248, 201, 326, 215, 428, 309, 365, 419, 652, 231, 695, 144, 452, 281, 210) Data <- data.frame(Year, Category, Frequency) ggplot(Data, aes(x = Year, y = Frequency, fill = Category, label = Frequency)) + geom_bar(stat = "identity") + geom_text(size = 3, position = position_stack(vjust = 0.5))
##### ggplot2 facet_grid
> ggplot(diamonds, aes(clarity)) + + geom_bar(aes(fill = cut)) + + facet_grid(cut ~ .)
##### Gauge Chart in R
ref and code :https://www.r-bloggers.com/gauge-chart-in-r/
##### gauge
gg.gauge <- function(pos,breaks=c(0,42,58,100)) { + require(ggplot2) + get.poly <- function(a,b,r1=0.5,r2=1.0) { + th.start <- pi*(1-a/100) + th.end <- pi*(1-b/100) + th <- seq(th.start,th.end,length=100) + x <- c(r1*cos(th),rev(r2*cos(th))) + y <- c(r1*sin(th),rev(r2*sin(th))) + return(data.frame(x,y)) + } + ggplot()+ ggtitle("by Volkan OBAN using R \n Gauge") + + geom_polygon(data=get.poly(breaks[1],breaks[2]),aes(x,y),fill="green")+ + geom_polygon(data=get.poly(breaks[2],breaks[3]),aes(x,y),fill="pink")+ + geom_polygon(data=get.poly(breaks[3],breaks[4]),aes(x,y),fill="purple")+ + geom_polygon(data=get.poly(pos-1,pos+1,0.2),aes(x,y))+ + geom_text(data=as.data.frame(breaks), size=5, fontface="bold", vjust=0, + aes(x=1.1*cos(pi*(1-breaks/100)),y=1.1*sin(pi*(1-breaks/100)),label=paste0(breaks,"%")))+ + annotate("text",x=0,y=0,label=pos,vjust=0,size=8,fontface="bold")+ + coord_fixed()+ + theme_bw()+ + theme(axis.text=element_blank(), + axis.title=element_blank(), + axis.ticks=element_blank(), + panel.grid=element_blank(), + panel.border=element_blank()) + } > gg.gauge(52,breaks=c(0,42,58,100) + + ) > library(gridExtra) > grid.newpage() > grid.draw(arrangeGrob(gg.gauge(22),gg.gauge(36), + gg.gauge(71),gg.gauge(95),ncol=2))
##### gauge
gg.gauge <- function(pos,breaks=c(0,42,58,100)) { + require(ggplot2) + get.poly <- function(a,b,r1=0.5,r2=1.0) { + th.start <- pi*(1-a/100) + th.end <- pi*(1-b/100) + th <- seq(th.start,th.end,length=100) + x <- c(r1*cos(th),rev(r2*cos(th))) + y <- c(r1*sin(th),rev(r2*sin(th))) + return(data.frame(x,y)) + } + ggplot()+ ggtitle("by Volkan OBAN using R \n Gauge") + + geom_polygon(data=get.poly(breaks[1],breaks[2]),aes(x,y),fill="green")+ + geom_polygon(data=get.poly(breaks[2],breaks[3]),aes(x,y),fill="pink")+ + geom_polygon(data=get.poly(breaks[3],breaks[4]),aes(x,y),fill="purple")+ + geom_polygon(data=get.poly(pos-1,pos+1,0.2),aes(x,y))+ + geom_text(data=as.data.frame(breaks), size=5, fontface="bold", vjust=0, + aes(x=1.1*cos(pi*(1-breaks/100)),y=1.1*sin(pi*(1-breaks/100)),label=paste0(breaks,"%")))+ + annotate("text",x=0,y=0,label=pos,vjust=0,size=8,fontface="bold")+ + coord_fixed()+ + theme_bw()+ + theme(axis.text=element_blank(), + axis.title=element_blank(), + axis.ticks=element_blank(), + panel.grid=element_blank(), + panel.border=element_blank()) + } > gg.gauge(52,breaks=c(0,42,58,100) + + )
##### DiagrammeR
> spec <- " + digraph { 'VOLKAN OBAN \n Data Scientist ' } + [1]: LETTERS[1] + " > > > grViz(replace_in_spec(spec))
##### DiagrammeR
> spec <- " + digraph { '@1' } + [1]: LETTERS[1] + " > grViz(replace_in_spec(spec)) > spec <- " + digraph a_nice_graph { + node [fontname = Arial] + a [label = 'by VOLKAN OBAN using R '] + b [label = 'Mathematics'] + c [label = 'Data Science'] + d [label = 'Analytics'] + e [label = 'Programming'] + f [label = 'Machine Learning'] + g [label = 'Python'] + h [label = 'Statistics'] + i [label = 'R'] + j [label = 'Istanbul'] + a -> { b c d e f g h i j} + } + [1]: 'top' + [2]: 10:20 + " > grViz(replace_in_spec(spec)) >
##### ggplot2 and ggthemr
> ggthemr('lilac') >ggplot(data = mpg, mapping = aes(x = class, y = hwy)) + + geom_boxplot() + + coord_flip() +
##### ggplot2 and ggthemr
sea ggplot(data = mpg, mapping = aes(x = class, y = hwy)) + + geom_boxplot() + + coord_flip()
##### ggplot2 and ggthemr
.................... ggplot(data = diamonds) + geom_bar(mapping = aes(x = cut, fill = clarity), position = "dodge")
##### ggplot2 and ggthemr
> ggthemr('lilac') > ggplot(data = diamonds) + + geom_bar(mapping = aes(x = cut, fill = clarity), position = "dodge") + ggtitle("by Volkan OBAN using R - ggplot2 and ggthemr packages /data(diamonds)")
##### ggplot2 and ggthemr
> ggthemr('sea') > ggplot(data = diamonds) + + geom_bar(mapping = aes(x = cut, fill = clarity), position = "dodge") + ggtitle("by Volkan OBAN using R - ggplot2 and ggthemr packages /data(diamonds)")
##### Visualize kmeans clustering
ref: http://handsondatascience.com/ClustersO.pdf
##### ggmap
> ds<-map_data("world") > p <- ggplot(ds, aes( x=long, y=lat, group=group)) > p <-p + geom_polygon() + ggtitle("by Volkan OBAN using R - ggmap") > p > > p <- ggplot(ds, aes(x=long, y=lat, group=group, fill=region)) > p <- p + geom_polygon() > p <- p + geom_polygon() > p <- p + theme(legend.position = "none") > p
##### Visualize kmeans clustering
> library(rattle) # Load weather dataset. Normalise names normVarNames(). Rattle: A free graphical interface for data mining with R. Version 4.1.0 Copyright (c) 2006-2015 Togaware Pty Ltd. Type 'rattle()' to shake, rattle, and roll your data. > library(randomForest) # Impute missing using na.roughfix(). randomForest 4.6-12 Type rfNews() to see new features/changes/bug fixes. > # Identify the dataset. > dsname <- "weather" > ds <- get(dsname) > names(ds) <- normVarNames(names(ds)) > vars <- names(ds) > target <- "rain_tomorrow" > risk <- "risk_mm" > id <- c("date", "location") > # Ignore the IDs and the risk variable. > ignore <- union(id, if (exists("risk")) risk) > # Ignore variables which are completely missing. > mvc <- sapply(ds[vars], function(x) sum(is.na(x))) # Missing value count. > mvn <- names(ds)[(which(mvc == nrow(ds)))] # Missing var names. > ignore <- union(ignore, mvn) > # Initialise the variables > vars <- setdiff(vars, ignore) > # Variable roles. > inputc <- setdiff(vars, target) > inputi <- sapply(inputc, function(x) which(x == names(ds)), USE.NAMES=FALSE) > numi <- intersect(inputi, which(sapply(ds, is.numeric))) > numc <- names(ds)[numi] > cati <- intersect(inputi, which(sapply(ds, is.factor))) > catc <- names(ds)[cati] > # Impute missing values, but do this wisely - understand why missing. > if (sum(is.na(ds[vars]))) ds[vars] <- na.roughfix(ds[vars]) > # Number of observations. > nobs <- nrow(ds) > model <- m.km <- kmeans(ds, 10) > model <- m.kms <- kmeans(scale(ds[numi]), 10) > model\$size [1] 34 54 15 70 24 32 30 44 43 20 > library(ggplot2) > library(reshape) Attaching package: ‘reshape’ The following object is masked from ‘package:Matrix’: expand > nclust <- 4 > model <- m.kms <- kmeans(scale(ds[numi]), nclust) > dscm <- melt(model\$centers) > names(dscm) <- c("Cluster", "Variable", "Value") > dscm\$Cluster <- factor(dscm\$Cluster) > dscm\$Order <- as.vector(sapply(1:length(numi), rep, nclust)) > p <- ggplot(dscm, + aes(x=reorder(Variable, Order), + y=Value, group=Cluster, colour=Cluster)) > p <- p + coord_polar() > p <- p + geom_point() > p <- p + geom_path() > p <- p + labs(x=NULL, y=NULL) > p <- p + theme(axis.ticks.y=element_blank(), axis.text.y = element_blank()) > p >
##### Visualize kmeans clustering
> set.seed(32297) d <- data.frame(x=runif(100),y=runif(100)) > clus <- kmeans(d,centers=5) > d\$cluster <- clus\$cluster > library('ggplot2') > library('grDevices') > h <- do.call(rbind, + lapply(unique(clus\$cluster), + function(c) { f <- subset(d,cluster==c); f[chull(f),]})) > ggplot() + + geom_text(data=d,aes(label=cluster,x=x,y=y, + color=cluster),size=3) + + geom_polygon(data=h,aes(x=x,y=y,group=cluster,fill=as.factor(cluster)), + alpha=0.4,linetype=0) + + theme(legend.position = "none")
##### wordcloud
> library(wordcloud) > > #Create a list of words (Random words concerning my work) > a=c("Volkan OBAN","Clustering","Turkey","Istanbul","Classification","Istanbul Technical University","Mathematics", + "Data Science","Analysis","Machine Learning","Science","Statistics","Data", + "Programming","Clustering","Recommedation","Visualization","Spark","Business","VOLKAN","R", "R", + "Data-Viz","Python","Linux","Programming","Graphs","Numbers", "Big Data", + "Computing","Data-Science","Analytics","GitHub","OBAN") > > #I give a frequency to each word of this list > b=sample(seq(0,1,0.01) , length(a) , replace=TRUE) > > #The package will automatically make the wordcloud ! (I add a black background) > par(bg="hotpink4") > wordcloud(a , b , col=terrain.colors(length(a) , alpha=0.9) , rot.per=0.3 ) >
##### Plot
> moxbuller = function(n) { + u = runif(n) + v = runif(n) + x = cos(2*pi*u)*sqrt(-2*log(v)) + y = sin(2*pi*v)*sqrt(-2*log(u)) + r = list(x=x, y=y) + return(r) + } > r = moxbuller(50000) > par(bg="aliceblue") > par(mar=c(0,0,0,0)) > plot(r\$x,r\$y, pch=".", col="hotpink4",main=" \n by Volkan OBAN using R", cex=1.2)
##### Plot
library(magrittr) > > add_line_points2 <- function(plot, df, ...) { + plot + + geom_line(aes(x = Time, y = weight, group = Chick), ..., data = df) + + geom_point(aes(x = Time, y = weight), ..., data = df) + } > > (plot4 <- ggplot() %>% add_line_points2(diet1) + %>% add_line_points2(diet2, colour = "red")
##### Plot
> library(ggplot2) > > data(ChickWeight) > diet1 <- subset(ChickWeight, Diet == 1) > diet2 <- subset(ChickWeight, Diet == 2) > add_line <- function(df) { + geom_line(aes(x = Time, y = weight, group = Chick), data = df) + } > > add_points <- function(df) { + geom_point(aes(x = Time, y = weight), data = df) + } > > add_line_points <- function(df) { + add_line(df) + add_points(df) + } (p <- ggplot(aes(x = Time, y = weight, group = Chick, colour = Diet), + data = ChickWeight) + + geom_line() + geom_point())
##### Plot
library(ggplot2) > > data(ChickWeight) > diet1 <- subset(ChickWeight, Diet == 1) > diet2 <- subset(ChickWeight, Diet == 2) > add_line <- function(df) { + geom_line(aes(x = Time, y = weight, group = Chick), data = df) + } > > add_points <- function(df) { + geom_point(aes(x = Time, y = weight), data = df) + } > > add_line_points <- function(df) { + add_line(df) + add_points(df) p <- ggplot(aes(x = Time, y = weight, group = Chick), data = diet1) + + geom_line() + geom_point()
##### lattice package --wireframe and cloud
cloud(Sepal.Length ~ Petal.Length * Petal.Width | Species, data = iris, screen = list(x = -90, y = 70),main="by Volkan OBAN using R", distance = .4, zoom = .6)
##### timeseries zoo package.
library(quantmod) > tckrs <- c("SPY", "QQQ", "GDX", "DBO", "VWO") > getSymbols(tckrs, from = "2007-01-01" SPY.Close <- SPY[,4] > QQQ.Close <- QQQ[,4] > GDX.Close <- GDX[,4] > DBO.Close <- DBO[,4] > VWO.Close <- VWO[,4] > SPY1 <- as.numeric(SPY.Close[1]) > QQQ1 <- as.numeric(QQQ.Close[1]) > GDX1 <- as.numeric(GDX.Close[1]) > DBO1 <- as.numeric(DBO.Close[1]) > VWO1 <- as.numeric(VWO.Close[1] + ) > SPY <- SPY.Close/SPY1 > QQQ <- QQQ.Close/QQQ1 > GDX <- GDX.Close/GDX1 > DBO <- DBO.Close/DBO1 > VWO <- VWO.Close/VWO1 > basket <- cbind(SPY, QQQ, GDX, DBO, VWO + ) > zoo.basket <- as.zoo(basket + ) > tsRainbow <- rainbow(ncol(zoo.basket)) > # Plot the overlayed series > plot(x = zoo.basket, ylab = "Cumulative Return", main = "by Volkan OBAN using R \n Cumulative Returns", + col = tsRainbow, screens = 1) > # Set a legend in the upper left hand corner to match color to return series > legend(x = "topleft", legend = c("SPY", "QQQ", "GDX", "DBO", "VWO"), lty = 1,col = tsRainbow)
##### ggcyto from bioconductor
> library(ggcyto) > data(GvHD) > fs <- GvHD[subset(pData(GvHD), Patient %in%5:7 & Visit %in% c(5:6))[["name"]]] > fr <- fs[[1]] > p <- ggcyto(fs, aes(x = `FSC-H`)) > p <- ggcyto(fs, aes(x = `FSC-H`, y = `SSC-H`)) + ggtitle("by Volkan OBAN using R") > p <- p + geom_hex(bins = 128) > p Warning message: Removed 257 rows containing missing values (geom_hex). > p + scale_fill_gradientn(colours = rainbow(7), trans = "sqrt") > library(knitr) > library(RColorBrewer) > p + scale_fill_gradientn(colours = brewer.pal(n=8,name="PiYG"),trans="sqrt")
##### ggcyto from bioconductor
library(ggcyto) data(GvHD) fs <- GvHD[subset(pData(GvHD), Patient %in%5:7 & Visit %in% c(5:6))[["name"]]] fr <- fs[[1]] p1 <- ggplot(mapping = aes(x = `FSC-H`, y = `SSC-H`)) + myColor_scale_fill + facet_grid(Patient~Visit) p1 + stat_binhex(data = fs, bin = 64)
##### ggplot2 and ggthemes
> p<-ggplot(diamonds, aes(cut, price)) + + geom_boxplot() + + coord_flip() + theme_solarized() + + scale_colour_solarized("purple") + ggtitle("by Volkan OBAN using R \n data(diamonds) ") + theme(plot.title = element_text(size = 12, face = "bold") + ) > p
##### SVM plot
> data(iris) > m2 <- svm(Species~., data = iris) > plot(m2, iris, Petal.Width ~ Petal.Length, + slice = list(Sepal.Width = 3, Sepal.Length = 4))
##### rasterVis
u1 <- cos(y) * cos(x) v1 <- cos(y) * sin(x) u2 <- sin(y) * sin(x) v2 <- sin(y) * cos(x) field <- stack(u, u1, u2, v, v1, v2) names(field) <- c('u', 'u1', 'u2', 'v', 'v1', 'v2') vectorplot(field, isField='dXY', narrows=300, lwd.arrows=.4, par.settings=BTCTheme(), layout=c(3, 1)) ## uLayer and vLayer define which layers contain ## horizontal and vertical components, respectively vectorplot(field, isField='dXY', narrows=300, uLayer=1:3, vLayer=6:4)
##### rasterVis
u1 <- cos(y) * cos(x) v1 <- cos(y) * sin(x) u2 <- sin(y) * sin(x) v2 <- sin(y) * cos(x) field <- stack(u, u1, u2, v, v1, v2) names(field) <- c('u', 'u1', 'u2', 'v', 'v1', 'v2') vectorplot(field, isField='dXY', narrows=300, lwd.arrows=.4, par.settings=BTCTheme(), layout=c(3, 1)) ## uLayer and vLayer define which layers contain ## horizontal and vertical components, respectively vectorplot(field, isField='dXY', narrows=300, uLayer=1:3, vLayer=6:4)
##### SWMPr and oce
library(SWMPr) library(oce) # clean input data, one hour time step, subset, fill gaps dat <- qaqc(apadbwq) %>% setstep(timestep = 60) %>% subset(., subset = c('2013-01-01 0:0', '2013-12-31 0:0'), select = 'depth') %>% na.approx(maxgap = 1e6) # get model datsl <- as.sealevel(elevation = dat\$depth, time = dat\$datetimestamp) mod <- tidem(t = datsl) # add predictions to observed data dat\$Estimated <- predict(mod) # plot ggplot(dat, aes(x = datetimestamp, y = Estimated)) + geom_line() + theme_bw()
##### Plot
constituents <- c('M2', 'S2', 'N2', 'K2', 'K1', 'O1', 'P1') # loop through tidal components, predict each with tidem preds <- sapply(constituents, function(x){ mod <- tidem(t = datsl, constituent = x) pred <- predict(mod) pred - mean(pred) }) # combine prediction, sum, add time data predall <- rowSums(preds) + mean(datsl[['elevation']]) preds <- data.frame(time = datsl[['time']], preds, Estimated = predall) head(preds) mod <- tidem(t = datsl) Note: the record is too short to fit for constituents: SA PI1 S1 PSI1 GAM2 H1 H2 T2 R2 > > # get components of interest > amps <- data.frame(mod@data[c('name', 'amplitude')]) %>% + filter(name %in% constituents) %>% + arrange(amplitude) > amps name amplitude 1 K2 0.01091190 2 N2 0.01342395 3 S2 0.02904518 4 P1 0.04100388 5 O1 0.11142455 6 M2 0.12005114 7 K1 0.12865764 > dat\$Estimated <- predict(mod) > > # plot one month > ggplot(dat, aes(x = datetimestamp, y = depth)) + + geom_point() + + geom_line(aes(y = Estimated), colour = 'blue') + + scale_x_datetime(limits = as.POSIXct(c('2013-07-01', '2013-07-31'))) + + scale_y_continuous(limits = c(0.9, 2)) + + theme_bw()
##### SWMPr and oce
library(SWMPr) Warning message: package ‘SWMPr’ was built under R version 3.3.3 > library(oce) > > # clean, one hour time step, subset, fill gaps > dat <- qaqc(apadbwq) %>% + setstep(timestep = 60) %>% + subset(subset = c('2013-01-01 0:0', '2013-12-31 0:0'), select = 'depth') %>% + na.approx(maxgap = 1e6) > datsl <- as.sealevel(elevation = dat\$depth, time = dat\$datetimestamp) > plot(datsl,main="by Volkan OBAN using R")
##### mosaic plot
> library("graphics") > # Mosaic plot of observed values > mosaicplot(housetasks, las=2, col="steelblue", + main = " \n housetasks - observed counts")
##### MAPS
> require(maps) > Tur = map_data('world', region = 'Turkey') > ggplot(Tur, aes(x = long, y = lat, group = group)) + + geom_polygon(fill = 'red', colour = 'black') +ggtitle("TURKEY- TÜRKİYE CENNETİM"
##### Plot
> c <- ggplot(diamonds, aes(carat, price)) > c + geom_bin2d() > require(hexbin) > c + geom_hex() > c + geom_hex(bins = 10)
##### ggplot2
> wdata = data.frame( + s = factor(rep(c("F", "M"), each=200)), + weight = c(rnorm(200, 55), rnorm(200, 58))) a <- ggplot(wdata, aes(x = weight)) > a + geom_dotplot()
##### ggplot2
> set.seed(1234) > wdata = data.frame( + s = factor(rep(c("F", "M"), each=200)), + weight = c(rnorm(200, 55), rnorm(200, 58))) > head(wdata) s weight 1 F 53.79293 2 F 55.27743 3 F 56.08444 4 F 52.65430 5 F 55.42912 6 F 55.50606 > qplot(s, weight, data = wdata, geom = "dotplot", + stackdir = "center", binaxis = "y", dotsize = 0.5)
##### pie chart
> df <- data.frame( + group = c("X", "Y", "Z"), + value = c(37, 43, 20) + ) > head(df) group value 1 X 37 2 Y 43 3 Z 20 > library(ggplot2) > bp<- ggplot(df, aes(x="", y=value, fill=group))+ + geom_bar(width = 1, stat = "identity") > bp > bp<- ggplot(df, aes(x="", y=value, fill=group))+ + geom_bar(width = 1, stat = "identity") > pie <- bp + coord_polar("y", start=0) > pie > pie + scale_fill_manual(values=c("#999999", "#E69F00", "#56B4E9")) > ggplot(PlantGrowth, aes(x=factor(1), fill=group))+ + geom_bar(width = 1)+ + coord_polar("y") > ggplot(PlantGrowth, aes(x=factor(1), fill=group))+ + geom_bar(width = 1)+ + coord_polar("y") > blank_theme <- theme_minimal()+ + theme( + axis.title.x = element_blank(), + axis.title.y = element_blank(), + panel.border = element_blank(), + panel.grid=element_blank(), + axis.ticks = element_blank(), + plot.title=element_text(size=14, face="bold") + ) > library(scales) > pie + scale_fill_grey() + blank_theme + + theme(axis.text.x=element_blank()) + + geom_text(aes(y = value/3 + c(0, cumsum(value)[-length(value)]), + label = percent(value/100)), size=5 + ) > pie + scale_fill_brewer("Blues") + blank_theme + + theme(axis.text.x=element_blank())+ + geom_text(aes(y = value/3 + c(0, cumsum(value)[-length(value)]), + label = percent(value/100)), size=5) >
##### ggplot2
correlation matrix > mydata <- mtcars[, c(1,3,4,5,6,7)] > cormat <- round(cor(mydata),2) > library(reshape2) > melted_cormat <- melt(cormat) > head(melted_cormat) library(ggplot2) > ggplot(data = melted_cormat, aes(Var2, Var1, fill = value))+ geom_tile(color = "white")+ scale_fill_gradient2(low = "purple", high = "red", mid = "white", midpoint = 0, limit = c(-1,1), space = "Lab", name="Pearson\n Correlation") + theme_minimal()+ theme(axis.text.x = element_text(angle = 45, vjust = 1, size = 12, hjust = 1))+ coord_fixed()
##### Plot
> ohio <- midwest %>% + filter(state == "OH") %>% + select(county, percollege) %>% + arrange(percollege) %>% + mutate(Avg = mean(percollege, na.rm = TRUE), + Above = ifelse(percollege - Avg > 0, TRUE, FALSE), + county = factor(county, levels = .\$county) ggplot(ohio, aes(percollege, county, color = Above)) + + geom_segment(aes(x = Avg, y = county, xend = percollege, yend = county), color = "grey50") + ggtitle("preprared by Volkan OBAN using R - ggplot2 - data(midwest) ") + + geom_point()
##### rworldmap
> library(rworldmap) > newmap <- getMap(resolution = "high") > plot(newmap,main=" R - rworldmap", + xlim = c(-20, 59), + ylim = c(35, 71), + asp = 1)
##### canvasXpress package
> data <- t(iris[,1:4]) > varAnnot <- as.matrix(iris[,5]) > colnames(varAnnot) <- "Species" > canvasXpress(t(data),varAnnot=varAnnot, graphType='Scatter3D', colorBy='Species')
##### canvasXpress package
> data <- t(iris[,1:4]) > smpAnnot <- as.matrix(iris[,5]) > colnames(smpAnnot) <- "Species" > canvasXpress(data,title="by Volkan OBAN using R \n canvasXpress package", smpAnnot=smpAnnot, graphType='Boxplot', groupingFactors=list('Species')) > # or > canvasXpress(data,title="by Volkan OBAN using R \n canvasXpress package",smpAnnot=smpAnnot, graphType='Boxplot', afterRender=list(list('groupSamples', list('Species'))))
##### ggplot2
> library(ggplot2) > g <- ggplot(mpg, aes(manufacturer)) > g + geom_bar(aes(fill=class), width = 0.5) + + theme(axis.text.x = element_text(angle=65, vjust=0.6)) + + labs(title="by Volkan OBAN using R", + subtitle=" Categorywise Bar Chart \n Manufacturer of vehicles", + caption="Source: Manufacturers from 'mpg' dataset")
##### ggmap-İzmir
qmap(location = "izmir")
##### waffle and gridExtra
gridExtra::grid.arrange( + waffle(c(Volkan=50, Oban=50), rows=5,title="by Volkan OBAN using R - gridExtra and waffle packages", xlab="R-waffle package"), + waffle(c(Oban=25, Volkan=75), rows=5), waffle(c(Oban=7, Volkan=93), rows=5), waffle(c(Oban=42, Volkan=58), rows=5), waffle(c(Oban=2, Volkan=98), rows=5), waffle(c(oban=63, Volkan=37), rows=5),waffle(c(Oban=2, Volkan=98), rows=5), waffle(c(oban=75, Volkan=25), rows=5),waffle(c(Oban=15, Volkan=85), rows=5), waffle(c(oban=63, Volkan=37), rows=5),waffle(c(Oban=0, Volkan=100), rows=5), waffle(c(oban=100, Volkan=0), rows=5) )
##### plotrix
> slices <- c(18, 12, 4, 16, 8, 9, 12) > labels <- c("A", "B", "C", "X", "V", "O", "Z") > library(plotrix) > pie3D(slices,labels=labels,explode=0.1, main=" 3D- explodated Pie Chart")
##### ggraph
ref: https://www.r-bloggers.com/introduction-to-ggraph-layouts/
##### ggbeeswarm
> library(gridExtra) > dat <- list( 'Normal'=rnorm(50),'Dense normal'= rnorm(500),'Bimodal'=c(rnorm(100), rnorm(100,5)), 'Trimodal'=c(rnorm(100), rnorm(100,5),rnorm(100,-3)) + ) > labs<-rep(names(dat),sapply(dat,length)) > labs<-factor(labs,levels=unique(labs)) > dat<-unlist(dat) > > > > > > p1<-ggplot(mapping=aes(labs, dat)) +geom_quasirandom(method='smiley',alpha=.2) + ggtitle('Default (n/5)') + labs(x='Volkan OBAN') > p2<-ggplot(mapping=aes(labs, dat)) + geom_quasirandom(method='smiley',nbins=50,alpha=.2) +ggtitle('nbins=50') > p3<-ggplot(mapping=aes(labs, dat)) +geom_quasirandom(method='smiley',nbins=100,alpha=.2) + ggtitle('nbins=100') > p4<-ggplot(mapping=aes(labs, dat)) +geom_quasirandom(method='smiley',nbins=250,alpha=.2) +ggtitle('nbins=250') > grid.arrange(p1, p2, p3, p4, ncol=1) >
##### psych package
ref: https://cran.r-project.org/web/packages/psych/psych.pdf
##### factor Analysis- ggplot2 grid gridExtra and psych
ref: http://rpubs.com/danmirman/plotting_factor_analysis
##### ggtree
pp <- ggtree(tree) %>% phylopic("79ad5f09-cf21-4c89-8e7d-0c82a00ce728", print(pp)
##### ggtree
ref : https://bioconductor.org/packages/devel/bioc/manuals/ggtree/man/ggtree.pdf
##### mlrMBO
library(mlrMBO) fun = makeSingleObjectiveFunction( name = "SineMixture", fn = function(x) sin(x[1])*cos(x[2])/2 + 0.04 * sum(x^2), par.set = makeNumericParamSet(id = "x", len = 2, lower = -5, upper = 5) ) ctrl = makeMBOControl() # For this numeric optimization we are going to use the Expected Improvement as infill criterion: ctrl = setMBOControlInfill(ctrl, crit = crit.ei) # We will allow for exactly 25 evaluations of the objective function: ctrl = setMBOControlTermination(ctrl, max.evals = 25L) library(ggplot2) des = generateDesign(n = 8L, par.set = getParamSet(fun), fun = lhs::randomLHS) autoplot(fun, render.levels = TRUE) + geom_point(data = des)
##### mlrMBO ecr and plot3D
set.seed(1) library(mlrMBO) fun = makeSingleObjectiveFunction( name = "SineMixture", fn = function(x) sin(x[1])*cos(x[2])/2 + 0.04 * sum(x^2), par.set = makeNumericParamSet(id = "x", len = 2, lower = -5, upper = 5) ) library(plot3D) plot3D(fun, contour = TRUE, lightning = TRUE)
##### ggforce
rocketData <- data.frame( x = c(1,1,2,2), y = c(1,2,2,3) ) rocketData <- do.call(rbind, lapply(seq_len(500)-1, function(i) { rocketData\$y <- rocketData\$y - c(0,i/500); rocketData\$group <- i+1; rocketData })) rocketData2 <- data.frame( x = c(2, 2.25, 2), y = c(2, 2.5, 3) ) rocketData2 <- do.call(rbind, lapply(seq_len(500)-1, function(i) { rocketData2\$x[2] <- rocketData2\$x[2] - i*0.25/500; rocketData2\$group <- i+1 + 500; rocketData2 })) ggplot() + geom_link(aes(x=2, y=2, xend=3, yend=3, alpha=..index.., size = ..index..), colour='goldenrod', n=500) + geom_bezier(aes(x=x, y=y, group=group, colour=..index..), data=rocketData) + geom_bezier(aes(x=y, y=x, group=group, colour=..index..), data=rocketData) + geom_bezier(aes(x=x, y=y, group=group, colour=1), data=rocketData2) + geom_bezier(aes(x=y, y=x, group=group, colour=1), data=rocketData2) + geom_text(aes(x=1.65, y=1.65, label='vvv', angle=45), colour='white', size=15) + coord_fixed() + scale_x_reverse() + scale_y_reverse() + scale_alpha(range=c(1, 0), guide='none') + scale_size_continuous(range=c(20, 0.1), trans='exp', guide='none') + scale_color_continuous(guide='none') + xlab('') + ylab('') + ggtitle('ggforce: ggplot2') + theme(plot.title = element_text(size = 20))
##### LDA-ggplot2
MASS package data(iris)
##### corrplot
M <- cor(mtcars) ord <- corrMatOrder(M, order = "AOE") M2 <- M[ord,ord] corrplot.mixed(M2) corrplot.mixed(M2, lower = "ellipse", upper = "circle") corrplot.mixed(M2, lower = "square", upper = "circle") corrplot.mixed(M2, lower = "shade", upper = "circle") corrplot.mixed(M2, tl.pos = "lt") corrplot.mixed(M2, tl.pos = "lt", diag = "u") corrplot.mixed(M2, tl.pos = "lt", , diag = "l")
##### corrplot
data(mtcars) M <- cor(mtcars) ## different color series col1 <- colorRampPalette(c("#7F0000","red","#FF7F00","yellow","white", "cyan", "#007FFF", "blue","#00007F")) col2 <- colorRampPalette(c("#67001F", "#B2182B", "#D6604D", "#F4A582", "#FDDBC7", "#FFFFFF", "#D1E5F0", "#92C5DE", "#4393C3", "#2166AC", "#053061")) col3 <- colorRampPalette(c("red", "white", "blue")) col4 <- colorRampPalette(c("#7F0000","red","#FF7F00","yellow","#7FFF7F", "cyan", "#007FFF", "blue","#00007F")) wb <- c("white","black") par(ask = TRUE) ## different color scale and methods to display corr-matrix corrplot(M, method = "number", col = "black", cl.pos = "n") corrplot(M, method = "number") corrplot(M) corrplot(M, order = "AOE") corrplot(M, order = "AOE", addCoef.col = "grey") corrplot(M, order = "AOE", col = col1(20), cl.length = 21, addCoef.col = "grey") corrplot(M, order = "AOE", col = col1(10), addCoef.col = "grey") corrplot(M, order = "AOE", col = col2(200)) corrplot(M, order = "AOE", col = col2(200), addCoef.col = "grey") corrplot(M, order = "AOE", col = col2(20), cl.length = 21, addCoef.col = "grey") corrplot(M, order = "AOE", col = col2(10), addCoef.col = "grey")
##### ggmap
> world <- map_data("world") Attaching package: ‘maps’ The following object is masked from ‘package:plyr’: ozone > worldmap <- ggplot(world, aes(long, lat, group = group)) + + geom_path() + + scale_y_continuous(NULL, breaks = (-2:3) * 30, labels = NULL) + + scale_x_continuous(NULL, breaks = (-4:4) * 45, labels = NULL) > > worldmap + coord_map() > # Some crazier projections > worldmap + coord_map("ortho") > worldmap + coord_map("stereographic")
##### ggmap
> world <- map_data("world") Attaching package: ‘maps’ The following object is masked from ‘package:plyr’: ozone > worldmap <- ggplot(world, aes(long, lat, group = group)) + + geom_path() + + scale_y_continuous(NULL, breaks = (-2:3) * 30, labels = NULL) + + scale_x_continuous(NULL, breaks = (-4:4) * 45, labels = NULL) > > worldmap + coord_map() > # Some crazier projections > worldmap + coord_map("ortho") > worldmap + coord_map("stereographic")
##### ggplot2
ref: http://jdobr.es/blog/data-vis-with-ggplot/
##### ggplot2
ref: http://jdobr.es/blog/data-vis-with-ggplot/
##### chemmineR package.
data(sdfsample) (sdfset <- sdfsample) ## Plot single compound structure plotStruc(sdfset[[1]]) ## Plot several compounds structures plot(sdfset[1:4]) ## Highlighting substructures (here all rings) myrings <- as.numeric(gsub(".*_", "", unique(unlist(rings(sdfset[1]))))) plot(sdfset[1], colbonds=myrings) ## Customize plot plot(sdfset[1:4], griddim=c(2,2), print_cid=letters[1:4], print=FALSE, noHbonds=FALSE)
##### chemmineR package.
## Import SDFset sample set data(sdfsample) (sdfset <- sdfsample) ## Plot single compound structure plotStruc(sdfset[[1]]) ## Plot several compounds structures plot(sdfset[1:4]) ## Highlighting substructures (here all rings) myrings <- as.numeric(gsub(".*_", "", unique(unlist(rings(sdfset[1]))))) plot(sdfset[1], colbonds=myrings)
##### chemmineR package.
data(sdfsample) (sdfset <- sdfsample) ## Plot single compound structure plotStruc(sdfset[[1]]) ## Plot several compounds structures plot(sdfset[1:4])
##### chemmineR package.
data(sdfsample) sdfset <- sdfsample ## Create bond matrix for first two molecules in sdfset conMA(sdfset[1:2], exclude=c("H")) ## Return bond matrix for first molecule and plot its structure with atom numbering conMA(sdfset[[1]], exclude=c("H")) plot(sdfset[1], atomnum = TRUE, noHbonds=FALSE , no_print_atoms = "", atomcex=0.8) ref:https://www.bioconductor.org/packages/devel/bioc/manuals/ChemmineR/man/ChemmineR.pdf
##### grid package
dsmall <- diamonds[sample(nrow(diamonds), 1000), ] > library(grid) > a <- ggplot(dsmall, aes(color, price/carat)) + geom_jitter(size=4, alpha = I(1 / 1.5), aes(color=color)) > b <- ggplot(dsmall, aes(color, price/carat, color=color)) + geom_boxplot() > c <- ggplot(dsmall, aes(color, price/carat, fill=color)) + geom_boxplot() + theme(legend.position = "none") > grid.newpage() # Open a new page on grid device > pushViewport(viewport(layout = grid.layout(2, 2))) # Assign to device viewport with 2 by 2 grid layout > print(a, vp = viewport(layout.pos.row = 1, layout.pos.col = 1:2)) > print(b, vp = viewport(layout.pos.row = 2, layout.pos.col = 1)) > print(c, vp = viewport(layout.pos.row = 2, layout.pos.col = 2, width=0.3, height=0.3, x=0.8, y=0.8))
##### ggplot2
df <- data.frame(group = rep(c("Above", "Below"), each=10), x = rep(1:10, 2), y = c(runif(10, 0, 1), runif(10, -1, 0))) > p <- ggplot(df, aes(x=x, y=y, fill=group)) + geom_bar(stat="identity", position="identity") > p
##### ggplot2
ref: https://learnr.wordpress.com/page/4/ Dikesh Jariwala
##### Create Air Travel Route Maps in ggplot---R-bloggers
R-bloggers # Read flight list flights <- read.csv("flights.csv", stringsAsFactors = FALSE) # Lookup coordinates library(ggmap) airports <- unique(c(flights\$From, flights\$To)) coords <- geocode(airports) airports <- data.frame(airport=airports, coords) flights <- merge(flights, airports, by.x="To", by.y="airport") flights <- merge(flights, airports, by.x="From", by.y="airport") # Plot flight routes library(ggplot2) library(ggrepel) worldmap <- borders("world", colour="#efede1", fill="#efede1") # create a layer of borders ggplot() + worldmap + geom_curve(data=flights, aes(x = lon.x, y = lat.x, xend = lon.y, yend = lat.y), col = "#b29e7d", size = 1, curvature = .2) + geom_point(data=airports, aes(x = lon, y = lat), col = "#970027") + geom_text_repel(data=airports, aes(x = lon, y = lat, label = airport), col = "black", size = 2, segment.color = NA) + theme(panel.background = element_rect(fill="white"), axis.line = element_blank(), axis.text.x = element_blank(), axis.text.y = element_blank(), axis.ticks = element_blank(), axis.title.x = element_blank(), axis.title.y = element_blank() )
Funnel
##### qgraph
qgraph(dat.3[-c(1:3,13:15),],layout=L.3,nNodes=30,directed=FALSE,edge.labels=TRUE,esize=14)
##### qgraph
> dat.3 <- matrix(c(1:15*2-1,1:15*2),,2) > dat.3 <- cbind(dat.3,round(seq(-0.7,0.7,length=15),1)) > L.3 <- matrix(1:30,nrow=2) > # Different esize: > qgraph(dat.3,layout=L.3,directed=FALSE,edge.labels=TRUE,esize=14) > qgraph(dat.3[-c(1:3,13:15),],layout=L.3,nNodes=30,directed=FALSE, + edge.labels=TRUE,esize=14) > > qgraph(dat.3,layout=L.3,directed=FALSE,edge.labels=TRUE,esize=14,maximum=1) > title("by Volkan OBAN using R-qgraph package",line=2.5)
##### explodingboxplotR package
> library(explodingboxplotR) > > # use this to replicate > # from ?boxplot > #boxplot(count ~ spray, data = InsectSprays, col = "lightgray") > > exploding_boxplot( + data.frame( + rowname = rownames(InsectSprays), + InsectSprays, + stringsAsFactors = FALSE), + y = "count", + group = "spray", + color = "spray", + label = "rowname" + )
##### threejs
z <- seq(-10, 10, 0.1) x <- cos(z) y <- sin(z) scatterplot3js(x, y, z, color=rainbow(length(z)))
##### threejs
N <- 100 i <- sample(3, N, replace=TRUE) x <- matrix(rnorm(N*3),ncol=3) lab <- c("small", "bigger", "biggest") scatterplot3js(x, color=rainbow(N), labels=lab[i], size=i, renderer="canvas")
##### threejs
data(flights) # Approximate locations as factors dest <- factor(sprintf("%.2f:%.2f",flights[,3], flights[,4])) # A table of destination frequencies freq <- sort(table(dest), decreasing=TRUE) # The most frequent destinations in these data, possibly hub airports? frequent_destinations <- names(freq)[1:10] # Subset the flight data by destination frequency idx <- dest %in% frequent_destinations frequent_flights <- flights[idx, ] # Lat/long and counts of frequent flights ll <- unique(frequent_flights[,3:4]) # Plot frequent destinations as bars, and the flights to and from # them as arcs. Adjust arc width and color by frequency. globejs(lat=ll[,1], long=ll[,2], arcs=frequent_flights, arcsHeight=0.3, arcsLwd=2, arcsColor="#ffff00", arcsOpacity=0.15, atmosphere=TRUE, color="#00aaff", pointsize=0.5)
##### threejs
library(rgdal) library(threejs) # Download MODIS 16-day 1 degree Vegetation Index data manually from # http://neo.sci.gsfc.nasa.gov/view.php?datasetId=MOD13A2_M_NDVI # or use the following cached copy from May 25, 2014 cache <- tempfile() writeBin( readBin( url("http://illposed.net/nycr2015/MOD13A2_E_NDVI_2014-05-25_rgb_360x180.TIFF", open="rb"), what="raw", n=1e6), con=cache) x <- readGDAL(cache) # Obtain lat/long coordinates and model values as a data.frame x <- as.data.frame(cbind(coordinates(x), x@data[,1])) names(x) <- c("long","lat","value") # Remove ocean areas and NA values x <- x[x\$value < 255,] x <- na.exclude(x) # Cut the values up into levels corresponding to the # 99th, 95th, 90th, percentiles and then all the rest. x\$q <- as.numeric( cut(x\$value, breaks=quantile(x\$value, probs=c(0,0.90,0.95,0.99,1)), include.lowest=TRUE)) # Colors for each level col = c("#0055ff","#00aaff","#00ffaa","#aaff00")[x\$q] # bling out the data globejs(lat=x\$lat, long=x\$long, val=x\$q^3, # Bar height color=col, pointsize=0.5, atmosphere=TRUE)
##### DiagrammeR
library(DiagrammeR) > > create_random_graph(140, 100, set_seed = 23) %>% + join_node_attrs(get_w_connected_cmpts(.)) %>% + select_nodes_by_id(get_articulation_points(.)) %>% + set_node_attrs_ws("peripheries", 2) %>% + set_node_attrs_ws("width", 0.65) %>% + set_node_attrs_ws("height", 0.65) %>% + set_node_attrs_ws("penwidth", 3) %>% + clear_selection() %>% + add_global_graph_attrs( + attr = + c("color", "penwidth", "width", "height"), + value = + c("gray80", "3", "0.5", "0.5"), + attr_type = + c("edge", "edge", "node", "node")) %>% + colorize_node_attrs( + node_attr_from = "wc_component", + node_attr_to = "fillcolor", + alpha = 80) %>% + set_node_attr_to_display() %>% + select_nodes_by_degree("deg >= 3") %>% + trav_both_edge() %>% + set_edge_attrs_ws("penwidth", 4) %>% + set_edge_attrs_ws("color", "gray60") %>% + clear_selection() %>% + render_graph()
##### highcharter package.
ref. and code: https://www.r-bloggers.com/giving-a-thematic-touch-to-your-interactive-chart/
##### highcharter package.theme
ref: https://www.r-bloggers.com/giving-a-thematic-touch-to-your-interactive-chart/
##### spnet package
data(world.map.simplified, package = "spnet") graph.map.plot.position(world.map.simplified) graph.map.plot.position(world.map.simplified, cex = 0.4) graph.map.plot.position(world.map.simplified, label = 'ID ', cex = 0.3)
##### ndtv
ref: https://cran.r-project.org/web/packages/ndtv/ndtv.pdf
##### ndtv
data(McFarland_cls33_10_16_96) coords<-plot(cls33_10_16_96) # center layout coords with 100 unit area layout.center(coords,xlim=c(0,100),ylim=c(0,100)) # rescale layout coords to unit interval layout.normalize(coords)
##### qgraph
ref:https://cran.r-project.org/web/packages/qgraph/qgraph.pdf
##### tsna
library(networkDynamicData) data(vanDeBunt_students) times<-get.change.times(vanDeBunt_students) vanDProj<-timeProjectedNetwork(vanDeBunt_students,onsets = times,termini = times) # plot it with gray for the time edges plot(vanDProj, arrowhead.cex = 0, edge.col=ifelse(vanDProj%e%'edge.type'=='within_slice','black','gray'),vertex.cex=0.7,mode='kamadakawai')
##### geomnet
library(geomnet) > library(dplyr) > # create plot > ggplot(data = soccernet, aes(from_id = home, to_id = away)) + + geom_net(aes(colour = div, group = div), ealpha = .25, + layout.alg = 'fruchtermanreingold') + + facet_wrap(~season) + + theme_net()
##### geomnet
> ggplot(data = lesmisnet, aes(from_id = from, to_id = to, + linewidth = degree / 5 + 0.1 )) + + geom_net(aes(size = degree, alpha = degree), + colour = "grey30", ecolour = "grey60", + layout.alg = "fruchtermanreingold", labelon = TRUE, vjust = -0.75) + + scale_alpha(range = c(0.3, 1)) + theme_net() + ggtitle("by Volkan OBAN using R - geomnet")
##### geomnet
data(football) ftnet <- fortify(as.edgedf(football\$edges), football\$vertices) p <- ggplot(data=ftnet, aes(from_id=from_id, to_id=to_id)) p + geom_net(aes(colour=value), linewidth=0.75, size=4.5, ecolour="grey80") + scale_colour_brewer("Conference", palette="Paired") + theme_net() + theme(legend.position="bottom")
##### geomnet
emailnet <- fortify(emailedges, email\$nodes, group = "day") Joining edge and node information by from_id and label respectively. > ggplot(data = emailnet, aes(from_id = from, to_id = to_id)) + + geom_net(aes(colour= CurrentEmploymentType), linewidth=0.5, fiteach=TRUE) + + scale_colour_brewer(palette="Set2") + facet_wrap(~day, nrow=2) + theme(legend.position="bottom") + ggtitle("by Volkan OBAN using R - geomnet")
##### geomnet
emailedges <- as.edgedf(subset(email\$edges, nrecipients < 54)) emailnet <- fortify(emailedges, email\$nodes) #no facets ggplot(data = emailnet, aes(from_id = from_id, to_id = to_id)) + geom_net(aes(colour= CurrentEmploymentType), linewidth=0.5) + scale_colour_brewer(palette="Set2")
##### geomnet
data(theme_elements) TEnet <- fortify(as.edgedf(theme_elements\$edges[,c(2,1)]), theme_elements\$vertices) ggplot(data = TEnet, aes(from_id = from_id, to_id = to_id)) + geom_net(labelon=TRUE, vjust=-0.5)
##### geomnet
library(geomnet) Zorunlu paket yükleniyor: ggplot2 > data(blood) > p <- ggplot(data = blood\$edges, aes(from_id = from, to_id = to)) > p + geom_net(vertices=blood\$vertices, aes(colour=..type..)) + theme_net() > > bloodnet <- fortify(as.edgedf(blood\$edges), blood\$vertices) Using from as the from node column and to as the to node column. If this is not correct, rewrite dat so that the first 2 columns are from and to node, respectively. Joining edge and node information by from_id and label resp