Hi I the have following code in R plotly.
I want to provide axes ticks for e.g. 0:10 for X-axis and seq(from=1000, to=4000, length.out=11) for Y-axis. Can you please help me with this ?
set.seed(0)
#Sample matrix
bitmap<-matrix(rnorm(150000,mean=1:500),nrow = 300, ncol = 500)
plot_ly(z=bitmap) %>% add_heatmap()
Are you looking for tickvals and ticktext?
library(plotly)
library(magrittr)
set.seed(0)
#Sample matrix
nrows <- 300
ncols <- 500
bitmap<-matrix(rnorm(150000 ,mean = 1:500),nrow = nrows, ncol = ncols)
plot_ly(z=bitmap) %>%
add_heatmap() %>%
layout(xaxis=list(tickvals = seq(from = 0,
to = ncols,
length.out = 10),
ticktext = c(0:9)),
yaxis=list(tickvals = seq(from = 0,
to = nrows,
length.out = 11),
ticktext = seq(from = 1000,
to = 4000,
length.out = 11)
)
)
Related
I am trying to widen the end of ribbon. Is it possible?
library(circlize)
mat2 = matrix(sample(100, 35), nrow = 5)
rownames(mat2) = letters[1:5]
colnames(mat2) = letters[1:7]
chordDiagram(mat2, grid.col = 1:7, directional = 1, row.col = 1:5)
Thanks
You can use the target.prop.height argument:
chordDiagram(mat2, grid.col = 1:7, directional = 1, row.col = 1:5,
target.prop.height = mm_h(1))
chordDiagram(mat2, grid.col = 1:7, directional = 1, row.col = 1:5,
target.prop.height = mm_h(3))
How can I make this red polygon partially transparent so I can see the points underneath it?
library(ks)
set.seed(1234)
x <- runif(1000) + -150
y <- runif(1000) + 20
my.data <- data.frame(x,y)
my.matrix <- as.matrix(my.data)
my_gps_hpi <- Hpi(x = my.matrix, pilot = "samse", pre = "scale")
my.fhat <- kde(x = my.matrix, compute.cont = TRUE, h = my_gps_hpi,
xmin = c(min(my.data$x), min(my.data$y)),
xmax = c(max(my.data$x), max(my.data$y)),
bgridsize = c(100, 100))
my.contours <- c(75)
contourLevels(my.fhat, cont = my.contours)
contourSizes(my.fhat, cont = my.contours, approx = TRUE)
plot(my.data$x, my.data$y)
plot(my.fhat, lwd = 3, display = "filled.contour", cont = my.contours, add = TRUE)
png(file="transparent_polygon_June21_2021.png")
plot(my.data$x, my.data$y)
plot(my.fhat, lwd = 3, display = "filled.contour", cont = my.contours, add = TRUE)
dev.off()
I think I have figured out a solution by digging around in the source code in the file kde.R.
I made several changes to my code.
Changed my.fhat to fhat because the source code might want fhat.
Changed my.contours to contours for the same reason.
Changed contourLevels(my.fhat, cont = my.contours) to hts <- contourLevels(fhat, cont = contours) for the same reason.
Extracted the col.fun from the source code and changed it to return the color of my choice: col.fun <- function(n) {rgb(255, 0, 0, 127, maxColorValue=255)}.
Modified the plot statement to that shown in the code below.
Here is the modified R code:
setwd('C:/Users/mark_/Documents/ctmm/density_in_R/')
set.seed(1234)
library(ks)
x <- runif(1000) + -150
y <- runif(1000) + 20
my.data <- data.frame(x,y)
my.matrix <- as.matrix(my.data)
gps_hpi <- Hpi(x = my.matrix, pilot = "samse", pre = "scale")
fhat <- kde(x = my.matrix, compute.cont = TRUE, h = gps_hpi,
xmin = c(min(my.data$x), min(my.data$y)),
xmax = c(max(my.data$x), max(my.data$y)),
bgridsize = c(100, 100))
contours <- c(75)
hts <- contourLevels(fhat, cont = contours)
contourSizes(fhat, cont = contours, approx = TRUE)
col.fun <- function(n) {rgb(255, 0, 0, 127, maxColorValue=255)}
col.fun(1)
plot(fhat, lwd = 3, display = "filled.contour", cont = contours, col.fun = col.fun(1), drawpoints=TRUE)
png(file="transparent_polygon_June22_2021.png")
plot(fhat, lwd = 3, display = "filled.contour", cont = contours, col.fun = col.fun(1), drawpoints=TRUE)
dev.off()
I have multiple data.frames and each one of them represent the pairwise interactions of individuals at different time points.
Here is an example of how my data.frames look.
df1 <- matrix(data = rexp(9, rate = 10), nrow = 3, ncol = 3)
df2 <- matrix(data = rexp(16, rate = 10), nrow = 4, ncol = 4)
df3 <- matrix(data = rexp(4, rate = 10), nrow = 2, ncol = 2)
I would like to plot them as it is pointed in this page (https://plotly.com/r/sliders/)
where with a slider I can move from one heatmap to the other.
I have tried so far with plotly but I have not succeeded. Any help is highly appreciated.
I am struggling for long with this issue. I might be a bit blind at this point so please forgive me if the question is stupid.
Following the Sine Wave Slider example on https://plotly.com/r/sliders/ this can be achieved like so. The first step of my approach involves converting the matrices to dataframes with columns x, y, z. Second instead of lines we plot heatmaps.
df1 <- matrix(data = rexp(9, rate = 10), nrow = 3, ncol = 3)
df2 <- matrix(data = rexp(16, rate = 10), nrow = 4, ncol = 4)
df3 <- matrix(data = rexp(4, rate = 10), nrow = 2, ncol = 2)
library(tibble)
library(tidyr)
library(plotly)
# Make dataframes
d <- lapply(list(df1, df2, df3), function(d) {
d %>%
as_tibble(.colnames = seq(ncol(.))) %>%
rowid_to_column("x") %>%
pivot_longer(-x, names_to = "y", values_to = "z") %>%
mutate(y = stringr::str_extract(y, "\\d"),
y = as.numeric(y))
})
aval <- list()
for(step in seq_along(d)){
aval[[step]] <-list(visible = FALSE,
name = paste0('v = ', step),
x = d[[step]]$x,
y = d[[step]]$y,
z = d[[step]]$z)
}
aval[1][[1]]$visible = TRUE
steps <- list()
fig <- plot_ly()
for (i in seq_along(aval)) {
fig <- add_trace(fig, x = aval[i][[1]]$x, y = aval[i][[1]]$y, z = aval[i][[1]]$z, visible = aval[i][[1]]$visible,
name = aval[i][[1]]$name, type = "heatmap")
fig
step <- list(args = list('visible', rep(FALSE, length(aval))), method = 'restyle')
step$args[[2]][i] = TRUE
steps[[i]] = step
}
fig <- fig %>%
layout(sliders = list(list(active = 0,
currentvalue = list(prefix = "Heatmap: "),
steps = steps)))
fig
I'm trying to draw a similar a matrix image like this using a known matrix. in this image each square represent the frequency of the corresponding number in vertical axis, and darker color square means high frequency of that number. For example, my known matrix could be generate as
Ture <- rep(8, 100)
PA <- rep(7, 100)
ED <- sample(6:8, 100, replace = T)
ER <- rep(0, 100)
IC1 <- sample(1:2, 100, replace = T)
NE <- sample(3:4, 100, replace = T)
BCV <- sample(5:7, 100, replace = T)
Oracle <- sample(5:6, 100, replace = T)
M <- rbind(Ture, PA, ED, ER, IC1, NE, BCV, Oracle)
Thanks very much!
Further to my comment above, you can do the following
image(M, axes = F, col = rev(gray.colors(12, start = 0, end = 1)))
axis(1, at = seq(0, 1, length.out = nrow(M)), labels = rownames(M))
axis(2, at = seq(0, 1, length.out = 11), labels = seq(0, 100, length.out = 11))
I generally create a fanplot like this:
n.ahead <- 10
m <- matrix(,nrow = 5000,ncol = 10)
library(fanplot)
m[,1] <- rnorm(5000,0.01,sd = 0.005)
m[,2] <- rnorm(5000,0.02,0.006)
m[,3] <- rnorm(5000,0.03,0.008)
m[,4] <- rnorm(5000,0.04,0.01)
m[,5] <- rnorm(5000,0.06,0.013)
m[,6] <- rnorm(5000,0.1,0.015)
m[,7] <- rnorm(5000,0.11,0.02)
m[,8] <- rnorm(5000,0.13,0.025)
m[,9] <- rnorm(5000,0.14,0.05)
m[,10] <- rnorm(5000,0.18,0.07)
n.ahead <- 10
fancol <- colorRampPalette(c('black', 'white'))
plot(
NULL, type = 'n', lwd = 3, col = 'black',
xlim = c(0, n.ahead), ylab = 'Y', ylim = c(0,max(m)), xlab = 'Year',
las = 1, xaxt = 'n', main = 'Y'
)
fan(
m, fan.col = fancol, ln.col = 'grey', txt = c('90','95', '99'),
anchor = 0, frequency = 1, probs = c(seq(1, 99, 1), 99.9, 99.95, 99.99), ln =
c(50, 90, 99, 99.9, 99.95, 99.99)
)
axis(1, at = 0:n.ahead, tcl = 0.5)
axis(1, at = seq(0, n.ahead, 0.25), labels = FALSE, tcl = 0.25)
It does the trick in the sense that a fanlplot is created. However, I don't really like it. Are there alternatives with dynamic charts like we see in dygraphs and rCharts I can use in Shiny?
Thanks.