Function plotting in r - r

x<-seq(-2*pi,2*pi) #range of x
f<-(2*(abs(sin(x)))+(1/2))
f1<-function(x)(2*(abs(sin(x)))+(1/2))
x1=seq(-2*pi,-pi)
g<-2*cos(x1)
gun<- function(y) 2*cos(x1)
curve(gun, from=-2*pi, to=-pi, type='l')
So, I want to plot these functions in the same graph but I get an error when I try to plot g:
Error in curve(gun, from = -2 * pi, to = -pi, type = "l") :
'expr' did not evaluate to an object of length 'n'
I am not sure how to fix this, I've seen people use Vectorize() but it doesn't seem to help.
Any advices?

You are calling data stored in your environment in your function. It should be referencing the data that is passed into it.
x<-seq(-2*pi,2*pi) #range of x
f<-(2*(abs(sin(x)))+(1/2))
f1<-function(x)(2*(abs(sin(x)))+(1/2))
g<-2*cos(x1)
gun<- function(y) 2*cos(y)
curve(gun, from=-2*pi, to=2*pi, type='l')
to add the second function to the plot you can run this
curve(f1, from = -2*pi, to = 2*pi, type = 'l', col = "red", add = TRUE)

Related

How to plot splom function?

i'm trying to recreate this graph
require(car)
scatterplotMatrix(~Week+Cases+Egg.Pr+Beef.Pr+Pork.Pr+Chicken.Pr+Cereal.Pr, reg.line = lm,
smooth = TRUE, spread = FALSE, span = 0.5, id.n = 0, diagonal = 'boxplot', data = Eggs)
using the lattice package,
i've been trying to make it work with this structure, but it just comes out wrong:
splom(Eggs, panel = function(Week, Cases, Egg.Pr, Beef.Pr, Pork.Pr, Chicken.Pr, Cereal.Pr) {
panel.xyplot(Week, Cases, Egg.Pr, Beef.Pr, Pork.Pr, Chicken.Pr, Cereal.Pr)
panel.lmline(Week, Cases, Egg.Pr, Beef.Pr, Pork.Pr, Chicken.Pr, Cereal.Pr)
panel.smooth(Week, Cases, Egg.Pr, Beef.Pr, Pork.Pr, Chicken.Pr, Cereal.Pr)
}, spread = FALSE, span = 0.5, id.n = 0, diagonal = 'boxplot',
data = Eggs)
please help me out, and overexplain as much as possible
With some guessing from context, and since you asked for overexplanation:
First, you need to refine your understanding of panel functions. They are supposed to be general purpose functions describing the plotting procedure, not specific to the data at hand. With that in mind, we can rewrite your first attempt as:
myPanel <- function(x, y, ...) {
panel.xyplot(x, y, ...)
panel.lmline(x, y, ...)
panel.loess(x, y, ...)
}
Note that panel.smooth will not work, for reasons that are too complicated to get into (but basically, it's not grid-based, as lattice requires).
With this, you should be able to do
Eggs <- Duncan[-1] # placeholder to make example reproducible
splom(Eggs, panel = myPanel)
This leaves the diagonal, for which you need another panel function. Here's one suggestion which can be fine-tuned as per your requirements:
myDiagonal <- function(x, ...) {
diag.panel.splom(x, ...) # retain default and build on it
ycenter <- quantile(x, 0.25, na.rm = TRUE)
panel.bwplot(x = x, y = rep(ycenter, length(x)),
box.width = 0.1 * diff(range(x, finite = TRUE))),
...)
}
Combining, you can now do
splom(Eggs, panel = myPanel, diag.panel = myDiagonal)
The sprinkling of ...-s are important, but I'm not going to go into why. For the rest, documentation of the corresponding functions should help you figure out how to fine tune.

Log chart in blotter function chart.Posn() possible?

