Nothing
# Copyright 2017 Steven E. Pav. All Rights Reserved.
# Author: Steven E. Pav
# This file is part of ggallin.
#
# ggallin is free software: you can redistribute it and/or modify
# it under the terms of the GNU Lesser General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# ggallin is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser General Public License
# along with ggallin. If not, see <http://www.gnu.org/licenses/>.
# env var:
# nb:
# see also:
# todo:
# changelog:
#
# Created: 2017.09.29
# Copyright: Steven E. Pav, 2017-2017
# Author: Steven E. Pav
# Comments: Steven E. Pav
# helpers#FOLDUP
set.char.seed <- function(str) {
set.seed(as.integer(charToRaw(str)))
}
#UNFOLD
library(ggplot2)
library(scales)
# setup
tmpf <- tempfile(fileext='.png')
#cat('printing to ',tmpf,'\n')
png(tmpf)
context("geom_cloud runs")#FOLDUP
test_that("basic usage",{#FOLDUP
set.char.seed("b78cd6ea-03b8-4346-a23f-3190bafcd74e")
set.seed(2134)
nobs <- 200
mydat <- data.frame(grp=sample(c(0,1),nobs,replace=TRUE),
colfac=sample(letters[1:2],nobs,replace=TRUE),
rowfac=sample(letters[10 + (1:3)],nobs,replace=TRUE))
mydat$x <- seq(0,1,length.out=nobs) + 0.33 * mydat$grp
mydat$y <- 0.25 * rnorm(nobs) + 2 * mydat$grp
mydat$grp <- factor(mydat$grp)
mydat$se <- sqrt(mydat$x)
ph <- ggplot(mydat,aes(x=x,y=y,ymin=y-se,ymax=y+se,color=grp)) +
facet_grid(rowfac ~ colfac) +
geom_line() +
geom_errorbar() +
labs(title='uncertainty by errorbar')
print(ph)
ph <- ggplot(mydat,aes(x=x,y=y,ymin=y-se,ymax=y+se,fill=grp)) +
facet_grid(rowfac ~ colfac) +
geom_line() +
geom_cloud(steps=15,max_alpha=0.85) +
labs(title='uncertainty by cloudr')
print(ph)
# sentinel
expect_true(TRUE)
})#UNFOLD
#UNFOLD
context("misc transforms work")#FOLDUP
test_that("basic usage",{#FOLDUP
set.char.seed("5ad1ee23-bd0b-4b08-ac77-0d2addcbed7d")
ph <- ggplot(data.frame(x=rnorm(100),y=runif(100)),aes(x=x,y=y)) +
geom_point() +
scale_x_continuous(trans=ssqrt_trans)
print(ph)
ph <- ggplot(data.frame(x=rnorm(100),y=runif(100)),aes(x=x,y=y)) +
geom_point() +
scale_x_continuous(trans=pseudolog10_trans)
print(ph)
# sentinel
expect_true(TRUE)
})#UNFOLD
#UNFOLD
context("interpolation transforms work")#FOLDUP
test_that("interp trans",{#FOLDUP
set.char.seed("75745a61-3841-4e19-8fff-9e5781945182")
set.seed(1234)
ph <- ggplot(data.frame(x=rnorm(100),y=runif(100)),aes(x=x,y=y)) +
geom_point() +
scale_x_continuous(trans=interp_trans(x=seq(-10,10,by=1),y=cumsum(runif(21))))
print(ph)
set.seed(1234)
ph <- ggplot(data.frame(x=rnorm(100),y=runif(100)),aes(x=x,y=y)) +
geom_point() +
scale_x_continuous(trans=interp_trans(data=data.frame(x=seq(-10,10,by=1),y=cumsum(runif(21)))))
print(ph)
set.seed(1234)
ph <- ggplot(data.frame(x=rnorm(100),y=runif(100)),aes(x=x,y=y)) +
geom_point() +
scale_x_continuous(trans=interp_trans(data.frame(x=seq(-10,10,by=1),y=cumsum(runif(21)))))
print(ph)
# this is like trans_sqrt:
set.seed(1234)
myx <- seq(0,5,by=0.01)
ph <- ggplot(data.frame(x=rnorm(100),y=runif(100)),aes(x=x,y=y)) +
geom_point() +
scale_y_continuous(trans=interp_trans(x=myx,y=sqrt(myx)))
print(ph)
# try interp trans on dates !
myx <- as.Date(seq(0,1000,by=1),origin='1970-01-01')
ph <- ggplot(data.frame(x=myx[1:100],y=runif(100)),aes(x=x,y=y)) +
geom_point() +
scale_y_continuous(trans=interp_trans(x=myx,y=sqrt(seq_along(myx))))
print(ph)
# sentinel
expect_true(TRUE)
})#UNFOLD
test_that("warp trans",{#FOLDUP
set.char.seed("421d6cc8-70cc-4a03-90ac-97c58e9bfa5b")
set.seed(1234)
ph <- ggplot(data.frame(x=rnorm(100),y=runif(100)),aes(x=x,y=y)) +
geom_point() +
scale_x_continuous(trans=warp_trans(x=seq(-10,10,by=1),w=runif(21)))
print(ph)
# equivalently:
set.seed(1234)
ph <- ggplot(data.frame(x=rnorm(100),y=runif(100)),aes(x=x,y=y)) +
geom_point() +
scale_x_continuous(trans=warp_trans(data=data.frame(x=seq(-10,10,by=1),w=runif(21))))
print(ph)
# negatives ok
set.seed(1234)
ph <- ggplot(data.frame(x=rnorm(100),y=runif(100)),aes(x=x,y=y)) +
geom_point() +
scale_x_continuous(trans=warp_trans(data=data.frame(x=seq(-10,10,by=1),w=-runif(21))))
print(ph)
# not sorted x
set.seed(1234)
ph <- ggplot(data.frame(x=rnorm(100),y=runif(100)),aes(x=x,y=y)) +
geom_point() +
scale_x_continuous(trans=warp_trans(data=data.frame(x=rev(seq(-10,10,by=1)),w=runif(21))))
print(ph)
# equivalently:
set.seed(1234)
ph <- ggplot(data.frame(x=rnorm(100),y=runif(100)),aes(x=x,y=y)) +
geom_point() +
scale_x_continuous(trans=warp_trans(data.frame(x=seq(-10,10,by=1),w=runif(21))))
print(ph)
# try warp trans on dates !
myx <- as.Date(seq(0,1000,by=1),origin='1970-01-01')
ph <- ggplot(data.frame(x=myx[1:100],y=runif(100)),aes(x=x,y=y)) +
geom_point() +
scale_y_continuous(trans=warp_trans(x=myx,w=0.1*sqrt(seq_along(myx))))
print(ph)
# sentinel
expect_true(TRUE)
})#UNFOLD
#UNFOLD
context("compose transforms work")#FOLDUP
test_that("basic usage",{#FOLDUP
set.char.seed("f8c79fa5-680c-41b0-8dd6-e337b315cd08")
# compose transformatins with %of%:
ph <- ggplot(data.frame(x=rnorm(100),y=exp(rnorm(100,mean=-2,sd=4))),aes(x=x,y=y)) +
geom_point() +
scale_y_continuous(trans=scales::reverse_trans() %of% scales::log10_trans())
print(ph)
# reverse a warp trans on dates
myx <- as.Date(seq(0,1000,by=1),origin='1970-01-01')
ph <- ggplot(data.frame(x=myx[1:100],y=runif(100)),aes(x=x,y=y)) +
geom_point() +
scale_y_continuous(trans=scales::reverse_trans() %of% warp_trans(x=myx,w=0.1*sqrt(seq_along(myx))))
print(ph)
# sentinel
expect_true(TRUE)
})#UNFOLD
#UNFOLD
# teardown:
dev.off()
unlink(tmpf)
#for vim modeline: (do not edit)
# vim:ts=2:sw=2:tw=79:fdm=marker:fmr=FOLDUP,UNFOLD:cms=#%s:syn=r:ft=r:ai:si:cin:nu:fo=croql:cino=p0t0c5(0:
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.