Related
I am trying to create an heatmap with a row annotation inclusive of p-values as reported in the example in the guide for the use of the ComplexHeatmap package (https://jokergoo.github.io/ComplexHeatmap-reference/book/heatmap-annotations.html#simple-annotation).
I tried to reproduce the example:
library(ComplexHeatmap)
library(circlize) # colorRamp2 function
set.seed(123)
pvalue = 10^-runif(10, min = 0, max = 3)
is_sig = pvalue < 0.01
pch = rep("*", 10)
pch[!is_sig] = NA
# color mapping for -log10(pvalue)
pvalue_col_fun = colorRamp2(c(0, 2, 3), c("green", "white", "red"))
ha = HeatmapAnnotation(
pvalue = anno_simple(-log10(pvalue), col = pvalue_col_fun, pch = pch),
annotation_name_side = "left")
ht = Heatmap(matrix(rnorm(100), 10), name = "mat", top_annotation = ha)
# now we generate two legends, one for the p-value
# see how we define the legend for pvalue
lgd_pvalue = Legend(title = "p-value", col = pvalue_col_fun, at = c(0, 1, 2, 3),
labels = c("1", "0.1", "0.01", "0.001"))
# and one for the significant p-values
lgd_sig = Legend(pch = "*", type = "points", labels = "< 0.01")
# these two self-defined legends are added to the plot by `annotation_legend_list`
draw(ht, annotation_legend_list = list(lgd_pvalue, lgd_sig))
but when I am creating the annotation ha I get the error
Error in anno_simple(-log10(pvalue), col = pvalue_col_fun, pch = pch) :
could not find function "anno_simple"
likely showing a possible problem with the package.
The version of the ComplexHeatmap package I am running is 1.20.0.
The R version is 3.5.1.
Could you please help me solving this problem?
Thanks
I'm having a problem with implementing the function bt.matching.find from the SIT toolbox which is hosted on Github. After downloading the toolbox following the steps described here, I tried to replicate the code described in this blog
library(SIT.dates)
library(SIT)
objt <- bt.matching.find(Cl(data), normalize.fn = normalize.mean, dist.fn = 'dist.euclidean', plot=T)
R did not find the function, so I tried using spacing to access the function
objt <- SIT:::bt.matching.find(Cl(data), normalize.fn = normalize.mean, dist.fn = 'dist.euclidean', plot=T)
But this time I got a weird error which has nothing to do with any argument in the function
Error in last(data, n.reference) : could not find function "last"
I did research on the function bt.matching.find using the function getAnywhere and here's what I got
getAnywhere("bt.matching.find")
A single object matching ‘bt.matching.find’ was found
It was found in the following places
namespace:SIT
with value
function (data, n.query = 90, n.reference = 252 * 10, n.match = 10,
normalize.fn = normalize.mean.sd, dist.fn = dist.euclidean,
plot = FALSE, plot.dist = FALSE, layout = NULL, main = NULL)
{
data = last(data, n.reference)
reference = coredata(data)
n = len(reference)
query = reference[(n - n.query + 1):n]
reference = reference[1:(n - n.query)]
main = paste(main, join(format(range(index(data)[(n - n.query +
1):n]), "%d%b%Y"), " - "))
n.query = len(query)
n.reference = len(reference)
dist.fn.name = ""
if (is.character(dist.fn)) {
dist.fn.name = paste("with", dist.fn)
dist.fn = get(dist.fn)
}
dist = rep(NA, n.reference)
query.normalized = match.fun(normalize.fn)(query)
for (i in n.query:n.reference) {
window = reference[(i - n.query + 1):i]
window.normalized = match.fun(normalize.fn)(window)
dist[i] = match.fun(dist.fn)(rbind(query.normalized,
window.normalized))
if (i%%100 == 0)
cat(i, "\n")
}
min.index = c()
temp = dist
temp[temp > mean(dist, na.rm = T)] = NA
for (i in 1:n.match) {
if (any(!is.na(temp))) {
index = which.min(temp)
min.index[i] = index
temp[max(0, index - 2 * n.query):min(n.reference,
(index + n.query))] = NA
}
}
n.match = len(min.index)
if (plot) {
dates = index(data)[1:len(dist)]
if (is.null(layout)) {
if (plot.dist)
layout(1:2)
else layout(1)
}
par(mar = c(2, 4, 2, 2))
if (plot.dist) {
plot(dates, dist, type = "l", col = "gray", main = paste("Top
Historical Matches for",
main, dist.fn.name), ylab = "Distance", xlab = "")
abline(h = mean(dist, na.rm = T), col = "darkgray",
lwd = 2)
points(dates[min.index], dist[min.index], pch = 22,
col = "red", bg = "red")
text(dates[min.index], dist[min.index], 1:n.match,
adj = c(1, 1), col = "black", xpd = TRUE)
}
plota(data, type = "l", col = "gray", LeftMargin = 1,
main = iif(!plot.dist, paste("Top Historical Matches for",
main), NULL))
plota.lines(last(data, 90), col = "blue")
for (i in 1:n.match) {
plota.lines(data[(min.index[i] - n.query + 1):min.index[i]],
col = "red")
}
text(index4xts(data)[min.index - n.query/2], reference[min.index -
n.query/2], 1:n.match, adj = c(1, -1), col = "black",
xpd = TRUE)
plota.legend(paste("Pattern: ", main, ",Match Number"),
"blue,red")
}
return(list(min.index = min.index, dist = dist[min.index],
query = query, reference = reference, dates = index(data),
main = main))
}
<bytecode: 0x000000e7e11c8a00>
<environment: namespace:SIT>
I tried calling the function using backports package
library(backports)
.onLoad <- function(libname, pkgname) {
backports::import(SIT, "bt.matching.find", force = TRUE)
}
But this also didn't work
Why is R not able to access the function? could this be because this package was built under an older version?
Additional information
Environment
sessionInfo()
R version 3.5.3 (2019-03-11)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 8.1 x64 (build 9600)
The problem was solved with help from the developer of the package, for anyone who is interested in using the code, here are the adjustments that should be done
library(SIT)
library(quantmod)
tickers = 'SPY'
data = getSymbols(tickers, src = 'yahoo', from = '1950-01-01', auto.assign = F)
obj = SIT:::bt.matching.find(Cl(data), normalize.fn = SIT:::normalize.mean, dist.fn = 'dist.euclidean', plot=T)
matches = SIT:::bt.matching.overlay(obj, plot.index=1:90, plot=T)
layout(1:2)
matches = SIT:::bt.matching.overlay(obj, plot=T, layout=T)
SIT:::bt.matching.overlay.table(obj, matches, plot=T, layout=T)
I have SSIS package that gets data into database and then executes R Script. R script creates new folder (names it based on the current date) and generate some pdf files into this folder. I have deployed this package on server and created Job that executes it every night. The problem is that each morning I am finding only empty folders (with correct date name) without any pdf files. However, If I execute that package manually in Visual Studio it works fine and pdfs are there. Am I missing something here? I appreciate every answer.
EDIT
When I execute manually it is directly on the server
Package looks like this
and here is my R script
dir.create(file.path(output.path, date))
library(RODBC)
conn <- odbcConnect("Azure", uid = "aaaaa", pwd = "aaaaa")
etldata <- sqlFetch(conn,"dbo.EtlLogsData", stringsAsFactors = FALSE)
pdf(paste('ETL_Duration_For_Effective_Date_', date,'.pdf',sep = ""),
width = 12,
height = 8,
paper = 'special')
par(mar = c(5, 17, 5, 3))
plot(c(min(etldata_day$st_sec), max(etldata_day$et_sec)),
c(sn[1], sn[1]),
ylim = c(0, n),
yaxt = 'n',
xaxt = 'n',
ylab = '',
xlab = 'Time',
main = paste('ETL Duration With Effective Date ', date, sep = ""))
abline(h = sn, untf = FALSE, col = "gray90")
for (i in 1:n){
lines(c(etldata_day$st_sec[i], etldata_day$et_sec[i]),
c(sn[i], sn[i]),
type = "l", lwd = 2)
arrows(etldata_day$st_sec[i], sn[i],
etldata_day$et_sec[i], sn[i],
length = 0.025, angle = 90, lwd = 2)
arrows(etldata_day$et_sec[i], sn[i],
etldata_day$st_sec[i], sn[i],
length = 0.025, angle = 90, lwd = 2)
}
# Print y axis labels
axis(2, at = sn, labels = etldata_day$TaskName, las = 1, cex.axis = 1)
# Print x axis labels
xat <- seq(from = min(etldata_day$st_sec), to = max(etldata_day$et_sec), length.out = 10)
xlabels <- secondsToString(xat)
axis(1, at = xat, labels = substr(xlabels,1,8), cex.axis = 1)
dev.off()
After plot() I use some FOR cycles, and LINES(),
I am plotting a time series with the timePlot function of the open air package of R. The graph has grey grid lines in the background that I would like to turn off but I do not find a way to do it. I would expect something simple such as grid = FALSE, but that is not the case. It appears to be rather complex, requiring the use of extra arguments which are passed to xyplot of the library lattice. I believe the answer lies some where in the par.settings function but all attempts have failed. Does anyone have any suggestions to this issue?
Here is by script:
timeozone <- import(i, date="date", date.format = "%m/%d/%Y", header=TRUE, na.strings="")
ROMO = timePlot(timeozone, pollutant = c("C7", "C9", "C10"), group = TRUE, stack = FALSE,y.relation = "same", date.breaks = 9, lty = c(1,2,3), lwd = c(2, 3, 3), fontsize = 15, cols = c("black", "black"), ylab = "Ozone (ppbv)")
panel = function(x, y) {
panel.grid(h = 0, v = 0)
panel.xyplot(x,y)
}
I am developing an interactive scatterplot so that when the user rolls over a data point, a label is displayed. However, I would also like to add edges between certain data points.
I am successful at developing the interactive scatterplot using several libraries, including grid, gridSVG, lattice, and adegraphics. Below is a MWE:
library(grid)
library(gridSVG)
library(lattice)
library(adegraphics)
x = rnorm(10)
y = rnorm(10)
dat = data.frame(label = letters[1:10], x, y)
customPanel2 <- function(x, y, ...) {
for (j in 1:nrow(dat)) {
grid.circle(x[j], y[j], r = unit(.5, "mm"),
default.unit = "native",
name = paste("point", j, sep = "."))
}
}
xyplot(y ~ x, panel = customPanel2, xlab = "x variable", ylab=NULL, scales=list(tck = c(1,0), y=list(at=NULL)))
for (i in 1:nrow(dat)) {
grid.text(as.character(dat$label)[i], x = 0.1, y = 0.01, just = c("left", "bottom"), name = paste("label", i, sep = "."), gp = gpar(fontface = "bold.italic"))
}
for (i in 1:nrow(dat)) {
grid.garnish(paste("point", i, sep = "."), onmouseover = paste('highlight("', i, '.1.1")', sep = ""), onmouseout = paste('dim("', i, '.1.1")', sep = ""))
grid.garnish(paste("label", i, sep = "."), visibility = "hidden")
}
grid.script(filename = "aqm.js", inline = TRUE)
grid.export("interactiveScat.svg")
The resulting .svg file accomplishes everything I am aiming for - except that I also wish to add certain non-interactive edges. I tried to do this by incorporating the adeg.panel.edges method from the adegraphics library after defining the edges and the coordinates to be mapped. So, basically my xplot(...) function from before is replaced with:
edges = matrix(c(1, 2, 3, 2, 4, 1, 3, 4), byrow = TRUE, ncol = 2)
coords <- matrix(c(x[1], y[1], x[2], y[2], x[3], y[3], x[4], y[4]), byrow = TRUE, ncol = 2)
xyplot(y ~ x, panel = function(customPanel2){adeg.panel.edges(edges, coords, lty = 1:4, cex = 5)}, xlab = "x variable", ylab=NULL, scales=list(tck = c(1,0), y=list(at=NULL)))
It seems that this simply erases the interactive scatterplot made from the original xyplot, and simply outputs the static edge and coordinate image.
I tried to follow the example as seen in (http://finzi.psych.upenn.edu/library/adegraphics/html/adeg.panel.nb.html). Specifically, this example:
edges <- matrix(c(1, 2, 3, 2, 4, 1, 3, 4), byrow = TRUE, ncol = 2)
coords <- matrix(c(0, 1, 1, 0, 0, -1, -1, 0), byrow = TRUE, ncol = 2)
xyplot(coords[,2] ~ coords[,1],
panel = function(...){adeg.panel.edges(edges, coords, lty = 1:4, cex = 5)})
I am a bit at a loss as to how to troubleshoot this problem, especially as I am mimicking the example code. Any suggestions are greatly appreciated!
If what you are trying to produce is a node-link diagram of a network an alternate solution is to coerce your data into a network object and use the ndtv package to generate svg/htmlwidget interactive plots for your network. The ndtv package is designed for dynamic networks, but will generate interactive plots for static nets as well.
library(ndtv)
data(emon) # load a list of example networks
render.d3movie(emon[[5]]) # render network 5 in the browser
Much more detail is in the tutorial http://statnet.csde.washington.edu/workshops/SUNBELT/current/ndtv/ndtv-d3_vignette.html
However, this does not use grid/lattice graphics at all