Is it possible to draw a log price chart in the chart.Posn() or chart.Reconcile() functions of blotter? I tried adding log.scale = TRUE to the function call without success. Is the underlying chart_Series function still too "experimental" to support this functionality or is the function call not correct?
chart.Posn(Portfolio = portfolio.st, Symbol = "GSPC", log.scale = TRUE)
Update: I have been trying to use the chart_Series() function directly, setting the ylog graphical parameter:
par(ylog=TRUE)
chart_Series(Cl(GSPC))
But I receive an error "log scale needs positive bounds" despite the data being all positive.
Btw, GSPC is an OHLCV time-series xts of the S&P 500 that plots in chartSeries() and chart_Series(), but just not with log-scale for either charting functions.
I found this old post not as a solution but as an alternative:
Does chart_Series() work with logarithmic axis?
I don't think there is any parameter like log.scale that chart_Series recognises. You could simply do chart_Series(log(Cl(GSPC)). You could also do some basic modifications to chart.Posn to put things on the log scale. Use as a starting point the source code for chart.Posn.
Here is an example of a modified function you could make. You can obviously modify it further in any way you please.
# We need an example. So,
# Source this code from the directory containing quantstrat, or at least source the macd.R demo in quantstrat.
source("demo/macd.R")
log.chart.Posn <- function(Portfolio, Symbol, Dates = NULL, env = .GlobalEnv) {
pname<-Portfolio
Portfolio<-getPortfolio(pname)
x <- get(Symbol, env)
Prices <- log(x)
chart_Series(Prices)
#browser()
if(is.null(Dates)) Dates<-paste(first(index(Prices)),last(index(Prices)),sep='::')
#scope the data by Dates
Portfolio$symbols[[Symbol]]$txn<-Portfolio$symbols[[Symbol]]$txn[Dates]
Portfolio$symbols[[Symbol]]$posPL<-Portfolio$symbols[[Symbol]]$posPL[Dates]
Trades = Portfolio$symbols[[Symbol]]$txn$Txn.Qty
Buys = log(Portfolio$symbols[[Symbol]]$txn$Txn.Price[which(Trades>0)])
Sells = log(Portfolio$symbols[[Symbol]]$txn$Txn.Price[which(Trades<0)])
Position = Portfolio$symbols[[Symbol]]$txn$Pos.Qty
if(nrow(Position)<1) stop ('no transactions/positions to chart')
if(as.POSIXct(first(index(Prices)))<as.POSIXct(first(index(Position)))) Position<-rbind(xts(0,order.by=first(index(Prices)-1)),Position)
Positionfill = na.locf(merge(Position,index(Prices)))
CumPL = cumsum(Portfolio$symbols[[Symbol]]$posPL$Net.Trading.PL)
if(length(CumPL)>1)
CumPL = na.omit(na.locf(merge(CumPL,index(Prices))))
else
CumPL = NULL
if(!is.null(CumPL)) {
CumMax <- cummax(CumPL)
Drawdown <- -(CumMax - CumPL)
Drawdown<-rbind(xts(-max(CumPL),order.by=first(index(Drawdown)-1)),Drawdown)
} else {
Drawdown <- NULL
}
if(!is.null(nrow(Buys)) && nrow(Buys) >=1 ) (add_TA(Buys,pch=2,type='p',col='green', on=1));
if(!is.null(nrow(Sells)) && nrow(Sells) >= 1) (add_TA(Sells,pch=6,type='p',col='red', on=1));
if(nrow(Position)>=1) {
(add_TA(Positionfill,type='h',col='blue', lwd=2))
(add_TA(Position,type='p',col='orange', lwd=2, on=2))
}
if(!is.null(CumPL)) (add_TA(CumPL, col='darkgreen', lwd=2))
if(!is.null(Drawdown)) (add_TA(Drawdown, col='darkred', lwd=2, yaxis=c(0,-max(CumMax))))
plot(current.chob())
}
log.chart.Posn(Portfolio = portfolio.st, Sym = "AAPL", Dates = NULL, env = .GlobalEnv)
add_MACD() # Simply added to make the plot almost identical to what is in demo/macd.R
This is what the original chart looks like:
New plot, with log scales:

optimized VennDiagram with internal labels r

