This question already has answers here:
Shading a kernel density plot between two points.
(5 answers)
Closed 7 years ago.
I've written code to plot density data for variations of an A/B test. I'd like to improve the visual by shading (with the fill being slightly transparent) the area below each curve. I'm currently using matplot, but understand ggplot might be a better option.
Any ideas? Thanks.
# Setup data frame - these are results from an A/B experiment
conv_data = data.frame(
VarNames = c("Variation 1", "Variation 2", "Variation 3") # Set variation names
,NumSuccess = c(1,90,899) # Set number of successes / conversions
,NumTrials = c(10,100,1070) # Set number of trials
)
conv_data$NumFailures = conv_data$NumTrials - conv_data$NumSuccess # Set number of failures [no conversions]
num_var = NROW(conv_data) # Set total number of variations
plot_col = rainbow(num_var) # Set plot colors
get_density_data <- function(n_var, s, f) {
x = seq(0,1,length.out=100) # 0.01,0.02,0.03...1
dens_data = matrix(data = NA, nrow=length(x), ncol=(n_var+1))
dens_data[,1] = x
# set density data
for(j in 1:n_var) {
# +1 to s[], f[] to ensure uniform prior
dens_data[,j+1] = dbeta(x, s[j]+1, f[j]+1)
}
return(dens_data)
}
density_data = get_density_data(num_var, conv_data$NumSuccess, conv_data$NumFailures)
matplot(density_data[,1]*100, density_data[,-1], type = "l", lty = 1, col = plot_col, ylab = "Probability Density", xlab = "Conversion Rate %", yaxt = "n")
legend("topleft", col=plot_col, legend = conv_data$VarNames, lwd = 1)
This produces the following plot:
# Setup data frame - these are results from an A/B experiment
conv_data = data.frame(
VarNames = c("Variation 1", "Variation 2", "Variation 3") # Set variation names
,NumSuccess = c(1,90,899) # Set number of successes / conversions
,NumTrials = c(10,100,1070) # Set number of trials
)
conv_data$NumFailures = conv_data$NumTrials - conv_data$NumSuccess # Set number of failures [no conversions]
num_var = NROW(conv_data) # Set total number of variations
plot_col = rainbow(num_var) # Set plot colors
get_density_data <- function(n_var, s, f) {
x = seq(0,1,length.out=100) # 0.01,0.02,0.03...1
dens_data = matrix(data = NA, nrow=length(x), ncol=(n_var+1))
dens_data[,1] = x
# set density data
for(j in 1:n_var) {
# +1 to s[], f[] to ensure uniform prior
dens_data[,j+1] = dbeta(x, s[j]+1, f[j]+1)
}
return(dens_data)
}
density_data = get_density_data(num_var, conv_data$NumSuccess, conv_data$NumFailures)
matplot(density_data[,1]*100, density_data[,-1], type = "l",
lty = 1, col = plot_col, ylab = "Probability Density",
xlab = "Conversion Rate %", yaxt = "n")
legend("topleft", col=plot_col, legend = conv_data$VarNames, lwd = 1)
## and add this part
for (ii in seq_along(plot_col))
polygon(c(density_data[, 1] * 100, rev(density_data[, 1] * 100)),
c(density_data[, ii + 1], rep(0, nrow(density_data))),
col = adjustcolor(plot_col[ii], alpha.f = .25))
Was able to answer own question with:
df = as.data.frame(t(conversion_data))
dfs = stack(df)
ggplot(dfs, aes(x=values)) + geom_density(aes(group=ind, colour=ind, fill=ind), alpha=0.3)
Related
I am generating a landscape pattern that evolves over time. The problem with the code is that I have clearly defined a window for the object bringing up the error but the window is not being recognised. I also do not see how any points are falling outside of the window, or how that would make a difference.
library(spatstat)
library(dplyr)
# Define the window
win <- owin(c(0, 100), c(0, 100))
# Define the point cluster
cluster1 <- rMatClust(kappa = 0.0005, scale = 0.1, mu = 20,
win = win, center = c(5,5))
# define the spread of the points
spread_rate <- 1
new_nests_per_year<-5
years<-10
# Plot the initial cluster
plot(win, main = "Initial cluster")
points(cluster1, pch = 20, col = "red")
newpoints<-list()
# Loop for n years
for (i in 1:years) {
# Generate new points that spread from the cluster
newpoints[[1]] <-rnorm(new_nests_per_year, mean = centroid.owin(cluster1)$y, sd = spread_rate)
newpoints[[2]] <-rnorm(new_nests_per_year, mean = centroid.owin(cluster1)$x, sd = spread_rate)
# Convert the list to a data frame
newpoints_df <- data.frame(newpoints)
# Rename the columns of the data frame
colnames(newpoints_df) <- c("x", "y")
# Combine the new points with the existing points
cluster1_df <- data.frame(cluster1)
newtotaldf<-bind_rows(cluster1_df,newpoints_df)
cluster1<-as.ppp(newtotaldf, x = newtotaldf$x, y = newtotaldf$y,
window = win)
# Plot the updated cluster
plot(win, main = paste("Cluster after year", i))
points(cluster1, pch = 20, col = "red")
}
However, when I run line:
cluster1<-as.ppp(newtotaldf, x = newtotaldf$x, y = newtotaldf$y,
window = win)
I recieve the error:
Error: x,y coords given but no window specified
Why would this be the case?
In your code, if you use the command W = win it should solve the issue. I also believe you can simplify the command without specifying x and y:
## ...[previous code]...
cluster1 <- as.ppp(newtotaldf, W = win)
plot(win)
points(cluster1, pch = 20, col = "red")
To expand upon visualize a list of colors/palette in R I am trying to display a series of custom colour palettes in R in a single figure. Is there a way that I can expand on one of the methods listed in the link to display the list of palettes below:
convert_coolers <- function(coolers_string){
strsplit(coolers_string, split = ", ")[[1]]
}
# diverging
storm_panels <- convert_coolers("#001219, #005f73, #0a9396, #94d2bd, #e9d8a6, #ee9b00, #ca6702, #bb3e03, #ae2012, #9b2226")
harry_tipper <- convert_coolers("#f72585, #b5179e, #7209b7, #560bad, #480ca8, #3a0ca3, #3f37c9, #4361ee, #4895ef, #4cc9f0")
firepit <- convert_coolers("#03071e, #370617, #6a040f, #9d0208, #d00000, #dc2f02, #e85d04, #f48c06, #faa307, #ffba08")
# sequences
the_deep <- convert_coolers("#03045e, #023e8a, #0077b6, #0096c7, #00b4d8, #48cae4, #90e0ef, #ade8f4, #caf0f8")
earth <- convert_coolers("#ede0d4, #e6ccb2, #ddb892, #b08968, #7f5539, #9c6644")
# categorical
pastal_rainbow <- convert_coolers("#ff595e, #ffca3a, #8ac926, #1982c4, #6a4c93")
fisherman <- convert_coolers("#353535, #3c6e71, #ffffff, #d9d9d9, #284b63")
in a figure resembling that displayed by RColorBrewer::display.brewer.all()? i.e. with palettes stacked as horizontal bars labelled to the left with the palette title.
I have been trying to dissect the method out from the RColorBrewer function but am finding that it depends too much on internal variables for me to understand what is going on.
I achieved what I set out to do by modifying RColorBrewer::display.brewer.all
Following directly on from the code in the question:
display_custom_palettes <- function(palette_list, palette_names){
nr <- length(palette_list)
nc <- max(lengths(palette_list))
ylim <- c(0, nr)
oldpar <- par(mgp = c(2, 0.25, 0))
on.exit(par(oldpar))
plot(1, 1, xlim = c(0, nc), ylim = ylim, type = "n", axes = FALSE,
bty = "n", xlab = "", ylab = "")
for (i in 1:nr) {
nj <- length(palette_list[[i]])
shadi <- palette_list[[i]]
rect(xleft = 0:(nj - 1), ybottom = i - 1, xright = 1:nj,
ytop = i - 0.2, col = shadi, border = "light grey")
}
text(rep(-0.1, nr), (1:nr) - 0.6, labels = palette_names, xpd = TRUE,
adj = 1)
}
plot.new()
palette_list <- list(storm_panels, harry_tipper, firepit, the_deep, earth, pastal_rainbow, fisherman)
palette_names <- c("storm panels", "harry tipper", "firepit", "the deep", "earth", "rainbow", "fisherman")
display_custom_palettes(palette_list, palette_names)
I first started with developing a SMA moving average but I wanted to adapt the function to initiate a stock name from the user
here is my code below
library(quantmod)
library(TTR)
library(PerformanceAnalytics)
stock = readline("Enter the stock name:")
stock
getSymbols(stock, src = 'yahoo', from = '2021-01-01')
barChart(as.name(stock), theme = chartTheme('black'))
# Creating Leading and Lagging Technical Indicators
# a. Simple Moving Average (SMA)
# 1. stock
sma10_stock <- SMA(as.name(stock)$as.name(stock.Close), n = 10)
sma15_stock <- SMA(as.name(stock)$as.name(stock.Close), n = 15)
lineChart(as.name(stock), theme = chartTheme('black'))
addSMA(n = 10, col = 'blue')
addSMA(n = 15, col = 'orange')
legend('left', col = c('green','blue','orange'),
legend = c('stock','SMA10','SMA15'), lty = 1, bty = 'n',
text.col = 'white', cex = 0.8)
# Creating Trading signal with Indicators
# SMA
# a. stock
# SMA 10 Crossover Signal
sma10_stock_ts <- Lag(
ifelse(Lag(Cl(as.name(stock))) < Lag(as.name(stock)) & Cl(as.name(stock)) > sma10_stock,1,
ifelse(Lag(Cl(AMC)) > Lag(sma10_stock) & Cl(AMC) < sma10_stock,-1,0)))
sma10_stock_ts[is.na(sma10_stock_ts)] <- 0
As #MrFlick mentioned you can pass character value of stock in getSymbols with auto.assign = FALSE. To use SMA function you'll not be able to use $stock.Close, you can replace it with column number instead.
library(quantmod)
library(TTR)
library(PerformanceAnalytics)
stock = readline("Enter the stock name:")
data <- getSymbols(stock,src = 'yahoo', from = '2021-01-01', auto.assign = FALSE)
barChart(data, theme = chartTheme('black'))
# Creating Leading and Lagging Technical Indicators
# a. Simple Moving Average (SMA)
# 1. stock
sma10_stock <- SMA(data[, 4], n = 10)
sma15_stock <- SMA(data[, 4], n = 15)
lineChart(data, theme = chartTheme('black'))
addSMA(n = 10, col = 'blue')
addSMA(n = 15, col = 'orange')
legend('left', col = c('green','blue','orange'),
legend = c('stock','SMA10','SMA15'), lty = 1, bty = 'n',
text.col = 'white', cex = 0.8)
I would like to plot several forecasts on the same plot in different colours, however, the scale is off.
I'm open to any other methods.
reproducible example:
require(forecast)
# MAKING DATA
data <- c(3.86000, 19.55810, 19.51091, 20.74048, 20.71333, 29.04191, 30.28864, 25.64300, 23.33368, 23.70870 , 26.16600 ,27.61286 , 27.88409 , 28.41400 , 24.81957 , 24.60952, 27.49857, 32.08000 , 29.98000, 27.49000 , 237.26150, 266.35478, 338.30000, 377.69476, 528.65905, 780.00000 )
a.ts <- ts(data,start=c(2005,1),frequency=12)
# FORECASTS
arima011_css =stats::arima(x = a.ts, order = c(0, 1, 1), method = "CSS") # css estimate
arima011_forecast = forecast(arima011_css, h=10, level=c(99.5))
arima321_css =stats::arima(x = a.ts, order = c(3, 2, 1), method = "CSS") # css estimate
arima321_forecast = forecast(arima321_css, h=10, level=c(99.5))
# MY ATTEMPT AT PLOTS
plot(arima321_forecast)
par(new=T)
plot(arima011_forecast)
Here is something similar to #jay.sf but using ggplot2.
library(ggplot2)
autoplot(a.ts) +
autolayer(arima011_forecast, series = "ARIMA(0,1,1)", alpha = 0.5) +
autolayer(arima321_forecast, series = "ARIMA(3,2,1)", alpha = 0.5) +
guides(colour = guide_legend("Model"))
Created on 2020-05-19 by the reprex package (v0.3.0)
You could do a manual plot using a sequence of dates.
rn <- format(seq.Date(as.Date("2005-01-01"), by="months", length.out=12*3), "%Y.%m")
Your ARIMAs you'll need as.matrix form.
arima321_mat <- as.matrix(as.data.frame(arima321_forecast))
arima011_mat <- as.matrix(as.data.frame(arima011_forecast))
Some colors with different alpha=.
col.1 <- rainbow(2, ,.7)
col.2 <- rainbow(2, ,.7, alpha=.2)
For the CIs use polygon.
plot(data, type="l", xlim=c(1, length(rn)), ylim=c(0, 3500), xaxt="n", main="Forecasts")
axis(1, axTicks(1), labels=F)
mtext(rn[(seq(rn)-1) %% 5 == 0], 1, 1, at=axTicks(1))
lines((length(data)+1):length(rn), arima321_mat[,1], col=col.1[1], lwd=2)
polygon(c(27:36, 36:27), c(arima321_mat[,2], rev(arima321_mat[,3])), col=col.2[1],
border=NA)
lines((length(data)+1):length(rn), arima011_mat[,1], col=col.1[2], lwd=3)
polygon(c(27:36, 36:27), c(arima011_mat[,2], rev(arima011_mat[,3])), col=col.2[2],
border=NA)
legend("topleft", legend=c("ARIMA(3,2,1)", "ARIMA(0,1,1)"), col=col.1, lwd=2, cex=.9)
Edit: To avoid the repetition of lines and polygon calls, you may unite them using Map.
mats <- list(arima321_mat, arima011_mat) ## put matrices into list
plot(.)
axis(.)
mtext(.)
Map(function(i) {
lines((length(data)+1):length(rn), mats[[i]][,1], col=col.1[i], lwd=2)
polygon(c(27:36, 36:27), c(mats[[i]][,2], rev(mats[[i]][,3])), col=col.2[i], border=NA)
}, 1:2)
legend(.)
require(forecast)
data <- c(3.86000, 19.55810, 19.51091, 20.74048, 20.71333, 29.04191, 30.28864, 25.64300, 23.33368, 23.70870 , 26.16600 ,27.61286 , 27.88409 , 28.41400 , 24.81957 , 24.60952, 27.49857, 32.08000 , 29.98000, 27.49000 , 237.26150, 266.35478, 338.30000, 377.69476, 528.65905, 780.00000 )
a.ts <- ts(data,start=c(2005,1),frequency=12)
arima011_css =stats::arima(x = a.ts, order = c(0, 1, 1), method = "CSS") # css estimate
arima011_forecast = predict(arima011_css, n.ahead = 2)$pred
arima321_css =stats::arima(x = a.ts, order = c(3, 2, 1), method = "CSS") # css estimate
arima321_forecast = predict(arima321_css, n.ahead = 2)$pred
plot(a.ts, type = "o", xlim = c(2005, 2007.5) , ylim = c(-1, 1200) , ylab = "price" ,main = "2 month Forecast")
range = c(2007+(3/12), 2007+(4/12)) # adding the dates for the prediction
lines(y = arima011_forecast , x = range , type = "o", col = "red")
lines(y = arima321_forecast, x = range , type = "o", col = "blue")
Complete beginner at R here trying to perform nonmetric multidimensional scaling on a 95x95 matrix of similarities where 8 corresponds to very similar and 1 corresponds to very dissimilar. I also have an additional column (96th) signifying type and ranging from 0 to 1.
First I load the data:
dsimilarity <- read.table("d95x95matrix.txt",
header = T,
row.names = c("Y1", "Y2", "Y3", "Y4", "Y5", "Y6", "Y7", "Y8", "Y9", "Y10", "Y11", "Y12", "Y13", "Y14", "Y15", "Y16", "Y17", "Y18", "Y19", "Y20",
"Y21", "Y22", "Y23", "Y24", "Y25", "Y26", "Y27", "Y28", "Y29", "Y30", "Y31", "Y32", "Y33", "Y34", "Y35", "Y36", "Y37", "Y38", "Y39", "Y40",
"Y41", "Y42", "Y43", "Y44", "Y45", "Y46", "Y47", "Y48", "Y49", "Y50", "Y51", "Y52", "Y53", "Y54", "Y55", "Y56", "Y57", "Y58", "Y59", "Y60",
"Y61", "Y62", "Y63", "Y64", "Y65", "Y66", "Y67", "Y68", "Y69", "Y70", "Y71", "Y72", "Y73", "Y74", "Y75", "Y76", "Y77", "Y78", "Y79", "Y80",
"Y81", "Y82", "Y83", "Y84", "Y85", "Y86", "Y87", "Y88", "Y89", "Y90", "Y91", "Y92", "Y93", "Y94", "Y95"))
I convert the matrix of similarities into a matrix of dissimilarities, and exclude the 96th column:
ddissimilarity <- dsimilarity; ddissimilarity[1:95, 1:95] = 8 - ddissimilarity[1:95, 1:95]
Then I perform the nonmetric MDS using the Smacof function:
ordinal.mds.results <- smacofSym(ddissimilarity[1:95, 1:95],
type = c("ordinal"),
ndim = 2,
ties = "primary",
verbose = T )
I create a new data frame (I'm following a guide and don't really know what's going on here):
mds.config <- as.data.frame(ordinal.mds.results$conf)
All well and good thus far (to my knowledge). However at this point I will try to create an xyplot of the data and get a good result using this code:
xyplot(D2 ~ D1, data = mds.config,
aspect = 1,
main = "Figure 1. MDS solution",
panel = function (x, y) {
panel.xyplot(x, y, col = "black")
panel.text(x, y-.03, labels = rownames(mds.config),
cex = .75)
},
xlab = "MDS Axis 1",
ylab = "MDS Axis 2",
xlim = c(-1.1, 1.1),
ylim = c(-1.1, 1.1))
Now I want to create a figure that incorporates the type in column 96th and assigns different colors to observations of the two different types. However, can't quite figure out how to do so. Does anyone have any ideas of where I'm going wrong here?
xyplot(D2 ~ D1, data = mds.config ~ ddissimilarity[96:96, 96:96],
aspect = 1,
main = "Figure 1. MDS solution",
panel = function (x, y) {
panel.xyplot(x, y, col = "black")
panel.text(x, y-.03, labels = rownames(mds.config),
cex = .75)
},
xlab = "MDS Axis 1",
ylab = "MDS Axis 2",
xlim = c(-1.1, 1.1),
ylim = c(-1.1, 1.1),
group = "Type")