How to fit logarithmic curve over the points in r? - r

I want to fit my points with logarithmic curve. Here is my data which contains x and y. I desire to plot x and y and the add a logarithmic fitting curve.
x<-structure(list(X2.y = c(39.99724745, 29.55541525, 23.39578201,
15.46797044, 10.52063652, 7.296161198, 6.232038434, 4.811851132,
4.641281547, 4.198523289, 3.325515839, 2.596563723, 1.894902523,
1.556380314), X5.y = c(62.76037622, 48.54726084, 37.71302646,
24.93942365, 17.71060023, 13.31130267, 10.36341862, 7.706914722,
7.170517624, 6.294292013, 4.917428837, 3.767836298, 2.891519878,
2.280974128), X10.y = c(77.83154815, 61.12151516, 47.19228808,
31.21034981, 22.47098182, 17.29384973, 13.09875178, 9.623698726,
8.845091983, 7.681873268, 5.971413758, 4.543320659, 3.551367285,
2.760718282), X25.y = c(96.87401383, 77.00911883, 59.16936025,
39.13368164, 28.48573658, 22.32580849, 16.55485248, 12.0455604,
10.96092113, 9.435085861, 7.303126501, 5.523147205, 4.385086234,
3.366876291), X50.y = c(111.0008027, 88.79545082, 68.05463659,
45.01166182, 32.94782526, 26.05880295, 19.11878542, 13.84223574,
12.53056405, 10.73571912, 8.291067088, 6.25003851, 5.003586577,
3.81655893), X100.y = c(125.0232816, 100.4947544, 76.87430545,
50.84623991, 37.37696657, 29.76423356, 21.66378667, 15.6256447,
14.08861698, 12.0267487, 9.271712877, 6.971562563, 5.61752001,
4.262921183)), class = "data.frame", row.names = c(NA, -14L))
I tried this:
single_idf<-function(x) {
idf<-x
durations = c(5/60, 10/60, 15/60, 30/60, 1, 2, 3, 4, 5, 6, 8, 12, 18, 24)
nd = length(durations)
Tp = c(2, 5, 10, 25, 50, 100)
nTp = length(Tp)
psym = seq(1, nTp)
# open new window for this graph, set plotting parameters for a single graph panel
windows()
par(mfrow = c(1,1), mar = c(5, 5, 5, 5), cex = 1)
# set up custom axis labels and grid line locations
ytick = c(1,2,3,4,5,6,7,8,9,10,20,30,40,50,60,70,80,90,100,
200,300,400,500,600,700,800,900,1000,1100,1200,1300,1400)
yticklab = as.character(ytick)
xgrid = c(5,6,7,8,9,10,15,20,30,40,50,60,120,180,240,300,360,
420,480,540,600,660,720,840,960,1080,1200,1320,1440)
xtick = c(5,10,15,20,30,60,120,180,240,300,360,480,720,1080,1440)
xticklab = c("5","10","15","20","30","60","2","3","4","5","6","8","12","18","24")
ymax1 = max(idf)
durations = durations*60
plot(durations, col=c("#FF00FF") ,lwd=c(1), idf[, 1],
xaxt="n",yaxt="n",
pch = psym[1], log = "xy",
xlim = c(4, 24*60), ylim = range(c(1,idf+150)),
xlab = "(min) Duration (hr)",
ylab = "Intensity (mm/hr)"
)
for (iT in 2:nTp) {
points(durations, idf[, iT], pch = psym[iT], col="#FF00FF",lwd=1)
}
for (iT in 1:nTp) {
mod.lm = lm(log10(idf[, iT]) ~ log10(durations))
b0 = mod.lm$coef[1]
b1 = mod.lm$coef[2]
yfit = log(10^(b0 + b1*log10(durations)))
lines(durations,col=c("#FF00FF"),yfit, lty = psym[iT],lwd=1)
}
}
But when I run this, the curves stands far away from the points. I want to see curves over the points. How can I arrange this?
single_idf(x)

