_ | 覦覈襦 | 豕蠏手 | 殊螳 | 譯殊碁
FrontPage › R蠏碁曙-

Contents

1 3d surface
2 magick
3 蠏碁9覲 覿襯 3谿る所 覲伎願鍵(ggjoy)
4 ggplot x豢 觜蠍
5 谿 plot
6 覯觚谿(bubble chart)
7 area chart 螻, 覯(~) 豺蠍
8 伎豢
9 abline, legend
10 誤磯磯 襦
11 xlab, ylab, title 譟一
12 text
13 parallel plot?
14 覯襦 蠏碁狩蠍 譟一
15 x豢 朱襖覦蠑瑚鍵
16 x豢 讌
17 ggplot2::stat_density2d()
18 boxplot.2d
19 蠍磯蓋 scatter plot
20 襷一る 企Ν 螳 願鍵
21 smoothScatter
22 ggpairs
23 pairs(貉れろ磯伎)
24 Spider(Radar) Chart


1 3d surface #

https://stackoverflow.com/questions/41700400/smoothing-3d-plot-in-r
library(mgcv)

x<- rnorm(200)
y<- rnorm(200)
z<-rnorm(200)

tab<-data.frame(x,y,z)
tab

#surface wireframe:

mod <- gam(z ~ te(x, y), data = tab)

library(rgl)
library(deldir)

zfit <- fitted(mod)
col <- cm.colors(20)[1 + 
         round(19*(zfit - min(zfit))/diff(range(zfit)))]

persp3d(deldir(x, y, z = zfit), col = col)
aspect3d(1, 2, 1)
3d_surface.png


4 ggplot x豢 觜蠍 #

ggplot(df1, aes(x=grp, y=val)) + geom_boxplot(outlier.shape = NA) + ylim(0, 30) + theme(axis.text.x = element_text(angle = 90, hjust = 1))
  • 45 觜蠍: theme(axis.text.x = element_text(angle = 45, hjust = 1))
  • 90 觜蠍: theme(axis.text.x = element_text(angle = 90, hjust = 1))

5 谿 plot #

--Practical Data Science with R, ISBN 978-1-61729-156-2
d <- data.frame(y=(1:10)^2,x=1:10)
model <- lm(y~x,data=d)
d$prediction <- predict(model,newdata=d)

library('ggplot2')
ggplot(data=d) + geom_point(aes(x=x,y=y)) +
geom_line(aes(x=x,y=prediction),color='blue') +
geom_segment(aes(x=x,y=prediction,yend=y,xend=x)) +
scale_y_continuous('')

6 覯觚谿(bubble chart) #

dfx = data.frame(ev1=1:10, ev2=sample(10:99, 10), ev3=10:1)
symbols(x=dfx$ev1, y=dfx$ev2, circles=dfx$ev3, inches=1/3, ann=F, bg="steelblue2", fg=NULL)

7 area chart 螻, 覯(~) 豺蠍 #

polygon(c(x, rev(x)), c(y$upr, rev(y$lwr)), col = "gray", border = NA)

8 伎豢 #

plotrix れ 谿瑚 覦 豢豌 --> http://rpubs.com/cardiomoon/19042
library("plotrix")
going_up <- seq(3, 7, by = 0.5) + rnorm(9)
going_down <- rev(60:74) + rnorm(15)

twoord.plot(2:10, going_up, 1:15, going_down, xlab = "Sequence", ylab = "Ascending values", 
            rylab = "Descending values", lcol = 4, main = "Plot with two ordinates - points and lines", 
            do.first = "plot_bg();grid(col=\"white\",lty=1)")

twoord.plot(2:10, going_up, 1:15, going_down, xlab = "Sequence", lylim = range(going_up) + 
              c(-1, 10), rylim = range(going_down) + c(-10, 2), ylab = "Ascending values", 
            ylab.at = 5, rylab = "Descending values", rylab.at = 65, lcol = 4, main = "Plot with two ordinates - separated lines", 
            lytickpos = 3:7, rytickpos = seq(55, 75, by = 5), do.first = "plot_bg();grid(col=\"white\",lty=1)")

るジ
set.seed(2015-04-13)

d = data.frame(x =seq(1,10),
           n = c(0,0,1,2,3,4,4,5,6,6),
           logp = signif(-log10(runif(10)), 2))

#譬
par(mar = c(5,5,2,5))
with(d, plot(x, logp, type="l", col="red3", 
             ylab=expression(-log[10](italic(p))),
             ylim=c(0,3)))

#
par(new = T)
with(d, plot(x, n, pch=16, axes=F, xlab=NA, ylab=NA, cex=1.2))
axis(side = 4)
mtext(side = 4, line = 3, 'Number genes selected')
legend("topleft",
       legend=c(expression(-log[10](italic(p))), "N genes"),
       lty=c(1,0), pch=c(NA, 16), col=c("red3", "black"))
