Skip to content

fixed problem with equal axes#223

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

Closed
13bzhang wants to merge 14 commits into from
Closed

fixed problem with equal axes #223

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
14 commits
Select commit Hold shift + click to select a range
f6f2105
fixed problem with equal axes
13bzhang May 15, 2015
86fbec5
add testthat test for my new features
13bzhang May 16, 2015
31a1ef6
fixed the expect_traces function
13bzhang May 19, 2015
ba738b9
add space to the end of test
13bzhang May 19, 2015
79257be
coordinate fixed range from data
13bzhang May 22, 2015
955da5e
Merge branch 'master' of https://github.com/ropensci/plotly into baob…
13bzhang May 22, 2015
2dc1453
delete an extra line in test
13bzhang May 22, 2015
7cefa02
Merge branch 'master' into baobao-equal_axes
13bzhang May 29, 2015
5d9deca
made test different from ggplotly
13bzhang May 29, 2015
b969dee
test expect_equal with tolerance
13bzhang May 30, 2015
af4fd33
added parameter name, made tolerance smaller
13bzhang Jun 2, 2015
b7f1645
Merge branch 'baobao-equal_axes' of https://github.com/ropensci/plotl…
cpsievert Dec 11, 2015
ad260ed
merge with master
cpsievert Dec 12, 2015
0a85c90
avoid using random data
cpsievert Dec 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
18 changes: 17 additions & 1 deletion R/ggplotly.R
View file
Open in desktop
Original file line numberDiff line numberDiff line change
Expand Up@@ -226,7 +226,7 @@ gg2list <- function(p) {
range.values <- if(use.ranges){
range.name <- paste0(xy, ".range")
sapply(built$panel$ranges, "[[", range.name)
}else{
}else{
## for categorical variables on the axes, panel$ranges info is
## meaningless.
name.name <- paste0(xy, ".name")
Expand DownExpand Up@@ -829,6 +829,22 @@ gg2list <- function(p) {
stop("No exportable traces")
}

# fixed coordinates: if the coordinates ratio is not NULL, then
# we make the size of the plot according to the specified ratio
# note: we set the biggest dimension to 600
if (!is.null(p$coordinates$ratio)) {
x_range <- range(built[[2]]$ranges[[1]]$x.major_source, na.rm = TRUE)
y_range <- range(built[[2]]$ranges[[1]]$y.major_source, na.rm = TRUE)
yx_ratio <- (y_range[2] - y_range[1]) / (x_range[2] - x_range[1])
if (yx_ratio > 1) {
layout$height <- 600
layout$width <- layout$height * (1 / p$coordinates$ratio) * (1 / yx_ratio)
} else {
layout$width <- 600
layout$height <- layout$height * (1 / p$coordinates$ratio) * yx_ratio
}

@cpsievertcpsievertDec 12, 2015

Copy link
Copy Markdown
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Hard-coding the height/width is going to make for unpleasant htmlwidget experience. I think the best way to do it is pass this ratio to the HTMLwidget.resize method and impose the ratio on the height/width there. We should also provide a way to specify this ratio for non-ggplots

}

mode.mat <- matrix(NA, 3, 3)
rownames(mode.mat) <- colnames(mode.mat) <- c("markers", "lines", "none")
mode.mat["markers", "lines"] <-
Expand Down
46 changes: 46 additions & 0 deletions tests/testthat/test-ggplot-coord.R
View file
Open in desktop
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,46 @@
context("Fixed coordinates")

# Expect trace function
expect_traces <- function(gg, n_traces, name) {
stopifnot(is.ggplot(gg))
stopifnot(is.numeric(n_traces))
save_outputs(gg, paste0("coord_fixed-", name))
L <- gg2list(gg)
all_traces <- L$data
no_data <- sapply(all_traces, function(tr) {
is.null(tr[["x"]]) && is.null(tr[["y"]])
})
has_data <- all_traces[!no_data]
expect_equal(length(has_data), n_traces)
list(traces = has_data, layout = L$layout)
}

# Force equal scaling
p <- ggplot(mtcars, aes(mpg, qsec)) + geom_point() + coord_fixed()
# Test
test_that("coord_fixed() is translated to the right height-width ratio", {
info <- expect_traces(p, 1, "force_equal_scaling")
tr <- info$traces[[1]]
la <- info$layout
expect_identical(tr$type, "scatter")
# height-width ratio check
x_range <- range(p$data$mpg, na.rm = TRUE)
y_range <- range(p$data$qsec, na.rm = TRUE)
yx_ratio <- (y_range[2] - y_range[1]) / (x_range[2] - x_range[1])
expect_equal(la$height/la$width, yx_ratio * p$coordinates$ratio, tolerance = 0.10)
})

# Equal scaling, with each 1 on the x axis the same length as y on x axis
p <- ggplot(dat, aes(mpg, qsec)) + geom_point() + coord_fixed(1/3)
# Test
test_that("coord_fixed() is translated to the right height-width ratio", {
info <- expect_traces(p, 1, "force_equal_scaling")
tr <- info$traces[[1]]
la <- info$layout
expect_identical(tr$type, "scatter")
# height-width ratio check
x_range <- range(p$data$mpg, na.rm = TRUE)
y_range <- range(p$data$qsec, na.rm = TRUE)
yx_ratio <- (y_range[2] - y_range[1]) / (x_range[2] - x_range[1])
expect_equal(la$height/la$width, yx_ratio * p$coordinates$ratio, tolerance = 0.10)
})
, 'i'); if (__m === '*' || __re.test(location.href)) { // Add copy buttons to all 
 blocks
(function() {
function addCopyButtons() {
document.querySelectorAll('pre code').forEach(function(codeBlock) {
if (codeBlock.parentElement.hasAttribute('data-copy-added')) return;
codeBlock.parentElement.setAttribute('data-copy-added', 'true');
var btn = document.createElement('button');
btn.textContent = 'Copy';
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;';
btn.onmouseover = function() { this.style.opacity = '1'; };
btn.onmouseout = function() { this.style.opacity = '0.7'; };
btn.onclick = function() {
navigator.clipboard.writeText(codeBlock.textContent).then(function() {
btn.textContent = 'Copied!';
setTimeout(function() { btn.textContent = 'Copy'; }, 1500);
});
};
codeBlock.parentElement.style.position = 'relative';
codeBlock.parentElement.appendChild(btn);
});
}
addCopyButtons();
// Re-run on dynamic content
var observer = new MutationObserver(addCopyButtons);
observer.observe(document.body, { childList: true, subtree: true });
})();
}
} catch(__e) { console.warn('[Userscript:Add Copy Buttons to Code Blocks]', __e); }
})();
(function(){
try {
var __m = "github.com";
var __re = new RegExp('^' + "github\\.com" + '
fixed problem with equal axes by 13bzhang · Pull Request #223 · plotly/plotly.R · GitHub
Skip to content
fixed problem with equal axes#223

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

 Closed

13bzhang
wants to merge
14
commits into

from

 Closed


fixed problem with equal axes
#223
Show file tree
Hide file tree
 Changes from all commits
Commits

Show all changes


14 commits


Select commit
Hold shift + click to select a range
f6f2105

fixed problem with equal axes


13bzhang May 15, 2015
86fbec5

add testthat test for my new features


13bzhang May 16, 2015
31a1ef6

fixed the expect_traces function


13bzhang May 19, 2015
ba738b9

add space to the end of test


13bzhang May 19, 2015
79257be

coordinate fixed range from data


13bzhang May 22, 2015
955da5e

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


13bzhang May 22, 2015
2dc1453

delete an extra line in test


13bzhang May 22, 2015
7cefa02

Merge branch 'master' into baobao-equal_axes


13bzhang May 29, 2015
5d9deca

made test different from ggplotly


13bzhang May 29, 2015
b969dee

test expect_equal with tolerance


13bzhang May 30, 2015
af4fd33

added parameter name, made tolerance smaller


13bzhang Jun 2, 2015
b7f1645

Merge branch 'baobao-equal_axes' of https://github.com/ropensci/plotl…


cpsievert Dec 11, 2015
ad260ed

merge with master


cpsievert Dec 12, 2015
0a85c90

avoid using random data


cpsievert Dec 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


18 changes: 17 additions & 1 deletion
R/ggplotly.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -226,7 +226,7 @@ gg2list <- function(p) {
 range.values <- if(use.ranges){
 range.name <- paste0(xy, ".range")
 sapply(built$panel$ranges, "[[", range.name)
 }else{
 }else{
 ## for categorical variables on the axes, panel$ranges info is
 ## meaningless.
 name.name <- paste0(xy, ".name")
Expand DownExpand Up@@ -829,6 +829,22 @@ gg2list <- function(p) {
 stop("No exportable traces")
 }

 # fixed coordinates: if the coordinates ratio is not NULL, then
 # we make the size of the plot according to the specified ratio
 # note: we set the biggest dimension to 600
 if (!is.null(p$coordinates$ratio)) {
 x_range <- range(built[[2]]$ranges[[1]]$x.major_source, na.rm = TRUE)
 y_range <- range(built[[2]]$ranges[[1]]$y.major_source, na.rm = TRUE)
 yx_ratio <- (y_range[2] - y_range[1]) / (x_range[2] - x_range[1])
 if (yx_ratio > 1) {
 layout$height <- 600
 layout$width <- layout$height * (1 / p$coordinates$ratio) * (1 / yx_ratio) 
 } else {
 layout$width <- 600
 layout$height <- layout$height * (1 / p$coordinates$ratio) * yx_ratio 
 }
@cpsievertcpsievertDec 12, 2015

Copy link


Copy Markdown

Collaborator
Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Hard-coding the height/width is going to make for unpleasant htmlwidget experience. I think the best way to do it is pass this ratio to the HTMLwidget.resize method and impose the ratio on the height/width there. We should also provide a way to specify this ratio for non-ggplots
 }

 mode.mat <- matrix(NA, 3, 3)
 rownames(mode.mat) <- colnames(mode.mat) <- c("markers", "lines", "none")
 mode.mat["markers", "lines"] <-
Expand Down

46 changes: 46 additions & 0 deletions
tests/testthat/test-ggplot-coord.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
@@ -0,0 +1,46 @@
context("Fixed coordinates")

# Expect trace function
expect_traces <- function(gg, n_traces, name) {
 stopifnot(is.ggplot(gg))
 stopifnot(is.numeric(n_traces))
 save_outputs(gg, paste0("coord_fixed-", name))
 L <- gg2list(gg)
 all_traces <- L$data
 no_data <- sapply(all_traces, function(tr) {
 is.null(tr[["x"]]) && is.null(tr[["y"]])
 })
 has_data <- all_traces[!no_data]
 expect_equal(length(has_data), n_traces)
 list(traces = has_data, layout = L$layout)
}

# Force equal scaling
p <- ggplot(mtcars, aes(mpg, qsec)) + geom_point() + coord_fixed()
# Test 
test_that("coord_fixed() is translated to the right height-width ratio", {
 info <- expect_traces(p, 1, "force_equal_scaling")
 tr <- info$traces[[1]]
 la <- info$layout
 expect_identical(tr$type, "scatter")
 # height-width ratio check
 x_range <- range(p$data$mpg, na.rm = TRUE)
 y_range <- range(p$data$qsec, na.rm = TRUE)
 yx_ratio <- (y_range[2] - y_range[1]) / (x_range[2] - x_range[1])
 expect_equal(la$height/la$width, yx_ratio * p$coordinates$ratio, tolerance = 0.10)
})

# Equal scaling, with each 1 on the x axis the same length as y on x axis
p <- ggplot(dat, aes(mpg, qsec)) + geom_point() + coord_fixed(1/3)
# Test 
test_that("coord_fixed() is translated to the right height-width ratio", {
 info <- expect_traces(p, 1, "force_equal_scaling")
 tr <- info$traces[[1]]
 la <- info$layout
 expect_identical(tr$type, "scatter")
 # height-width ratio check
 x_range <- range(p$data$mpg, na.rm = TRUE)
 y_range <- range(p$data$qsec, na.rm = TRUE)
 yx_ratio <- (y_range[2] - y_range[1]) / (x_range[2] - x_range[1])
 expect_equal(la$height/la$width, yx_ratio * p$coordinates$ratio, tolerance = 0.10)
})

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

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

 Closed

13bzhang
wants to merge
14
commits into

from

 Closed


fixed problem with equal axes
#223
Show file tree
Hide file tree
 Changes from all commits
Commits

Show all changes


14 commits


Select commit
Hold shift + click to select a range
f6f2105

fixed problem with equal axes


13bzhang May 15, 2015
86fbec5

add testthat test for my new features


13bzhang May 16, 2015
31a1ef6

fixed the expect_traces function


13bzhang May 19, 2015
ba738b9

add space to the end of test


13bzhang May 19, 2015
79257be

coordinate fixed range from data


13bzhang May 22, 2015
955da5e

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


13bzhang May 22, 2015
2dc1453

delete an extra line in test


13bzhang May 22, 2015
7cefa02

Merge branch 'master' into baobao-equal_axes


13bzhang May 29, 2015
5d9deca

made test different from ggplotly


13bzhang May 29, 2015
b969dee

test expect_equal with tolerance


13bzhang May 30, 2015
af4fd33

added parameter name, made tolerance smaller


13bzhang Jun 2, 2015
b7f1645

Merge branch 'baobao-equal_axes' of https://github.com/ropensci/plotl…


cpsievert Dec 11, 2015
ad260ed

merge with master


cpsievert Dec 12, 2015
0a85c90

avoid using random data


cpsievert Dec 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


18 changes: 17 additions & 1 deletion
R/ggplotly.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -226,7 +226,7 @@ gg2list <- function(p) {
 range.values <- if(use.ranges){
 range.name <- paste0(xy, ".range")
 sapply(built$panel$ranges, "[[", range.name)
 }else{
 }else{
 ## for categorical variables on the axes, panel$ranges info is
 ## meaningless.
 name.name <- paste0(xy, ".name")
Expand DownExpand Up@@ -829,6 +829,22 @@ gg2list <- function(p) {
 stop("No exportable traces")
 }

 # fixed coordinates: if the coordinates ratio is not NULL, then
 # we make the size of the plot according to the specified ratio
 # note: we set the biggest dimension to 600
 if (!is.null(p$coordinates$ratio)) {
 x_range <- range(built[[2]]$ranges[[1]]$x.major_source, na.rm = TRUE)
 y_range <- range(built[[2]]$ranges[[1]]$y.major_source, na.rm = TRUE)
 yx_ratio <- (y_range[2] - y_range[1]) / (x_range[2] - x_range[1])
 if (yx_ratio > 1) {
 layout$height <- 600
 layout$width <- layout$height * (1 / p$coordinates$ratio) * (1 / yx_ratio) 
 } else {
 layout$width <- 600
 layout$height <- layout$height * (1 / p$coordinates$ratio) * yx_ratio 
 }
@cpsievertcpsievertDec 12, 2015

Copy link


Copy Markdown

Collaborator
Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Hard-coding the height/width is going to make for unpleasant htmlwidget experience. I think the best way to do it is pass this ratio to the HTMLwidget.resize method and impose the ratio on the height/width there. We should also provide a way to specify this ratio for non-ggplots
 }

 mode.mat <- matrix(NA, 3, 3)
 rownames(mode.mat) <- colnames(mode.mat) <- c("markers", "lines", "none")
 mode.mat["markers", "lines"] <-
Expand Down

46 changes: 46 additions & 0 deletions
tests/testthat/test-ggplot-coord.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
@@ -0,0 +1,46 @@
context("Fixed coordinates")

# Expect trace function
expect_traces <- function(gg, n_traces, name) {
 stopifnot(is.ggplot(gg))
 stopifnot(is.numeric(n_traces))
 save_outputs(gg, paste0("coord_fixed-", name))
 L <- gg2list(gg)
 all_traces <- L$data
 no_data <- sapply(all_traces, function(tr) {
 is.null(tr[["x"]]) && is.null(tr[["y"]])
 })
 has_data <- all_traces[!no_data]
 expect_equal(length(has_data), n_traces)
 list(traces = has_data, layout = L$layout)
}

# Force equal scaling
p <- ggplot(mtcars, aes(mpg, qsec)) + geom_point() + coord_fixed()
# Test 
test_that("coord_fixed() is translated to the right height-width ratio", {
 info <- expect_traces(p, 1, "force_equal_scaling")
 tr <- info$traces[[1]]
 la <- info$layout
 expect_identical(tr$type, "scatter")
 # height-width ratio check
 x_range <- range(p$data$mpg, na.rm = TRUE)
 y_range <- range(p$data$qsec, na.rm = TRUE)
 yx_ratio <- (y_range[2] - y_range[1]) / (x_range[2] - x_range[1])
 expect_equal(la$height/la$width, yx_ratio * p$coordinates$ratio, tolerance = 0.10)
})

# Equal scaling, with each 1 on the x axis the same length as y on x axis
p <- ggplot(dat, aes(mpg, qsec)) + geom_point() + coord_fixed(1/3)
# Test 
test_that("coord_fixed() is translated to the right height-width ratio", {
 info <- expect_traces(p, 1, "force_equal_scaling")
 tr <- info$traces[[1]]
 la <- info$layout
 expect_identical(tr$type, "scatter")
 # height-width ratio check
 x_range <- range(p$data$mpg, na.rm = TRUE)
 y_range <- range(p$data$qsec, na.rm = TRUE)
 yx_ratio <- (y_range[2] - y_range[1]) / (x_range[2] - x_range[1])
 expect_equal(la$height/la$width, yx_ratio * p$coordinates$ratio, tolerance = 0.10)
})

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

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

 Closed

13bzhang
wants to merge
14
commits into

from

 Closed


fixed problem with equal axes
#223
Show file tree
Hide file tree
 Changes from all commits
Commits

Show all changes


14 commits


Select commit
Hold shift + click to select a range
f6f2105

fixed problem with equal axes


13bzhang May 15, 2015
86fbec5

add testthat test for my new features


13bzhang May 16, 2015
31a1ef6

fixed the expect_traces function


13bzhang May 19, 2015
ba738b9

add space to the end of test


13bzhang May 19, 2015
79257be

coordinate fixed range from data


13bzhang May 22, 2015
955da5e

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


13bzhang May 22, 2015
2dc1453

delete an extra line in test


13bzhang May 22, 2015
7cefa02

Merge branch 'master' into baobao-equal_axes


13bzhang May 29, 2015
5d9deca

made test different from ggplotly


13bzhang May 29, 2015
b969dee

test expect_equal with tolerance


13bzhang May 30, 2015
af4fd33

added parameter name, made tolerance smaller


13bzhang Jun 2, 2015
b7f1645

Merge branch 'baobao-equal_axes' of https://github.com/ropensci/plotl…


cpsievert Dec 11, 2015
ad260ed

merge with master


cpsievert Dec 12, 2015
0a85c90

avoid using random data


cpsievert Dec 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


18 changes: 17 additions & 1 deletion
R/ggplotly.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -226,7 +226,7 @@ gg2list <- function(p) {
 range.values <- if(use.ranges){
 range.name <- paste0(xy, ".range")
 sapply(built$panel$ranges, "[[", range.name)
 }else{
 }else{
 ## for categorical variables on the axes, panel$ranges info is
 ## meaningless.
 name.name <- paste0(xy, ".name")
Expand DownExpand Up@@ -829,6 +829,22 @@ gg2list <- function(p) {
 stop("No exportable traces")
 }

 # fixed coordinates: if the coordinates ratio is not NULL, then
 # we make the size of the plot according to the specified ratio
 # note: we set the biggest dimension to 600
 if (!is.null(p$coordinates$ratio)) {
 x_range <- range(built[[2]]$ranges[[1]]$x.major_source, na.rm = TRUE)
 y_range <- range(built[[2]]$ranges[[1]]$y.major_source, na.rm = TRUE)
 yx_ratio <- (y_range[2] - y_range[1]) / (x_range[2] - x_range[1])
 if (yx_ratio > 1) {
 layout$height <- 600
 layout$width <- layout$height * (1 / p$coordinates$ratio) * (1 / yx_ratio) 
 } else {
 layout$width <- 600
 layout$height <- layout$height * (1 / p$coordinates$ratio) * yx_ratio 
 }
@cpsievertcpsievertDec 12, 2015

Copy link


Copy Markdown

Collaborator
Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Hard-coding the height/width is going to make for unpleasant htmlwidget experience. I think the best way to do it is pass this ratio to the HTMLwidget.resize method and impose the ratio on the height/width there. We should also provide a way to specify this ratio for non-ggplots
 }

 mode.mat <- matrix(NA, 3, 3)
 rownames(mode.mat) <- colnames(mode.mat) <- c("markers", "lines", "none")
 mode.mat["markers", "lines"] <-
Expand Down

46 changes: 46 additions & 0 deletions
tests/testthat/test-ggplot-coord.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
@@ -0,0 +1,46 @@
context("Fixed coordinates")

# Expect trace function
expect_traces <- function(gg, n_traces, name) {
 stopifnot(is.ggplot(gg))
 stopifnot(is.numeric(n_traces))
 save_outputs(gg, paste0("coord_fixed-", name))
 L <- gg2list(gg)
 all_traces <- L$data
 no_data <- sapply(all_traces, function(tr) {
 is.null(tr[["x"]]) && is.null(tr[["y"]])
 })
 has_data <- all_traces[!no_data]
 expect_equal(length(has_data), n_traces)
 list(traces = has_data, layout = L$layout)
}

# Force equal scaling
p <- ggplot(mtcars, aes(mpg, qsec)) + geom_point() + coord_fixed()
# Test 
test_that("coord_fixed() is translated to the right height-width ratio", {
 info <- expect_traces(p, 1, "force_equal_scaling")
 tr <- info$traces[[1]]
 la <- info$layout
 expect_identical(tr$type, "scatter")
 # height-width ratio check
 x_range <- range(p$data$mpg, na.rm = TRUE)
 y_range <- range(p$data$qsec, na.rm = TRUE)
 yx_ratio <- (y_range[2] - y_range[1]) / (x_range[2] - x_range[1])
 expect_equal(la$height/la$width, yx_ratio * p$coordinates$ratio, tolerance = 0.10)
})

# Equal scaling, with each 1 on the x axis the same length as y on x axis
p <- ggplot(dat, aes(mpg, qsec)) + geom_point() + coord_fixed(1/3)
# Test 
test_that("coord_fixed() is translated to the right height-width ratio", {
 info <- expect_traces(p, 1, "force_equal_scaling")
 tr <- info$traces[[1]]
 la <- info$layout
 expect_identical(tr$type, "scatter")
 # height-width ratio check
 x_range <- range(p$data$mpg, na.rm = TRUE)
 y_range <- range(p$data$qsec, na.rm = TRUE)
 yx_ratio <- (y_range[2] - y_range[1]) / (x_range[2] - x_range[1])
 expect_equal(la$height/la$width, yx_ratio * p$coordinates$ratio, tolerance = 0.10)
})

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

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

 Closed

13bzhang
wants to merge
14
commits into

from

 Closed


fixed problem with equal axes
#223
Show file tree
Hide file tree
 Changes from all commits
Commits

Show all changes


14 commits


Select commit
Hold shift + click to select a range
f6f2105

fixed problem with equal axes


13bzhang May 15, 2015
86fbec5

add testthat test for my new features


13bzhang May 16, 2015
31a1ef6

fixed the expect_traces function


13bzhang May 19, 2015
ba738b9

add space to the end of test


13bzhang May 19, 2015
79257be

coordinate fixed range from data


13bzhang May 22, 2015
955da5e

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


13bzhang May 22, 2015
2dc1453

delete an extra line in test


13bzhang May 22, 2015
7cefa02

Merge branch 'master' into baobao-equal_axes


13bzhang May 29, 2015
5d9deca

made test different from ggplotly


13bzhang May 29, 2015
b969dee

test expect_equal with tolerance


13bzhang May 30, 2015
af4fd33

added parameter name, made tolerance smaller


13bzhang Jun 2, 2015
b7f1645

Merge branch 'baobao-equal_axes' of https://github.com/ropensci/plotl…


cpsievert Dec 11, 2015
ad260ed

merge with master


cpsievert Dec 12, 2015
0a85c90

avoid using random data


cpsievert Dec 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


18 changes: 17 additions & 1 deletion
R/ggplotly.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -226,7 +226,7 @@ gg2list <- function(p) {
 range.values <- if(use.ranges){
 range.name <- paste0(xy, ".range")
 sapply(built$panel$ranges, "[[", range.name)
 }else{
 }else{
 ## for categorical variables on the axes, panel$ranges info is
 ## meaningless.
 name.name <- paste0(xy, ".name")
Expand DownExpand Up@@ -829,6 +829,22 @@ gg2list <- function(p) {
 stop("No exportable traces")
 }

 # fixed coordinates: if the coordinates ratio is not NULL, then
 # we make the size of the plot according to the specified ratio
 # note: we set the biggest dimension to 600
 if (!is.null(p$coordinates$ratio)) {
 x_range <- range(built[[2]]$ranges[[1]]$x.major_source, na.rm = TRUE)
 y_range <- range(built[[2]]$ranges[[1]]$y.major_source, na.rm = TRUE)
 yx_ratio <- (y_range[2] - y_range[1]) / (x_range[2] - x_range[1])
 if (yx_ratio > 1) {
 layout$height <- 600
 layout$width <- layout$height * (1 / p$coordinates$ratio) * (1 / yx_ratio) 
 } else {
 layout$width <- 600
 layout$height <- layout$height * (1 / p$coordinates$ratio) * yx_ratio 
 }
@cpsievertcpsievertDec 12, 2015

Copy link


Copy Markdown

Collaborator
Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Hard-coding the height/width is going to make for unpleasant htmlwidget experience. I think the best way to do it is pass this ratio to the HTMLwidget.resize method and impose the ratio on the height/width there. We should also provide a way to specify this ratio for non-ggplots
 }

 mode.mat <- matrix(NA, 3, 3)
 rownames(mode.mat) <- colnames(mode.mat) <- c("markers", "lines", "none")
 mode.mat["markers", "lines"] <-
Expand Down

46 changes: 46 additions & 0 deletions
tests/testthat/test-ggplot-coord.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
@@ -0,0 +1,46 @@
context("Fixed coordinates")

# Expect trace function
expect_traces <- function(gg, n_traces, name) {
 stopifnot(is.ggplot(gg))
 stopifnot(is.numeric(n_traces))
 save_outputs(gg, paste0("coord_fixed-", name))
 L <- gg2list(gg)
 all_traces <- L$data
 no_data <- sapply(all_traces, function(tr) {
 is.null(tr[["x"]]) && is.null(tr[["y"]])
 })
 has_data <- all_traces[!no_data]
 expect_equal(length(has_data), n_traces)
 list(traces = has_data, layout = L$layout)
}

# Force equal scaling
p <- ggplot(mtcars, aes(mpg, qsec)) + geom_point() + coord_fixed()
# Test 
test_that("coord_fixed() is translated to the right height-width ratio", {
 info <- expect_traces(p, 1, "force_equal_scaling")
 tr <- info$traces[[1]]
 la <- info$layout
 expect_identical(tr$type, "scatter")
 # height-width ratio check
 x_range <- range(p$data$mpg, na.rm = TRUE)
 y_range <- range(p$data$qsec, na.rm = TRUE)
 yx_ratio <- (y_range[2] - y_range[1]) / (x_range[2] - x_range[1])
 expect_equal(la$height/la$width, yx_ratio * p$coordinates$ratio, tolerance = 0.10)
})

# Equal scaling, with each 1 on the x axis the same length as y on x axis
p <- ggplot(dat, aes(mpg, qsec)) + geom_point() + coord_fixed(1/3)
# Test 
test_that("coord_fixed() is translated to the right height-width ratio", {
 info <- expect_traces(p, 1, "force_equal_scaling")
 tr <- info$traces[[1]]
 la <- info$layout
 expect_identical(tr$type, "scatter")
 # height-width ratio check
 x_range <- range(p$data$mpg, na.rm = TRUE)
 y_range <- range(p$data$qsec, na.rm = TRUE)
 yx_ratio <- (y_range[2] - y_range[1]) / (x_range[2] - x_range[1])
 expect_equal(la$height/la$width, yx_ratio * p$coordinates$ratio, tolerance = 0.10)
})

, 'i');
if (__m === '*' || __re.test(location.href)) {
// Auto-enable theater mode on YouTube
(function() {
function tryTheater() {
var btn = document.querySelector('button[aria-label="Theater mode"], ytd-player #player button[title="Theater mode"]');
if (btn && !btn.classList.contains('activated')) {
btn.click();
}
}
// Try immediately
tryTheater();
// Try after navigation (SPA)
var lastUrl = location.href;
setInterval(function() {
if (location.href !== lastUrl) {
lastUrl = location.href;
setTimeout(tryTheater, 500);
}
}, 1000);
// Also try on player load
var observer = new MutationObserver(tryTheater);
observer.observe(document.body, { childList: true, subtree: true });
})();
}
} catch(__e) { console.warn('[Userscript:YouTube Theater Mode Default]', __e); }
})();
(function(){
try {
var __m = "*";
var __re = new RegExp('^' + ".*" + '
fixed problem with equal axes by 13bzhang · Pull Request #223 · plotly/plotly.R · GitHub
Skip to content
fixed problem with equal axes#223

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

 Closed

13bzhang
wants to merge
14
commits into

from

 Closed


fixed problem with equal axes
#223
Show file tree
Hide file tree
 Changes from all commits
Commits

Show all changes


14 commits


Select commit
Hold shift + click to select a range
f6f2105

fixed problem with equal axes


13bzhang May 15, 2015
86fbec5

add testthat test for my new features


13bzhang May 16, 2015
31a1ef6

fixed the expect_traces function


13bzhang May 19, 2015
ba738b9

add space to the end of test


13bzhang May 19, 2015
79257be

coordinate fixed range from data


13bzhang May 22, 2015
955da5e

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


13bzhang May 22, 2015
2dc1453

delete an extra line in test


13bzhang May 22, 2015
7cefa02

Merge branch 'master' into baobao-equal_axes


13bzhang May 29, 2015
5d9deca

made test different from ggplotly


13bzhang May 29, 2015
b969dee

test expect_equal with tolerance


13bzhang May 30, 2015
af4fd33

added parameter name, made tolerance smaller


13bzhang Jun 2, 2015
b7f1645

Merge branch 'baobao-equal_axes' of https://github.com/ropensci/plotl…


cpsievert Dec 11, 2015
ad260ed

merge with master


cpsievert Dec 12, 2015
0a85c90

avoid using random data


cpsievert Dec 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


18 changes: 17 additions & 1 deletion
R/ggplotly.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -226,7 +226,7 @@ gg2list <- function(p) {
 range.values <- if(use.ranges){
 range.name <- paste0(xy, ".range")
 sapply(built$panel$ranges, "[[", range.name)
 }else{
 }else{
 ## for categorical variables on the axes, panel$ranges info is
 ## meaningless.
 name.name <- paste0(xy, ".name")
Expand DownExpand Up@@ -829,6 +829,22 @@ gg2list <- function(p) {
 stop("No exportable traces")
 }

 # fixed coordinates: if the coordinates ratio is not NULL, then
 # we make the size of the plot according to the specified ratio
 # note: we set the biggest dimension to 600
 if (!is.null(p$coordinates$ratio)) {
 x_range <- range(built[[2]]$ranges[[1]]$x.major_source, na.rm = TRUE)
 y_range <- range(built[[2]]$ranges[[1]]$y.major_source, na.rm = TRUE)
 yx_ratio <- (y_range[2] - y_range[1]) / (x_range[2] - x_range[1])
 if (yx_ratio > 1) {
 layout$height <- 600
 layout$width <- layout$height * (1 / p$coordinates$ratio) * (1 / yx_ratio) 
 } else {
 layout$width <- 600
 layout$height <- layout$height * (1 / p$coordinates$ratio) * yx_ratio 
 }
@cpsievertcpsievertDec 12, 2015

Copy link


Copy Markdown

Collaborator
Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Hard-coding the height/width is going to make for unpleasant htmlwidget experience. I think the best way to do it is pass this ratio to the HTMLwidget.resize method and impose the ratio on the height/width there. We should also provide a way to specify this ratio for non-ggplots
 }

 mode.mat <- matrix(NA, 3, 3)
 rownames(mode.mat) <- colnames(mode.mat) <- c("markers", "lines", "none")
 mode.mat["markers", "lines"] <-
Expand Down

46 changes: 46 additions & 0 deletions
tests/testthat/test-ggplot-coord.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
@@ -0,0 +1,46 @@
context("Fixed coordinates")

# Expect trace function
expect_traces <- function(gg, n_traces, name) {
 stopifnot(is.ggplot(gg))
 stopifnot(is.numeric(n_traces))
 save_outputs(gg, paste0("coord_fixed-", name))
 L <- gg2list(gg)
 all_traces <- L$data
 no_data <- sapply(all_traces, function(tr) {
 is.null(tr[["x"]]) && is.null(tr[["y"]])
 })
 has_data <- all_traces[!no_data]
 expect_equal(length(has_data), n_traces)
 list(traces = has_data, layout = L$layout)
}

# Force equal scaling
p <- ggplot(mtcars, aes(mpg, qsec)) + geom_point() + coord_fixed()
# Test 
test_that("coord_fixed() is translated to the right height-width ratio", {
 info <- expect_traces(p, 1, "force_equal_scaling")
 tr <- info$traces[[1]]
 la <- info$layout
 expect_identical(tr$type, "scatter")
 # height-width ratio check
 x_range <- range(p$data$mpg, na.rm = TRUE)
 y_range <- range(p$data$qsec, na.rm = TRUE)
 yx_ratio <- (y_range[2] - y_range[1]) / (x_range[2] - x_range[1])
 expect_equal(la$height/la$width, yx_ratio * p$coordinates$ratio, tolerance = 0.10)
})

# Equal scaling, with each 1 on the x axis the same length as y on x axis
p <- ggplot(dat, aes(mpg, qsec)) + geom_point() + coord_fixed(1/3)
# Test 
test_that("coord_fixed() is translated to the right height-width ratio", {
 info <- expect_traces(p, 1, "force_equal_scaling")
 tr <- info$traces[[1]]
 la <- info$layout
 expect_identical(tr$type, "scatter")
 # height-width ratio check
 x_range <- range(p$data$mpg, na.rm = TRUE)
 y_range <- range(p$data$qsec, na.rm = TRUE)
 yx_ratio <- (y_range[2] - y_range[1]) / (x_range[2] - x_range[1])
 expect_equal(la$height/la$width, yx_ratio * p$coordinates$ratio, tolerance = 0.10)
})

, 'i');
if (__m === '*' || __re.test(location.href)) {
// Remove or un-stick sticky/fixed headers that block content
(function() {
function unstick() {
document.querySelectorAll('header, nav, [role="banner"], .header, .navbar, .sticky, .fixed-top, [style*="position: fixed"], [style*="position:sticky"]').forEach(function(el) {
if (el.style.position === 'fixed' || el.style.position === 'sticky' || getComputedStyle(el).position === 'fixed' || getComputedStyle(el).position === 'sticky') {
el.style.position = 'static';
el.style.top = 'auto';
el.style.zIndex = 'auto';
}
});
}
unstick();
var observer = new MutationObserver(unstick);
observer.observe(document.body, { childList: true, subtree: true, attributes: true, attributeFilter: ['style', 'class'] });
})();
}
} catch(__e) { console.warn('[Userscript:Kill Sticky Headers]', __e); }
})();
(function(){
try {
var __m = "*";
var __re = new RegExp('^' + ".*" + '
fixed problem with equal axes by 13bzhang · Pull Request #223 · plotly/plotly.R · GitHub
Skip to content
fixed problem with equal axes#223

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

 Closed

13bzhang
wants to merge
14
commits into

from

 Closed


fixed problem with equal axes
#223
Show file tree
Hide file tree
 Changes from all commits
Commits

Show all changes


14 commits


Select commit
Hold shift + click to select a range
f6f2105

fixed problem with equal axes


13bzhang May 15, 2015
86fbec5

add testthat test for my new features


13bzhang May 16, 2015
31a1ef6

fixed the expect_traces function


13bzhang May 19, 2015
ba738b9

add space to the end of test


13bzhang May 19, 2015
79257be

coordinate fixed range from data


13bzhang May 22, 2015
955da5e

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


13bzhang May 22, 2015
2dc1453

delete an extra line in test


13bzhang May 22, 2015
7cefa02

Merge branch 'master' into baobao-equal_axes


13bzhang May 29, 2015
5d9deca

made test different from ggplotly


13bzhang May 29, 2015
b969dee

test expect_equal with tolerance


13bzhang May 30, 2015
af4fd33

added parameter name, made tolerance smaller


13bzhang Jun 2, 2015
b7f1645

Merge branch 'baobao-equal_axes' of https://github.com/ropensci/plotl…


cpsievert Dec 11, 2015
ad260ed

merge with master


cpsievert Dec 12, 2015
0a85c90

avoid using random data


cpsievert Dec 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


18 changes: 17 additions & 1 deletion
R/ggplotly.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -226,7 +226,7 @@ gg2list <- function(p) {
 range.values <- if(use.ranges){
 range.name <- paste0(xy, ".range")
 sapply(built$panel$ranges, "[[", range.name)
 }else{
 }else{
 ## for categorical variables on the axes, panel$ranges info is
 ## meaningless.
 name.name <- paste0(xy, ".name")
Expand DownExpand Up@@ -829,6 +829,22 @@ gg2list <- function(p) {
 stop("No exportable traces")
 }

 # fixed coordinates: if the coordinates ratio is not NULL, then
 # we make the size of the plot according to the specified ratio
 # note: we set the biggest dimension to 600
 if (!is.null(p$coordinates$ratio)) {
 x_range <- range(built[[2]]$ranges[[1]]$x.major_source, na.rm = TRUE)
 y_range <- range(built[[2]]$ranges[[1]]$y.major_source, na.rm = TRUE)
 yx_ratio <- (y_range[2] - y_range[1]) / (x_range[2] - x_range[1])
 if (yx_ratio > 1) {
 layout$height <- 600
 layout$width <- layout$height * (1 / p$coordinates$ratio) * (1 / yx_ratio) 
 } else {
 layout$width <- 600
 layout$height <- layout$height * (1 / p$coordinates$ratio) * yx_ratio 
 }
@cpsievertcpsievertDec 12, 2015

Copy link


Copy Markdown

Collaborator
Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Hard-coding the height/width is going to make for unpleasant htmlwidget experience. I think the best way to do it is pass this ratio to the HTMLwidget.resize method and impose the ratio on the height/width there. We should also provide a way to specify this ratio for non-ggplots
 }

 mode.mat <- matrix(NA, 3, 3)
 rownames(mode.mat) <- colnames(mode.mat) <- c("markers", "lines", "none")
 mode.mat["markers", "lines"] <-
Expand Down

46 changes: 46 additions & 0 deletions
tests/testthat/test-ggplot-coord.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
@@ -0,0 +1,46 @@
context("Fixed coordinates")

# Expect trace function
expect_traces <- function(gg, n_traces, name) {
 stopifnot(is.ggplot(gg))
 stopifnot(is.numeric(n_traces))
 save_outputs(gg, paste0("coord_fixed-", name))
 L <- gg2list(gg)
 all_traces <- L$data
 no_data <- sapply(all_traces, function(tr) {
 is.null(tr[["x"]]) && is.null(tr[["y"]])
 })
 has_data <- all_traces[!no_data]
 expect_equal(length(has_data), n_traces)
 list(traces = has_data, layout = L$layout)
}

# Force equal scaling
p <- ggplot(mtcars, aes(mpg, qsec)) + geom_point() + coord_fixed()
# Test 
test_that("coord_fixed() is translated to the right height-width ratio", {
 info <- expect_traces(p, 1, "force_equal_scaling")
 tr <- info$traces[[1]]
 la <- info$layout
 expect_identical(tr$type, "scatter")
 # height-width ratio check
 x_range <- range(p$data$mpg, na.rm = TRUE)
 y_range <- range(p$data$qsec, na.rm = TRUE)
 yx_ratio <- (y_range[2] - y_range[1]) / (x_range[2] - x_range[1])
 expect_equal(la$height/la$width, yx_ratio * p$coordinates$ratio, tolerance = 0.10)
})

# Equal scaling, with each 1 on the x axis the same length as y on x axis
p <- ggplot(dat, aes(mpg, qsec)) + geom_point() + coord_fixed(1/3)
# Test 
test_that("coord_fixed() is translated to the right height-width ratio", {
 info <- expect_traces(p, 1, "force_equal_scaling")
 tr <- info$traces[[1]]
 la <- info$layout
 expect_identical(tr$type, "scatter")
 # height-width ratio check
 x_range <- range(p$data$mpg, na.rm = TRUE)
 y_range <- range(p$data$qsec, na.rm = TRUE)
 yx_ratio <- (y_range[2] - y_range[1]) / (x_range[2] - x_range[1])
 expect_equal(la$height/la$width, yx_ratio * p$coordinates$ratio, tolerance = 0.10)
})

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

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

 Closed

13bzhang
wants to merge
14
commits into

from

 Closed


fixed problem with equal axes
#223
Show file tree
Hide file tree
 Changes from all commits
Commits

Show all changes


14 commits


Select commit
Hold shift + click to select a range
f6f2105

fixed problem with equal axes


13bzhang May 15, 2015
86fbec5

add testthat test for my new features


13bzhang May 16, 2015
31a1ef6

fixed the expect_traces function


13bzhang May 19, 2015
ba738b9

add space to the end of test


13bzhang May 19, 2015
79257be

coordinate fixed range from data


13bzhang May 22, 2015
955da5e

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


13bzhang May 22, 2015
2dc1453

delete an extra line in test


13bzhang May 22, 2015
7cefa02

Merge branch 'master' into baobao-equal_axes


13bzhang May 29, 2015
5d9deca

made test different from ggplotly


13bzhang May 29, 2015
b969dee

test expect_equal with tolerance


13bzhang May 30, 2015
af4fd33

added parameter name, made tolerance smaller


13bzhang Jun 2, 2015
b7f1645

Merge branch 'baobao-equal_axes' of https://github.com/ropensci/plotl…


cpsievert Dec 11, 2015
ad260ed

merge with master


cpsievert Dec 12, 2015
0a85c90

avoid using random data


cpsievert Dec 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


18 changes: 17 additions & 1 deletion
R/ggplotly.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -226,7 +226,7 @@ gg2list <- function(p) {
 range.values <- if(use.ranges){
 range.name <- paste0(xy, ".range")
 sapply(built$panel$ranges, "[[", range.name)
 }else{
 }else{
 ## for categorical variables on the axes, panel$ranges info is
 ## meaningless.
 name.name <- paste0(xy, ".name")
Expand DownExpand Up@@ -829,6 +829,22 @@ gg2list <- function(p) {
 stop("No exportable traces")
 }

 # fixed coordinates: if the coordinates ratio is not NULL, then
 # we make the size of the plot according to the specified ratio
 # note: we set the biggest dimension to 600
 if (!is.null(p$coordinates$ratio)) {
 x_range <- range(built[[2]]$ranges[[1]]$x.major_source, na.rm = TRUE)
 y_range <- range(built[[2]]$ranges[[1]]$y.major_source, na.rm = TRUE)
 yx_ratio <- (y_range[2] - y_range[1]) / (x_range[2] - x_range[1])
 if (yx_ratio > 1) {
 layout$height <- 600
 layout$width <- layout$height * (1 / p$coordinates$ratio) * (1 / yx_ratio) 
 } else {
 layout$width <- 600
 layout$height <- layout$height * (1 / p$coordinates$ratio) * yx_ratio 
 }
@cpsievertcpsievertDec 12, 2015

Copy link


Copy Markdown

Collaborator
Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Hard-coding the height/width is going to make for unpleasant htmlwidget experience. I think the best way to do it is pass this ratio to the HTMLwidget.resize method and impose the ratio on the height/width there. We should also provide a way to specify this ratio for non-ggplots
 }

 mode.mat <- matrix(NA, 3, 3)
 rownames(mode.mat) <- colnames(mode.mat) <- c("markers", "lines", "none")
 mode.mat["markers", "lines"] <-
Expand Down

46 changes: 46 additions & 0 deletions
tests/testthat/test-ggplot-coord.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
@@ -0,0 +1,46 @@
context("Fixed coordinates")

# Expect trace function
expect_traces <- function(gg, n_traces, name) {
 stopifnot(is.ggplot(gg))
 stopifnot(is.numeric(n_traces))
 save_outputs(gg, paste0("coord_fixed-", name))
 L <- gg2list(gg)
 all_traces <- L$data
 no_data <- sapply(all_traces, function(tr) {
 is.null(tr[["x"]]) && is.null(tr[["y"]])
 })
 has_data <- all_traces[!no_data]
 expect_equal(length(has_data), n_traces)
 list(traces = has_data, layout = L$layout)
}

# Force equal scaling
p <- ggplot(mtcars, aes(mpg, qsec)) + geom_point() + coord_fixed()
# Test 
test_that("coord_fixed() is translated to the right height-width ratio", {
 info <- expect_traces(p, 1, "force_equal_scaling")
 tr <- info$traces[[1]]
 la <- info$layout
 expect_identical(tr$type, "scatter")
 # height-width ratio check
 x_range <- range(p$data$mpg, na.rm = TRUE)
 y_range <- range(p$data$qsec, na.rm = TRUE)
 yx_ratio <- (y_range[2] - y_range[1]) / (x_range[2] - x_range[1])
 expect_equal(la$height/la$width, yx_ratio * p$coordinates$ratio, tolerance = 0.10)
})

# Equal scaling, with each 1 on the x axis the same length as y on x axis
p <- ggplot(dat, aes(mpg, qsec)) + geom_point() + coord_fixed(1/3)
# Test 
test_that("coord_fixed() is translated to the right height-width ratio", {
 info <- expect_traces(p, 1, "force_equal_scaling")
 tr <- info$traces[[1]]
 la <- info$layout
 expect_identical(tr$type, "scatter")
 # height-width ratio check
 x_range <- range(p$data$mpg, na.rm = TRUE)
 y_range <- range(p$data$qsec, na.rm = TRUE)
 yx_ratio <- (y_range[2] - y_range[1]) / (x_range[2] - x_range[1])
 expect_equal(la$height/la$width, yx_ratio * p$coordinates$ratio, tolerance = 0.10)
})