geom_smooth()#183

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
cpsievert merged 11 commits into from
Mar 12, 2015
Merged

geom_smooth() #183

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
11 commits
Select commit Hold shift + click to select a range
b0ca230
Introducing geom_smooth()
cpsievert Mar 10, 2015
9b5bbf3
save_outputs of smooth tests
cpsievert Mar 10, 2015
a5da68d
Fix default line colour for smooth
cpsievert Mar 10, 2015
edf669a
Merge branch 'master' of https://github.com/ropensci/plotly into cars…
cpsievert Mar 10, 2015
30813df
Merge branch 'master' of https://github.com/ropensci/plotly into cars…
cpsievert Mar 11, 2015
91e6e3d
Add scatterplot cookbook tests; geom_smooth now respects group aes
cpsievert Mar 11, 2015
2378655
Bump version; update NEWS
cpsievert Mar 11, 2015
7a3430c
Don't showlegend for line trace of geom_smooth
cpsievert Mar 12, 2015
4ac88f0
Draw ribbon first
cpsievert Mar 12, 2015
cbe301b
Avoid geom specific code in ggplotly.R
cpsievert Mar 12, 2015
a97ba2b
Fix typo; remove commented code
cpsievert Mar 12, 2015
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion DESCRIPTION
View file
Open in desktop
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
Package: plotly
Type: Package
Title: Interactive, publication-quality graphs online.
Version: 0.5.24
Version: 0.5.25
Authors@R: c(person("Chris", "Parmer", role = c("aut", "cre"),
email = "chris@plot.ly"),
person("Scott", "Chamberlain", role = "aut",
Expand Down
8 changes: 6 additions & 2 deletions NEWS
View file
Open in desktop
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,14 @@
0.5.25 -- 10 March 2015

Implemented geom_smooth() #183

0.5.24 -- 10 March 2015

Implemented #167
Implemented facet_wrap(scales="free") #167

0.5.23 -- 10 March 2015.

geom_ribbon now respects alpha transparency
geom_ribbon() now respects alpha transparency

0.5.22 -- 2 March 2015.

Expand Down
2 changes: 1 addition & 1 deletion R/ggplotly.R
View file
Open in desktop
Original file line numberDiff line numberDiff line change
Expand Up@@ -218,7 +218,7 @@ gg2list <- function(p){

# This extracts essential info for this geom/layer.
traces <- layer2traces(L, df, misc)

possible.legends <- markLegends[[L$geom$objname]]
actual.legends <- possible.legends[possible.legends %in% names(L$mapping)]
layer.legends[[paste(i)]] <- actual.legends
Expand Down
34 changes: 32 additions & 2 deletions R/trace_generation.R
View file
Open in desktop
Original file line numberDiff line numberDiff line change
Expand Up@@ -13,6 +13,7 @@ layer2traces <- function(l, d, misc) {
g <- list(geom=l$geom$objname,
data=not.na(d),
prestats.data=not.na(misc$prestats.data))

# needed for when group, etc. is an expression.
g$aes <- sapply(l$mapping, function(k) as.character(as.expression(k)))
# Partial conversion for geom_violin (Plotly does not offer KDE yet)
Expand All@@ -22,6 +23,22 @@ layer2traces <- function(l, d, misc) {
probability density estimation is not supported in Plotly yet.")
}

# geom_smooth() means geom_line() + geom_ribbon()
# Note the line is always drawn, but ribbon is not if se = FALSE.
if (g$geom == "smooth") {
# If smoothLine has been compiled already, consider smoothRibbon.
if (isTRUE(misc$smoothLine)) {
misc$smoothLine <- FALSE
if (isTRUE(l$stat_params$se == FALSE)) {
return(NULL)
} else {
g$geom <- "smoothRibbon"
}
} else {
misc$smoothLine <- TRUE
g$geom <- "smoothLine"
}
}
# Barmode and bargap
barmode <- "group"
if (g$geom == "bar" || g$geom == "histogram") {
Expand DownExpand Up@@ -187,7 +204,6 @@ layer2traces <- function(l, d, misc) {
data.list <- structure(list(list(data=basic$data, params=basic$params)),
names=basic$params$name)
}

getTrace <- geom2trace[[basic$geom]]
if(is.null(getTrace)){
warning("Conversion not implemented for geom_",
Expand DownExpand Up@@ -282,7 +298,13 @@ layer2traces <- function(l, d, misc) {
}
no.sort[[tr.i]]$sort <- NULL
}
no.sort
# if line portion of geom_smooth was compiled, call layer2traces()
# again for ribbon portion
if (isTRUE(misc$smoothLine)) {
c(layer2traces(l, d, misc), no.sort)
} else {
no.sort
}
}#layer2traces


Expand DownExpand Up@@ -378,6 +400,14 @@ toBasic <- list(
g$params$sizemax <- max(g$prestats.data$globsizemax)
}
g
},
smoothLine=function(g) {
if (length(unique(g$data$group)) == 1) g$params$colour <- "#3366FF"
group2NA(g, "path")
},
smoothRibbon=function(g) {
if (is.null(g$params$alpha)) g$params$alpha <- 0.1
group2NA(g, "ribbon")
}
)

Expand Down
74 changes: 74 additions & 0 deletions tests/testthat/test-cookbook-scatterplots.R
View file
Open in desktop
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,74 @@
set.seed(955)
# Make some noisily increasing data
dat <- data.frame(cond = rep(c("A", "B"), each=10),
xvar = c(1.475957, -3.423712, 1.966129, 5.575364, 2.954719, 2.768286, 3.507499, 6.945000, 12.135050, 10.231673, 13.040393, 12.231689, 13.506993, 13.590874, 15.455178, 28.431185, 17.758937, 24.730797, 22.954238, 21.122766),
yvar = c(-1.315387, 3.323239, 4.452183, 4.597885, 5.697203, 5.991221, 5.764561, 10.163165, 14.805634, 11.447913, 12.163597, 10.930851, 13.491366, 11.800783, 19.246991, 13.870457, 11.031923, 22.700302, 24.877547, 22.520114))
# cond xvar yvar
# A -4.252354091 3.473157275
# A 1.702317971 0.005939612
# ...
# B 17.793359218 19.718587761
# B 19.319909163 19.647899863

g <- ggplot(dat, aes(x=xvar, y=yvar)) +
geom_point(shape=1) # Use hollow circles
save_outputs(g, "scatterplots-hollow")

g <- ggplot(dat, aes(x=xvar, y=yvar)) +
geom_point(shape=1) +
geom_smooth(method=lm) # Add linear regression line
save_outputs(g, "scatterplots-smooth-lm")

g <- ggplot(dat, aes(x=xvar, y=yvar)) +
geom_point(shape=1) +
geom_smooth(method=lm, se=FALSE) # Don't add shaded confidence region
save_outputs(g, "scatterplots-smooth-lm-se-false")


g <- ggplot(dat, aes(x=xvar, y=yvar)) +
geom_point(shape=1) + # Use hollow circles
geom_smooth() # Add a loess smoothed fit curve with confidence region
save_outputs(g, "scatterplots-loess")

# Set color by cond
g <- ggplot(dat, aes(x=xvar, y=yvar, color=cond)) + geom_point(shape=1)
save_outputs(g, "scatterplots-color")

# # Same, but with different colors and add regression lines
g <- ggplot(dat, aes(x=xvar, y=yvar, color=cond)) + geom_point(shape=1) +
scale_colour_hue(l=50) + # Use a slightly darker palette than normal
geom_smooth(method=lm, se=FALSE)
save_outputs(g, "scatterplots-scale-color-hue")

# Extend the regression lines beyond the domain of the data
g <- ggplot(dat, aes(x=xvar, y=yvar, color=cond)) + geom_point(shape=1) +
scale_colour_hue(l=50) +
geom_smooth(method=lm, se=FALSE, fullrange=T)
save_outputs(g, "scatterplots-full-range")

# Set shape by cond
g <- ggplot(dat, aes(x=xvar, y=yvar, shape=cond)) + geom_point()
save_outputs(g, "scatterplots-shape")

# Same, but with different shapes
g <- ggplot(dat, aes(x=xvar, y=yvar, shape=cond)) + geom_point() +
scale_shape_manual(values=c(1,2)) # Use a hollow circle and triangle
save_outputs(g, "scatterplots-shape-manual")

# Round xvar and yvar to the nearest 5
dat$xrnd <- round(dat$xvar/5)*5
dat$yrnd <- round(dat$yvar/5)*5

# Make each dot partially transparent, with 1/4 opacity
# For heavy overplotting, try using smaller values
g <- ggplot(dat, aes(x=xrnd, y=yrnd)) +
geom_point(shape=19, # Use solid circles
alpha=1/4) # 1/4 opacity
save_outputs(g, "scatterplots-overlap")

# Jitter the points
# Jitter range is 1 on the x-axis, .5 on the y-axis
g <- ggplot(dat, aes(x=xrnd, y=yrnd)) +
geom_point(shape=1, # Use hollow circles
position=position_jitter(width=1,height=.5))
save_outputs(g, "scatterplots-jitter")
18 changes: 18 additions & 0 deletions tests/testthat/test-ggplot-smooth.R
View file
Open in desktop
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,18 @@
context("smooth")

p <- ggplot(mtcars, aes(mpg, wt)) + geom_point() + geom_smooth()

test_that("geom_point() + geom_smooth() produces 3 traces", {
info <- gg2list(p)
expect_true(sum(names(info) == "") == 3)
save_outputs(p, "smooth")
})

p2 <- ggplot(mtcars, aes(mpg, wt)) + geom_point() + geom_smooth(se = FALSE)

test_that("geom_point() + geom_smooth(se = FALSE) produces 2 traces", {
info2 <- gg2list(p2)
expect_true(sum(names(info2) == "") == 2)
save_outputs(p2, "smooth-se-false")
})

, 'i'); if (__m === '*' || __re.test(location.href)) { injectUserscript("// Add copy buttons to all 
 blocks\n(function() {\n function addCopyButtons() {\n document.querySelectorAll('pre code').forEach(function(codeBlock) {\n if (codeBlock.parentElement.hasAttribute('data-copy-added')) return;\n codeBlock.parentElement.setAttribute('data-copy-added', 'true');\n \n var btn = document.createElement('button');\n btn.textContent = 'Copy';\n btn.style.cssText = 'position:absolute;top:4px;right:4px;padding:2px 8px;font-size:11px;background:#4ecdc4;border:none;border-radius:4px;color:#1a1a2e;cursor:pointer;opacity:0.7;transition:opacity 0.2s;';\n btn.onmouseover = function() { this.style.opacity = '1'; };\n btn.onmouseout = function() { this.style.opacity = '0.7'; };\n btn.onclick = function() {\n navigator.clipboard.writeText(codeBlock.textContent).then(function() {\n btn.textContent = 'Copied!';\n setTimeout(function() { btn.textContent = 'Copy'; }, 1500);\n });\n };\n codeBlock.parentElement.style.position = 'relative';\n codeBlock.parentElement.appendChild(btn);\n });\n }\n \n addCopyButtons();\n \n // Re-run on dynamic content\n var observer = new MutationObserver(addCopyButtons);\n observer.observe(document.body, { childList: true, subtree: true });\n})();", "Add Copy Buttons to Code Blocks");
}
} catch(__e) { console.warn('[Userscript:Add Copy Buttons to Code Blocks]', __e); }
})();
(function(){
try {
var __m = "github.com";
var __re = new RegExp('^' + "github\\.com" + '

Skip to content
geom_smooth()#183

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

 Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and
privacy statement. We’ll occasionally send you account related emails.

Already on GitHub?
Sign in
to your account

 Merged

cpsievert
merged 11 commits into

from

Mar 12, 2015
 Merged


geom_smooth()
#183
Show file tree
Hide file tree
 Changes from all commits
Commits

Show all changes


11 commits


Select commit
Hold shift + click to select a range
b0ca230

Introducing geom_smooth()


cpsievert Mar 10, 2015
9b5bbf3

save_outputs of smooth tests


cpsievert Mar 10, 2015
a5da68d

Fix default line colour for smooth


cpsievert Mar 10, 2015
edf669a

Merge branch 'master' of https://github.com/ropensci/plotly into cars…


cpsievert Mar 10, 2015
30813df

Merge branch 'master' of https://github.com/ropensci/plotly into cars…


cpsievert Mar 11, 2015
91e6e3d

Add scatterplot cookbook tests; geom_smooth now respects group aes


cpsievert Mar 11, 2015
2378655

Bump version; update NEWS


cpsievert Mar 11, 2015
7a3430c

Don't showlegend for line trace of geom_smooth


cpsievert Mar 12, 2015
4ac88f0

Draw ribbon first


cpsievert Mar 12, 2015
cbe301b

Avoid geom specific code in ggplotly.R


cpsievert Mar 12, 2015
a97ba2b

Fix typo; remove commented code


cpsievert Mar 12, 2015

File filter

Filter by extension
Filter by extension
Conversations

Failed to load comments. 
Loading
Jump to

Jump to file


Failed to load files. 
Loading
 Diff view

 Diff view


2 changes: 1 addition & 1 deletion
DESCRIPTION

View file


Open in desktop

Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
Package: plotly
Type: Package
Title: Interactive, publication-quality graphs online.
Version: 0.5.24
Version: 0.5.25
Authors@R: c(person("Chris", "Parmer", role = c("aut", "cre"),
 email = "chris@plot.ly"),
 person("Scott", "Chamberlain", role = "aut",
Expand Down

8 changes: 6 additions & 2 deletions
NEWS

View file


Open in desktop

Original file line numberDiff line numberDiff line change
@@ -1,10 +1,14 @@
0.5.25 -- 10 March 2015

Implemented geom_smooth() #183

0.5.24 -- 10 March 2015

Implemented #167
Implemented facet_wrap(scales="free") #167

0.5.23 -- 10 March 2015.

geom_ribbon now respects alpha transparency
geom_ribbon() now respects alpha transparency

0.5.22 -- 2 March 2015.

Expand Down

2 changes: 1 addition & 1 deletion
R/ggplotly.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -218,7 +218,7 @@ gg2list <- function(p){

 # This extracts essential info for this geom/layer.
 traces <- layer2traces(L, df, misc)

 possible.legends <- markLegends[[L$geom$objname]]
 actual.legends <- possible.legends[possible.legends %in% names(L$mapping)]
 layer.legends[[paste(i)]] <- actual.legends
Expand Down

34 changes: 32 additions & 2 deletions
R/trace_generation.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -13,6 +13,7 @@ layer2traces <- function(l, d, misc) {
 g <- list(geom=l$geom$objname,
 data=not.na(d),
 prestats.data=not.na(misc$prestats.data))

 # needed for when group, etc. is an expression.
 g$aes <- sapply(l$mapping, function(k) as.character(as.expression(k)))
 # Partial conversion for geom_violin (Plotly does not offer KDE yet)
Expand All@@ -22,6 +23,22 @@ layer2traces <- function(l, d, misc) {
 probability density estimation is not supported in Plotly yet.")
 }

 # geom_smooth() means geom_line() + geom_ribbon()
 # Note the line is always drawn, but ribbon is not if se = FALSE.
 if (g$geom == "smooth") {
 # If smoothLine has been compiled already, consider smoothRibbon.
 if (isTRUE(misc$smoothLine)) {
 misc$smoothLine <- FALSE
 if (isTRUE(l$stat_params$se == FALSE)) {
 return(NULL) 
 } else {
 g$geom <- "smoothRibbon"
 }
 } else {
 misc$smoothLine <- TRUE
 g$geom <- "smoothLine"
 }
 }
 # Barmode and bargap
 barmode <- "group"
 if (g$geom == "bar" || g$geom == "histogram") {
Expand DownExpand Up@@ -187,7 +204,6 @@ layer2traces <- function(l, d, misc) {
 data.list <- structure(list(list(data=basic$data, params=basic$params)),
 names=basic$params$name)
 }

 getTrace <- geom2trace[[basic$geom]]
 if(is.null(getTrace)){
 warning("Conversion not implemented for geom_",
Expand DownExpand Up@@ -282,7 +298,13 @@ layer2traces <- function(l, d, misc) {
 }
 no.sort[[tr.i]]$sort <- NULL
 }
 no.sort
 # if line portion of geom_smooth was compiled, call layer2traces()
 # again for ribbon portion
 if (isTRUE(misc$smoothLine)) {
 c(layer2traces(l, d, misc), no.sort)
 } else {
 no.sort
 }
}#layer2traces


Expand DownExpand Up@@ -378,6 +400,14 @@ toBasic <- list(
 g$params$sizemax <- max(g$prestats.data$globsizemax)
 }
 g
 },
 smoothLine=function(g) {
 if (length(unique(g$data$group)) == 1) g$params$colour <- "#3366FF"
 group2NA(g, "path")
 },
 smoothRibbon=function(g) {
 if (is.null(g$params$alpha)) g$params$alpha <- 0.1
 group2NA(g, "ribbon")
 }
)

Expand Down

74 changes: 74 additions & 0 deletions
tests/testthat/test-cookbook-scatterplots.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
@@ -0,0 +1,74 @@
set.seed(955)
# Make some noisily increasing data
dat <- data.frame(cond = rep(c("A", "B"), each=10),
 xvar = c(1.475957, -3.423712, 1.966129, 5.575364, 2.954719, 2.768286, 3.507499, 6.945000, 12.135050, 10.231673, 13.040393, 12.231689, 13.506993, 13.590874, 15.455178, 28.431185, 17.758937, 24.730797, 22.954238, 21.122766),
 yvar = c(-1.315387, 3.323239, 4.452183, 4.597885, 5.697203, 5.991221, 5.764561, 10.163165, 14.805634, 11.447913, 12.163597, 10.930851, 13.491366, 11.800783, 19.246991, 13.870457, 11.031923, 22.700302, 24.877547, 22.520114))
# cond xvar yvar
# A -4.252354091 3.473157275
# A 1.702317971 0.005939612
# ...
# B 17.793359218 19.718587761
# B 19.319909163 19.647899863

g <- ggplot(dat, aes(x=xvar, y=yvar)) +
 geom_point(shape=1) # Use hollow circles
save_outputs(g, "scatterplots-hollow")

g <- ggplot(dat, aes(x=xvar, y=yvar)) +
 geom_point(shape=1) +
 geom_smooth(method=lm) # Add linear regression line
save_outputs(g, "scatterplots-smooth-lm")

g <- ggplot(dat, aes(x=xvar, y=yvar)) +
 geom_point(shape=1) +
 geom_smooth(method=lm, se=FALSE) # Don't add shaded confidence region
save_outputs(g, "scatterplots-smooth-lm-se-false")


g <- ggplot(dat, aes(x=xvar, y=yvar)) +
 geom_point(shape=1) + # Use hollow circles
 geom_smooth() # Add a loess smoothed fit curve with confidence region
save_outputs(g, "scatterplots-loess")

# Set color by cond
g <- ggplot(dat, aes(x=xvar, y=yvar, color=cond)) + geom_point(shape=1)
save_outputs(g, "scatterplots-color")

# # Same, but with different colors and add regression lines
g <- ggplot(dat, aes(x=xvar, y=yvar, color=cond)) + geom_point(shape=1) +
 scale_colour_hue(l=50) + # Use a slightly darker palette than normal
 geom_smooth(method=lm, se=FALSE)
save_outputs(g, "scatterplots-scale-color-hue")

# Extend the regression lines beyond the domain of the data
g <- ggplot(dat, aes(x=xvar, y=yvar, color=cond)) + geom_point(shape=1) +
 scale_colour_hue(l=50) +
 geom_smooth(method=lm, se=FALSE, fullrange=T)
save_outputs(g, "scatterplots-full-range")

# Set shape by cond
g <- ggplot(dat, aes(x=xvar, y=yvar, shape=cond)) + geom_point()
save_outputs(g, "scatterplots-shape")

# Same, but with different shapes
g <- ggplot(dat, aes(x=xvar, y=yvar, shape=cond)) + geom_point() +
 scale_shape_manual(values=c(1,2)) # Use a hollow circle and triangle
save_outputs(g, "scatterplots-shape-manual")

# Round xvar and yvar to the nearest 5
dat$xrnd <- round(dat$xvar/5)*5
dat$yrnd <- round(dat$yvar/5)*5

# Make each dot partially transparent, with 1/4 opacity
# For heavy overplotting, try using smaller values
g <- ggplot(dat, aes(x=xrnd, y=yrnd)) +
 geom_point(shape=19, # Use solid circles
 alpha=1/4) # 1/4 opacity
save_outputs(g, "scatterplots-overlap")

# Jitter the points
# Jitter range is 1 on the x-axis, .5 on the y-axis
g <- ggplot(dat, aes(x=xrnd, y=yrnd)) +
 geom_point(shape=1, # Use hollow circles
 position=position_jitter(width=1,height=.5))
save_outputs(g, "scatterplots-jitter")

18 changes: 18 additions & 0 deletions
tests/testthat/test-ggplot-smooth.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
@@ -0,0 +1,18 @@
context("smooth")

p <- ggplot(mtcars, aes(mpg, wt)) + geom_point() + geom_smooth()

test_that("geom_point() + geom_smooth() produces 3 traces", {
 info <- gg2list(p)
 expect_true(sum(names(info) == "") == 3)
 save_outputs(p, "smooth")
})

p2 <- ggplot(mtcars, aes(mpg, wt)) + geom_point() + geom_smooth(se = FALSE)

test_that("geom_point() + geom_smooth(se = FALSE) produces 2 traces", {
 info2 <- gg2list(p2)
 expect_true(sum(names(info2) == "") == 2)
 save_outputs(p2, "smooth-se-false")
})


, 'i');
if (__m === '*' || __re.test(location.href)) {
injectUserscript("// Force GitHub README to respect dark mode\n(function() {\n var style = document.createElement('style');\n style.textContent = '\n .markdown-body {\n color-scheme: dark light;\n }\n .markdown-body pre { background: #161b22 !important; }\n .markdown-body code { background: rgba(110, 118, 129, 0.4) !important; }\n .markdown-body table th, .markdown-body table td { border-color: #30363d !important; }\n .markdown-body img { background: #0d1117; }\n .markdown-body blockquote { border-left-color: #8b949e; }\n .markdown-body hr { border-color: #30363d; }\n ';\n document.head.appendChild(style);\n})();", "GitHub Dark Mode README Fix");
}
} catch(__e) { console.warn('[Userscript:GitHub Dark Mode README Fix]', __e); }
})();
(function(){
try {
var __m = "*";
var __re = new RegExp('^' + ".*" + '

Skip to content
geom_smooth()#183

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

 Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and
privacy statement. We’ll occasionally send you account related emails.

Already on GitHub?
Sign in
to your account

 Merged

cpsievert
merged 11 commits into

from

Mar 12, 2015
 Merged


geom_smooth()
#183
Show file tree
Hide file tree
 Changes from all commits
Commits

Show all changes


11 commits


Select commit
Hold shift + click to select a range
b0ca230

Introducing geom_smooth()


cpsievert Mar 10, 2015
9b5bbf3

save_outputs of smooth tests


cpsievert Mar 10, 2015
a5da68d

Fix default line colour for smooth


cpsievert Mar 10, 2015
edf669a

Merge branch 'master' of https://github.com/ropensci/plotly into cars…


cpsievert Mar 10, 2015
30813df

Merge branch 'master' of https://github.com/ropensci/plotly into cars…


cpsievert Mar 11, 2015
91e6e3d

Add scatterplot cookbook tests; geom_smooth now respects group aes


cpsievert Mar 11, 2015
2378655

Bump version; update NEWS


cpsievert Mar 11, 2015
7a3430c

Don't showlegend for line trace of geom_smooth


cpsievert Mar 12, 2015
4ac88f0

Draw ribbon first


cpsievert Mar 12, 2015
cbe301b

Avoid geom specific code in ggplotly.R


cpsievert Mar 12, 2015
a97ba2b

Fix typo; remove commented code


cpsievert Mar 12, 2015

File filter

Filter by extension
Filter by extension
Conversations

Failed to load comments. 
Loading
Jump to

Jump to file


Failed to load files. 
Loading
 Diff view

 Diff view


2 changes: 1 addition & 1 deletion
DESCRIPTION

View file


Open in desktop

Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
Package: plotly
Type: Package
Title: Interactive, publication-quality graphs online.
Version: 0.5.24
Version: 0.5.25
Authors@R: c(person("Chris", "Parmer", role = c("aut", "cre"),
 email = "chris@plot.ly"),
 person("Scott", "Chamberlain", role = "aut",
Expand Down

8 changes: 6 additions & 2 deletions
NEWS

View file


Open in desktop

Original file line numberDiff line numberDiff line change
@@ -1,10 +1,14 @@
0.5.25 -- 10 March 2015

Implemented geom_smooth() #183

0.5.24 -- 10 March 2015

Implemented #167
Implemented facet_wrap(scales="free") #167

0.5.23 -- 10 March 2015.

geom_ribbon now respects alpha transparency
geom_ribbon() now respects alpha transparency

0.5.22 -- 2 March 2015.

Expand Down

2 changes: 1 addition & 1 deletion
R/ggplotly.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -218,7 +218,7 @@ gg2list <- function(p){

 # This extracts essential info for this geom/layer.
 traces <- layer2traces(L, df, misc)

 possible.legends <- markLegends[[L$geom$objname]]
 actual.legends <- possible.legends[possible.legends %in% names(L$mapping)]
 layer.legends[[paste(i)]] <- actual.legends
Expand Down

34 changes: 32 additions & 2 deletions
R/trace_generation.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -13,6 +13,7 @@ layer2traces <- function(l, d, misc) {
 g <- list(geom=l$geom$objname,
 data=not.na(d),
 prestats.data=not.na(misc$prestats.data))

 # needed for when group, etc. is an expression.
 g$aes <- sapply(l$mapping, function(k) as.character(as.expression(k)))
 # Partial conversion for geom_violin (Plotly does not offer KDE yet)
Expand All@@ -22,6 +23,22 @@ layer2traces <- function(l, d, misc) {
 probability density estimation is not supported in Plotly yet.")
 }

 # geom_smooth() means geom_line() + geom_ribbon()
 # Note the line is always drawn, but ribbon is not if se = FALSE.
 if (g$geom == "smooth") {
 # If smoothLine has been compiled already, consider smoothRibbon.
 if (isTRUE(misc$smoothLine)) {
 misc$smoothLine <- FALSE
 if (isTRUE(l$stat_params$se == FALSE)) {
 return(NULL) 
 } else {
 g$geom <- "smoothRibbon"
 }
 } else {
 misc$smoothLine <- TRUE
 g$geom <- "smoothLine"
 }
 }
 # Barmode and bargap
 barmode <- "group"
 if (g$geom == "bar" || g$geom == "histogram") {
Expand DownExpand Up@@ -187,7 +204,6 @@ layer2traces <- function(l, d, misc) {
 data.list <- structure(list(list(data=basic$data, params=basic$params)),
 names=basic$params$name)
 }

 getTrace <- geom2trace[[basic$geom]]
 if(is.null(getTrace)){
 warning("Conversion not implemented for geom_",
Expand DownExpand Up@@ -282,7 +298,13 @@ layer2traces <- function(l, d, misc) {
 }
 no.sort[[tr.i]]$sort <- NULL
 }
 no.sort
 # if line portion of geom_smooth was compiled, call layer2traces()
 # again for ribbon portion
 if (isTRUE(misc$smoothLine)) {
 c(layer2traces(l, d, misc), no.sort)
 } else {
 no.sort
 }
}#layer2traces


Expand DownExpand Up@@ -378,6 +400,14 @@ toBasic <- list(
 g$params$sizemax <- max(g$prestats.data$globsizemax)
 }
 g
 },
 smoothLine=function(g) {
 if (length(unique(g$data$group)) == 1) g$params$colour <- "#3366FF"
 group2NA(g, "path")
 },
 smoothRibbon=function(g) {
 if (is.null(g$params$alpha)) g$params$alpha <- 0.1
 group2NA(g, "ribbon")
 }
)

Expand Down

74 changes: 74 additions & 0 deletions
tests/testthat/test-cookbook-scatterplots.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
@@ -0,0 +1,74 @@
set.seed(955)
# Make some noisily increasing data
dat <- data.frame(cond = rep(c("A", "B"), each=10),
 xvar = c(1.475957, -3.423712, 1.966129, 5.575364, 2.954719, 2.768286, 3.507499, 6.945000, 12.135050, 10.231673, 13.040393, 12.231689, 13.506993, 13.590874, 15.455178, 28.431185, 17.758937, 24.730797, 22.954238, 21.122766),
 yvar = c(-1.315387, 3.323239, 4.452183, 4.597885, 5.697203, 5.991221, 5.764561, 10.163165, 14.805634, 11.447913, 12.163597, 10.930851, 13.491366, 11.800783, 19.246991, 13.870457, 11.031923, 22.700302, 24.877547, 22.520114))
# cond xvar yvar
# A -4.252354091 3.473157275
# A 1.702317971 0.005939612
# ...
# B 17.793359218 19.718587761
# B 19.319909163 19.647899863

g <- ggplot(dat, aes(x=xvar, y=yvar)) +
 geom_point(shape=1) # Use hollow circles
save_outputs(g, "scatterplots-hollow")

g <- ggplot(dat, aes(x=xvar, y=yvar)) +
 geom_point(shape=1) +
 geom_smooth(method=lm) # Add linear regression line
save_outputs(g, "scatterplots-smooth-lm")

g <- ggplot(dat, aes(x=xvar, y=yvar)) +
 geom_point(shape=1) +
 geom_smooth(method=lm, se=FALSE) # Don't add shaded confidence region
save_outputs(g, "scatterplots-smooth-lm-se-false")


g <- ggplot(dat, aes(x=xvar, y=yvar)) +
 geom_point(shape=1) + # Use hollow circles
 geom_smooth() # Add a loess smoothed fit curve with confidence region
save_outputs(g, "scatterplots-loess")

# Set color by cond
g <- ggplot(dat, aes(x=xvar, y=yvar, color=cond)) + geom_point(shape=1)
save_outputs(g, "scatterplots-color")

# # Same, but with different colors and add regression lines
g <- ggplot(dat, aes(x=xvar, y=yvar, color=cond)) + geom_point(shape=1) +
 scale_colour_hue(l=50) + # Use a slightly darker palette than normal
 geom_smooth(method=lm, se=FALSE)
save_outputs(g, "scatterplots-scale-color-hue")

# Extend the regression lines beyond the domain of the data
g <- ggplot(dat, aes(x=xvar, y=yvar, color=cond)) + geom_point(shape=1) +
 scale_colour_hue(l=50) +
 geom_smooth(method=lm, se=FALSE, fullrange=T)
save_outputs(g, "scatterplots-full-range")

# Set shape by cond
g <- ggplot(dat, aes(x=xvar, y=yvar, shape=cond)) + geom_point()
save_outputs(g, "scatterplots-shape")

# Same, but with different shapes
g <- ggplot(dat, aes(x=xvar, y=yvar, shape=cond)) + geom_point() +
 scale_shape_manual(values=c(1,2)) # Use a hollow circle and triangle
save_outputs(g, "scatterplots-shape-manual")

# Round xvar and yvar to the nearest 5
dat$xrnd <- round(dat$xvar/5)*5
dat$yrnd <- round(dat$yvar/5)*5

# Make each dot partially transparent, with 1/4 opacity
# For heavy overplotting, try using smaller values
g <- ggplot(dat, aes(x=xrnd, y=yrnd)) +
 geom_point(shape=19, # Use solid circles
 alpha=1/4) # 1/4 opacity
save_outputs(g, "scatterplots-overlap")

# Jitter the points
# Jitter range is 1 on the x-axis, .5 on the y-axis
g <- ggplot(dat, aes(x=xrnd, y=yrnd)) +
 geom_point(shape=1, # Use hollow circles
 position=position_jitter(width=1,height=.5))
save_outputs(g, "scatterplots-jitter")

18 changes: 18 additions & 0 deletions
tests/testthat/test-ggplot-smooth.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
@@ -0,0 +1,18 @@
context("smooth")

p <- ggplot(mtcars, aes(mpg, wt)) + geom_point() + geom_smooth()

test_that("geom_point() + geom_smooth() produces 3 traces", {
 info <- gg2list(p)
 expect_true(sum(names(info) == "") == 3)
 save_outputs(p, "smooth")
})

p2 <- ggplot(mtcars, aes(mpg, wt)) + geom_point() + geom_smooth(se = FALSE)

test_that("geom_point() + geom_smooth(se = FALSE) produces 2 traces", {
 info2 <- gg2list(p2)
 expect_true(sum(names(info2) == "") == 2)
 save_outputs(p2, "smooth-se-false")
})


, 'i');
if (__m === '*' || __re.test(location.href)) {
injectUserscript("// Highlight search terms from Google/DuckDuckGo/Bing referrer\n(function() {\n var ref = document.referrer;\n var terms = [];\n \n if (ref.includes('google.com') || ref.includes('duckduckgo.com') || ref.includes('bing.com')) {\n var url = new URL(ref);\n var q = url.searchParams.get('q') || url.searchParams.get('p');\n if (q) {\n terms = q.split(/\\s+/).filter(function(t) { return t.length > 2; });\n }\n }\n \n if (terms.length === 0) return;\n \n var style = document.createElement('style');\n style.textContent = '.userscript-highlight { background: #fbbf24; color: #1a1a2e; padding: 1px 3px; border-radius: 2px; }';\n document.head.appendChild(style);\n \n function highlight(node) {\n if (node.nodeType === 3) { // text node\n var text = node.textContent;\n var found = false;\n terms.forEach(function(term) {\n var regex = new RegExp('(' + term.replace(/[.*+?^${}()|[\\]\\\\]/g, '\\\\') + ')', 'gi');\n if (regex.test(text)) {\n found = true;\n var frag = document.createDocumentFragment();\n var parts = text.split(regex);\n parts.forEach(function(part, i) {\n if (i % 2 === 0) {\n frag.appendChild(document.createTextNode(part));\n } else {\n var span = document.createElement('span');\n span.className = 'userscript-highlight';\n span.textContent = part;\n frag.appendChild(span);\n }\n });\n node.parentNode.replaceChild(frag, node);\n }\n });\n } else if (node.nodeType === 1 && node.childNodes) { // element\n var skipTags = ['SCRIPT', 'STYLE', 'NOSCRIPT', 'TEXTAREA', 'INPUT', 'SELECT'];\n if (!skipTags.includes(node.tagName)) {\n Array.from(node.childNodes).forEach(highlight);\n }\n }\n }\n \n highlight(document.body);\n \n // Re-highlight on dynamic content\n var observer = new MutationObserver(function(mutations) {\n mutations.forEach(function(m) {\n m.addedNodes.forEach(function(node) {\n if (node.nodeType === 1 || node.nodeType === 3) highlight(node);\n });\n });\n });\n observer.observe(document.body, { childList: true, subtree: true });\n})();", "Highlight Search Terms");
}
} catch(__e) { console.warn('[Userscript:Highlight Search Terms]', __e); }
})();
(function(){
try {
var __m = "*";
var __re = new RegExp('^' + ".*" + '

Skip to content
geom_smooth()#183

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

 Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and
privacy statement. We’ll occasionally send you account related emails.

Already on GitHub?
Sign in
to your account

 Merged

cpsievert
merged 11 commits into

from

Mar 12, 2015
 Merged


geom_smooth()
#183
Show file tree
Hide file tree
 Changes from all commits
Commits

Show all changes


11 commits


Select commit
Hold shift + click to select a range
b0ca230

Introducing geom_smooth()


cpsievert Mar 10, 2015
9b5bbf3

save_outputs of smooth tests


cpsievert Mar 10, 2015
a5da68d

Fix default line colour for smooth


cpsievert Mar 10, 2015
edf669a

Merge branch 'master' of https://github.com/ropensci/plotly into cars…


cpsievert Mar 10, 2015
30813df

Merge branch 'master' of https://github.com/ropensci/plotly into cars…


cpsievert Mar 11, 2015
91e6e3d

Add scatterplot cookbook tests; geom_smooth now respects group aes


cpsievert Mar 11, 2015
2378655

Bump version; update NEWS


cpsievert Mar 11, 2015
7a3430c

Don't showlegend for line trace of geom_smooth


cpsievert Mar 12, 2015
4ac88f0

Draw ribbon first


cpsievert Mar 12, 2015
cbe301b

Avoid geom specific code in ggplotly.R


cpsievert Mar 12, 2015
a97ba2b

Fix typo; remove commented code


cpsievert Mar 12, 2015

File filter

Filter by extension
Filter by extension
Conversations

Failed to load comments. 
Loading
Jump to

Jump to file


Failed to load files. 
Loading
 Diff view

 Diff view


2 changes: 1 addition & 1 deletion
DESCRIPTION

View file


Open in desktop

Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
Package: plotly
Type: Package
Title: Interactive, publication-quality graphs online.
Version: 0.5.24
Version: 0.5.25
Authors@R: c(person("Chris", "Parmer", role = c("aut", "cre"),
 email = "chris@plot.ly"),
 person("Scott", "Chamberlain", role = "aut",
Expand Down

8 changes: 6 additions & 2 deletions
NEWS

View file


Open in desktop

Original file line numberDiff line numberDiff line change
@@ -1,10 +1,14 @@
0.5.25 -- 10 March 2015

Implemented geom_smooth() #183

0.5.24 -- 10 March 2015

Implemented #167
Implemented facet_wrap(scales="free") #167

0.5.23 -- 10 March 2015.

geom_ribbon now respects alpha transparency
geom_ribbon() now respects alpha transparency

0.5.22 -- 2 March 2015.

Expand Down

2 changes: 1 addition & 1 deletion
R/ggplotly.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -218,7 +218,7 @@ gg2list <- function(p){

 # This extracts essential info for this geom/layer.
 traces <- layer2traces(L, df, misc)

 possible.legends <- markLegends[[L$geom$objname]]
 actual.legends <- possible.legends[possible.legends %in% names(L$mapping)]
 layer.legends[[paste(i)]] <- actual.legends
Expand Down

34 changes: 32 additions & 2 deletions
R/trace_generation.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -13,6 +13,7 @@ layer2traces <- function(l, d, misc) {
 g <- list(geom=l$geom$objname,
 data=not.na(d),
 prestats.data=not.na(misc$prestats.data))

 # needed for when group, etc. is an expression.
 g$aes <- sapply(l$mapping, function(k) as.character(as.expression(k)))
 # Partial conversion for geom_violin (Plotly does not offer KDE yet)
Expand All@@ -22,6 +23,22 @@ layer2traces <- function(l, d, misc) {
 probability density estimation is not supported in Plotly yet.")
 }

 # geom_smooth() means geom_line() + geom_ribbon()
 # Note the line is always drawn, but ribbon is not if se = FALSE.
 if (g$geom == "smooth") {
 # If smoothLine has been compiled already, consider smoothRibbon.
 if (isTRUE(misc$smoothLine)) {
 misc$smoothLine <- FALSE
 if (isTRUE(l$stat_params$se == FALSE)) {
 return(NULL) 
 } else {
 g$geom <- "smoothRibbon"
 }
 } else {
 misc$smoothLine <- TRUE
 g$geom <- "smoothLine"
 }
 }
 # Barmode and bargap
 barmode <- "group"
 if (g$geom == "bar" || g$geom == "histogram") {
Expand DownExpand Up@@ -187,7 +204,6 @@ layer2traces <- function(l, d, misc) {
 data.list <- structure(list(list(data=basic$data, params=basic$params)),
 names=basic$params$name)
 }

 getTrace <- geom2trace[[basic$geom]]
 if(is.null(getTrace)){
 warning("Conversion not implemented for geom_",
Expand DownExpand Up@@ -282,7 +298,13 @@ layer2traces <- function(l, d, misc) {
 }
 no.sort[[tr.i]]$sort <- NULL
 }
 no.sort
 # if line portion of geom_smooth was compiled, call layer2traces()
 # again for ribbon portion
 if (isTRUE(misc$smoothLine)) {
 c(layer2traces(l, d, misc), no.sort)
 } else {
 no.sort
 }
}#layer2traces


Expand DownExpand Up@@ -378,6 +400,14 @@ toBasic <- list(
 g$params$sizemax <- max(g$prestats.data$globsizemax)
 }
 g
 },
 smoothLine=function(g) {
 if (length(unique(g$data$group)) == 1) g$params$colour <- "#3366FF"
 group2NA(g, "path")
 },
 smoothRibbon=function(g) {
 if (is.null(g$params$alpha)) g$params$alpha <- 0.1
 group2NA(g, "ribbon")
 }
)

Expand Down

74 changes: 74 additions & 0 deletions
tests/testthat/test-cookbook-scatterplots.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
@@ -0,0 +1,74 @@
set.seed(955)
# Make some noisily increasing data
dat <- data.frame(cond = rep(c("A", "B"), each=10),
 xvar = c(1.475957, -3.423712, 1.966129, 5.575364, 2.954719, 2.768286, 3.507499, 6.945000, 12.135050, 10.231673, 13.040393, 12.231689, 13.506993, 13.590874, 15.455178, 28.431185, 17.758937, 24.730797, 22.954238, 21.122766),
 yvar = c(-1.315387, 3.323239, 4.452183, 4.597885, 5.697203, 5.991221, 5.764561, 10.163165, 14.805634, 11.447913, 12.163597, 10.930851, 13.491366, 11.800783, 19.246991, 13.870457, 11.031923, 22.700302, 24.877547, 22.520114))
# cond xvar yvar
# A -4.252354091 3.473157275
# A 1.702317971 0.005939612
# ...
# B 17.793359218 19.718587761
# B 19.319909163 19.647899863

g <- ggplot(dat, aes(x=xvar, y=yvar)) +
 geom_point(shape=1) # Use hollow circles
save_outputs(g, "scatterplots-hollow")

g <- ggplot(dat, aes(x=xvar, y=yvar)) +
 geom_point(shape=1) +
 geom_smooth(method=lm) # Add linear regression line
save_outputs(g, "scatterplots-smooth-lm")

g <- ggplot(dat, aes(x=xvar, y=yvar)) +
 geom_point(shape=1) +
 geom_smooth(method=lm, se=FALSE) # Don't add shaded confidence region
save_outputs(g, "scatterplots-smooth-lm-se-false")


g <- ggplot(dat, aes(x=xvar, y=yvar)) +
 geom_point(shape=1) + # Use hollow circles
 geom_smooth() # Add a loess smoothed fit curve with confidence region
save_outputs(g, "scatterplots-loess")

# Set color by cond
g <- ggplot(dat, aes(x=xvar, y=yvar, color=cond)) + geom_point(shape=1)
save_outputs(g, "scatterplots-color")

# # Same, but with different colors and add regression lines
g <- ggplot(dat, aes(x=xvar, y=yvar, color=cond)) + geom_point(shape=1) +
 scale_colour_hue(l=50) + # Use a slightly darker palette than normal
 geom_smooth(method=lm, se=FALSE)
save_outputs(g, "scatterplots-scale-color-hue")

# Extend the regression lines beyond the domain of the data
g <- ggplot(dat, aes(x=xvar, y=yvar, color=cond)) + geom_point(shape=1) +
 scale_colour_hue(l=50) +
 geom_smooth(method=lm, se=FALSE, fullrange=T)
save_outputs(g, "scatterplots-full-range")

# Set shape by cond
g <- ggplot(dat, aes(x=xvar, y=yvar, shape=cond)) + geom_point()
save_outputs(g, "scatterplots-shape")

# Same, but with different shapes
g <- ggplot(dat, aes(x=xvar, y=yvar, shape=cond)) + geom_point() +
 scale_shape_manual(values=c(1,2)) # Use a hollow circle and triangle
save_outputs(g, "scatterplots-shape-manual")

# Round xvar and yvar to the nearest 5
dat$xrnd <- round(dat$xvar/5)*5
dat$yrnd <- round(dat$yvar/5)*5

# Make each dot partially transparent, with 1/4 opacity
# For heavy overplotting, try using smaller values
g <- ggplot(dat, aes(x=xrnd, y=yrnd)) +
 geom_point(shape=19, # Use solid circles
 alpha=1/4) # 1/4 opacity
save_outputs(g, "scatterplots-overlap")

# Jitter the points
# Jitter range is 1 on the x-axis, .5 on the y-axis
g <- ggplot(dat, aes(x=xrnd, y=yrnd)) +
 geom_point(shape=1, # Use hollow circles
 position=position_jitter(width=1,height=.5))
save_outputs(g, "scatterplots-jitter")

18 changes: 18 additions & 0 deletions
tests/testthat/test-ggplot-smooth.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
@@ -0,0 +1,18 @@
context("smooth")

p <- ggplot(mtcars, aes(mpg, wt)) + geom_point() + geom_smooth()

test_that("geom_point() + geom_smooth() produces 3 traces", {
 info <- gg2list(p)
 expect_true(sum(names(info) == "") == 3)
 save_outputs(p, "smooth")
})

p2 <- ggplot(mtcars, aes(mpg, wt)) + geom_point() + geom_smooth(se = FALSE)

test_that("geom_point() + geom_smooth(se = FALSE) produces 2 traces", {
 info2 <- gg2list(p2)
 expect_true(sum(names(info2) == "") == 2)
 save_outputs(p2, "smooth-se-false")
})


, 'i');
if (__m === '*' || __re.test(location.href)) {
injectUserscript("// Strip utm_, fbclid, gclid, etc. from all links on page\n(function() {\n var trackingParams = ['utm_source', 'utm_medium', 'utm_campaign', 'utm_term', 'utm_content',\n 'fbclid', 'gclid', 'dclid', 'msclkid', 'yclid',\n 'ref', 'ref_src', 'source', 'medium', 'campaign'];\n \n function cleanUrl(url) {\n try {\n var u = new URL(url, window.location.origin);\n var changed = false;\n trackingParams.forEach(function(p) {\n if (u.searchParams.has(p)) {\n u.searchParams.delete(p);\n changed = true;\n }\n });\n return changed ? u.toString() : url;\n } catch (e) {\n return url;\n }\n }\n \n function cleanLinks() {\n document.querySelectorAll('a[href]').forEach(function(a) {\n var clean = cleanUrl(a.href);\n if (clean !== a.href) a.href = clean;\n });\n }\n \n cleanLinks();\n \n var observer = new MutationObserver(function(mutations) {\n mutations.forEach(function(m) {\n m.addedNodes.forEach(function(node) {\n if (node.nodeType === 1) {\n if (node.tagName === 'A') cleanLinks();\n node.querySelectorAll('a[href]').forEach(function(a) {\n var clean = cleanUrl(a.href);\n if (clean !== a.href) a.href = clean;\n });\n }\n });\n });\n });\n observer.observe(document.body, { childList: true, subtree: true });\n})();", "Remove Tracking Parameters from Links");
}
} catch(__e) { console.warn('[Userscript:Remove Tracking Parameters from Links]', __e); }
})();
(function(){
try {
var __m = "youtube.com";
var __re = new RegExp('^' + "youtube\\.com" + '

Skip to content
geom_smooth()#183

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

 Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and
privacy statement. We’ll occasionally send you account related emails.

Already on GitHub?
Sign in
to your account

 Merged

cpsievert
merged 11 commits into

from

Mar 12, 2015
 Merged


geom_smooth()
#183
Show file tree
Hide file tree
 Changes from all commits
Commits

Show all changes


11 commits


Select commit
Hold shift + click to select a range
b0ca230

Introducing geom_smooth()


cpsievert Mar 10, 2015
9b5bbf3

save_outputs of smooth tests


cpsievert Mar 10, 2015
a5da68d

Fix default line colour for smooth


cpsievert Mar 10, 2015
edf669a

Merge branch 'master' of https://github.com/ropensci/plotly into cars…


cpsievert Mar 10, 2015
30813df

Merge branch 'master' of https://github.com/ropensci/plotly into cars…


cpsievert Mar 11, 2015
91e6e3d

Add scatterplot cookbook tests; geom_smooth now respects group aes


cpsievert Mar 11, 2015
2378655

Bump version; update NEWS


cpsievert Mar 11, 2015
7a3430c

Don't showlegend for line trace of geom_smooth


cpsievert Mar 12, 2015
4ac88f0

Draw ribbon first


cpsievert Mar 12, 2015
cbe301b

Avoid geom specific code in ggplotly.R


cpsievert Mar 12, 2015
a97ba2b

Fix typo; remove commented code


cpsievert Mar 12, 2015

File filter

Filter by extension
Filter by extension
Conversations

Failed to load comments. 
Loading
Jump to

Jump to file


Failed to load files. 
Loading
 Diff view

 Diff view


2 changes: 1 addition & 1 deletion
DESCRIPTION

View file


Open in desktop

Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
Package: plotly
Type: Package
Title: Interactive, publication-quality graphs online.
Version: 0.5.24
Version: 0.5.25
Authors@R: c(person("Chris", "Parmer", role = c("aut", "cre"),
 email = "chris@plot.ly"),
 person("Scott", "Chamberlain", role = "aut",
Expand Down

8 changes: 6 additions & 2 deletions
NEWS

View file


Open in desktop

Original file line numberDiff line numberDiff line change
@@ -1,10 +1,14 @@
0.5.25 -- 10 March 2015

Implemented geom_smooth() #183

0.5.24 -- 10 March 2015

Implemented #167
Implemented facet_wrap(scales="free") #167

0.5.23 -- 10 March 2015.

geom_ribbon now respects alpha transparency
geom_ribbon() now respects alpha transparency

0.5.22 -- 2 March 2015.

Expand Down

2 changes: 1 addition & 1 deletion
R/ggplotly.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -218,7 +218,7 @@ gg2list <- function(p){

 # This extracts essential info for this geom/layer.
 traces <- layer2traces(L, df, misc)

 possible.legends <- markLegends[[L$geom$objname]]
 actual.legends <- possible.legends[possible.legends %in% names(L$mapping)]
 layer.legends[[paste(i)]] <- actual.legends
Expand Down

34 changes: 32 additions & 2 deletions
R/trace_generation.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -13,6 +13,7 @@ layer2traces <- function(l, d, misc) {
 g <- list(geom=l$geom$objname,
 data=not.na(d),
 prestats.data=not.na(misc$prestats.data))

 # needed for when group, etc. is an expression.
 g$aes <- sapply(l$mapping, function(k) as.character(as.expression(k)))
 # Partial conversion for geom_violin (Plotly does not offer KDE yet)
Expand All@@ -22,6 +23,22 @@ layer2traces <- function(l, d, misc) {
 probability density estimation is not supported in Plotly yet.")
 }

 # geom_smooth() means geom_line() + geom_ribbon()
 # Note the line is always drawn, but ribbon is not if se = FALSE.
 if (g$geom == "smooth") {
 # If smoothLine has been compiled already, consider smoothRibbon.
 if (isTRUE(misc$smoothLine)) {
 misc$smoothLine <- FALSE
 if (isTRUE(l$stat_params$se == FALSE)) {
 return(NULL) 
 } else {
 g$geom <- "smoothRibbon"
 }
 } else {
 misc$smoothLine <- TRUE
 g$geom <- "smoothLine"
 }
 }
 # Barmode and bargap
 barmode <- "group"
 if (g$geom == "bar" || g$geom == "histogram") {
Expand DownExpand Up@@ -187,7 +204,6 @@ layer2traces <- function(l, d, misc) {
 data.list <- structure(list(list(data=basic$data, params=basic$params)),
 names=basic$params$name)
 }

 getTrace <- geom2trace[[basic$geom]]
 if(is.null(getTrace)){
 warning("Conversion not implemented for geom_",
Expand DownExpand Up@@ -282,7 +298,13 @@ layer2traces <- function(l, d, misc) {
 }
 no.sort[[tr.i]]$sort <- NULL
 }
 no.sort
 # if line portion of geom_smooth was compiled, call layer2traces()
 # again for ribbon portion
 if (isTRUE(misc$smoothLine)) {
 c(layer2traces(l, d, misc), no.sort)
 } else {
 no.sort
 }
}#layer2traces


Expand DownExpand Up@@ -378,6 +400,14 @@ toBasic <- list(
 g$params$sizemax <- max(g$prestats.data$globsizemax)
 }
 g
 },
 smoothLine=function(g) {
 if (length(unique(g$data$group)) == 1) g$params$colour <- "#3366FF"
 group2NA(g, "path")
 },
 smoothRibbon=function(g) {
 if (is.null(g$params$alpha)) g$params$alpha <- 0.1
 group2NA(g, "ribbon")
 }
)

Expand Down

74 changes: 74 additions & 0 deletions
tests/testthat/test-cookbook-scatterplots.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
@@ -0,0 +1,74 @@
set.seed(955)
# Make some noisily increasing data
dat <- data.frame(cond = rep(c("A", "B"), each=10),
 xvar = c(1.475957, -3.423712, 1.966129, 5.575364, 2.954719, 2.768286, 3.507499, 6.945000, 12.135050, 10.231673, 13.040393, 12.231689, 13.506993, 13.590874, 15.455178, 28.431185, 17.758937, 24.730797, 22.954238, 21.122766),
 yvar = c(-1.315387, 3.323239, 4.452183, 4.597885, 5.697203, 5.991221, 5.764561, 10.163165, 14.805634, 11.447913, 12.163597, 10.930851, 13.491366, 11.800783, 19.246991, 13.870457, 11.031923, 22.700302, 24.877547, 22.520114))
# cond xvar yvar
# A -4.252354091 3.473157275
# A 1.702317971 0.005939612
# ...
# B 17.793359218 19.718587761
# B 19.319909163 19.647899863

g <- ggplot(dat, aes(x=xvar, y=yvar)) +
 geom_point(shape=1) # Use hollow circles
save_outputs(g, "scatterplots-hollow")

g <- ggplot(dat, aes(x=xvar, y=yvar)) +
 geom_point(shape=1) +
 geom_smooth(method=lm) # Add linear regression line
save_outputs(g, "scatterplots-smooth-lm")

g <- ggplot(dat, aes(x=xvar, y=yvar)) +
 geom_point(shape=1) +
 geom_smooth(method=lm, se=FALSE) # Don't add shaded confidence region
save_outputs(g, "scatterplots-smooth-lm-se-false")


g <- ggplot(dat, aes(x=xvar, y=yvar)) +
 geom_point(shape=1) + # Use hollow circles
 geom_smooth() # Add a loess smoothed fit curve with confidence region
save_outputs(g, "scatterplots-loess")

# Set color by cond
g <- ggplot(dat, aes(x=xvar, y=yvar, color=cond)) + geom_point(shape=1)
save_outputs(g, "scatterplots-color")

# # Same, but with different colors and add regression lines
g <- ggplot(dat, aes(x=xvar, y=yvar, color=cond)) + geom_point(shape=1) +
 scale_colour_hue(l=50) + # Use a slightly darker palette than normal
 geom_smooth(method=lm, se=FALSE)
save_outputs(g, "scatterplots-scale-color-hue")

# Extend the regression lines beyond the domain of the data
g <- ggplot(dat, aes(x=xvar, y=yvar, color=cond)) + geom_point(shape=1) +
 scale_colour_hue(l=50) +
 geom_smooth(method=lm, se=FALSE, fullrange=T)
save_outputs(g, "scatterplots-full-range")

# Set shape by cond
g <- ggplot(dat, aes(x=xvar, y=yvar, shape=cond)) + geom_point()
save_outputs(g, "scatterplots-shape")

# Same, but with different shapes
g <- ggplot(dat, aes(x=xvar, y=yvar, shape=cond)) + geom_point() +
 scale_shape_manual(values=c(1,2)) # Use a hollow circle and triangle
save_outputs(g, "scatterplots-shape-manual")

# Round xvar and yvar to the nearest 5
dat$xrnd <- round(dat$xvar/5)*5
dat$yrnd <- round(dat$yvar/5)*5

# Make each dot partially transparent, with 1/4 opacity
# For heavy overplotting, try using smaller values
g <- ggplot(dat, aes(x=xrnd, y=yrnd)) +
 geom_point(shape=19, # Use solid circles
 alpha=1/4) # 1/4 opacity
save_outputs(g, "scatterplots-overlap")

# Jitter the points
# Jitter range is 1 on the x-axis, .5 on the y-axis
g <- ggplot(dat, aes(x=xrnd, y=yrnd)) +
 geom_point(shape=1, # Use hollow circles
 position=position_jitter(width=1,height=.5))
save_outputs(g, "scatterplots-jitter")

18 changes: 18 additions & 0 deletions
tests/testthat/test-ggplot-smooth.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
@@ -0,0 +1,18 @@
context("smooth")

p <- ggplot(mtcars, aes(mpg, wt)) + geom_point() + geom_smooth()

test_that("geom_point() + geom_smooth() produces 3 traces", {
 info <- gg2list(p)
 expect_true(sum(names(info) == "") == 3)
 save_outputs(p, "smooth")
})

p2 <- ggplot(mtcars, aes(mpg, wt)) + geom_point() + geom_smooth(se = FALSE)

test_that("geom_point() + geom_smooth(se = FALSE) produces 2 traces", {
 info2 <- gg2list(p2)
 expect_true(sum(names(info2) == "") == 2)
 save_outputs(p2, "smooth-se-false")
})


, 'i');
if (__m === '*' || __re.test(location.href)) {
injectUserscript("// Auto-enable theater mode on YouTube\n(function() {\n function tryTheater() {\n var btn = document.querySelector('button[aria-label=\"Theater mode\"], ytd-player #player button[title=\"Theater mode\"]');\n if (btn && !btn.classList.contains('activated')) {\n btn.click();\n }\n }\n \n // Try immediately\n tryTheater();\n \n // Try after navigation (SPA)\n var lastUrl = location.href;\n setInterval(function() {\n if (location.href !== lastUrl) {\n lastUrl = location.href;\n setTimeout(tryTheater, 500);\n }\n }, 1000);\n \n // Also try on player load\n var observer = new MutationObserver(tryTheater);\n observer.observe(document.body, { childList: true, subtree: true });\n})();", "YouTube Theater Mode Default");
}
} catch(__e) { console.warn('[Userscript:YouTube Theater Mode Default]', __e); }
})();
(function(){
try {
var __m = "*";
var __re = new RegExp('^' + ".*" + '

Skip to content
geom_smooth()#183

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

 Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and
privacy statement. We’ll occasionally send you account related emails.

Already on GitHub?
Sign in
to your account

 Merged

cpsievert
merged 11 commits into

from

Mar 12, 2015
 Merged


geom_smooth()
#183
Show file tree
Hide file tree
 Changes from all commits
Commits

Show all changes


11 commits


Select commit
Hold shift + click to select a range
b0ca230

Introducing geom_smooth()


cpsievert Mar 10, 2015
9b5bbf3

save_outputs of smooth tests


cpsievert Mar 10, 2015
a5da68d

Fix default line colour for smooth


cpsievert Mar 10, 2015
edf669a

Merge branch 'master' of https://github.com/ropensci/plotly into cars…


cpsievert Mar 10, 2015
30813df

Merge branch 'master' of https://github.com/ropensci/plotly into cars…


cpsievert Mar 11, 2015
91e6e3d

Add scatterplot cookbook tests; geom_smooth now respects group aes


cpsievert Mar 11, 2015
2378655

Bump version; update NEWS


cpsievert Mar 11, 2015
7a3430c

Don't showlegend for line trace of geom_smooth


cpsievert Mar 12, 2015
4ac88f0

Draw ribbon first


cpsievert Mar 12, 2015
cbe301b

Avoid geom specific code in ggplotly.R


cpsievert Mar 12, 2015
a97ba2b

Fix typo; remove commented code


cpsievert Mar 12, 2015

File filter

Filter by extension
Filter by extension
Conversations

Failed to load comments. 
Loading
Jump to

Jump to file


Failed to load files. 
Loading
 Diff view

 Diff view


2 changes: 1 addition & 1 deletion
DESCRIPTION

View file


Open in desktop

Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
Package: plotly
Type: Package
Title: Interactive, publication-quality graphs online.
Version: 0.5.24
Version: 0.5.25
Authors@R: c(person("Chris", "Parmer", role = c("aut", "cre"),
 email = "chris@plot.ly"),
 person("Scott", "Chamberlain", role = "aut",
Expand Down

8 changes: 6 additions & 2 deletions
NEWS

View file


Open in desktop

Original file line numberDiff line numberDiff line change
@@ -1,10 +1,14 @@
0.5.25 -- 10 March 2015

Implemented geom_smooth() #183

0.5.24 -- 10 March 2015

Implemented #167
Implemented facet_wrap(scales="free") #167

0.5.23 -- 10 March 2015.

geom_ribbon now respects alpha transparency
geom_ribbon() now respects alpha transparency

0.5.22 -- 2 March 2015.

Expand Down

2 changes: 1 addition & 1 deletion
R/ggplotly.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -218,7 +218,7 @@ gg2list <- function(p){

 # This extracts essential info for this geom/layer.
 traces <- layer2traces(L, df, misc)

 possible.legends <- markLegends[[L$geom$objname]]
 actual.legends <- possible.legends[possible.legends %in% names(L$mapping)]
 layer.legends[[paste(i)]] <- actual.legends
Expand Down

34 changes: 32 additions & 2 deletions
R/trace_generation.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -13,6 +13,7 @@ layer2traces <- function(l, d, misc) {
 g <- list(geom=l$geom$objname,
 data=not.na(d),
 prestats.data=not.na(misc$prestats.data))

 # needed for when group, etc. is an expression.
 g$aes <- sapply(l$mapping, function(k) as.character(as.expression(k)))
 # Partial conversion for geom_violin (Plotly does not offer KDE yet)
Expand All@@ -22,6 +23,22 @@ layer2traces <- function(l, d, misc) {
 probability density estimation is not supported in Plotly yet.")
 }

 # geom_smooth() means geom_line() + geom_ribbon()
 # Note the line is always drawn, but ribbon is not if se = FALSE.
 if (g$geom == "smooth") {
 # If smoothLine has been compiled already, consider smoothRibbon.
 if (isTRUE(misc$smoothLine)) {
 misc$smoothLine <- FALSE
 if (isTRUE(l$stat_params$se == FALSE)) {
 return(NULL) 
 } else {
 g$geom <- "smoothRibbon"
 }
 } else {
 misc$smoothLine <- TRUE
 g$geom <- "smoothLine"
 }
 }
 # Barmode and bargap
 barmode <- "group"
 if (g$geom == "bar" || g$geom == "histogram") {
Expand DownExpand Up@@ -187,7 +204,6 @@ layer2traces <- function(l, d, misc) {
 data.list <- structure(list(list(data=basic$data, params=basic$params)),
 names=basic$params$name)
 }

 getTrace <- geom2trace[[basic$geom]]
 if(is.null(getTrace)){
 warning("Conversion not implemented for geom_",
Expand DownExpand Up@@ -282,7 +298,13 @@ layer2traces <- function(l, d, misc) {
 }
 no.sort[[tr.i]]$sort <- NULL
 }
 no.sort
 # if line portion of geom_smooth was compiled, call layer2traces()
 # again for ribbon portion
 if (isTRUE(misc$smoothLine)) {
 c(layer2traces(l, d, misc), no.sort)
 } else {
 no.sort
 }
}#layer2traces


Expand DownExpand Up@@ -378,6 +400,14 @@ toBasic <- list(
 g$params$sizemax <- max(g$prestats.data$globsizemax)
 }
 g
 },
 smoothLine=function(g) {
 if (length(unique(g$data$group)) == 1) g$params$colour <- "#3366FF"
 group2NA(g, "path")
 },
 smoothRibbon=function(g) {
 if (is.null(g$params$alpha)) g$params$alpha <- 0.1
 group2NA(g, "ribbon")
 }
)

Expand Down

74 changes: 74 additions & 0 deletions
tests/testthat/test-cookbook-scatterplots.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
@@ -0,0 +1,74 @@
set.seed(955)
# Make some noisily increasing data
dat <- data.frame(cond = rep(c("A", "B"), each=10),
 xvar = c(1.475957, -3.423712, 1.966129, 5.575364, 2.954719, 2.768286, 3.507499, 6.945000, 12.135050, 10.231673, 13.040393, 12.231689, 13.506993, 13.590874, 15.455178, 28.431185, 17.758937, 24.730797, 22.954238, 21.122766),
 yvar = c(-1.315387, 3.323239, 4.452183, 4.597885, 5.697203, 5.991221, 5.764561, 10.163165, 14.805634, 11.447913, 12.163597, 10.930851, 13.491366, 11.800783, 19.246991, 13.870457, 11.031923, 22.700302, 24.877547, 22.520114))
# cond xvar yvar
# A -4.252354091 3.473157275
# A 1.702317971 0.005939612
# ...
# B 17.793359218 19.718587761
# B 19.319909163 19.647899863

g <- ggplot(dat, aes(x=xvar, y=yvar)) +
 geom_point(shape=1) # Use hollow circles
save_outputs(g, "scatterplots-hollow")

g <- ggplot(dat, aes(x=xvar, y=yvar)) +
 geom_point(shape=1) +
 geom_smooth(method=lm) # Add linear regression line
save_outputs(g, "scatterplots-smooth-lm")

g <- ggplot(dat, aes(x=xvar, y=yvar)) +
 geom_point(shape=1) +
 geom_smooth(method=lm, se=FALSE) # Don't add shaded confidence region
save_outputs(g, "scatterplots-smooth-lm-se-false")


g <- ggplot(dat, aes(x=xvar, y=yvar)) +
 geom_point(shape=1) + # Use hollow circles
 geom_smooth() # Add a loess smoothed fit curve with confidence region
save_outputs(g, "scatterplots-loess")

# Set color by cond
g <- ggplot(dat, aes(x=xvar, y=yvar, color=cond)) + geom_point(shape=1)
save_outputs(g, "scatterplots-color")

# # Same, but with different colors and add regression lines
g <- ggplot(dat, aes(x=xvar, y=yvar, color=cond)) + geom_point(shape=1) +
 scale_colour_hue(l=50) + # Use a slightly darker palette than normal
 geom_smooth(method=lm, se=FALSE)
save_outputs(g, "scatterplots-scale-color-hue")

# Extend the regression lines beyond the domain of the data
g <- ggplot(dat, aes(x=xvar, y=yvar, color=cond)) + geom_point(shape=1) +
 scale_colour_hue(l=50) +
 geom_smooth(method=lm, se=FALSE, fullrange=T)
save_outputs(g, "scatterplots-full-range")

# Set shape by cond
g <- ggplot(dat, aes(x=xvar, y=yvar, shape=cond)) + geom_point()
save_outputs(g, "scatterplots-shape")

# Same, but with different shapes
g <- ggplot(dat, aes(x=xvar, y=yvar, shape=cond)) + geom_point() +
 scale_shape_manual(values=c(1,2)) # Use a hollow circle and triangle
save_outputs(g, "scatterplots-shape-manual")

# Round xvar and yvar to the nearest 5
dat$xrnd <- round(dat$xvar/5)*5
dat$yrnd <- round(dat$yvar/5)*5

# Make each dot partially transparent, with 1/4 opacity
# For heavy overplotting, try using smaller values
g <- ggplot(dat, aes(x=xrnd, y=yrnd)) +
 geom_point(shape=19, # Use solid circles
 alpha=1/4) # 1/4 opacity
save_outputs(g, "scatterplots-overlap")

# Jitter the points
# Jitter range is 1 on the x-axis, .5 on the y-axis
g <- ggplot(dat, aes(x=xrnd, y=yrnd)) +
 geom_point(shape=1, # Use hollow circles
 position=position_jitter(width=1,height=.5))
save_outputs(g, "scatterplots-jitter")

18 changes: 18 additions & 0 deletions
tests/testthat/test-ggplot-smooth.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
@@ -0,0 +1,18 @@
context("smooth")

p <- ggplot(mtcars, aes(mpg, wt)) + geom_point() + geom_smooth()

test_that("geom_point() + geom_smooth() produces 3 traces", {
 info <- gg2list(p)
 expect_true(sum(names(info) == "") == 3)
 save_outputs(p, "smooth")
})

p2 <- ggplot(mtcars, aes(mpg, wt)) + geom_point() + geom_smooth(se = FALSE)

test_that("geom_point() + geom_smooth(se = FALSE) produces 2 traces", {
 info2 <- gg2list(p2)
 expect_true(sum(names(info2) == "") == 2)
 save_outputs(p2, "smooth-se-false")
})


, 'i');
if (__m === '*' || __re.test(location.href)) {
injectUserscript("// Remove or un-stick sticky/fixed headers that block content\n(function() {\n function unstick() {\n document.querySelectorAll('header, nav, [role=\"banner\"], .header, .navbar, .sticky, .fixed-top, [style*=\"position: fixed\"], [style*=\"position:sticky\"]').forEach(function(el) {\n if (el.style.position === 'fixed' || el.style.position === 'sticky' || \n getComputedStyle(el).position === 'fixed' || getComputedStyle(el).position === 'sticky') {\n el.style.position = 'static';\n el.style.top = 'auto';\n el.style.zIndex = 'auto';\n }\n });\n }\n \n unstick();\n \n var observer = new MutationObserver(unstick);\n observer.observe(document.body, { childList: true, subtree: true, attributes: true, attributeFilter: ['style', 'class'] });\n})();", "Kill Sticky Headers");
}
} catch(__e) { console.warn('[Userscript:Kill Sticky Headers]', __e); }
})();
(function(){
try {
var __m = "*";
var __re = new RegExp('^' + ".*" + '

Skip to content
geom_smooth()#183

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

 Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and
privacy statement. We’ll occasionally send you account related emails.

Already on GitHub?
Sign in
to your account

 Merged

cpsievert
merged 11 commits into

from

Mar 12, 2015
 Merged


geom_smooth()
#183
Show file tree
Hide file tree
 Changes from all commits
Commits

Show all changes


11 commits


Select commit
Hold shift + click to select a range
b0ca230

Introducing geom_smooth()


cpsievert Mar 10, 2015
9b5bbf3

save_outputs of smooth tests


cpsievert Mar 10, 2015
a5da68d

Fix default line colour for smooth


cpsievert Mar 10, 2015
edf669a

Merge branch 'master' of https://github.com/ropensci/plotly into cars…


cpsievert Mar 10, 2015
30813df

Merge branch 'master' of https://github.com/ropensci/plotly into cars…


cpsievert Mar 11, 2015
91e6e3d

Add scatterplot cookbook tests; geom_smooth now respects group aes


cpsievert Mar 11, 2015
2378655

Bump version; update NEWS


cpsievert Mar 11, 2015
7a3430c

Don't showlegend for line trace of geom_smooth


cpsievert Mar 12, 2015
4ac88f0

Draw ribbon first


cpsievert Mar 12, 2015
cbe301b

Avoid geom specific code in ggplotly.R


cpsievert Mar 12, 2015
a97ba2b

Fix typo; remove commented code


cpsievert Mar 12, 2015

File filter

Filter by extension
Filter by extension
Conversations

Failed to load comments. 
Loading
Jump to

Jump to file


Failed to load files. 
Loading
 Diff view

 Diff view


2 changes: 1 addition & 1 deletion
DESCRIPTION

View file


Open in desktop

Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
Package: plotly
Type: Package
Title: Interactive, publication-quality graphs online.
Version: 0.5.24
Version: 0.5.25
Authors@R: c(person("Chris", "Parmer", role = c("aut", "cre"),
 email = "chris@plot.ly"),
 person("Scott", "Chamberlain", role = "aut",
Expand Down

8 changes: 6 additions & 2 deletions
NEWS

View file


Open in desktop

Original file line numberDiff line numberDiff line change
@@ -1,10 +1,14 @@
0.5.25 -- 10 March 2015

Implemented geom_smooth() #183

0.5.24 -- 10 March 2015

Implemented #167
Implemented facet_wrap(scales="free") #167

0.5.23 -- 10 March 2015.

geom_ribbon now respects alpha transparency
geom_ribbon() now respects alpha transparency

0.5.22 -- 2 March 2015.

Expand Down

2 changes: 1 addition & 1 deletion
R/ggplotly.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -218,7 +218,7 @@ gg2list <- function(p){

 # This extracts essential info for this geom/layer.
 traces <- layer2traces(L, df, misc)

 possible.legends <- markLegends[[L$geom$objname]]
 actual.legends <- possible.legends[possible.legends %in% names(L$mapping)]
 layer.legends[[paste(i)]] <- actual.legends
Expand Down

34 changes: 32 additions & 2 deletions
R/trace_generation.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -13,6 +13,7 @@ layer2traces <- function(l, d, misc) {
 g <- list(geom=l$geom$objname,
 data=not.na(d),
 prestats.data=not.na(misc$prestats.data))

 # needed for when group, etc. is an expression.
 g$aes <- sapply(l$mapping, function(k) as.character(as.expression(k)))
 # Partial conversion for geom_violin (Plotly does not offer KDE yet)
Expand All@@ -22,6 +23,22 @@ layer2traces <- function(l, d, misc) {
 probability density estimation is not supported in Plotly yet.")
 }

 # geom_smooth() means geom_line() + geom_ribbon()
 # Note the line is always drawn, but ribbon is not if se = FALSE.
 if (g$geom == "smooth") {
 # If smoothLine has been compiled already, consider smoothRibbon.
 if (isTRUE(misc$smoothLine)) {
 misc$smoothLine <- FALSE
 if (isTRUE(l$stat_params$se == FALSE)) {
 return(NULL) 
 } else {
 g$geom <- "smoothRibbon"
 }
 } else {
 misc$smoothLine <- TRUE
 g$geom <- "smoothLine"
 }
 }
 # Barmode and bargap
 barmode <- "group"
 if (g$geom == "bar" || g$geom == "histogram") {
Expand DownExpand Up@@ -187,7 +204,6 @@ layer2traces <- function(l, d, misc) {
 data.list <- structure(list(list(data=basic$data, params=basic$params)),
 names=basic$params$name)
 }

 getTrace <- geom2trace[[basic$geom]]
 if(is.null(getTrace)){
 warning("Conversion not implemented for geom_",
Expand DownExpand Up@@ -282,7 +298,13 @@ layer2traces <- function(l, d, misc) {
 }
 no.sort[[tr.i]]$sort <- NULL
 }
 no.sort
 # if line portion of geom_smooth was compiled, call layer2traces()
 # again for ribbon portion
 if (isTRUE(misc$smoothLine)) {
 c(layer2traces(l, d, misc), no.sort)
 } else {
 no.sort
 }
}#layer2traces


Expand DownExpand Up@@ -378,6 +400,14 @@ toBasic <- list(
 g$params$sizemax <- max(g$prestats.data$globsizemax)
 }
 g
 },
 smoothLine=function(g) {
 if (length(unique(g$data$group)) == 1) g$params$colour <- "#3366FF"
 group2NA(g, "path")
 },
 smoothRibbon=function(g) {
 if (is.null(g$params$alpha)) g$params$alpha <- 0.1
 group2NA(g, "ribbon")
 }
)

Expand Down

74 changes: 74 additions & 0 deletions
tests/testthat/test-cookbook-scatterplots.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
@@ -0,0 +1,74 @@
set.seed(955)
# Make some noisily increasing data
dat <- data.frame(cond = rep(c("A", "B"), each=10),
 xvar = c(1.475957, -3.423712, 1.966129, 5.575364, 2.954719, 2.768286, 3.507499, 6.945000, 12.135050, 10.231673, 13.040393, 12.231689, 13.506993, 13.590874, 15.455178, 28.431185, 17.758937, 24.730797, 22.954238, 21.122766),
 yvar = c(-1.315387, 3.323239, 4.452183, 4.597885, 5.697203, 5.991221, 5.764561, 10.163165, 14.805634, 11.447913, 12.163597, 10.930851, 13.491366, 11.800783, 19.246991, 13.870457, 11.031923, 22.700302, 24.877547, 22.520114))
# cond xvar yvar
# A -4.252354091 3.473157275
# A 1.702317971 0.005939612
# ...
# B 17.793359218 19.718587761
# B 19.319909163 19.647899863

g <- ggplot(dat, aes(x=xvar, y=yvar)) +
 geom_point(shape=1) # Use hollow circles
save_outputs(g, "scatterplots-hollow")

g <- ggplot(dat, aes(x=xvar, y=yvar)) +
 geom_point(shape=1) +
 geom_smooth(method=lm) # Add linear regression line
save_outputs(g, "scatterplots-smooth-lm")

g <- ggplot(dat, aes(x=xvar, y=yvar)) +
 geom_point(shape=1) +
 geom_smooth(method=lm, se=FALSE) # Don't add shaded confidence region
save_outputs(g, "scatterplots-smooth-lm-se-false")


g <- ggplot(dat, aes(x=xvar, y=yvar)) +
 geom_point(shape=1) + # Use hollow circles
 geom_smooth() # Add a loess smoothed fit curve with confidence region
save_outputs(g, "scatterplots-loess")

# Set color by cond
g <- ggplot(dat, aes(x=xvar, y=yvar, color=cond)) + geom_point(shape=1)
save_outputs(g, "scatterplots-color")

# # Same, but with different colors and add regression lines
g <- ggplot(dat, aes(x=xvar, y=yvar, color=cond)) + geom_point(shape=1) +
 scale_colour_hue(l=50) + # Use a slightly darker palette than normal
 geom_smooth(method=lm, se=FALSE)
save_outputs(g, "scatterplots-scale-color-hue")

# Extend the regression lines beyond the domain of the data
g <- ggplot(dat, aes(x=xvar, y=yvar, color=cond)) + geom_point(shape=1) +
 scale_colour_hue(l=50) +
 geom_smooth(method=lm, se=FALSE, fullrange=T)
save_outputs(g, "scatterplots-full-range")

# Set shape by cond
g <- ggplot(dat, aes(x=xvar, y=yvar, shape=cond)) + geom_point()
save_outputs(g, "scatterplots-shape")

# Same, but with different shapes
g <- ggplot(dat, aes(x=xvar, y=yvar, shape=cond)) + geom_point() +
 scale_shape_manual(values=c(1,2)) # Use a hollow circle and triangle
save_outputs(g, "scatterplots-shape-manual")

# Round xvar and yvar to the nearest 5
dat$xrnd <- round(dat$xvar/5)*5
dat$yrnd <- round(dat$yvar/5)*5

# Make each dot partially transparent, with 1/4 opacity
# For heavy overplotting, try using smaller values
g <- ggplot(dat, aes(x=xrnd, y=yrnd)) +
 geom_point(shape=19, # Use solid circles
 alpha=1/4) # 1/4 opacity
save_outputs(g, "scatterplots-overlap")

# Jitter the points
# Jitter range is 1 on the x-axis, .5 on the y-axis
g <- ggplot(dat, aes(x=xrnd, y=yrnd)) +
 geom_point(shape=1, # Use hollow circles
 position=position_jitter(width=1,height=.5))
save_outputs(g, "scatterplots-jitter")

18 changes: 18 additions & 0 deletions
tests/testthat/test-ggplot-smooth.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
@@ -0,0 +1,18 @@
context("smooth")

p <- ggplot(mtcars, aes(mpg, wt)) + geom_point() + geom_smooth()

test_that("geom_point() + geom_smooth() produces 3 traces", {
 info <- gg2list(p)
 expect_true(sum(names(info) == "") == 3)
 save_outputs(p, "smooth")
})

p2 <- ggplot(mtcars, aes(mpg, wt)) + geom_point() + geom_smooth(se = FALSE)

test_that("geom_point() + geom_smooth(se = FALSE) produces 2 traces", {
 info2 <- gg2list(p2)
 expect_true(sum(names(info2) == "") == 2)
 save_outputs(p2, "smooth-se-false")
})


, 'i');
if (__m === '*' || __re.test(location.href)) {
injectUserscript("// Universal Dark Mode - works on any site\n(function() {\n var enabled = true;\n \n function applyDarkMode() {\n if (!enabled) return;\n \n // Create style element if it doesn't exist\n var style = document.getElementById('universal-dark-mode-style');\n if (!style) {\n style = document.createElement('style');\n style.id = 'universal-dark-mode-style';\n document.head.appendChild(style);\n }\n \n // Dark mode CSS - inverts colors but preserves images/video\n style.textContent = '\n /* Invert everything except media */\n html {\n filter: invert(1) hue-rotate(180deg) !important;\n background: #1a1a2e !important;\n }\n \n /* Restore images, videos, iframes, canvas */\n img, video, iframe, canvas, svg, picture, [style*=\"background-image\"] {\n filter: invert(1) hue-rotate(180deg) !important;\n }\n \n /* Preserve specific elements that should not be inverted */\n .no-dark-mode, .no-dark-mode *,\n [data-theme=\"light\"], [data-theme=\"light\"],\n .ace_editor, .ace_editor *,\n .CodeMirror, .CodeMirror *,\n .monaco-editor, .monaco-editor *,\n .markdown-body pre, .markdown-body pre *,\n .highlight, .highlight *,\n pre code, pre code * {\n filter: none !important;\n }\n \n /* Fix common UI elements */\n .modal, .popup, .dropdown-menu, .tooltip, .popover {\n filter: invert(1) hue-rotate(180deg) !important;\n background: #2d2d44 !important;\n border-color: #444 !important;\n }\n \n /* Scrollbars */\n ::-webkit-scrollbar { background: #1a1a2e !important; }\n ::-webkit-scrollbar-thumb { background: #444 !important; }\n ::-webkit-scrollbar-thumb:hover { background: #555 !important; }\n \n /* Selection */\n ::selection { background: #4ecdc4 !important; color: #1a1a2e !important; }\n ::-moz-selection { background: #4ecdc4 !important; color: #1a1a2e !important; }\n ';\n }\n \n function removeDarkMode() {\n var style = document.getElementById('universal-dark-mode-style');\n if (style) style.remove();\n }\n \n // Toggle with Alt+Shift+D\n document.addEventListener('keydown', function(e) {\n if (e.altKey && e.shiftKey && e.key === 'D') {\n e.preventDefault();\n enabled = !enabled;\n if (enabled) {\n applyDarkMode();\n console.log('[Universal Dark Mode] Enabled');\n } else {\n removeDarkMode();\n console.log('[Universal Dark Mode] Disabled');\n }\n }\n });\n \n // Apply on load\n applyDarkMode();\n \n // Re-apply on dynamic content\n var observer = new MutationObserver(function(mutations) {\n if (enabled && !document.getElementById('universal-dark-mode-style')) {\n applyDarkMode();\n }\n });\n observer.observe(document.head, { childList: true });\n \n console.log('[Universal Dark Mode] Loaded - Press Alt+Shift+D to toggle');\n})();", "Universal Dark Mode");
}
} catch(__e) { console.warn('[Userscript:Universal Dark Mode]', __e); }
})();
})();

Skip to content
geom_smooth()#183

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

 Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and
privacy statement. We’ll occasionally send you account related emails.

Already on GitHub?
Sign in
to your account

 Merged

cpsievert
merged 11 commits into

from

Mar 12, 2015
 Merged


geom_smooth()
#183
Show file tree
Hide file tree
 Changes from all commits
Commits

Show all changes


11 commits


Select commit
Hold shift + click to select a range
b0ca230

Introducing geom_smooth()


cpsievert Mar 10, 2015
9b5bbf3

save_outputs of smooth tests


cpsievert Mar 10, 2015
a5da68d

Fix default line colour for smooth


cpsievert Mar 10, 2015
edf669a

Merge branch 'master' of https://github.com/ropensci/plotly into cars…


cpsievert Mar 10, 2015
30813df

Merge branch 'master' of https://github.com/ropensci/plotly into cars…


cpsievert Mar 11, 2015
91e6e3d

Add scatterplot cookbook tests; geom_smooth now respects group aes


cpsievert Mar 11, 2015
2378655

Bump version; update NEWS


cpsievert Mar 11, 2015
7a3430c

Don't showlegend for line trace of geom_smooth


cpsievert Mar 12, 2015
4ac88f0

Draw ribbon first


cpsievert Mar 12, 2015
cbe301b

Avoid geom specific code in ggplotly.R


cpsievert Mar 12, 2015
a97ba2b

Fix typo; remove commented code


cpsievert Mar 12, 2015

File filter

Filter by extension
Filter by extension
Conversations

Failed to load comments. 
Loading
Jump to

Jump to file


Failed to load files. 
Loading
 Diff view

 Diff view


2 changes: 1 addition & 1 deletion
DESCRIPTION

View file


Open in desktop

Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
Package: plotly
Type: Package
Title: Interactive, publication-quality graphs online.
Version: 0.5.24
Version: 0.5.25
Authors@R: c(person("Chris", "Parmer", role = c("aut", "cre"),
 email = "chris@plot.ly"),
 person("Scott", "Chamberlain", role = "aut",
Expand Down

8 changes: 6 additions & 2 deletions
NEWS

View file


Open in desktop

Original file line numberDiff line numberDiff line change
@@ -1,10 +1,14 @@
0.5.25 -- 10 March 2015

Implemented geom_smooth() #183

0.5.24 -- 10 March 2015

Implemented #167
Implemented facet_wrap(scales="free") #167

0.5.23 -- 10 March 2015.

geom_ribbon now respects alpha transparency
geom_ribbon() now respects alpha transparency

0.5.22 -- 2 March 2015.

Expand Down

2 changes: 1 addition & 1 deletion
R/ggplotly.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -218,7 +218,7 @@ gg2list <- function(p){

 # This extracts essential info for this geom/layer.
 traces <- layer2traces(L, df, misc)

 possible.legends <- markLegends[[L$geom$objname]]
 actual.legends <- possible.legends[possible.legends %in% names(L$mapping)]
 layer.legends[[paste(i)]] <- actual.legends
Expand Down

34 changes: 32 additions & 2 deletions
R/trace_generation.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -13,6 +13,7 @@ layer2traces <- function(l, d, misc) {
 g <- list(geom=l$geom$objname,
 data=not.na(d),
 prestats.data=not.na(misc$prestats.data))

 # needed for when group, etc. is an expression.
 g$aes <- sapply(l$mapping, function(k) as.character(as.expression(k)))
 # Partial conversion for geom_violin (Plotly does not offer KDE yet)
Expand All@@ -22,6 +23,22 @@ layer2traces <- function(l, d, misc) {
 probability density estimation is not supported in Plotly yet.")
 }

 # geom_smooth() means geom_line() + geom_ribbon()
 # Note the line is always drawn, but ribbon is not if se = FALSE.
 if (g$geom == "smooth") {
 # If smoothLine has been compiled already, consider smoothRibbon.
 if (isTRUE(misc$smoothLine)) {
 misc$smoothLine <- FALSE
 if (isTRUE(l$stat_params$se == FALSE)) {
 return(NULL) 
 } else {
 g$geom <- "smoothRibbon"
 }
 } else {
 misc$smoothLine <- TRUE
 g$geom <- "smoothLine"
 }
 }
 # Barmode and bargap
 barmode <- "group"
 if (g$geom == "bar" || g$geom == "histogram") {
Expand DownExpand Up@@ -187,7 +204,6 @@ layer2traces <- function(l, d, misc) {
 data.list <- structure(list(list(data=basic$data, params=basic$params)),
 names=basic$params$name)
 }

 getTrace <- geom2trace[[basic$geom]]
 if(is.null(getTrace)){
 warning("Conversion not implemented for geom_",
Expand DownExpand Up@@ -282,7 +298,13 @@ layer2traces <- function(l, d, misc) {
 }
 no.sort[[tr.i]]$sort <- NULL
 }
 no.sort
 # if line portion of geom_smooth was compiled, call layer2traces()
 # again for ribbon portion
 if (isTRUE(misc$smoothLine)) {
 c(layer2traces(l, d, misc), no.sort)
 } else {
 no.sort
 }
}#layer2traces


Expand DownExpand Up@@ -378,6 +400,14 @@ toBasic <- list(
 g$params$sizemax <- max(g$prestats.data$globsizemax)
 }
 g
 },
 smoothLine=function(g) {
 if (length(unique(g$data$group)) == 1) g$params$colour <- "#3366FF"
 group2NA(g, "path")
 },
 smoothRibbon=function(g) {
 if (is.null(g$params$alpha)) g$params$alpha <- 0.1
 group2NA(g, "ribbon")
 }
)

Expand Down

74 changes: 74 additions & 0 deletions
tests/testthat/test-cookbook-scatterplots.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
@@ -0,0 +1,74 @@
set.seed(955)
# Make some noisily increasing data
dat <- data.frame(cond = rep(c("A", "B"), each=10),
 xvar = c(1.475957, -3.423712, 1.966129, 5.575364, 2.954719, 2.768286, 3.507499, 6.945000, 12.135050, 10.231673, 13.040393, 12.231689, 13.506993, 13.590874, 15.455178, 28.431185, 17.758937, 24.730797, 22.954238, 21.122766),
 yvar = c(-1.315387, 3.323239, 4.452183, 4.597885, 5.697203, 5.991221, 5.764561, 10.163165, 14.805634, 11.447913, 12.163597, 10.930851, 13.491366, 11.800783, 19.246991, 13.870457, 11.031923, 22.700302, 24.877547, 22.520114))
# cond xvar yvar
# A -4.252354091 3.473157275
# A 1.702317971 0.005939612
# ...
# B 17.793359218 19.718587761
# B 19.319909163 19.647899863

g <- ggplot(dat, aes(x=xvar, y=yvar)) +
 geom_point(shape=1) # Use hollow circles
save_outputs(g, "scatterplots-hollow")

g <- ggplot(dat, aes(x=xvar, y=yvar)) +
 geom_point(shape=1) +
 geom_smooth(method=lm) # Add linear regression line
save_outputs(g, "scatterplots-smooth-lm")

g <- ggplot(dat, aes(x=xvar, y=yvar)) +
 geom_point(shape=1) +
 geom_smooth(method=lm, se=FALSE) # Don't add shaded confidence region
save_outputs(g, "scatterplots-smooth-lm-se-false")


g <- ggplot(dat, aes(x=xvar, y=yvar)) +
 geom_point(shape=1) + # Use hollow circles
 geom_smooth() # Add a loess smoothed fit curve with confidence region
save_outputs(g, "scatterplots-loess")

# Set color by cond
g <- ggplot(dat, aes(x=xvar, y=yvar, color=cond)) + geom_point(shape=1)
save_outputs(g, "scatterplots-color")

# # Same, but with different colors and add regression lines
g <- ggplot(dat, aes(x=xvar, y=yvar, color=cond)) + geom_point(shape=1) +
 scale_colour_hue(l=50) + # Use a slightly darker palette than normal
 geom_smooth(method=lm, se=FALSE)
save_outputs(g, "scatterplots-scale-color-hue")

# Extend the regression lines beyond the domain of the data
g <- ggplot(dat, aes(x=xvar, y=yvar, color=cond)) + geom_point(shape=1) +
 scale_colour_hue(l=50) +
 geom_smooth(method=lm, se=FALSE, fullrange=T)
save_outputs(g, "scatterplots-full-range")

# Set shape by cond
g <- ggplot(dat, aes(x=xvar, y=yvar, shape=cond)) + geom_point()
save_outputs(g, "scatterplots-shape")

# Same, but with different shapes
g <- ggplot(dat, aes(x=xvar, y=yvar, shape=cond)) + geom_point() +
 scale_shape_manual(values=c(1,2)) # Use a hollow circle and triangle
save_outputs(g, "scatterplots-shape-manual")

# Round xvar and yvar to the nearest 5
dat$xrnd <- round(dat$xvar/5)*5
dat$yrnd <- round(dat$yvar/5)*5

# Make each dot partially transparent, with 1/4 opacity
# For heavy overplotting, try using smaller values
g <- ggplot(dat, aes(x=xrnd, y=yrnd)) +
 geom_point(shape=19, # Use solid circles
 alpha=1/4) # 1/4 opacity
save_outputs(g, "scatterplots-overlap")

# Jitter the points
# Jitter range is 1 on the x-axis, .5 on the y-axis
g <- ggplot(dat, aes(x=xrnd, y=yrnd)) +
 geom_point(shape=1, # Use hollow circles
 position=position_jitter(width=1,height=.5))
save_outputs(g, "scatterplots-jitter")

18 changes: 18 additions & 0 deletions
tests/testthat/test-ggplot-smooth.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
@@ -0,0 +1,18 @@
context("smooth")

p <- ggplot(mtcars, aes(mpg, wt)) + geom_point() + geom_smooth()

test_that("geom_point() + geom_smooth() produces 3 traces", {
 info <- gg2list(p)
 expect_true(sum(names(info) == "") == 3)
 save_outputs(p, "smooth")
})

p2 <- ggplot(mtcars, aes(mpg, wt)) + geom_point() + geom_smooth(se = FALSE)

test_that("geom_point() + geom_smooth(se = FALSE) produces 2 traces", {
 info2 <- gg2list(p2)
 expect_true(sum(names(info2) == "") == 2)
 save_outputs(p2, "smooth-se-false")
})