--豢豌: http://www.r-bloggers.com/r-single-plot-with-two-different-y-axes/

9 abline, legend #

library(party)
library(caret)
gtree <- ctree(Species ~ ., data = iris)
plot(gtree)

attach(iris)
colour <- c("black", "red", "blue")
plot(Petal.Width, Petal.Length, pch=20, col=c(colour[Species]))
abline(h=4.8, col="blue", lty=2);text(0.75,5,"Petal.Length > 4.8", col="blue")
abline(h=1.9, col="black", lty=2);text(1,2.2,"Petal.Length > 1.9", col="black")
abline(v=1.7, col="red", lty=2);text(2,4,"Petal.Width > 1.7", col="red")
legend(0.1, 6.5, c("setosa","versicolor", "virginica"), pch=20, col=colour)

11 xlab, ylab, title 譟一 #

for(i in 1:max(cl$cluster)){
  p_cluster <- ggplot(tmp[tmp$cluster == i, ], aes(x=variable, y=value, colour=factor(cluster))) 
  p_cluster + geom_line() + ggtitle(paste0("cluster", i))+theme(axis.text=element_text(size=20),
  axis.title=element_text(size=20,face="bold"),plot.title=element_text(family="Times", face="bold", size=20))
  ggsave(file=paste0("c:\\plot\\cluster", i, ".png"))  
}

12 text #

prior <- seq(0, 1, 0.1)
posterior <- (piror*1/2)/(piror*1/2+(1-piror)*0.09)
plot(prior, posterior, main="豺語", type="l")
abline(0,1)
abline(h=0.5, v=0.5)
point_label <- paste0("(", prior,", ", round(posterior, 3), ")")
text(prior, posterior, point_label, cex=0.8, pos=4, col="red") 

14 覯襦 蠏碁狩蠍 譟一 #

p<-ggplot(df, aes(x=殊, y=蟆, colour=ルゴ)) + geom_point(size=4) + facet_wrap( ~ 蟲螳, nrow=3)
p + theme(
        strip.text.x = element_text(size=20), 
        legend.title = element_text(size=20, face="bold"), 
        legend.text = element_text(size = 20, face = "bold")) + 
    guides(size=10,colour = guide_legend(override.aes = list(size=7))) 

15 x豢 朱襖覦蠑瑚鍵 #

plot(tmp1$stage_no, tmp1$md, axes = FALSE, xlab="ろ伎", ylab="豌危")
axis(1, tmp1$stage_no,tmp1$stage_nm, las=2) #las=2 朱襖 碁襦
axis(2);box()

16 x豢 讌 #

library(ggplot2)
library("scales") #date_format()

ggplot(loess.df, aes(x=dt, y=s)) + geom_point() + geom_smooth() + 
    labs(x = "殊", y = " リ覈()") +
    scale_x_date(labels = date_format("%Y-%m"))

#xaxt='n' 旧 譴狩.
plot(df$dt, df$amt, type="l", xaxt='n')
axis.Date(side=1, df$dt, format = "%Y-%m-%d")

#strptime(x1, "%Y-%m-%d %H:%M:%OS")

17 ggplot2::stat_density2d() #

2谿 蠏碁襦 一襦 覲伎伎 一危磯れ 蠏碁9 覲蠍 譬.
rs <- data.frame()
for(i in 1:4){
    x <- c(rnorm(200,0,i),rnorm(200,4,i))
    y <- c(rnorm(200,0,i),rnorm(200,4,i))
    grp <- replicate(length(x), i)
    rs <- rbind(rs, data.frame(grp, x, y))
}

library(ggplot2)
p <- ggplot(rs, aes(x=x, y=y)) 
p + stat_density2d() + facet_wrap( ~ grp, nrow=2)
stat_density2d.png

18 boxplot.2d #

#install.packages("hdrcde")
library("hdrcde")
 
x <- c(rnorm(200,0,1),rnorm(200,4,1))
y <- c(rnorm(200,0,1),rnorm(200,4,1))

par(mfrow=c(2,2))
plot(x,y, pch="+", cex=.5)
hdr.boxplot.2d(x,y)
plot(hdr.2d(x, y), pointcol="red", show.points=TRUE, pch=3)
par(mfrow=c(1,1))
hdr.png

19 蠍磯蓋 scatter plot #

colour <- c("red", "blue", "black")
plot(iris$Sepal.Length, iris$Sepal.Width, col=c(colour[iris$Species]))
basic_scatter_plot.png

20 襷一る 企Ν 螳 願鍵 #

plot(dau ~ dau_pred, data=grossing)

identify() 襯 覃 螻 螳れ 企Ν esc襯 襯企 谿語 企Ν 螻褐 螳 語.
#rowname() 谿語 谿.
identify(grossing$dau_pred, grossing$dau, labels=row.names(grossing)) 

#x,y螳 谿. 覓朱 esc襯   襦 rowname 豢ル.
identify(grossing$dau_pred, grossing$dau, labels=paste0("x=",grossing$dau_pred, "\ny=", grossing$dau)) 

