Related
I'd like to plot a function f(x,y,z) in xyz-space by HeatMap.
I have the following code by https://lazarusa.github.io/BeautifulMakie/surfWireLines/RGBcube/ .
using GLMakie, GeometryBasics, Colors
positions = vec([(i, j, k) for i=1:L,j=1:L,k=1:L]) #3D coordinate
F = zeros(Float64,length(positions)
for i = 1:length(positions) #convert f(x,y,z) to an array
x = positions[i][1]
y = positions[i][2]
z = positions[i][3]
F[i] = f(x,y,z)
end
fig, ax = mesh(HyperRectangle(Vec3f0(positions[1]...),Vec3f0(0.8)), color = RGBA(0,0,F[1],0.5), transparency = false) #HyperRectangle(::position,::length),color=(::red,::green,::blue,::alpha)
wireframe!(ax,HyperRectangle(Vec3f0(positions[1]...), Vec3f0(0.8)), linewidth = 0.1, overdraw = false)
for i in 2:length(positions)
mesh!(ax, HyperRectangle(Vec3f0(positions[i]...), Vec3f0(0.8)), color = RGBA(0,0,F[i],0.5))
wireframe!(ax, HyperRectangle(Vec3f0(positions[i]...), Vec3f0(0.8)), linewidth = 0.1, overdraw = false)
end
fig
This code has mostly helped, but there's still a little problem.:
How to move the camera? (update_camera! needs Scene, but ax is LScene. I don't know what this is.)
How to adjust the axis (labels, ticks, etc.)?
How to add the colorbar?
How to save the figure?
again.
I did another example. This one is really fast. There, you have most of the options you want.
https://lazarusa.github.io/BeautifulMakie/surfWireLines/volumeScatters/
For custom ticks, you can always do
ax.xticks = ([1,2,3], ["1","2", "3"])
also, consider joining https://discourse.julialang.org, there more people could help, much much faster.
Complete code here as well.
# by Lazaro Alonso
using GLMakie
let
x = 1:10
y = 1:10
z = 1:10
f(x,y,z) = x^2 + y^2 + z^2
positions = vec([(i, j, k) for i in x,j in y, k in z])
vals = [f(ix,iy,iz) for ix in x, iy in y, iz in z]
fig, ax, pltobj = meshscatter(positions, color = vec(vals),
marker = FRect3D(Vec3f0(0), Vec3f0(10)), # here, if you use less than 10, you will see smaller squares.
colormap = :Spectral_11, colorrange = (minimum(vals), maximum(vals)),
transparency = true, # set to false, if you don't want the transparency.
shading= false,
figure = (; resolution = (800,800)),
axis=(; type=Axis3, perspectiveness = 0.5, azimuth = 7.19, elevation = 0.57,
xlabel = "x label", ylabel = "y label", zlabel = "z label",
aspect = (1,1,1)))
cbar = Colorbar(fig, pltobj, label = "f values", height = Relative(0.5))
xlims!(ax,-1,11)
ylims!(ax,-1,11)
zlims!(ax,-1,11)
fig[1,2] = cbar
fig
#save("fileName.png", fig) # here, you save your figure.
end
I have written following code for comparing between to different variables over a period. The code works fine but only problem is when i output the file as "jpeg" the lines are not smooth and my arrow is not as smooth as i like it to be in other words the graph feels very low quality. But when i output it as "pdf" i get smooth lines and graph is of higher quality. But pdf files are high in file size and i need to insert these graphs in word file. I find it relatively easy to append jpeg into the word file. So is it possible to improve image quality while being in jpeg format. I tried using res argument in jpeg() but it doesnot output the graph as it is displayed in the rstudio.
I will appreciate the help. Thanks!
code:
library(shape)
library(Hmisc)
### samples ######
xaxs = seq(1,30,length=30)
precip = sample(200:800, 30)
ero = sample(0:10, 30, replace = T)
#########
svpth = getwd()
nm = "try.jpeg"
jpeg(paste0(svpth,"/",nm), width=950 , height =760, quality = 200, pointsize =15)
par(mar= c(5,4,2,4), oma=c(1,1,1,1))
plot(xaxs,precip, type = "p", pch=15, col="green", ylim = c(200,1000),
xlab = "Year" , ylab = "", cex.main=1.5, cex.axis=1.5, cex.lab=1.5)
lines(xaxs, precip,lty =1, col="green")
# xtick<-seq(0,30, by=1)
# axis(side = 1, at=xtick, labels = FALSE )
minor.tick(nx=5, ny=2, tick.ratio=0.5, x.args = list(), y.args = list())
mtext("Depth (mm)", side = 2, line = 2.7, cex = 1.5)
par(new=T)
plot(xaxs, (ero * 10), ylim = c(0,max(pretty(range((ero * 10))))+20), type = "p", pch=20, cex=1.5, col="red", axes = F, xlab = "", ylab = "")
lines(xaxs, (ero * 10),lty =2, col="red")
axis(side = 4, at=pretty(range((ero * 10))), cex.axis = 1.5)
# mtext("Erosion (t/ha/yr)", side = 4, line = 2.2, cex = 1.5)
mtext(expression(paste("Erosion (t ", ha^-1, yr^-1, ")")), side = 4, line = 2.7, cex = 1.5)
legend("topleft", legend = c("Precipitation","Erosion"), lty = c(1,2), pch = c(15,20), col = c("green","red"), cex = 1.6, bty = "n")
####arrow
Arrows(7, 85, 11, 90,lwd= 1.1)
Arrows(26, 85, 21, 90, lwd= 1.1)
txt = "High erosion rates in \nwheat-planting years"
xt = 16
yt = 85
text(xt, yt, labels = txt, family="serif", cex = 1.23)
sw = strwidth(txt)+1.4
sh = strheight(txt) +6
frsz = 0.38
rect(xt - sw/2 - frsz, yt - sh/2 - frsz, xt + sw/2 + frsz, yt + sh/2 + frsz-1)
# legend(15,80, legend = c("High erosion rates in \nwheat-planting years\n"),
# xjust = 0.5, yjust = 0.5)
dev.off()
It didn't use base R, but this makes an svg, which is smaller than a jpeg and will create some beautiful images. MS Word has no problems with svg, either.
The svg-- 18 kb; the jpeg-- 592 kb for the same image.
Use if it works, if not, well, perhaps someone else could use it? This won't show in the plot pane in RStudio, it will show in the viewer pane.
After the code, I have an image of saving the plot in the viewer pane in RStudio.
library(plotly)
df = data.frame("Year" = xaxs, "Depth" = precip, "Erosion" = ero *10)
p = plot_ly(df) %>%
add_trace(x = ~Year, y = ~Depth,
type = 'scatter', mode = 'lines', # to have both the points and lines use 'lines+markers'
name = "Depth",
line = list(shape = "spline", # smooth the curves in the lines (not that effective with lines+markers)
color = "green")) %>%
add_trace(x = ~Year, y = ~Erosion,
mode = 'lines',
name = "Erosion",
yaxis = "y2", # second y axis
line = list(dash = 'dash', # dash the lines
shape = "spline", # smooth the curves in the lines
color = "red")) %>% # without "lines+markers" spline will smooth out the points of the line
add_annotations(inherit = F, # add the arrows at the top of the plot
x = list(12, 18), # this is plot coordinates
y = list(800, 800),
ax = list(-60, 60), # this is pixels
ay = list(10, 10),
showarrow = T,
text = "") %>%
add_annotations(inherit = F, # add the textbox at the top of the plot
x = 15, y = 800,
ax = 0, ay = 0,
showarrow = F,
bordercolor = 'black',
text = "High erosion rates in\nwheat-planting years") %>%
layout(yaxis2 = list(overlaying = "y", side = "right", # add labels
title = paste0("Erosion (t ",
"ha<sup>-1</sup>",
"yr<sup>-1</sup>",
")")),
yaxis = list(title = "Depth (mm)"),
legend = list(x = .1, y = 1000),
margin = list(r = 80)) # right margin space for label
To save it, add the functionality. The icons at the top of the plot in the image at the end won't show until you hover over them. I think you may find that if you use this, the height/width specifications you have aren't the best fit anymore.
(p <- p %>% config( # save the plot; add a save function to the plot
toImageButtonOptions = list(
format = "svg",
filename = "try",
width = 950,
height = 760)) # end config
) # end () for print simo object assignment
The plot. The width and height in this image are 950 x 550.
I want to generate a graph that would show a "vector field" in a plot using base R.
This section of the script will generate a graph with different circles (varying only their radius to make the base of the vector field).
r = 100 # Set the maximum radius to make an empty plot
x = function(ang) r* cos(ang) # To draw circles
y = function(ang) r* sin(ang) # To draw circles
nb = seq(from = 0,to = (2*pi),length.out = 100) # To have a sequence to draw the circles
plot(x(nb),y(nb), # Empty plot
asp = 1,
type = "n",
bg = "black",
col = "black",
pch =21, main = "Circle",
ylab = "Y values",
xlab ="X values")
abline(h=0,v=0) # Draw axes
for (i in seq(0,100,by = 5)) { # Draw a series of circles
r = i
points(x(nb),y(nb),
type = "l",
lwd = 1.0,
lty = 3)
}
# DRAWING TE VECTORS ----------------------
by = 10 # Define a "resolution" to see better the circles (This value will be smaller to be more precise)
changex = seq(0,100, by =by) # For each circle draw a radius with this sequence
current = -1 # This is to "flip" the orientation of the vectors
mag = current* seq(100,0, by = current*by)
arrows(x0 = changex, y0 = 0, # Draw the vectors
x1 = changex, y1 = mag,
code = 2,
length=0.1,
angle=40)
The rest of the code tries to print the vectors when changing the angle in the graph:
xycircle <- function(ang,r) { # function to draw position on the circle
x = r*cos(ang)
y = r*sin(ang)
return(list(x,y))
}
pilist = c(#0,1/4*pi,#1/2*pi, # List of PI values to go around the circle
#pi, #3/4*pi,
#3/2*pi,
2*pi)
for (pip in 1:length(pilist)) { # Going around the circle
ang = pilist[pip] # extract 1 angle value to draw
abline(a=0,b=tan(ang), lty = 3, lwd = 3) # Get a line that will show the angle selected
r = seq(0,100, by = by) # List of radius
mag = current* seq(-100,-0, by = by) # Magnitude of the vectors
for (i in 1:length(r)) { # Draw vectors when the angle changes
arrows(x0 = xycircle(ang,r[i])[[1]], # Base position of the vector (tangent to the circle)
y0 = xycircle(ang,r[i])[[2]],
x1 = cos(atan2(r[i],mag[i])-ang)*sqrt(r[i]^2+mag[i]^2), # Position of the tip of the vector (x)
y1 = sin(atan2(r[i],mag[i])-ang)*sqrt(r[i]^2+mag[i]^2), # Position of the tip of the vector (y)
code = 2, # Change the arrow head
length = 0.1,
angle = 40)
}
}
As you can see, when I complete a full revolution, the vectors are not aligned with the original vectors (they should...).
But when I start to turn around the circle (say 1/4*pi), it's perfect.
How would it be possible to make the vectors "turn" around the circle (based on angles) to make them rotate around the circle so that the vectors are always perpendicular to the circles (like the last graph, but all angles).
Finally, I got it to work
# parameter list ----------------------------------------------------------
by = 10
current = -1
invert.speed = TRUE
circleefrom = 10
circleeto = 28
# See 1 circle from 3 (2 for 4, 3 for 5...)
resolution = 15 # Which is also the number of arrows
resolution.circles = 100
maxcurrent = 10
mincurrent = 0
# Define functions --------------------------------------------------------
# Make a list of radius to draw various circles
r = seq(from = circleefrom, to = circleeto,
length.out = resolution)
# Make a function that will allow to draw circles and extract the values from the x,y position
xycircle <- function(ang,r) {
x = r*cos(ang)
y = r*sin(ang)
return(list(x,y))
}
# Samples enough point for the circles (100 at least)
nb = seq(from = 0, # starts at 0
to = (2*pi), # Does a FULL revolution around the circle
length.out = resolution.circles)
# Plot circles ------------------------------------------------------------
# Create empty canva
plot(x = xycircle(nb,max(r))[[1]],
y = xycircle(nb,max(r))[[2]],
asp = 1,
type = "n",
bg = "black",
col = "black",
pch =21, main = "Rheotaxis experiment",
ylab = "Y values",
xlab ="X values")
# Draw the axes
abline(h = 0,
v = 0)
# This will draw the circles
dbcicle = NULL
for (i in seq(from = circleefrom, to = circleeto,
length.out = resolution)) {
points(x = xycircle(nb,i)[[1]],
y = xycircle(nb,i)[[2]],
col = "blue",
type = "l",
lwd = 1.0,
lty = 3)
tmp = as.data.frame.list(x = c(xycircle(nb,i),i), col.names = c("x","y","radius"))
dbcicle = rbind(dbcicle,tmp)
}
# Add a black center to the design
plotrix::draw.circle(0, 0, radius = circleefrom,
nv = 1000,
border = NULL,
col = "black", lty = 1, lwd = 1)
# Add circle at the contour
plotrix::draw.circle(0, 0, radius = circleeto,
nv = 1000,
border = NULL,
col = NA, lty = 1, lwd = 1)
# Current specification ---------------------------------------------------
# Create the simulated current
if(invert.speed) {
mag = current * seq(from = mincurrent,
to = maxcurrent,
length.out = resolution + 1)
} else {
mag = current * seq(from = maxcurrent,
to = mincurrent,
length.out = resolution + 1)
}
# mag = current * rep(16,11)
# Draw the vecotrs of current --------------------------------------------
# Get different angle values
pilist = seq(from = 1/2*pi,
to = 2*pi,
by = 1/2*pi)
pilist = seq(from = 0,
to = 2*pi,
length.out = resolution)
dbcicle2 = NULL
for (pip in 1:length(pilist)) {
ang = pilist[pip]
abline(a=0,b=tan(ang), lty = 3, lwd = 3)
for (i in 1:length(r)) {
arrows(x0 = xycircle(ang,r[i])[[1]],
y0 = xycircle(ang,r[i])[[2]],
x1 = xycircle(c(ang-atan2(mag[i],r[i])),sqrt(r[i]^2+mag[i]^2))[[1]],
y1 = xycircle(c(ang-atan2(mag[i],r[i])),sqrt(r[i]^2+mag[i]^2))[[2]],
col = "blue",
code = 2,
length = 0.1,
angle = 40)
tmp = as.data.frame.list(x = c(xycircle(ang,r[i]),r[i],-1*mag[i],ang+pi/2),
col.names = c("x","y","radius","magnitude","ang"))
dbcicle2 = rbind(dbcicle2,tmp)
}
}
I'm using the plotly package and I'm trying to add a horizontal line to a graph. Is there any way of doing it using plotly?
It can be done using ggplot2 and the ggplotly function as shown below:
library(plotly)
p <- ggplot() +
geom_hline(yintercept = 4) +
xlim(c(0,10)) +
ylim(c(0,10))
ggplotly(p)
But I can't add this to an existing plotly plot.
Also, the axis of my charts are not fixed, so it would be difficult (but not impossible) to just work out an x and y coordinate system for a horizontal line, but I'd rather just add one automatically.
I've looked into the y0 and dy arguments, but I can't seem to get the code for those to work, either. I'm not quite sure what they do exactly, but I think they're maybe what I'm looking for? I can't find good examples of their usage.
There are two main ways to do this (using either data or 'paper' coordinates). Assuming data coordinates, the easiest current way is via add_segments():
plot_ly() %>%
add_segments(x = 4, xend = 4, y = 0, yend = 10) %>%
add_segments(x = 3, xend = 5, y = 5, yend = 5)
Notice how we've hard coded the extent of these lines in data coordinates; so when zooming and panning the plot, the line will be "clipped" at those values. If you don't want these lines to be clipped, use a line shape with xref/yref set to paper (this puts the graph region on a 0-1 scale, rather than on the x/y data scale):
vline <- function(x = 0, color = "red") {
list(
type = "line",
y0 = 0,
y1 = 1,
yref = "paper",
x0 = x,
x1 = x,
line = list(color = color)
)
}
hline <- function(y = 0, color = "blue") {
list(
type = "line",
x0 = 0,
x1 = 1,
xref = "paper",
y0 = y,
y1 = y,
line = list(color = color)
)
}
plot_ly() %>%
layout(shapes = list(vline(4), hline(5)))
Alternatively, you could add a shape (i.e. line) under layout(). The following example adds a vertical line:
p <- plot_ly(data, x = ~x.data, y = ~y.data, text = ~text.data, type = 'scatter',
mode = 'markers', marker = list(size = ~size.data, opacity= 0.5)) %>%
layout(shapes=list(type='line', x0= 0.2, x1= 0.2, y0=min(allyvalues), y1=max(allyvalues), line=list(dash='dot', width=1)),
title = 'This is the Title',
xaxis = list(title = "X-Axis", showgrid = TRUE),
yaxis = list(title = "Y-Axis", showgrid = TRUE))
p
Building on Carson's nice answer above, here is a convenience function closer to ggplot's geom_vline()
# Add vertical line(s) at position x to plotly plot p
# Additional arguments: color, width (px), dash ('solid','dot', 'dash', etc)
# See https://plotly.com/r/reference/#layout-shapes-items-shape-line
add_vline = function(p, x, ...) {
l_shape = list(
type = "line",
y0 = 0, y1 = 1, yref = "paper", # i.e. y as a proportion of visible region
x0 = x, x1 = x,
line = list(...)
)
p %>% layout(shapes=list(l_shape))
}
To make the function additive the following modifications to the function can be used
add_vline = function(p, x, ...) {
if(!is.null(p$x$layoutAttrs)){
index <- unname(which(sapply(p$x$layoutAttrs, function(x)
!is.null(x$shapes))))
} else {
index <- integer()
}
l_shape = list(
type = "line",
y0 = 0, y1 = 1, yref = "paper", # i.e. y as a proportion of visible region
x0 = x, x1 = x,
line = list(
...
),
layer = "below"
)
if(length(index) > 0){
shapes <- p$x$layoutAttrs[[index]]$shapes
shapes[[length(shapes) + 1]] <- l_shape
p$x$layoutAttrs[[index]]$shapes <- shapes
} else {
p <- plotly::layout(
p = p,
shapes = list(l_shape)
)
}
p
}
I am using a function which plots two graphs on the same picture. I want to add threshold line to the first graph and a different threshold on the second graph. I am using abline() function to do so. chr6 comes with a library as an example.
install.packages("GenWin")
library(GenWin)
chrom_num = 6
jpeg(filename = paste(chrom_num, ".jpg", sep=""), width = 1200, height = 800)
chr = splineAnalyze(chr6$Fst, chr6$Position, plotRaw = 1, plotWindows = 1, method = 4)
abline(0.3, 0, col = "green")
abline(6, 0, col = "green")
Both threshold lines show up on the second graph. How to prevent this? In other word is there a way to direct to which graph I am adding something?
If you want to add something, I think it would be better to make graphs by yourself from the analyzed data, chr (almost all code is picked out from splineAnalyze). This approach would enable you to customize the graph.
analyzed_data <- chr # All you need to do is changing these lines and data and col names of 1st plot()).
smoothness <- 100 # default value
jpeg(filename = paste("file_name", ".jpg", sep=""), width = 1200, height = 800)
par(mfrow = c(2,1))
# 1st graph
plot(Fst ~ Position, chr6, xlab = "Position (bp)", ylab = "Raw values")
with(analyzed_data,
lines(x = seq(0, max(rawSpline$x), by = smoothness),
y = predict(rawSpline, seq(0, max(rawSpline$x), by = smoothness)), col = "red")
)
abline(0.3, 0, col = "green")
# 2nd graph
with(analyzed_data,
plot(x = (windowData$WindowStop - windowData$WindowStart)/2 + windowData$WindowStart,
y = windowData$Wstat, xlab = "Position (bp)", ylab = "Spline Wstat", pch = 19)
)
abline(6, 0, col = "green")
dev.off()
Of course, you can do it using splineAnalyze(..., plotRaw = 1, plotWindows = 1, ...) and adding the lines.
jpeg(filename = paste("file_name2", ".jpg", sep=""), width = 1200, height = 800)
chr = splineAnalyze(chr6$Fst, chr6$Position, plotRaw = 1, plotWindows = 1, method = 4)
abline(6, 0, col = "green") # draw on 2nd panel
layout(matrix(c(2,1), ncol = 1)) # refocus 1st panel
par(new = T)
plot(Fst ~ Position, chr6, ann = F, type = "n", axes = F) # reproduce the coordinates
abline(0.3, 0, col = "green") # draw on 1st panel
dev.off()