Consider this as an option for you using ggplot2 and dplyr. Also added method='lm' to match OP expected output (Many thanks and credits to #AllanCameron for his magnificent advice):
library(ggplot2)
library(dplyr)
#Data
df <- data.frame(x,y)
#Plot
df %>%
pivot_longer(-y) %>%
ggplot(aes(x=log(y),y=log(value),color=name,group=name))+
geom_point()+
stat_smooth(geom = 'line',method = 'lm')
Output:

The main problem is that you were plotting the natural log of the fit rather than the fit itself.
If you change the line
yfit = log(10^(b0 + b1*log10(durations)))
To
yfit = 10^(b0 + b1*log10(durations))
And rerun your code, you get

Related

R: How to plot multiple ARIMA forecasts on the same time-series

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")

how to print some regression info on a figure

I have a data like this
df<- structure(list(How = c(3.1e-05, 0.000114, 0.000417, 0.00153,
0.00561, 0.0206, 0.0754, 0.277, 1.01, 3.72), Where = c(1, 0.948118156866697,
0.920303987764611, 1.03610743904536, 1.08332987533419, 0.960086785898477,
0.765642506120658, 0.572520170014998, 0.375835106792894, 0.254180720963181
)), class = "data.frame", row.names = c(NA, -10L))
library(drc)
I make my model like this
fit <- drm(formula = Where ~ How, data = df,
fct = LL.4(names=c("Slope","Lower Limit","Upper Limit", "EC50")))
Then I plot it like this
plot(NULL, xlim = c(0.000001, 4), ylim = c(0.01, 1.2),log = "x")
points(df$How, df$Where, pch = 20)
x1 = seq(0.000001, 4, by=0.0001)
y1 = coef(fit)[3] + (coef(fit)[2] - coef(fit)[3])/(1+(x1/coef(fit)[4])^((-1)*coef(fit)[1]))
lines(x1,y1)
Now I want to be able to print the following information inside the figure
max(df$How)
min(df$How)
coef(fit)[2]
coef(fit)[3]
(-1)*coef(fit)[1]
coef(fit)[4]
I tried to do it like this
text(labels = bquote(FirstT~"="~.(round(max(df$How)))))
text(labels = bquote(SecondT~"="~.(round(min(df$How))))
text(labels = bquote(A[min]~"="~.(round(coef(fit)[2]))))
text(labels = bquote(A[max]~"="~.(coef(fit)[3]))))
text(labels = paste0("Slope = ", round((-1)*coef(fit)[1])))
which of course does not work. I am more into an automatic way to find a place in right left corner of the figure that print these info
In the code below, we get the plot area coordinate ranges with par("usr") and then use those and the data point locations to automatically place the labels in the desired locations.
# Reduce margins
par(mar=c(5,4,0.5,0.5))
# Get extreme coordinates of plot area
p = par("usr")
p[1:2] = 10^p[1:2] # Because xscale is logged
text(max(df$How), df$Where[which.max(df$How)],
labels = bquote(FirstT~"="~.(round(max(df$How)))), pos=1)
text(min(df$How), df$Where[which.min(df$How)],
labels = bquote(SecondT~"="~.(round(min(df$How)))), pos=1)
text(1.1*p[1], p[3] + 0.02*diff(p[3:4]),
labels = bquote(A[min]~"="~.(round(coef(fit)[2]))), adj=c(0,0))

plot(var()) displays two different plots, how do I merge them into one? Also having two y axis

> dput(head(inputData))
structure(list(Date = c("2018:07:00", "2018:06:00", "2018:05:00",
"2018:04:00", "2018:03:00", "2018:02:00"), IIP = c(125.8, 127.5,
129.7, 122.6, 140.3, 127.4), CPI = c(139.8, 138.5, 137.8, 137.1,
136.5, 136.4), `Term Spread` = c(1.580025, 1.89438, 2.020112,
1.899074, 1.470544, 1.776862), RealMoney = c(142713.9916, 140728.6495,
140032.2762, 139845.5215, 139816.4682, 139625.865), NSE50 = c(10991.15682,
10742.97381, 10664.44773, 10472.93333, 10232.61842, 10533.10526
), CallMoneyRate = c(6.161175, 6.10112, 5.912088, 5.902226, 5.949956,
5.925538), STCreditSpread = c(-0.4977, -0.3619, 0.4923, 0.1592,
0.3819, -0.1363)), row.names = c(NA, -6L), class = c("tbl_df",
"tbl", "data.frame"))
I want to make my autoregressive plot like this plot:
#------> importing all libraries
library(readr)
install.packages("lubridtae")
library("lubridate")
install.packages("forecast")
library('ggplot2')
library('fpp')
library('forecast')
library('tseries')
#--------->reading data
inputData <- read_csv("C:/Users/sanat/Downloads/exercise_1.csv")
#--------->calculating the lag=1 for NSE50
diff_NSE50<-(diff(inputData$NSE50, lag = 1, differences = 1)/lag(inputData$NSE50))
diff_RealM2<-(diff(inputData$RealMoney, lag = 1, differences = 1)/lag(inputData$RealMoney))
plot.ts(diff_NSE50)
#--------->
lm_fit = dynlm(IIP ~ CallMoneyRate + STCreditSpread + diff_NSE50 + diff_RealM2, data = inputData)
summary(lm_fit)
#--------->
inputData_ts = ts(inputData, frequency = 12, start = 2012)
#--------->area of my doubt is here
VAR_data <- window(ts.union(ts(inputData$IIP), ts(inputData$CallMoneyRate)))
VAR_est <- VAR(y = VAR_data, p = 12)
plot(VAR_est)
I want to my plots to get plotted together in same plot. How do I serparate the var() plots to two separate ones.
Current plot:
My dataset :
dataset
Okay, so this still needs some work, but it should set the right framework for you. I would look more into working with the ggplot2 for future.
Few extra packages needed, namely library(vars) and library(dynlm).
Starting from,
VAR_est <- VAR(y = VAR_data, p = 12)
Now we extract the values we want from the VAR_est object.
y <- as.numeric(VAR_est$y[,1])
z <- as.numeric(VAR_est$y[,2])
x <- 1:length(y)
## second data set on a very different scale
par(mar = c(5, 4, 4, 4) + 0.3) # Leave space for z axis
plot(x, y, type = "l") # first plot
par(new = TRUE)
plot(x, z, type = "l", axes = FALSE, bty = "n", xlab = "", ylab = "")
axis(side=4, at = pretty(range(z)))
mtext("z", side=4, line=3)
I will leave you to add the dotted lines on etc...
Hint: Decompose the VAR_est object, for example, VAR_est$datamat, then see which bit of data corresponds to the part of the plot you want.
Used some of this

how can we do c means clustering in r,showing overlapping clusters

This is what i have tried
setwd("C:\\Ds")
reddit <- mtcars
reddit <- na.omit(reddit)
View(reddit)
cars<-reddit[,c(9,23)]
na.omit(cars)
col1<-cars[,1]/1000000
col2<-cars[,2]/1000000
z<-cbind(col1,col2)
cl<-means(z,4)
options(scipen = 10)
format(z,scientific=FALSE)
plot(z, col = cl$cluster,color=TRUE,las=1,xlab = "Gross in millions",ylab = "Budget in millions")
points(cl$centers, col = 1:2, pch = 18, cex = 2.5)
I want to create something like this:

R: How to add highlighted angle lines in polar plots?

Please consider the following sample polar plot:
library(plotrix)
testlen <- c(rnorm(36)*2 + 5)
testpos <- seq(0, 350, by = 10)
polar.plot(testlen, testpos, main = "Test Polar Plot",
lwd = 3, line.col = 4, rp.type = "s")
I would like to add lines at angles 30 and 330 as well as 150 and 210 (from the center to the outside). I experimented with the line function but could not get it to work.
The calculations for exact placement are a bit goofy but using your test data
set.seed(15)
testlen<-c(rnorm(36)*2+5)
testpos<-seq(0,350,by=10)
polar.plot(testlen,testpos,main="Test Polar Plot",
lwd=3,line.col=4,rp.type="s")
You can add lines at 20,150,210,300 with
add.line <- c(30,330, 150,210)/360*2*pi
maxlength <- max(pretty(range(testlen)))-min(testlen)
segments(0, 0, cos(add.line) * maxlength, sin(add.line) * maxlength,
col = "red")
And that makes the following plot
You can just use the rp.type = "r" argument and add = TRUE. So, something like
library(plotrix)
set.seed(1)
testlen <- c(rnorm(36)*2 + 5)
testpos <- seq(0,350, by = 10)
polar.plot(testlen, testpos, main = "Test Polar Plot",
lwd = 3, line.col = 4, rp.type = "s")
followed by
pos <- c(30, 330, 150, 210)
len <- c(10, 10, 10, 10)
polar.plot(lengths = len, polar.pos = pos,
radial.lim = c(0, 15),
lwd = 2, line.col = 2, rp.type = "r", add = TRUE)
yields your desired output.

Resources