I am using plot_roc_components function from rmda package. The definition of it has plot_generic() function. But, I am not able to find definition of this function. Why is it so?
The reason for it to see if there is an option for legend.size(). plot_roc_components gives me figure, however, I want to change the legend size. There is an option for legend.position, but not for its font size.
Could you please explain?
Thanks!
https://github.com/mdbrown/rmda/blob/57553a4cf5b6972176a0603b412260e367147619/R/plot_functions_sub.R
You were looking in one file but it was defined in another file.
plot_generic<- function(xx, predictors, value, plotNew,
standardize, confidence.intervals,
cost.benefit.axis = TRUE, cost.benefits, n.cost.benefits,
cost.benefit.xlab, xlab, ylab,
col, lty, lwd,
xlim, ylim, legend.position,
lty.fpr = 2, lty.tpr = 1,
tpr.fpr.legend = FALSE,
impact.legend = FALSE,
impact.legend.2 = FALSE,
population.size = 1000,
policy = policy, ...){
## xx is output from get_DecisionCurve,
## others are directly from the function call
#save old par parameters and reset them once the function exits.
old.par<- par("mar"); on.exit(par(mar = old.par))
xx.wide <- reshape::cast(xx, thresholds~model, value = value, add.missing = TRUE, fill = NA)
xx.wide$thresholds <- as.numeric(as.character(xx.wide$thresholds))
if(is.numeric(confidence.intervals)){
val_lower <- paste(value, "lower", sep = "_")
val_upper <- paste(value, "upper", sep = "_")
xx.lower <- cast(xx, thresholds~model, value = val_lower, add.missing = TRUE, fill = NA)
xx.upper <- cast(xx, thresholds~model, value = val_upper, add.missing = TRUE, fill = NA)
xx.lower$thresholds <- as.numeric(as.character(xx.lower$thresholds))
xx.upper$thresholds <- as.numeric(as.character(xx.upper$thresholds))
}
# adjust margins to add extra x-axis
if(cost.benefit.axis) par(mar = c(7.5, 4, 3, 2) + 0.1)
#set default ylim if not provided
#initial call to plot and add gridlines
Related
I'm trying to create a phylogeny where the branch lengths that I've coded are represented by colour rather than length. So I want the branch lengths to be equal.
Here is my code:
plotBranchbyTrait(tree.scaled, tree.scaled$edge.length, mode=c("edges"),palette="rainbow", use.edge.length = FALSE, node.depth = 2)
It's my understanding that use.edge.length = FALSE should make the branch lengths equal, and it does this if I code the tree using plot.phylo(). But the tree still shows up with the branch lengths when I use plotBranchbyTrait(). Anyone know how to get around this?
Unfortunately, optional arguments (...) are not directly passed to plot.phylo in the plotBranchbyTrait function. One non-elegant way to fix that is to modify the body directly in R to add a hard coded use.edge.length = FALSE option.
You can do this by creating a new function and modify it using body(foo)[[line_of_interest]] <- substitute(my_new_line <- that_does_something). The following example should work:
## Back up the function
plotBranchbyTrait_no_edge_length <- phytools::plotBranchbyTrait
## The line to modify:
body(plotBranchbyTrait_no_edge_length)[[34]]
# xx <- plot.phylo(tree, type = type, show.tip.label = show.tip.label,
# show.node.label = show.node.label, edge.color = colors, edge.width = edge.width,
# edge.lty = edge.lty, font = font, cex = cex, adj = adj, srt = srt,
# no.margin = no.margin, root.edge = root.edge, label.offset = label.offset,
# underscore = underscore, x.lim = x.lim, y.lim = y.lim, direction = direction,
# lab4ut = lab4ut, tip.color = tip.color, plot = plot, rotate.tree = rotate.tree,
# open.angle = open.angle, lend = 2, new = FALSE)
## Modify the line 34 by adding `use.edge.length = FALSE`
body(plotBranchbyTrait_no_edge_length)[[34]] <- substitute( xx <- plot.phylo(use.edge.length = FALSE, tree, type = type, show.tip.label = show.tip.label, show.node.label = show.node.label, edge.color = colors, edge.width = edge.width, edge.lty = edge.lty, font = font, cex = cex, adj = adj, srt = srt, no.margin = no.margin, root.edge = root.edge, label.offset = label.offset, underscore = underscore, x.lim = x.lim, y.lim = y.lim, direction = direction, lab4ut = lab4ut, tip.color = tip.color, plot = plot, rotate.tree = rotate.tree, open.angle = open.angle, lend = 2, new = FALSE) )
## Testing whether it worked
library(phytools)
tree <- pbtree(n=50)
x <- fastBM(tree)
## With use.edge.length = TRUE (default)
plotBranchbyTrait(tree, x, mode = "tips", edge.width = 4, prompt = FALSE)
## With use.edge.length = FALSE
plotBranchbyTrait_no_edge_length(tree, x, mode = "tips", edge.width = 4, prompt = FALSE)
You can find more on how to modify functions here.
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 have a question about the par function in R.
I want to change the color and/or width of a line in a graph with par function. (I am using par function because the gaps.plot command below does not allow "col" option to be included. The gaps.plot command is used after the synth command).
So, I used the following command. But I noticed that the lines of the BOX are changed rather than the lines of the GRAPHS.
synth1<-read.csv(file="C:\\Users\\Research\\R\\synthinR_v4.csv",header=TRUE)
attach(synth1)
library("Synth")
dataprep.out34 <- dataprep(foo = synth1, predictors = c("lncdsales", "md1", "md2","md3", "md4", "md5", "md6", "md7", "md8", "md9", "md10", "md11", "yd1", "yd2", "yd3", "yd4", "yd5", "yd6", "yd7", "yd8"), predictors.op = "mean", time.predictors.prior = -13:1, dependent = "lndigital", unit.variable = "artistalbumcode", time.variable = "release", treatment.identifier = 34, controls.identifier = c(1:33, 35:49), time.optimize.ssr = -13:1, time.plot = -13:25)
synth.out34 <- synth(data.prep.obj = dataprep.out34, method = "BFGS")
par(lwd = 2, col="#cccccc")
gaps.plot(synth.res = synth.out34, dataprep.res = dataprep.out34, Ylab = " Log Digital Sales ", Xlab = "Release", Ylim = c(-7, 7) , Main = NA)
Does anyone know how to fix this problem??
Thank you in advance for your willingness to help. I greatly appreciate it!
The col argument to par sets the default plotting colour (i.e. when col is not explicitly specified in plotting calls), but unfortunately col = "black" is hard-coded into the source of gaps.plot.
You can make a modified copy of the function by either (1) viewing the source (F2 in RStudio, or just executing gaps.plot), editing it and assigning it to a new object, or (2) doing something like the following:
gaps.plot2 <- eval(parse(text=gsub('col = "black"', 'col = "red"',
deparse(Synth:::gaps.plot))))
and then using gaps.plot2 as you would use gaps.plot:
gaps.plot2(synth.res = synth.out34, dataprep.res = dataprep.out34,
Ylab = " Log Digital Sales ", Xlab = "Release", Ylim = c(-7, 7) ,
Main = NA)
Alter the lwd similarly. For example to make lines red and have width of 3, use nested gsub calls like this:
gaps.plot2 <- eval(parse(text=gsub('lwd = 2', 'lwd = 3',
gsub('col = "black"', 'col = "red"',
deparse(Synth:::gaps.plot)))))
How might one add labels to an archmap from the archetypes package? Or alternatively, would it be possible to recreate the archmap output in ggplot?
Using code from the SportsAnalytics demo (I hope this isn't bad form)
library("SportsAnalytics")
library("archetypes")
data("NBAPlayerStatistics0910")
dat <- subset(NBAPlayerStatistics0910,
select = c(Team, Name, Position,
TotalMinutesPlayed, FieldGoalsMade))
mat <- as.matrix(subset(dat, select = c(TotalMinutesPlayed, FieldGoalsMade)))
a3 <- archetypes(mat, 3)
archmap(a3)
I'd like the player names ( NBAPlayerStatistics0910$Name ) over the points on the chart. Something like below but more readable.
If you don't mind tweaking things a bit, you can start with the archmap() function base, toss in an extra parameter and add a text() call:
amap2 <- function (object, a.names, projection = simplex_projection, projection_args = list(),
rotate = 0, cex = 1.5, col = 1, pch = 1, xlab = "", ylab = "",
axes = FALSE, asp = TRUE, ...)
{
stopifnot("archetypes" %in% class(object))
stopifnot(is.function(projection))
k <- object$k
if (k < 3) {
stop("Need at least 3 archetypes.\n")
}
cmds <- do.call(projection, c(list(parameters(object)), projection_args))
if (rotate != 0) {
a <- pi * rotate/180
A <- matrix(c(cos(a), -sin(a), sin(a), cos(a)), ncol = 2)
cmds <- cmds %*% A
}
hmds <- chull(cmds)
active <- 1:k %in% hmds
plot(cmds, type = "n", xlab = xlab, ylab = ylab, axes = axes,
asp = asp, ...)
points(coef(object) %*% cmds, col = col, pch = pch)
######################
# PLAY WITH THIS BIT #
######################
text(coef(object) %*% cmds, a.names, pos=4)
######################
rad <- ceiling(log10(k)) + 1.5
polygon(cmds[hmds, ])
points(cmds[active, ], pch = 21, cex = rad * cex, bg = "grey")
text(cmds[active, ], labels = (1:k)[active], cex = cex)
if (any(!active)) {
points(cmds[!active, , drop = FALSE], pch = 21, cex = rad *
cex, bg = "white", fg = "grey")
text(cmds[!active, , drop = FALSE], labels = (1:k)[!active],
cex = cex, col = "grey20")
}
invisible(cmds)
}
amap2(a3, dat$Name)
Obviously, my completely quick stab is not the end result you're looking for, but it should help you get on your way (if I read what you want to do correctly).
As the above screenshot showed, I used the function heatmap.2() here.
how can I change 'Value' in the color coded bar to any other name?
One can just use the data from gplots package:
library(gplots)
data(mtcars)
x <- as.matrix(mtcars)
rc <- rainbow(nrow(x), start=0, end=.3)
cc <- rainbow(ncol(x), start=0, end=.3)
heatmap.2(x, key=TRUE)
Many thanks :-)
The function heatmap.2 may have changed since #BondedDust answered, but its now possible to easily change the heatmap.2 key labels via:
key.xlab="New value"
First, your code from above (using the standard colors):
library(gplots)
data(mtcars)
x <- as.matrix(mtcars)
heatmap.2(x,key=TRUE)
Now replace the x and y labels:
library(gplots)
data(mtcars)
x <- as.matrix(mtcars)
heatmap.2(x, key=TRUE , key.xlab="New value", key.ylab="New count")
It's hard-coded. You will need to change it in the code. It appears about midway down the section that draws the key and the line is:
else mtext(side = 1, "Value", line = 2)
This is the section of the heatmap.2 code that creates the key (at least up to the point where the word "Value" appears) :
if (key) {
par(mar = c(5, 4, 2, 1), cex = 0.75)
tmpbreaks <- breaks
if (symkey) {
max.raw <- max(abs(c(x, breaks)), na.rm = TRUE)
min.raw <- -max.raw
tmpbreaks[1] <- -max(abs(x), na.rm = TRUE)
tmpbreaks[length(tmpbreaks)] <- max(abs(x), na.rm = TRUE)
}
else {
min.raw <- min(x, na.rm = TRUE)
max.raw <- max(x, na.rm = TRUE)
}
z <- seq(min.raw, max.raw, length = length(col))
image(z = matrix(z, ncol = 1), col = col, breaks = tmpbreaks,
xaxt = "n", yaxt = "n")
par(usr = c(0, 1, 0, 1))
lv <- pretty(breaks)
xv <- scale01(as.numeric(lv), min.raw, max.raw)
axis(1, at = xv, labels = lv)
if (scale == "row")
mtext(side = 1, "Row Z-Score", line = 2)
else if (scale == "column")
mtext(side = 1, "Column Z-Score", line = 2)
else mtext(side = 1, "Value", line = 2)
.... lots more code below
You should type heatmap.2 , then copy the source code to an editor and then use the search function to find "Value". Change "Value" to something else (in quotes) and then type heatmap.2 <- and paste in the code and hit return. (Unless you save this it will only persist as long as the session continues.)
Just come across same task recently. Now there is an option "key.title" to set the title for scale inlet:
library(gplots)
data(mtcars)
x <- as.matrix(mtcars)
heatmap.2(x, key.title = "New Title", key.xlab="New value", key.ylab="New count")
Unfortunately, it do not propagate properly if there is no histogram in inlet:
library(gplots)
data(mtcars)
x <- as.matrix(mtcars)
heatmap.2(x, key.title = "New Title", key.xlab="New value", key.ylab="New count")
Well, key.xlab working as expected and can be used instead.
I've checked the source code on github and it is already fixed there.