I've got a graph, but the self-loops are large relative to the network, is there a way to reduce the self-loop size without changing the remainder of the graph?
Test data:
test.matrix=cbind(mtcars$gear,mtcars$carb)
adj.mat=get.adjacency(graph.edgelist(as.matrix(test.matrix)))
g=graph.adjacency(adj.mat,mode="undirected")
plot(g)
I tried changing the curve_multiple, to no avail, and can't find anything in the documentation relating to reducing loop size.
There is no option to the igraph plot function that allows you to change the size of the loops.
However, a small change to the igraph source code does the trick. You can see the igraph plot function by running
plot.igraph
You will find that the igraph plot function creates a function called loop. Inside that function you will find the lines:
cp <- matrix(c(x0, y0, x0 + 0.4, y0 + 0.2, x0 + 0.4,
y0 - 0.2, x0, y0), ncol = 2, byrow = TRUE)
you can make the loop half as wide/high by changing this to:
cp <- matrix(c(x0, y0, x0 + 0.2, y0 + 0.1, x0 + 0.2,
y0 - 0.1, x0, y0), ncol = 2, byrow = TRUE)
#desc commented that you can temporarily make this change to the igraph plot function source code with
trace("plot.igraph",edit=TRUE)
Related
I would like to visualize some graphs with labeled vertices using GraphMakie.jl.
Sadly, makie doesn't seem to include the labels into its bounding box-calculation and the labels are therefore cut off. I would expect there to be some feature to add some padding to the Axis-object, but I can't find anything like this.
Minimal example:
using Graphs, GraphMakie
fig = Figure()
for i in 1:2
ax = Axis(fig[1,i])
g = wheel_graph(i+1)
graphplot!(ax, g, nlabels=["label" for _ in 1:i+1])
hidedecorations!(ax)
end
display(fig)
Things I tried that didn't work:
adding protrusions: ax.alignmode = Mixed(right = Makie.Protrusion(50))
refreshing limits: autolimits!(ax)
changing the layout gap: colgap!(fig.layout, 50)
manually overriding the size: ax.width = 400
The area inside the rectangle is determined by the plotted range of data. Therefore, to make the labels fit in the rectangle, you have to adjust the range in the "data domain", i.e., using xlims and ylims. To add a margin to these ranges, you have to first know these ranges and hence do the call to the graph layout-function manually. I've implemented a wrapper that does this and adds a margin-property to adjust the margins:
using Graphs, GraphMakie, NetworkLayout, CairoMakie
function graphplotWithMargin!(
ax::Axis,
g::SimpleGraph;
margin = (0.1, 0.1, 0.1, 0.1),
layout = Spring(),
args...)
local pos = layout(g)
graphplot!(ax, g; layout=_->pos, args...)
local x0, x1 = minimum(map(x->x[1],pos)), maximum(map(x->x[1],pos))
CairoMakie.xlims!(ax, x0 - margin[4] * (x1 - x0), x1 + margin[2] * (x1 - x0))
local y0, y1 = minimum(map(x->x[2],pos)), maximum(map(x->x[2],pos))
CairoMakie.ylims!(ax, y0 - margin[1] * (y1 - y0), y1 + margin[3] * (y1 - y0))
end
fig = Figure()
for i in 1:2
ax = Axis(fig[1,i])
g = wheel_graph(i+1)
graphplotWithMargin!(ax, g,
nlabels=["label" for _ in 1:i+1],
margin=(0.05, 0.15, 0.05, 0.05))
hidedecorations!(ax)
end
display(fig)
I am using image() and contour() to create a "heatmap" of probabilities - for example:
I was asked to change the labels such that they "do not overlap the lines, and the lines are unbroken." After consulting ?contour(), I tried changing to method = "edge" and method = "simple", but both fail print the labels (although the lines are unbroken), and cant seem to find posts regarding similar issues elsewhere.
Any advice on how to manipulate the labels to appear adjacent to (not on top of) unbroken lines would be much appreciated. I would prefer base R but also would welcome options from more flexible packages or alternative base R functions.
Minimal code to recreate example figure is here:
# Generate Data
Rs <- seq(0.02, 1.0, 0.005)
ks <- 10 ^ seq(-2.3, 0.5, 0.005)
prob <- function(Y,R,k) {
exp(lgamma(k*Y+Y-1) - lgamma(k*Y) - lgamma(Y+1) + (Y-1) * log(R/k) - (k*Y+Y-1) * log(1+R/k))
}
P05 <- matrix(NA, ncol = length(ks), nrow = length(Rs))
for(i in 1:length(Rs)) {
for(j in 1:length(ks)) {
P05[i,j] <- 1 - sum(prob(1:(5 - 1), Rs[i], ks[j]))
}
}
colfunc <- colorRampPalette(c("grey25", "grey90"))
lbreaks <- c(-1e-10, 1e-5, 1e-3, 5e-3, 1e-2, 2e-2, 5e-2, 1e-1, 1.5e-1, 1)
## Create Figure
image(Rs, ks, P05,
log="y", col = rev(colfunc(length(lbreaks)-1)), breaks = lbreaks, zlim = lbreaks,
ylim = c(min(ks), 2), xlim = c(0,1))
contour(Rs, ks, P05, levels = lbreaks, labcex = 1, add = TRUE)
There is an easy(ish) way to do this in ggplot, using the geomtextpath package.
First, convert your matrix to an x, y, z data frame:
df <- expand.grid(Rs = Rs, ks = ks)
df$z <- c(P05)
Now plot a filled contour, and then geom_textcontour. By default the text will break the lines, as in contour, but if you set the vjust above one or below zero the lines will close up as they don't need to break for the text.
I've added a few theme and scale elements to match the aesthetic of the base graphics function. Note the text and line size, color etc remain independently adjustable.
library(geomtextpath)
ggplot(df, aes(Rs, ks, z = z)) +
geom_contour_filled(breaks = lbreaks) +
geom_textcontour(breaks = lbreaks, color = 'black', size = 5,
aes(label = stat(level)), vjust = 1.2) +
scale_y_log10(breaks = c(0.01, 0.02, 0.05, 0.1, 0.2, 0.5, 1, 2),
expand = c(0, 0)) +
scale_fill_manual(values = rev(colfunc(9)), guide = 'none') +
scale_x_continuous(expand = c(0, 0)) +
theme_classic(base_size = 16) +
theme(axis.text.y = element_text(angle = 90, hjust = 0.5),
axis.ticks.length.y = unit(3, 'mm'),
plot.margin = margin(20, 20, 20, 20))
The contour function is mostly written in C, and as far as I can see, it doesn't support the kinds of labels you want.
So I think there are two ways to do this, neither of which is very appealing:
Modify the source to the function. You can see the start of the labelling code here. I think you would need to rebuild R to incorporate your changes; it's not easy to move a function from a base package to a contributed package.
Draw the plot with no labels, and add them manually after the fact. You could add them using text(), or produce an output file and use an external program to edit the output file.
I want to figure out how to build complex curved lines/polygons in R. We can easily draw a simple bezier line, e.g.
require(grid)
x <- c(0.25, 0.25, 0.75, 0.75)
y <- c(0.25, 0.75, 0.75, 0.25)
grid.newpage()
grid.bezier(x, y)
This method seems scale-constrained to 0-1 in both axes, and I'm not sure how to build beziers in a custom scale. I'm also unclear how R can bind these bezier objects together into polylines and ultimately polygons. If anyone can provide a minimal example I'd be very grateful. But alternatively a point in the right direction of documentation would greatly help, as I've not found a workflow so far. Thanks in advance.
As far as I understand grid.bezier you will have to chain individuals segments. This can be done via the id argument, but see also ?grig.bezier.
You can adjust the scale through viewports and the xscale and yscale.
library(grid)
x <- c(0.2, 0.2, 0.7, 0.4, 0.2, 0.2, 0.4, 0.4)
y <- c(0.2, 0.4, 0.7, 0.2, 0.2, 0, 0, 0.2)
grid.newpage()
grid.bezier(x, y, id=rep(1:2, each=4))
grid.newpage()
pushViewport(plotViewport(xscale=c(0, 10), yscale=c(0, 100)))
grid.xaxis()
grid.yaxis()
x <- x * 10
y <- y * 50
grid.bezier(x, y, id=rep(1:2, each=4), default.units="native")
Note that I used dataViewport which is just a convenience function wrapping viewport.
If you have the parametrization 'Y' of the curve you want to draw, you could just
t <- c(1:1000)*0.001
plot(t,Y(t))
or something like that.
I am attempting to reproduce a Stephen Few graphic with gradient circles that demonstrates the hard wired assumption that light appears from above. Here are the circles:
How can I recreate this? Drawing the circles isn't too bad but adding gradient is where I get thrown. I am thinking grid may create something more crisp but this may be a misconception I have.
Here is the start with drawing circles:
## John Fox circle function
source("http://dl.dropboxusercontent.com/u/61803503/wordpress/circle_fun.txt")
par(mar=rep(1, 4), bg = "grey80")
plot.new()
for (i in seq(0, 1, by = .2)) {
for (j in seq(.6, 1, by = .1)) {
circle(i, j, .5, "cm", , 1)
}
}
Related question: How to use R to build bubble charts with gradient fills
EDIT:
Thought I'd share the results:
And here's the code.
With some repeated use of clip, you can get there.
# set up a blank plot
par(mar=rep(0, 4))
par(bg="#cccccc")
plot(NA,xlim=0:1,ylim=0:1)
# define a function
grad.circ <- function(centrex,centrey,radius,col,resolution) {
colfunc <- colorRampPalette(col)
shades <- colfunc(resolution)
for (i in seq_along(shades) ) {
clip(
centrex - radius,
centrex + radius,
(centrey + radius) - ((i-1) * (radius*2)/length(shades)),
(centrey + radius) - (i * (radius*2)/length(shades))
)
symbols(
centrex,
centrey,
circles=radius,
bg=shades[i],
fg=NA,
add=TRUE,
inches=FALSE
)
}
}
# call the function
grad.circ(0.5,0.5,0.5,c("black", "white"),300)
Result:
EDIT (by Tyler Rinker):
I wanted to add the rest of the code I used to replicate the image:
FUN <- function(plot = TRUE, cols = c("black", "white")) {
plot(NA, xlim=0:1, ylim=0:1, axes=FALSE)
if (plot) {
grad.circ(0.5, 0.5, 0.5, cols, 300)
}
}
FUN2 <- function(){
lapply(1:3, function(i) FUN(,c("white", "black")))
FUN(F)
lapply(1:3, function(i) FUN())
}
X11(10, 4.5)
par(mfrow=c(3, 7))
par(mar=rep(0, 4))
par(bg="gray70")
invisible(lapply(1:3, function(i) FUN2()))
Here is a version using rasters and rasterImage:
image <- as.raster( matrix( seq(0,1,length.out=1001), nrow=1001, ncol=1001) )
tmp <- ( row(image) - 501 ) ^2 + ( col(image) - 501 )^2
image[tmp > 500^2] <- NA
image2 <- as.raster( matrix( seq(1,0, length.out=1001), nrow=1001, ncol=1001) )
image2[ tmp > 500^2 ] <- NA
image3 <- row(image) + col(image)
image3 <- image3/max(image3)
image3[tmp>500^2] <- NA
image4 <- 1-image3
image3 <- as.raster(image3)
image4 <- as.raster(image4)
plot( 0:1, 0:1, type='n', asp=1,ann=FALSE,axes=FALSE)
rect(0,0,1,1, col='grey')
rasterImage(image, 0.2, 0.2, 0.3, 0.3)
rasterImage(image2, 0.6, 0.6, 0.7, 0.7)
rasterImage(image3, 0.6, 0.3, 0.7, 0.4)
rasterImage(image4, 0.3, 0.7, 0.4, 0.8)
Other directions of shading can be made by changing the math a little.
You can do this using the (not on CRAN) package zernike . It's designed to produce various images related to Zernike polynomials, heavily used in optics & astronomy systems. Your desired images are pretty much the second Zernike term.
The author is Author: M.L. Peck (mpeck1#ix.netcom.com) ; I forget exactly where the R-package resides on hte web.
And here's an approach using sp and rgeos (similar application here and here).
library(sp)
library(rgeos)
library(raster)
Create two sets of 9 circles by buffering points, then plot their union to set up the plotting area.
b <- gBuffer(SpatialPoints(cbind(rep(1:3, 3), rep(1:3, each=3))), TRUE,
width=0.45, quadsegs=100)
b2 <- gBuffer(SpatialPoints(cbind(rep(5:7, 3), rep(1:3, each=3))), TRUE,
width=0.45, quadsegs=100)
plot(gUnion(b, b2), border=NA)
Step through the polygons and extract their bounding boxes.
bb <- sapply(b#polygons, bbox)
bb2 <- sapply(b2#polygons, bbox)
Plot stacked segments to simulate a gradient.
segments(rep(bb[1,], each=1000),
mapply(seq, bb[2,], bb[4,], len=1000),
rep(bb[3,], each=1000), col=gray.colors(1000, 0))
segments(rep(bb2[1,], each=1000),
mapply(seq, bb2[2,], bb2[4,], len=1000),
rep(bb2[3,], each=1000), col=rev(gray.colors(1000, 0)))
Difference the union of the SpatialPolygon objects and plot the differenced polygon to mask out the non-circles areas.
plot(gDifference(as(extent(par('usr')), 'SpatialPolygons'), gUnion(b, b2)),
col='gray80', border='gray80', add=TRUE)
For bonus circle smoothness, plot the circles once more, with colour equal to the background colour.
plot(gUnion(b, b2), border='gray80', lwd=2, add=TRUE)
I have a distance sequence, which I would like to plot of a line in spatstat. Example:
library(spatstat)
x <- c(0.3, 5)
y <- c(3, 1.2)
range.x <- c(0, max(x)+0.2)
range.y <- c(0, max(y)+0.2)
owin <- owin(range.x, range.y)
the.line <- psp(x0 = x[1],x1 = x[2],y0 = y[1],y1 = y[2], window = owin)
plot(the.line)
seqs <- data.frame(name = seq(1,7), distance = c(0.12, 0.3, 0.45, 0.5, 0.7, 0.89, 0.95))
lengths <- seqs$distance*lengths.psp(the.line)
I would like to plot lengths on top of the.line using seqs$name as labels in a following way (labels added with Illustrator):
Would anyone know how to do this? Help would be very much appreciated!
The text function will allow you to add text to an existing plot. Whether you can rotate the text or not depends on the graphics device that you are using, see ?par sections on 'crt' and 'srt'. Also see the 'adj' argument to text for how to get the text above the line rather than obscuring the line.
This all assumes that the plotting is being done in base graphics.
The following worked for me on windows (using the default windows graphics device) after running the code above:
x.new <- seqs$distance*x[2] + (1-seqs$distance)*x[1]
y.new <- seqs$distance*y[2] + (1-seqs$distance)*y[1]
tmp.x <- grconvertX(x, to='inches')
tmp.y <- grconvertY(y, to='inches')
theta <- atan2(diff(tmp.y),diff(tmp.x))*180/pi
text( x.new, y.new, seqs$name, adj=c(0,0), srt=theta )