I am trying to plot a venn diagram in an optimized way (see below) and with the cases as internal labels (not the number of cases in each intersection). I know there are post for each of them but non of the solutions allowed me to do both.
I have this:
x <- list()
x$A <- as.character(c("Per_36","Cent","CeM","vDG","LAVL","RSGd"))
x$B <- as.character(c("vCA1","DLE","Per_36","vDG","DIE","Per_35"))
x$C <- as.character(c("vCA1","Cg1","LAVL", "RSGc", "RSGd","Per_35","Per_36"))
x$D <- as.character(c("Por","Cg1","RSGc","LAVL","Per_35","RSGd","Per_36"))
require(VennDiagram)
v0 <-venn.diagram(x, lwd = 3, col = c("red", "green", "orange", "blue"),
fill = c("red", "blue", "green", "orange"), apha = 0.5, filename = NULL)
grid.draw(v0)
overlaps <- calculate.overlap(x)
overlaps <- rev(overlaps)
for (i in 1:length(overlaps)){
v0[[i+8]]$label <- paste(overlaps[[i]], collapse = "\n")
}
grid.newpage()
grid.draw(v0)
I get the following output:
Regarding the organization of the venn diagramI want to do this:
c <- venn(x, simplify = TRUE, small = 0.5, intersections = TRUE)
which I got from package gplots() using the venn function with simplify = TRUE. However, in the venn function, I seem to no be able to replace the counts by the names of the labels. I used the intersections = TRUE, which by the description of the argument should work, but it doesn't (although if I look inside the variable c, the info is there).
Logical flag indicating if the returned object should have the attribute
"individuals.in.intersections" featuring for every set a list of individuals
that are assigned to it.
Question: Using VennDiagrampackage, is there a way to do exactly the same as the simplify argument does in the venn function from gplots package?
Question 2: Using the venn function from gplots package, is there a way to display the names of each element instead of the element counts? Like I did in the 'venn.diagram' function?
Thanks in advance,
Here is my approach which is by far no solution rather a hack.
# Print a venn and save it to an object
a <- venn(list(letters[1:5], letters[3:8]))
# save the intersections
b <- attr(a, "intersections")
# find the coordinates
s <- seq(0,500,100); abline(h=s); text(s, y=s, x=0)
s <- seq(0,500,50); abline(v=s); text(s, y=0, x=s)
# the hack, destroy the venn to avoid the plotting of the internal numbers
rownames(a) <- letters[1:nrow(a)]
a
plot.venn(a)
>Error in data[n, 1] : subscript out of bounds
# include the internal labels
text(200,300,paste(b$`01`,collapse = "\n"))
text(200,200,paste(b$`11`,collapse = "\n"))
text(200,100,paste(b$`10`,collapse = "\n"))
It's annoying with multiple venns. Otherwise you can save the venn as an .svg and edit it with inkscape or similar softwares or ask the developer by email.
Edit:
If your plots looking alwas the same you can check the source code for the venn function (In RStudio by hitting F2) and copy paste the positions for 4 and 5 circle venns and replace the labels function lab("1000", data) with your desired labels.
For 4 circles:
text(35, 250, lab("1000", data))
text(140, 315, lab("0100", data))
text(260, 315, lab("0010", data))
text(365, 250, lab("0001", data))
text(90, 280, lab("1100", data), cex = small)
text(95, 110, lab("1010", data))
text(200, 50, lab("1001", data), cex = small)
text(200, 290, lab("0110", data))
text(300, 110, lab("0101", data))
text(310, 280, lab("0011", data), cex = small)
text(130, 230, lab("1110", data))
text(245, 75, lab("1101", data), cex = small)
text(155, 75, lab("1011", data), cex = small)
text(270, 230, lab("0111", data))
text(200, 150, lab("1111", data))
Edit
Nowadays I would switch to a ggplot solution
ggVennDiagram::ggVennDiagram(x)

floating.pie error while using nodelables from ape package

