R GGally ggpairs wrap control [дубликат]
Этот JavaScript должен работать для всех браузеров последней версии:
//Detect Browser
var isOpera = !!window.opera || navigator.userAgent.indexOf(' OPR/') >= 0;
// Opera 8.0+ (UA detection to detect Blink/v8-powered Opera)
var isFirefox = typeof InstallTrigger !== 'undefined'; // Firefox 1.0+
var isSafari = Object.prototype.toString.call(window.HTMLElement).indexOf('Constructor') > 0;
// At least Safari 3+: "[object HTMLElementConstructor]"
var isChrome = !!window.chrome && !isOpera; // Chrome 1+
var isIE = /*@cc_on!@*/false || !!document.documentMode; // At least IE6
var Host = window.location.host;
//Clear Basic Realm Authentication
if(isIE){
//IE
document.execCommand("ClearAuthenticationCache");
window.location = '/';
}
else if(isSafari)
{//Safari. but this works mostly on all browser except chrome
(function(safeLocation){
var outcome, u, m = "You should be logged out now.";
// IE has a simple solution for it - API:
try { outcome = document.execCommand("ClearAuthenticationCache") }catch(e){}
// Other browsers need a larger solution - AJAX call with special user name - 'logout'.
if (!outcome) {
// Let's create an xmlhttp object
outcome = (function(x){
if (x) {
// the reason we use "random" value for password is
// that browsers cache requests. changing
// password effectively behaves like cache-busing.
x.open("HEAD", safeLocation || location.href, true, "logout", (new Date()).getTime().toString())
x.send("");
// x.abort()
return 1 // this is **speculative** "We are done."
} else {
return
}
})(window.XMLHttpRequest ? new window.XMLHttpRequest() : ( window.ActiveXObject ? new ActiveXObject("Microsoft.XMLHTTP") : u ))
}
if (!outcome) {
m = "Your browser is too old or too weird to support log out functionality. Close all windows and restart the browser."
}
alert(m);
window.location = '/';
// return !!outcome
})(/*if present URI does not return 200 OK for GET, set some other 200 OK location here*/)
}
else{
//Firefox,Chrome
window.location = 'http://log:out@'+Host+'/';
}
2 ответа
Вы не используете wrap правильно - см. виньетку для деталей . Также для диагонали вам теперь нужно использовать функцию barDiag (но ggpairs дает очень полезные ошибки, чтобы сказать это)
Итак, для вашего примера мы можем изменить colour точек в нижние панели и fill баров ниже
library(GGally)
library(ggplot2)
ggpairs(swiss[1:3],
lower=list(continuous=wrap("smooth", colour="blue")),
diag=list(continuous=wrap("barDiag", fill="blue")))
Однако, поскольку цвет гладкой жестко закодирован (см. ggally_smooth), чтобы изменить свой цвет, вам необходимо определить свои собственные функции для передачи. Таким образом, отсюда
my_fn <- function(data, mapping, pts=list(), smt=list(), ...){
ggplot(data = data, mapping = mapping, ...) +
do.call(geom_point, pts) +
do.call(geom_smooth, smt)
}
# Plot
ggpairs(swiss[1:4],
lower = list(continuous =
wrap(my_fn,
pts=list(size=2, colour="red"),
smt=list(method="lm", se=F, size=5, colour="blue"))),
diag=list(continuous=wrap("barDiag", fill="blue")))
Аналогичным образом, это способ определить новую верхнюю корреляционную функцию (похожую на то, что у вас есть)
cor_fun <- function(data, mapping, method="pearson", ndp=2, sz=5, stars=TRUE, ...){
data <- na.omit(data[,c(as.character(mapping$x), as.character(mapping$y))])
x <- data[,as.character(mapping$x)]
y <- data[,as.character(mapping$y)]
corr <- cor.test(x, y, method=method)
est <- corr$estimate
lb.size <- sz* abs(est)
if(stars){
stars <- c("***", "**", "*", "")[findInterval(corr$p.value, c(0, 0.001, 0.01, 0.05, 1))]
lbl <- paste0(round(est, ndp), stars)
}else{
lbl <- round(est, ndp)
}
ggplot(data=data, mapping=mapping) +
annotate("text", x=mean(x), y=mean(y), label=lbl, size=lb.size,...)+
theme(panel.grid = element_blank())
}
ggpairs(swiss,
lower=list(continuous=wrap("smooth", colour="blue")),
diag=list(continuous=wrap("barDiag", fill="blue")),
upper=list(continuous=cor_fun))
-
1Большое спасибо, это очень ясно и обеспечивает эффективное решение – pachamaltese 17 June 2016 в 22:21
-
2всегда пожалуйста – user20650 17 June 2016 в 22:31
Вы можете изменить некоторые параметры функций GGally, используя wrap() , как описано здесь . Но не все параметры называются для wrap полезными. Например, если вы попытаетесь изменить палитру по умолчанию с ручной цветовой шкалой внутри wrap, вы можете получить ошибку, например Error in wrap("cor",…) all parameters must be named arguments. В этом случае вы можете создать пользовательские функции для создания любого вида объекта ggplot, подходящего для верхнего, нижнего или диагонального участков матрицы.
Однако есть (более безопасный) ярлык, если вы хотите изменить некоторые параметры (не названные в функциях GGally для wrap ped), не создавая настраиваемую функцию для создания объекта ggplot. Вы просто вызываете уже существующую функцию GGally в вызове функции, добавляя дополнительные параметры ggplot. Например, чтобы обеспечить ручной цвет шкалы для трех категорий (в новом столбце swiss $ groups):
swiss$groups <- gl(n = 3, k = 1, length = nrow(swiss), labels = c("A", "B", "C"))
ggpairs(swiss, mapping = aes(colour = groups), columns = 1:6,
upper = list(continuous = function(data, mapping, ...) {
ggally_cor(data = data, mapping = mapping, size = 2) + scale_colour_manual(values = c("black", "dark green", "red"))}),
lower = list(continuous = function(data, mapping, ...) {
ggally_smooth(data = data, mapping = mapping, alpha = .2) + scale_colour_manual(values = c("black", "dark green", "red"))}),
diag = list(continuous = function(data, mapping, ...) {
ggally_barDiag(data = data, mapping = mapping, alpha = .5) + scale_fill_manual(values = c("black", "dark green", "red"))}))
-
1Это также полезно, если вы хотите применить к каждому разделу разные
themeэлементы (upper,lowerилиdiag). Например, сохраняя сетки по умолчанию вlowerиdiag, но удаляя их вupper– FairMiles 28 October 2017 в 21:39