貊 identify() 襴 企Ν襷 螳 .
repeat {
  click.loc <- locator(1)
  if(!is.null(click.loc)){
      text( x = click.loc$x, y = click.loc$y, 
            labels = paste0("x=",round(click.loc$x,0), "\ny=", round(click.loc$y)), 
            cex = 0.8, col = "blue" )
  } 
  else break
}

21 smoothScatter #

朱朱 一(scatter plot)襯 蠏碁Μ覃 れ螻 螳.
plot(x,y)
smoothScatter01.png

蠏碁磯, 一危一 襷朱 螳 一危一 覿襯 蠍 企給. smoothScatter() 企 企れ 蠏豪概 蟆 螳 伎. 蠏碁殊 覲企 3螳 蟲一 蟆 .
library(graphics)
smoothScatter(x, y)
smoothScatter02.png

22 ggpairs #

pairs() data.frame 一襯 蠏碁れ. 豌企 覲願 襷讌襷, 襷 覲企ゼ 譴 一 . 蠏瑚 ggpairs(). 襴る 蟆.
library("GGally")
ggpairs(iris)
ggpairs.png

23 pairs(貉れろ磯伎) #

panel.cor <- function(x, y, digits=2, prefix="", cex.cor, ...) {
    usr <- par("usr")
    on.exit(par(usr))
    par(usr = c(0, 1, 0, 1))
    r <- abs(cor(x, y, use="complete.obs"))
    txt <- format(c(r, 0.123456789), digits=digits)[1]
    txt <- paste(prefix, txt, sep="")
    if(missing(cex.cor)) cex.cor <- 0.8/strwidth(txt)
    text(0.5, 0.5, txt, cex =  cex.cor * (1 + r) / 2)
}
    
panel.hist <- function(x, ...) {
  usr <- par("usr")
  on.exit(par(usr))
  par(usr = c(usr[1:2], 0, 1.5) )
  opar=par(ps=30) #font-size
  h <- hist(x, plot = FALSE)
  breaks <- h$breaks
  nB <- length(breaks)
  y <- h$counts
  y <- y/max(y)
  rect(breaks[-nB], 0, breaks[-1], y, col="white", ...)
}

panel.lm <- function (x, y, col = par("col"), bg = NA, pch = par("pch"),
                            cex = 1, col.smooth = "black", ...) {
    points(x, y, pch = pch, col = col, bg = bg, cex = cex)
    abline(stats::lm(y ~ x),  col = col.smooth, ...)
}

pairs(iris, pch=".",
                   upper.panel = panel.cor,
                   diag.panel  = panel.hist,
                   lower.panel = panel.lm)


# 觜覈
panel.lowess <- function (x, y, col = par("col"), bg = NA, pch = par("pch"),
                            cex = 1, col.smooth = "black", ...) {
    points(x, y, pch = pch, col = col, bg = bg, cex = cex)
    lines(lowess(x,y))
}

pairs(iris, pch=".",
                   upper.panel = panel.cor,
                   diag.panel  = panel.hist,
                   lower.panel = panel.lowess)
pairs.png

24 Spider(Radar) Chart #

tmp <- df[df$job_id == i, 4:7]
title <- head(df[df$job_id == i, 2],1)
tmp <- rbind(rep(12000,4) , rep(0,4), tmp) #max, min螳 誤伎 .
rownames(tmp) <- c("1", "2", "Active", "Churn")
colors_border <- c( rgb(0.2,0.5,0.5,0.9), rgb(0.8,0.2,0.5,0.9) , rgb(0.7,0.5,0.1,0.9) )
colors_in <- c( rgb(0.2,0.5,0.5,0.4), rgb(0.8,0.2,0.5,0.4) , rgb(0.7,0.5,0.1,0.4))
#radarchart(tmp, axistype=1, pcol=colors_border, plwd=2, plty=1, axislabcol="grey", cglcol="gray", caxislabels=seq(0,12000,2000), cglwd=0.8, vlcex=0.8, seg=4, title=title)
radarchart(tmp, axistype=1, pcol=colors_border, plwd=2, plty=1, axislabcol="grey", cglcol="gray", caxislabels=seq(0,12000,2000), cglwd=0.8, vlcex=0.8, seg=4, title="")
legend(x=0.7, y=1, legend = rownames(tmp[-c(1,2),]), bty = "n", pch=20 , col=colors_in , text.col = "black", cex=1.2, pt.cex=3)

覦 覲企れ. 螳. -- shanmdphd 2017-05-25 14:42:48
蠍 蠍郁鍵..
企: : るジ讓曙 襦螻豺 企Ν 譯殊語. 襦螻豺
EditText : Print : Mobile : FindPage : DeletePage : LikePages : Powered by MoniWiki : Last modified 2019-10-01 13:18:49

企 蠍郁 企 覦蟆 .