I get an error while using the ARD model of the ace function in R. The error is
Error in floating.pie.asp(XX[i], YY[i], pie[i, ], radius = xrad[i], col = piecol) :
floating.pie: x values must be non-negative
library(ape)
library(phylobase)
tree <- read.nexus("data1.nexus")
plot(tree)
data <- read.csv("phagy_species.csv")
clade.full <- extract.clade(tree, node=91)
plot(clade.full)
clade.1 <- drop.tip(clade.full, "Bar_bre")
clade.2<- drop.tip(clade.1, "Par_pho")
clade.3<- drop.tip(clade.2, "Par_iph")
clade.4<- drop.tip(clade.3, "Eur_ser")
clade.5<- drop.tip(clade.4, "Opo_sym")
clade.6<- drop.tip(clade.5, "Mor_pel")
clade.7<- drop.tip(clade.6, "Aph_hyp")
clade.8<- drop.tip(clade.7, "Ere_oem")
clade.9<- drop.tip(clade.8, "Cal_bud")
clade.10<- drop.tip(clade.9, "Lim_red")
clade.11<- drop.tip(clade.10, "Act_str")
clade.12<- drop.tip(clade.11, "Hel_hec")
clade.13<- drop.tip(clade.12,"Col_dir")
clade.14<- drop.tip(clade.13, "Hyp_pau")
clade.15<- drop.tip(clade.14, "Nym_pol")
clade.16<- drop.tip(clade.15, "Mel_cin")
clade.17<- drop.tip(clade.16,"Apa_iri")
clade.18<- drop.tip(clade.17, "Bib_hyp")
clade.19<- drop.tip(clade.18, "Mar_ors")
clade.20<- drop.tip(clade.19, "Apo_cra")
clade.21<- drop.tip(clade.20, "Pse_par")
clade.22 <- drop.tip(clade.21, "Lep_sin")
clade.23<- drop.tip(clade.22, "Dis_spi")
plot(clade.23)
data2 <- as.numeric(data[,2])
model2 <- ace(data2, clade.23, type="discrete", method="ML", model="ARD")
summary(model2)
d <-logLik(model2)
deviance(model2)
AIC(model2)
plot(clade.23, type="phylogram", cex=0.8, font=3, label.offset = 0.004)
co <- c("red", "blue", "green", "black")
nodelabels(pie = model2$lik.anc, piecol = co, cex = 0.5)
And that is when I get the error. There is no error if I use the original tree without trimming. But, when i trim them to my requirements, it goes in the negative.
Here is the data
tree file
data file
The matrix you are using for the proportions of the pie has complex numbers in it. To see this, try:
class(model2$lik.anc[1,1])
The rows of that matrix define the proportions of the pies, and they need to sum to 1. Your code produces a plot with pies if I replace the pie matrix in the nodelabels function like this:
nodelabels(pie = matrix(0.25, 64, 4), piecol = co, cex = 0.5)
because now there is a legitimate matrix for the pie argument with rows that sum to 1.
As for why you have complex numbers in that matrix, I am not sure. It is probably related to all the warnings produced by the ace in your example. But that is a completely different issue.
I had the same problem with my data. I put my data into the matrix (like Slow Ioris suggested) and then unlisted the matrix.
x <- matrix(data=c(model2$lik.anc[,1],model2$lik.anc[,2],model2$lik.anc[,3],model2$lik.anc[,4]))
plotTree(tree,ftype="i",label.offset = 0.02)
nodelabels(pie = unlist(x))
For other people having the same problem also after purging imaginable parts of their data: The nodelabels function gives the same error when you provide a data.frame instead of a matrix to pie.

Calculate equation from .csv file input and plot result over barplot

I coulnd't found any post with a related subject. I actually don't know if its posible.
So I have my. csv file:
Periodo;Teorico;Real;F1;F2;F3
20140101;50;20;7;7;16
20140108;55;29;11;5;5
20140115;52;21,4;8,6;10;12
20140122;66;32;9;8;17
I asign it to a data.frame:
df<-read.csv2('d:\\xxx\\test2.csv', header = T, sep = ";")
Then I do barplot function:
bp <- barplot(t(df[,-c(1:2)]),col=c("blue", "red", "green", "yellow"),legend=colnames(df[,-c(1:2)]),args.legend = list(x="topleft"))
axis(side = 1, at = bp, labels = df$Periodo)
title(main = "Teorico = Real + F1+F2+F3", font.main = 4)
Now I must calculate the following function: (efficiency function)
((Teorico-Real)/Teorico)*100
And represent the result of the function of each row on the top of each Periodo (week).
If you could help me with the code for the function and "replotting" parts or give some guidelines or posts related to this I would be really gratefull.
Thanks
You can try:
lbls <- round(((df$Teorico - df$Real) / df$Teorico)* 100)
mtext(lbls, at=bp)
(I just used round to make it look better.)

Resources