A client wants me to make a plot like this. This reference uses the rgl-package, but the quality of the exported figures is too low. Thus, I started in plotly. I can manage most of the things I want to do, but for some reason, all the bars are in different colors.
A MWE:
X<-1:60
Y<-sort(runif(60,-3,3))
Z<-runif(60,0,50)
p<-plot_ly(x = c(X[1],X[1]+1,X[1]+1,X[1]),
y = c(0,0,Y[1],Y[1]), z=c(0,0,0,0),type = "mesh3d",color=I("red"))
for(i in X){p<-add_trace(p,x = c(i,i+1,i+1,i),
y = c(0,0,Y[i],Y[i]), z=c(0,0,0,0),type = "mesh3d",color=I("red"))}
for(i in X){p<-add_trace(p,x = c(i,i+1,i+1,i),
y = c(0,0,0,0), z=c(0,0,Z[i],Z[i]),type = "mesh3d",i=c(0,0),
j=c(1,2),k=c(2,3),color=I("black"))}
p
While I would expect something in red and black, I get this multicolored result:
What I'm actually looking for is something like the following, with a color for each factor level, but for now, the result is identical to the one above:
X<-1:60
Y<-sort(runif(60,-3,3))
Z<-runif(60,0,50)
ColFactor<-sample(c(0,1),60,replace = TRUE)
p<-plot_ly(x = c(X[1],X[1]+1,X[1]+1,X[1]), y = c(0,0,Y[1],Y[1]), z=c(0,0,0,0),
type = "mesh3d",color=ColFactor,colors=c("red","blue"))
for(i in X){p<-add_trace(p,x = c(i,i+1,i+1,i), y = c(0,0,Y[i],Y[i]), z=c(0,0,0,0),
type = "mesh3d",color=ColFactor,colors=c("red","blue"))}
for(i in X){p<-add_trace(p,x = c(i,i+1,i+1,i), y = c(0,0,0,0), z=c(0,0,Z[i],Z[i]),
type = "mesh3d",i=c(0,0),j=c(1,2),k=c(2,3),color=I("black"))}
p
It seems there is some kind of issue when using plot_ly the way you intend to do.
However, there is a workaround (https://github.com/ropensci/plotly/issues/413).
To make things work you have to overriden the default values provided by plot_ly by mean of the plotly_build function.
The following code should work to obtain a plot where horizontal and vertical bars have different color:
X<-1:60
Y<-sort(runif(60,-3,3))
Z<-runif(60,0,50)
ColFactor<-sample(c(0,1),60,replace = TRUE)
p<-plot_ly(color=I("black")) #This plot a layout where to add the traces and adds
#the attribute color needed when overriding default. If it isn't included it doesn't work
#Which color you use here is unimportant, it will be override
#next lines add the bars, if you plot the result will be the same that you already know
for(i in X){p<-add_trace(p,x = c(i,i+1,i+1,i),
y = c(0,0,Y[i],Y[i]), z=c(0,0,0,0),type = "mesh3d")}
for(i in X){p<-add_trace(p,x = c(i,i+1,i+1,i),
y = c(0,0,0,0), z=c(0,0,Z[i],Z[i]),type = "mesh3d",i=c(0,0),
j=c(1,2),k=c(2,3))}
#next step: override the defaults options using plotly_build()
p.optionslist<-plotly_build(p)
#you have to change every trace individually that's what the for loop is
#horizontal bars
for(j in 1:((length(p.optionslist$x$data))/2)){
p.optionslist$x$data[[j]]$color=toRGB("red")
}
#horizontal vertical bars
for(j in (((length(p.optionslist$x$data)/2)+1):length(p.optionslist$x$data))){
p.optionslist$x$data[[j]]$color=toRGB("blue")
}
#The plot
p.optionslist
Regarding the use of a ColFactor the following code works (surely there is a better way but I don't know which one)
#overriding color option according to the value of ColFactor
p.optionslist2<-plotly_build(p)
for(j in 1:((length(p.optionslist2$x$data))/2)){
if(ColFactor[j]==1){
p.optionslist2$x$data[[j]]$color=toRGB("red")
}else{
p.optionslist2$x$data[[j]]$color=toRGB("blue")
}
}
for(j in (((length(p.optionslist2$x$data))/2)+1):length(p.optionslist2$x$data)){
i=j-length(ColFactor)
if(ColFactor[i]==1){
p.optionslist2$x$data[[j]]$color=toRGB("red")
}else{
p.optionslist2$x$data[[j]]$color=toRGB("blue")
}
}
#The plot with color by
p.optionslist2
If you want the vertical bars all in black and the horizontal bars by factor then you only have to combine both options:
p.optionslist3<-plotly_build(p)
for(j in 1:((length(p.optionslist3$x$data))/2)){
if(ColFactor[j]==1){
p.optionslist3$x$data[[j]]$color=toRGB("red")
}else{
p.optionslist3$x$data[[j]]$color=toRGB("blue")
}
}
for(j in (((length(p.optionslist3$x$data))/2)+1):length(p.optionslist3$x$data)){
p.optionslist3$x$data[[j]]$color=toRGB("black")
}
#The plot with color by
p.optionslist3
Hope it helps you!
Related
I am trying to plot 16 boxplots, using a for loop. My problem is, that the 2nd title is plotted on the first plot, the 3rd title on the second plot and so forth.
Does anyone have a guess on, what I am doing wrong?
My code is the following:
boxplot(data$distance[data$countryname=="Sweden"]~data$alliance[data$countryname=="Sweden"],title(main = "Sweden"))
boxplot(data$distance[data$countryname=="Norway"]~data$alliance[data$countryname=="Norway"],title(main = "Norway"))
boxplot(data$distance[data$countryname=="Denmark"]~data$alliance[data$countryname=="Denmark"],title(main = "Denmark"))
boxplot(data$distance[data$countryname=="Finland"]~data$alliance[data$countryname=="Finland"],title(main = "Finland"))
boxplot(data$distance[data$countryname=="Iceland"]~data$alliance[data$countryname=="Iceland"],title(main = "Iceland"))
boxplot(data$distance[data$countryname=="Belgium"]~data$alliance[data$countryname=="Belgium"],title(main = "Belgium"))
boxplot(data$distance[data$countryname=="Netherlands"]~data$alliance[data$countryname=="Netherlands"],title(main = "Netherlands"))
boxplot(data$distance[data$countryname=="Luxembourg"]~data$alliance[data$countryname=="Luxembourg"],title(main = "Luxembourg"))
boxplot(data$distance[data$countryname=="France"]~data$alliance[data$countryname=="France"],title(main = "France"))
boxplot(data$distance[data$countryname=="Italy"]~data$alliance[data$countryname=="Italy"],title(main = "Italy"))
boxplot(data$distance[data$countryname=="Spain"]~data$alliance[data$countryname=="Spain"],title(main = "Spain"))
boxplot(data$distance[data$countryname=="Portugal"]~data$alliance[data$countryname=="Portugal"],title(main = "Portugal"))
boxplot(data$distance[data$countryname=="Germany"]~data$alliance[data$countryname=="Germany"],title(main = "Germany"))
boxplot(data$distance[data$countryname=="Austria"]~data$alliance[data$countryname=="Austria"],title(main = "Austria"))
boxplot(data$distance[data$countryname=="Ireland"]~data$alliance[data$countryname=="Ireland"],title(main = "Ireland"))
boxplot(data$distance[data$countryname=="UK"]~data$alliance[data$countryname=="UK"],title(main = "UK"))
I think this could replace all your lines and fix your problem:
for (i in data$countryname)
boxplot(distance~alliance, subset(data, countryname==i), main=i)
But that's hard to verify without a reproducible example or some of your data.frame.
Based on the documentation, you should be assigning a title to your boxplots by making explicit calls to the function title(), rather than as a parameter in the call to boxplot(). The first two calls to generate your boxplots should look something like the following:
boxplot(data$distance[data$countryname=="Sweden"]~data$alliance[data$countryname=="Sweden"])
title(main = "Sweden")
boxplot(data$distance[data$countryname=="Norway"]~data$alliance[data$countryname=="Norway"])
title(main = "Norway")
I have the following piece of R code and I am trying to plot a series of curves. The curves are being plotted bu the values that are being plotted are incorrect. I have checked what values are calculated and they are not the same as the values that are being plotted.
Code (where data frames are being created):
maleHeightCentileDF <-data.frame(Age=numeric(),Values=numeric(),Centile=character())
femaleHeightCentileDF <- data.frame(Age=numeric(),Values=numeric(),Centile=character())
maleWeightCentileDF <- data.frame(Age=numeric(),Values=numeric(),Centile=character())
femaleWeightCentileDF <- data.frame(Age=numeric(),Values=numeric(),Centile=character())
for(i in 1:9)
{
maleHeightCentileDF<-
rbind(maleHeightCentileDF,data.frame(Age=maleLMSData$Months,Values=lmsFunctionToM(maleLMSData$L.ht,maleLMSData$M.ht,maleLMSData$S.ht,zValues[i]),Centile=pValues[i]))
femaleHeightCentileDF<-rbind(femaleHeightCentileDF,data.frame(Age=femaleLMSData$Months,Values= lmsFunctionToM(femaleLMSData$L.ht,femaleLMSData$M.ht,femaleLMSData$S.ht,zValues[i]),Centile=pValues[i]))
maleWeightCentileDF<-rbind(maleWeightCentileDF,data.frame(Age=maleLMSData$Months,Values= lmsFunctionToM(maleLMSData$L.wt,maleLMSData$M.wt,maleLMSData$S.wt,zValues[i]),Centile=pValues[i]))
femaleWeightCentileDF<-rbind(femaleWeightCentileDF,data.frame(Age=femaleLMSData$Months,Values= lmsFunctionToM(femaleLMSData$L.wt,femaleLMSData$M.wt,femaleLMSData$S.wt,zValues[i]),Centile=pValues[i]))
}
maleWeightCentileDF$Centile <- factor(maleWeightCentileDF$Centile, levels = rev(levels(maleWeightCentileDF$Centile)))
femaleWeightCentileDF$Centile <- factor(femaleWeightCentileDF$Centile, levels = rev(levels(femaleWeightCentileDF$Centile)))
maleHeightCentileDF$Centile <- factor(maleHeightCentileDF$Centile, levels = rev(levels(maleHeightCentileDF$Centile)))
femaleHeightCentileDF$Centile <- factor(femaleHeightCentileDF$Centile, levels = rev(levels(femaleHeightCentileDF$Centile)))
Code (where curves are plotted):
if(type=="wt")
{
if (gender=="Boys")
{
childDF <- data.frame(Age=maleChildrenData$Months[maleChildrenData$id==childID], Values=maleChildrenData$weight[maleChildrenData$id==childID])
plot<-ggplot(maleWeightCentileDF,aes(x=Age,y=Values, label = Centile))+geom_smooth(aes(colour=Centile),linetype='dotdash',se=FALSE)
plot<- plot+labs(x="Age (Months)",y="Weight (kg)") + scale_x_continuous(breaks=seq(0,60,5), limits = c(0,60))+scale_y_continuous(breaks = seq(0,30,1), limits = c(0,max(maleWeightCentileDF$Values)))
}
else
{
childDF <- data.frame(Age=femaleChildrenData$Months[femaleChildrenData$id==childID], Values=femaleChildrenData$weight[femaleChildrenData$id==childID])
plot<-ggplot(femaleWeightCentileDF,aes(x=Age,y=Values, label = Centile))+geom_smooth(aes(colour=Centile),linetype='dotdash',se=FALSE)
plot<- plot+labs(x="Age (Months)",y="Weight (kg)") + scale_x_continuous(breaks=seq(0,60,5), limits = c(0,60))+scale_y_continuous(breaks = seq(0,30,1), limits = c(0,max(femaleWeightCentileDF$Values)))
}
}
else
{
if (gender=="Boys")
{
childDF <- data.frame(Age=maleChildrenData$Months[maleChildrenData$id==childID], Values=maleChildrenData$height[maleChildrenData$id==childID])
plot<-ggplot(maleHeightCentileDF,aes(x=Age,y=Values, label = Centile))+geom_smooth(aes(colour=Centile),linetype='dotdash',se=FALSE)
plot<- plot+labs(x="Age (Months)",y="Height (cm)")+ scale_x_continuous(breaks=seq(0,60,5))+scale_y_continuous(breaks=seq(40,130,by=5), limits=c(40,max(maleHeightCentileDF$Values)))
}
else
{
childDF <- data.frame(Age=femaleChildrenData$Months[femaleChildrenData$id==childID], Values=femaleChildrenData$height[femaleChildrenData$id==childID])
plot<-ggplot(femaleHeightCentileDF,aes(x=Age,y=Values, label = Centile))+geom_smooth(aes(colour=Centile),linetype='dotdash',se=FALSE)
plot<- plot+labs(x="Age (Months)",y="Height (cm)")+ scale_x_continuous(breaks=seq(0,60,5))+scale_y_continuous(breaks=seq(40,130,by=5), limits=c(40,max(femaleHeightCentileDF$Values)))
}
}
Graph Outputted
Data that should be outputted
The first data point should be (0,4.81) but (0,6.02) (highlighted in graph) is plotted instead.
Any reasons why this could be happening??
After more research into the problem, I found that changing the function for plotting the curves from geom_smooth to geom_path fixed the problem. I am not sure why this fixed the problem but the issue has been fixed nonetheless.
I am trying to generate bar plots / columns using rCharts(v 0.4.2). My problem is that I have an year's worth of data and I need to group on Months. So in Total I have 12 bars that I need to display. However, I have only 9 unique colors after which the colors start repeating. I read this documentation and tried inserting
colors <- c('#7cb5ec','#434348', '#90ed7d', '#f7a35c','#8085e9','#f15c80', '#e4d354','#2b908f','#f45b5b','#91e8e1')
into my code and then calling it as follows :
c <- hPlot(x = 'Confi', y = 'n', data = tablefinalC, type = 'bar', group = 'Month',title = "Inccode By confi",
subtitle = "Bar Graph")
c$plotOptions(series = list(stacking = "normal",colors=paste0('colors'))
c$chart(backgroundColor = NULL)
c$set(dom = 'chart5')
However, I still get the same repetitive colors. So can someone please confirm how I can increase the amount of colors? Thanks in advance
You can create empty chart and then add series
Example
library(rCharts)
df=data.frame(x=1:10,y=-10:-1,z=letters[1:10],stringsAsFactors = F)
colors1=c( '#7cb5ec','#434348', '#90ed7d')
df$col=rep(colors1,round(nrow(df)/length(colors1),0)+1)[1:nrow(df)]
# Create new chart
a <- rCharts:::Highcharts$new()
# Set options
a$chart(type = "bar")
for(i in unique(df$z)){
a$series(name=i,stacking = "normal" ,color=df$col[df$z==i], data= rCharts::toJSONArray2(df[df$z==i,], json=F, names=T))
}
a#plot
Result
Update( re-read question)
if you want to add more colors custominze colors1 and df$col
df=data.frame(x=1:20,y=-20:-1,z=letters[1:20],stringsAsFactors = F)
colors1=c( '#0048BA','#B0BF1A','#7CB9E8','#C9FFE5','#B284BE',
'#5D8AA8','#00308F','#72A0C1','#AF002A','#F0F8FF',
'#84DE02','#E32636','#C46210','#EFDECD','#E52B50',
'#AB274F','#F19CBB','#AB274F','#D3212D','#3B7A57',
'#FFBF00','#FF7E00','#FF033E','#9966CC','#A4C639',
'#F2F3F4','#CD9575','#665D1E','#915C83','#841B2D'
)
df$col=colors1[1:nrow(df)]
Give you
According to the comments from others, this post has been separated into several
smaller questions from the previous version of this OP.
In the graph below, will you help me to (Newbie to R)
Custom legends according to the data they represent like filled for variable 1, circle points for variable 2 and line for variable 3 and their colors.
same letter size for the legend and axis-names.
The graph below is produced with the data in pdf device with following layout.
m <- matrix(c(1,2,3,3,4,5),nrow = 3,ncol = 2,byrow = TRUE)
layout(mat = m,heights = c(0.47,0.06,0.47))
par(mar=c(4,4.2,3,4.2))
#Codes for Fig A and B
...
#Margin for legend
par(mar = c(0.2,0.2,0.1,0.1))
# Code for legend
...
#Codes for Fig C and D
...
Using doubleYScale from latticeExtra and the data in the long format (see my previous answer), you can simplify the work:
No need to create a custom layout to superpose many plots
No need to create the legend manually
The idea is to create 2 separates objects and then merge them using doubleYScale. The latter will create the second axes. I hope I get your ploygon idea since it is not very clear why do you invert it in your OP.
library(latticeExtra)
obj1 <- xyplot(Variable~TimeVariable|Type,type='l',
groups=time, scales=list(x=list(relation='free'),
y=list(relation='free')),
auto.key=list(columns = 3,lines = TRUE,points=FALSE) ,
data = subset(dat.l,time !=1))
obj2 <- xyplot(Variable~TimeVariable|Type,
data = subset(dat.l,time ==1),type='l',
scales=list(x=list(alternating=2),
auto.key=list(columns = 3,lines = TRUE,points=FALSE),
y=list(relation='free')),
panel=function(x,y,...){
panel.xyplot(x,y,...)
panel.polygon(x,y,col='violetred4',border=NA,alpha=0.3)
})
doubleYScale(obj1, obj2, add.axis = TRUE,style1 = 0, style2 = 1)
Try the following:
1) For the legend part
The data can be found on https://www.dropbox.com/s/4kgq8tyvuvq22ym/stackfig1_2.csv
The code I used is as follows:
data <- read.csv("stackfig1_2.csv")
library(Hmisc)
label1=c(0,100,200,300)
plot(data$TimeVariable2C,data$Variable2C,axes=FALSE,ylab="",xlab="",xlim=c(0,24),
ylim=c(0,2.4),xaxs="i",yaxs="i",pch=19)
lines(data$TimeVariable3C,data$Variable3C)
axis(2,tick=T,at=seq(0.0,2.4,by=0.6),label= seq(0.0,2.4,by=0.6))
axis(1,tick=T,at=seq(0,24,by=6),label=seq(0,24,by=6))
mtext("(C)",side=1,outer=F,line=-10,adj=0.8)
minor.tick(nx=5,ny=5)
par(new=TRUE)
plot(data$TimeVariable1C,data$Variable1C,axes=FALSE,xlab="",ylab="",type="l",
ylim=c(800,0),xaxs="i",yaxs="i")
axis(3,xlim=c(0,24),tick=TRUE,at= seq(0,24,by=6),label=seq(0,24,by=6),col.axis="violetred4",col="violetred4")
axis(4,tick=TRUE,at= label1,label=label1,col.axis="violetred4",col="violetred4")
polygon(data$TimeVariable1C,data$Variable1C,col='violetred4',border=NA)
legend("top", legend = c("Variable A","Variable B","Variable C"), col = c("black","violetred4","black"),
ncol = 2, lwd =c("","",2),pch=c(19,15,NA),cex=1)
The output is as follows:
2) To make the font size same use the parameter cex and make it same everywhere.
require(quantmod)
require(PerformanceAnalytics)
getSymbols(c('SP500', 'WAAA', 'WBAA'), src = 'FRED', from = '1950-01-01')
X <- na.omit(merge(to.weekly(SP500), WAAA, WBAA))
dWAAA <- diff(WAAA / 100, 1)
dWBAA <- diff(WBAA / 100, 1)
D <- 20
dP.WAAA <- - D * dWAAA
dP.WBAA <- - D * dWBAA
charts.PerformanceSummary(p = .99, R = dP.WAAA['1990-01-01/2012-08-17'],
methods = 'ModifiedES', width = 48)
charts.PerformanceSummary(p = .99, R = dP.WBAA['1990-01-01/2012-08-17'],
methods = 'ModifiedES', width = 48)
May you tell me any way to set colors' smoothing-transitions-sequential palette in order to replace default black color with something which looks nicer?
I would like something which is blue-based and changes blue variety starting from the 1st plot ending to the 3rd one.
Thanks,
See ?chart.TimeSeries. I believe that the options you want are likely:
element.color # for the boxes, axes, etc
# and
colorset # for the actual chart lines
# try
colorset = 'darkblue'
# or
colorset = 'lightblue'
# as an extra argument to charts.PerformanceSummary
The colorsets provide different colors for the different chart elements, and work best when you plot more than one series on the same chart, to compare an asset to an index or a peer group, for example.
A vertical color ramp in R is not possible using base graphics, and conveys no information anyway.