Abdi-Basid
ADAN
"The purpose of this document is to consolidate
and improve the various R scripts used to perform the cited analyses."
Table
of Contents
# 1 - WIND DIRECTION
& WIND SPEED ANALYSIS :
# 3 - Vertical Extrapolation Wind
Speed (m/s) :
# 4 - Turbulence Intensity Diagram :
# 5 - VALIDATION SATTELITE DATA vs Observed:
# 6 - Weibull
Distribution Method:
# 7 - Goodness-of-fit estimation for Accuracy:
# 8 - WIND ROSE FOR
WIND DIRECTION DIAGRAM:
# 9 - CAPACITY FACTOR or INTERMITTENCE FACTOR MONTHLY :
# 10 - Wind Solar
geospatial distribution:
# 11 - EXTRACTION
NETCDF - OPEN GRIB and NETCDF:
# 12 - TECHNO
ECONOMIC ANALYSIS:
# 15 - COST OF RO: Reversis Osmosis:
# 16 - COST OF Ammonia NH3 Synthesis Loop – Haber Bosch
synthesis:
# 17 - LH2-COST Liquefaction of hydrogen cycle LHG # LNG =
Fischer-Tropsch :
# 18 - CO2 - CORBONE EMISSION SAVED AND ECONOMIC :
# 19 - Transport Cost OF NH3/ LH2/ Sea / Rail/
TRUCK:
# 1 - WIND DIRECTION
& WIND SPEED ANALYSIS :
data<-read.csv(file("clipboard"),header=T,sep="\t",
dec=",")
str(data)
data=data[,-1]
#
data<-read.csv(file("clipboard"),header=T,sep="\t",
dec=",",row.names=1)
attach(data)
str(data)
dim(data)
summary(data)
dir()
names(data)
#
#
Calculation of annual energy production
require(bReeze)
data("winddata",
package="bReeze")
set1
<- set(height=40, v.avg=winddata[,2], v.std=winddata[,5],
dir.avg=winddata[,14])
set2
<- set(height=30, v.avg=winddata[,6], v.std=winddata[,9],
dir.avg=winddata[,16])
ts
<- timestamp(timestamp=winddata[,1])
neubuerg
<- mast(timestamp=ts, set1, set2)
neubuerg
<- clean(mast=neubuerg)
#
https://search.r-project.org/CRAN/refmans/bReeze/html/aep.html
#
https://power-calculation.com/wind-power-energy-calculator.php
X=1:length(IOMSL);
summary(lm(IOMSL~X))
#
U=u10
#Eastward
V=v10
#Northward
#windSpd
<-function(U,V){
# sqrt(U^2+V^2)
#}
#windDir
<-function(U,V){
# (270-atan2(u,v)*180/pi)%%360
#}
WSPE=sqrt(U^2+V^2)
WDIR=
(270-atan2(V,U)*180/pi)%%360
#winddirect=atan(V/U);head(winddirect)
write.table(WSPE,
"wsp.txt", row.names=FALSE, col.names=FALSE)
write.table(WDIR,
"wdi.txt", row.names=FALSE, col.names=FALSE)
# 2
- WIND POWER DENSITY:
data<-read.csv(file("clipboard"),header=T,sep="\t",
dec=",")
str(data)
data=data[,-1]
#
library(prettyR)
describe(data,num.desc=c("mean","max","min","sd","var","median","valid.n"),xname=NA,horizontal=TRUE)
attach(data)
round(mean(V_80),3);
round(mean(V_40),3); round(mean(V_30),3);round(mean(V_20),3)
round(max(V_80),3);
round(max(V_40),3); round(max(V_30),3);round(max(V_20),3)
#
PD=rho* (sum(v2^3)/length(v2))/2 =
PD/A (W/M2)
cbind(names(data))
rho=1.225 #kg/m3
PDA
= (rho* (mean(V_80^3)))/2; round(PDA,3)
PDA
= (rho* (mean(V_40^3)))/2; round(PDA,3)
PDA
= (rho* (mean(V_30^3)))/2; round(PDA,3)
PDA
= (rho* (mean(V_20^3)))/2; round(PDA,3)
#
#
Intensity Turbulence IT (%)
TI15=V_80[V_80<=15.1
& V_80>=14.9 ];summary(TI15)#(sd(TI15)/mean(TI15))*100
#((0.75*mean(TI15))+5.6)/mean(TI15)*100
IT=
mean(SD_40)/mean(V_40); IT*100
#
library(bReeze)
#
data("winddata", package="bReeze")
#
View(winddata);dim(winddata)
#
set40 <- set(height=40, v.avg=winddata[,2],
v.std=winddata[,5],dir.avg=winddata[,14])
cbind(names(data))
set30
<- set(height= 30, v.avg= V_30, v.std= SD_30 ,dir.avg= DIR_30)
ts
<- timestamp(timestamp=data[,1]) #ts
<- timestamp(timestamp=winddata[,1])
neubuerg
<- mast(timestamp=ts, set30)
neubuerg
<- clean(mast=neubuerg)
neubuerg.ti=
turbulence(mast=neubuerg, turb.set=1)
plot(neubuerg.ti,
cex.axis=0.9, cex.lab=0.9, circles=c(0.05,0.15,0.05),col="blue",
col.axis="black",
col.circle="red", lwd.circle=2,
lty.circle= 1)
#
# plot(neubuerg.ti,
cex.axis=0.7, cex.lab=0.9, circles=c(0.05,0.20,0.05),
# col="lightgray",
col.axis="darkgray", col.border="gray",
col.circle="darkgray",
# col.cross="darkgray",
col.lab="darkgray", fg=TRUE, lty.circle="dotdash",
# lty.cross="longdash",
lwd.border=1.2, lwd.circle=1.2, lwd.cross=1.2,
# pos.axis=135, sec.space=0.6)
#
boxplot(data,
xlab="Month", ylab="Wind speed at 80 m
[m/s]",col=rainbow(15))
grid(lty=1,col="black")
abline(v=c(1:12))
par(new=TRUE)
# 3 - Vertical Extrapolation Wind
Speed (m/s) :
data<-read.csv(file("clipboard"),header=T,sep="\t",
dec=",")
str(data)
data=data[,-1]
#
attach(data)
cbind(names(data))
v1=CFSR
h1=10
h2=80
#
alpha=(0.37-(0.088*log(mean(v1))))/(1-(0.088*log(h1/10)));alpha
v2=v1*((h2/h1)^alpha);mean(v2)
write.table(v2,"data.txt",
row.names=FALSE, col.names=FALSE)
#Verification de
l'extrapolation
#https://sci-hub.se/https://doi.org/10.1016/j.enconman.2004.12.005
(log(mean(v2))-log(mean(v1)))/(log(h2)-log(h1))-alpha
mean(v1)
mean(v2)
#
#
3D Scatter Plot for Wind analysis
cbind(names(data))
attach(data)
#
x=Pression..Bar.
y=Temperature...C.
z=
Wind.speed...m.s.
library("plot3D")
x11()
#b”,
“b2”, “f”, “g”, “bl”, “bl2”, “u”, “n”
scatter3D(x, y, z, phi
= 0.7, bty = "b2",
pch
= 20, cex = 2, ticktype = "detailed") # theta = -25
#
Add another point (black color)
scatter3D(x
= 7, y = 3, z = 3.5, add = TRUE, colkey = FALSE,
pch = 18, cex = 3, col =
"black")
#
#
greyish background for the boxtype (bty = "g")
scatter3D(x, y, z, phi
= 0, bty = "g",
pch
= 20, cex = 2, ticktype = "detailed")
#
line plot
scatter3D(x, y, z, phi
= 0, bty = "g", type = "l",
ticktype
= "detailed", lwd = 4)
#
points and lines
scatter3D(x, y, z, phi
= 0, bty = "g", type = "b",
ticktype
= "detailed", pch = 20,
cex = c(0.5, 1, 1.5))
#
vertical lines
scatter3D(x,
y, z, phi = 0, bty = "b2",
type = "h",
ticktype = "detailed")
#
#
library(plot3D)
VADeath=data
VADeath=as.matrix(VADeath)
class(VADeath)
hist3D
(x = 1:nrow(VADeath), y = 1:ncol(VADeath), z = VADeath,
bty = "b2", phi = 30, theta = -65,
xlab = "", ylab =
"", zlab = "", main = "",
col = "blue", border =
"red", shade = 0.5,
ticktype = "detailed", space
= 0.19, d =5, cex.axis = 0.95)
#http://www.sthda.com/english/wiki/impressive-package-for-3d-and-4d-graph-r-software-and-data-visualization
#
#scatter3D(x,
y, z, phi = 0, bty = "g", type
= "h",
# ticktype = "detailed", pch
= 19, cex = 0.5)
#https://www.learnbyexample.org/r-scatter-plot-base-graph/
#library(scatterplot3d)
#scatterplot3d(V_80,
Temp, Pression,
# pch = 16,
# type="h",
# angle = 45,
# xlab = "Wind speed
(m/s)",
# ylab = "Temperature
(°C)",
# zlab = "Pression "
# )
library('corrplot')
#
http://www.sthda.com/english/wiki/visualize-correlation-matrix-using-correlogram
cor.mtest
<- function(mat, ...) {
mat <- as.matrix(mat)
n <- ncol(mat)
p.mat<- matrix(NA, n, n)
diag(p.mat)
<- 0
for (i in 1:(n - 1)) {
for (j in (i + 1):n) {
tmp <- cor.test(mat[, i], mat[, j],
...)
p.mat[i, j] <- p.mat[j, i] <-
tmp$p.value
}
}
colnames(p.mat) <- rownames(p.mat) <-
colnames(mat)
p.mat
}
M
<- cor(data)
p.mat
<- cor.mtest(M)
title
<- "p-value significance"
col
<- colorRampPalette(c("#BB4444", "#EE9988",
"#FFFFFF", "#77AADD", "#4477AA"))
corrplot(M,
method="color", col=col(200),
diag=FALSE, # tl.pos="d",
type="upper",
order="hclust",
title=title,
addCoef.col = "black", # Add
coefficient of correlation
# Combine with significance
p.mat = p.mat, sig.level = 0.05, insig
= "blank"
# hide correlation coefficient on the
principal diagonal
)
cor(data,
method="pearson")
cor(data,
method="kendall")
cor(data,
method="spearman")
# 4
- Turbulence Intensity Diagram :
data<-read.csv(file("clipboard"),header=T,sep="\t",
dec=",")
str(data)
names(data)
attach(data)
summary(data)
#data=data[,-c(1,2,3)]
which(data[,2]
>=0.25 )
View(data)
#data1=subset(data,
V_80 > )
V=V_30
d12= subset(data, V> 1 & V < 2)
d23= subset(data, V> 2 & V < 3)
d34= subset(data, V> 3 & V < 4)
d45= subset(data, V> 4 & V < 5)
d56= subset(data, V> 5 & V < 6)
d67= subset(data, V> 6 & V < 7)
d78= subset(data, V> 7 & V < 8)
d89= subset(data, V> 8 & V < 9)
d910= subset(data, V> 9 & V < 10)
d1011=
subset(data, V> 10 & V < 11)
d1112=
subset(data, V> 11 & V < 12)
d1213=
subset(data, V> 12 & V < 13)
d1314=
subset(data, V> 13 & V < 14)
d1415=
subset(data, V> 14 & V < 15)
d1516=
subset(data, V> 15 & V < 16)
d1617=
subset(data, V> 16 & V < 17)
d1718=
subset(data, V> 17 & V < 18)
d1819=
subset(data, V> 18 & V < 19)
d1920=
subset(data, V> 19 & V < 20)
d2021=
subset(data, V> 20 & V < 21)
d2122=
subset(data, V> 21 & V < 22)
#
c1=sapply(d12, mean)
c2=sapply(d23, mean)
c3=sapply(d34, mean)
c4=sapply(d45, mean)
c5=sapply(d56, mean)
c6=sapply(d67, mean)
c7=sapply(d78, mean)
c8=sapply(d89, mean)
c9=sapply(d910, mean)
c10=sapply(d1011,
mean)
c11=sapply(d1112,
mean)
c12=sapply(d1213,
mean)
c13=sapply(d1314,
mean)
c14=sapply(d1415,
mean)
c15=sapply(d1516,
mean)
c16=sapply(d1617,
mean)
c17=sapply(d1718,
mean)
c18=sapply(d1819,
mean)
c19=sapply(d1920,
mean)
c20=sapply(d2021,
mean)
c21=sapply(d2122,
mean)
#
rbind(c1,c2,c3,c4,c5,c6,c7,c8,c9,c10,c11,c12,c13,c14,c15,c16,c17,c18,c19,c20,c21)
# 5 - VALIDATION
SATTELITE DATA vs Observed:
data<-read.csv(file("clipboard"),header=T,sep="\t",
dec=",")
str(data)
names(data)
attach(data)
summary(data)
require(plotrix)
names(data)
#
lwd = 0.9, cex = 1.5
oldpar<-taylor.diagram(V_80,ERA5,pch=19,pos.cor=TRUE,grad.corr.lines=c(0.2,0.4,0.6,0.8,0.9,1),
pcex=1,cex.axis=1,normalize=FALSE,show.gamma=TRUE,ngamma=5,gamma.col="green",sd.arcs=5)
# show.gamma=TRUE,ngamma=3,gamma.col="blue",sd.arcs=5
#
taylor.diagram(V_80,MERRA2,add=TRUE,pch=19,col="blue")
taylor.diagram(V_80,NCEP,add=TRUE,pch=19,col=
"green")
taylor.diagram(V_80,ICOADS,add=TRUE,pch=19,col="cyan")
taylor.diagram(V_80,CFSR,add=TRUE,pch=19,col="orange")
#
par(oldpar)
taylor.diagram(V_80,ERA5,pos.cor=FALSE)
taylor.diagram(V_80,MERRA2,add=TRUE,col="blue")
taylor.diagram(V_80,NCEP,add=TRUE,col=
"green")
taylor.diagram(V_80,ICOADS,add=TRUE,col="cyan")
taylor.diagram(V_80,CFSR,add=TRUE,col="orange")
#
data<-read.csv(file("clipboard"),header=T,sep="\t",
dec=",", row.names=1)
str(data)
require(openair)
names(data)
date1=
as.Date(data$date,format='%d/%m/%Y') #
date= as.Date('01/01/2015',format='%d/%m/%Y')
data$date<-date1
#
a <- as.Date(data$date, format = "%d-%b-%y")
TaylorDiagram(data,
obs = "obs", mod = "mod", group = "model")
#TaylorDiagram(mod.dat,
obs = "obs", mod = "mod", group = "model", type =
"season")
#
Estimate the accuracy of solar radiation models: VALIDATION SOLAR SATTELITE
DATA
#
#
Test Parametric and Non Parametric Correlation
data1=na.omit(data)
cor.test(S,O,
data=data, method="pearson") #
pearson”, “kendall”, “spearman”
round(cor(data1),3)
#*-*Root-mean-square
deviation (*-mode POURCENTAGE # -mode
Unite variable )
rmse=(sqrt(sum((S-O)^2)/sum(O^2)))*100;
round(rmse, 3)
#RMSE=
sqrt(sum((S-O)^2)/ length(S))
#RRMSEmm
= sqrt(sum((weibullmm-F)^2)/ length(F))/(sum(F)/length(F))
#RMSD
= RMSE
#
#-*-Mean
absolute error
mae=sum(abs(S-O))/length(O);
round(mae, 3)
#
#
Mean Percentage Error
mpe=(sum(S-O)/sum(O)
)*100; round(mpe, 3)
#
#
Percentage bias for a 95% confidence intervaL
Us=0.05*100 # pyranometer ±5%
accuracy (http://dx.doi.org/10.1016/j.solener.2015.08.015)
Uctn=
-sqrt(Us^2 + mpe^2 + rmse^2);
round(Uctn, 3)
Uctp=
+sqrt(Us^2 + mpe^2 + rmse^2);
round(Uctp, 3)
#
#
https://sci-hub.st/https://doi.org/10.1016/j.rser.2018.03.003
#
https://sci-hub.st/https://doi.org/10.1016/j.solener.2011.02.013
#
https://solargis.com/blog/best-practices/improving-accuracy-of-solar-power-forecasts
#
data=read.table(file("clipboard"),header=T,
sep="\t", dec=".", row.names=1)
#
data=read.table(file("clipboard"),header=T, sep="\t",
dec=".")
str(data)
attach(data)
#
# 3D PLOT IN R
#
#
install.packages("rgl", dependencies = TRUE) # Change Mirror in R
Marseille
require(rgl)
require(lattice)
require(latticeExtra)
library(plotly)
library(rayshader)
library(ggplot2)
library(av)
#
x= GHI
y= T2m
z= Clear.Index
persp3d(x,y,z,col="blue")
plot3d(x = GHI, y =
T2m, z = Clear.Index)
lines3d(x = GHI, y =
T2m, z = Clear.Index)
surface3d(x = GHI, y =
T2m, z = Clear.Index)
#
plot_ly(x=x,y=y,z=z,
type="surface")
#
library(akima)
im
<- with(data,interp(x,y,z))
x11();with(im,image(x,y,z))
#
https://stackoverflow.com/questions/6720526/plot-3d-data-in-r
#
p
<- ggplot(data, aes(X,T2m, fill = GHI)) +
geom_tile() +
scale_fill_fermenter(type = "div",
palette = "RdYlBu")
plot_gg(p) # ALT + F4
render_movie(filename
= "plot.gif")
#
https://stackoverflow.com/questions/26794236/ggplot2-3d-bar-plot
#
attach(data)
dim(data)
names(data)
str(data)
#
x1=
data$GHI
y1=
data$ClearIndex
z1=
data$T2m
library("plot3D")
x11()
#b”,
“b2”, “f”, “g”, “bl”, “bl2”, “u”, “n”
scatter3D(x1, y1, z1,
phi = 0.55, bty = "b2",
pch
= 20, cex = 2, ticktype = "detailed") # theta = -25
#-#-#
library(rgl);require(car)
scatter3d(x1,
y1, z1)
scatter3d(x
= x1, y = y1, z = z1, point.col = "blue", surface=FALSE,labels =
rownames(data), id.n=nrow(data))
scatter3d(x
= x1, y = y1, z = z1, groups = as.factor(data$X))
#
http://www.sthda.com/english/wiki/amazing-interactive-3d-scatter-plots-r-software-and-data-visualization
# 6 - Weibull Distribution Method:
data<-read.csv(file("clipboard"),header=T,sep="\t",
dec=",", row.names=1)
str(data)
summary(data)
names(data)
#Probabiity
Distribution Function(PDF)
#---Statistic
Parameter
attach(data)
v2=V_80
#
#---
Test value of K and c weibull parameters
require(MASS)
library(fitdistrplus)
#
“mle”, “mme”, “qme”, “mge”, “mse”
fit.weibull
<- fitdist( v2, distr = "weibull", method = "mle", lower
= c(0, 0));fit.weibull
fit.weibull2
<- fitdist(v2, distr = "weibull", method = "mse", lower
= c(0, 0));fit.weibull2
fit.weibull3
<- fitdist(v2, distr = "weibull", method = "mge", lower
= c(0, 0));fit.weibull3
gofstat(list(fit.weibull,
fit.weibull2))
#fit.gamma
<- fitdist(temp, distr = "gamma", method = "mle", lower
= c(0, 0), start = list(scale = 1, shape = 1))
#fit.weibull
<- fitdist(temp, distr = "weibull", method = "mle",
lower = c(0, 0))
#fit.gamma
<- fitdist(temp, distr = "gamma", method = "mle", lower
= c(0, 0), start = list(scale = 1, shape = 1))
#plot(fit.weibull)
#plot(fit.gamma)
#ESTIMATION
OTHER WEIBULL 2 and 3 PARAMETER
# Distribution Parameter Weibull:
1)Shape 2)Scale 3)Threshold
# Distribution Parameter Rayleigh: 1 or 2 parameter
#Estimating
parameters of the Weibull distribution through classical methods
# "greg1" (for the method of generalized regression
type 1)
# "greg2" (for the method of generalized regression
type 2)
# "lm" (for the method of L-moment)
# "ml" (for the method of maximum likelihood (ML)
# "mlm" (for the method of logarithmic moment)
# "moment" (for the method of moment)
# "pm" (for the method of percentile)
# "rank" (for the method of rank correlation)
# "reg" (for the method of least square)
# "ustat" (for the method of U-statistic)
# "wml" (for the method of weighted ML)
# "wreg" (for the method of weighted least square)
# "mle" (for the method of ML),
# "mm1" (for the method of modified moment (MM)
type 1)
# "mm2" (for the method of MM type 2)
# "mm3" (for the method of MM type 3)
# "mml1" (for the method of modified ML type 1)
# "mml2" (for the method of modified ML type 2)
# "mml3" (for the method of modified ML type 3)
# "mml4" (for the method of modified ML type 4)
# "moment" (for the method of moment)
# "mps" (for the method of maximum product spacing)
# "tlm" (for the method of T-L moment)
# "wml" (for the method of weighted ML)
#if(!require('ForestFit'))
{
# install.packages('ForestFit')
# library('ForestFit')
#}
#library('ForestFit')
#
starts<-c(2, 2 ,0)
#fitWeibull(v2,
TRUE, "ml", starts)
#fitWeibull(data,
TRUE, "mps", starts)
#fitWeibull(data,
TRUE, "wml", starts)
#fitWeibull(data,
FALSE, "mlm", starts)
#fitWeibull(data,
FALSE, "ustat", starts)
#
v2=V_80
moy=mean(v2)
sd=(sd(v2)*length(v2))/(length(v2)-1)
count=data.frame(table(v2))
#
Kurtosis & Skewness
skew=sum((v2-moy)^3/sd^3)/(length(v2)-1)
kurt=sum((((v2-moy)^4)/(sd^4))-3)/(length(v2)-1)
min=min(v2)
max=max(v2)
#
rbind(c("Statistic
of v2"),moy,sd,skew,kurt,min,max)
#
# - 1 - Empirical
Jestus
#Empirique de Jestus
kej=(sd/moy)^-1.086
cej=moy/gamma((1+(1/kej)))
kej;cej
#
- 2 - Maximum Loglikelihood
#kmv=1/(sum(v2^(kej+0.09)*log(v2))/sum(v2^(kej+0.09))
-sum(log(v2))/length(v2))
#cmv=(sum(v2^kmv)/length(v2))^(1/kmv)
library(fitdistrplus);fit.weibull
<- fitdist(v2, distr = "weibull", method = "mle", lower
= c(0, 0));fit.weibull
#mledist(v2,
distr="weibull", start = NULL, fix.arg = NULL, optim.method =
"default")$estimate
kmv=3.306007;cmv=11.153787
#
- 3 - Moment Method
#Empirical
method of Justus/ moment method
cej;kej
cmm=
11.188 ; kmm= 3.258
round(mean(v2),4);
round(cmm*gamma(1+(1/kmm)),4); round(sd(v2),4); round(cmm*
sqrt(gamma(1+(2/kmm))-(gamma(1+(1/kmm))^2 )),4)
#
- 4 - WAsp Method
F=1-exp(-(mean(v2)/(cmm+0.055))^(kmm+0.055))
cwasp=(sum(v2^3)/(length(v2)*gamma((3/(kmm+0.05))+1)))^(1/3)
X=1-mean(F)
w1=-log(X)
#log(w1)==log((moy/cwasp)^k)#log((moy/cwasp)^k)=k*log(moy)-log(cwasp)=k*log(moy/cwasp)
kwasp
= log(w1)/log(moy/cwasp)
kwasp;cwasp
#
- 5 - Power Density
#Power-Density
Method OR Energy pattern factor method
E=(sum(v2^3)/length(v2))/moy^3
kpd=1+(3.69/E^2)
cpd=moy/gamma((1+(1/kpd)))
kpd;cpd
#
- 6 - Median and Quartile
library(fitdistrplus);qmedist(v2,
"weibull", probs=c(1/3, 2/3))$estimate #Quantile matching
kqm=3.673783;cqm=
11.344275
#
cbind(quantile(v2))
#Q0
Q1 = 7.8357805 # 25%
Q3 = 12.4450632 # 75%
Q2 = 10.2556539 # 50%
#Q4
#kmq=1.573/log(Q3/Q1)
kmq=log(log(1/4)/log(3/4))/log(Q3/Q1)
cmq=Q2/log(2)^(1/kmq)
kmq;cmq
#
- 7 - Empirical of Lysen
#Empirical
method of lysen (EML)
keml=(sd/moy)^-1.086
ceml=moy/gamma(1+(1/keml))
ceml2=mean(v2)*(0.568+(0.433/keml))^(-(1/keml))
keml;ceml
#-8-Curving-Fitting
Method
kcf=(0.9874/(sd/moy))^1.0983
ccf=moy/gamma((1+(1/kcf)))
kcf;ccf
#-9-Modified
maximum likelihood Method
frq=hist(v2);
dev.off()
#kmml=1/(sum((frq$mids^(kmv+0.09))*log(frq$mids)*frq$density)/sum((frq$mids^(kmv+0.09))*frq$density)
-sum(log(frq$mids)*frq$density)/sum(frq$density))#cmml=(sum(frq$mids^kmml*frq$density)/sum(frq$density))^(1/kmml)
kmml=sum(frq$mids^(kmv+0.09)*log(frq$mids)*frq$density)/((sum(frq$mids^(kmv+0.09)*frq$density))-
(sum(log(frq$mids)*frq$density)/sum(frq$density)))
cmml=((1/sum(frq$density))*sum(frq$mids^kmml*frq$density))^(1/kmml)
kmml;cmml
#-10-Weighted
Least Square Method
F=1-exp(-(v2/(cmm+0.09))^(kmm+0.09))
x = log(v2)
y =log(-log(1-F))
w=((1-F)*log(1-F))^2
library(MASS);summary(rlm(y~x,weights
= 1/w))
kwls= 3.758000e+00
Intercept= -9.239300e+00
cwls=exp(-(Intercept/kwls))
kwls;cwls
#-11-Least
square Method Or Graphical method
F=1-exp(-(v2/(cmm+0.09))^(kmm+0.09))
x = log(v2)
y =log(-log(1-F))
ls=lm(y~x);summary(ls)
kls= 3.348e+00
Intercept= -8.112e+00
cls=exp(-(Intercept/kls))
kls;cls
#
#-12-Probability
weighted moments Method (based on power density method)
#sort(x,
decreasing = FALSE, na.last = TRUE)
#vi=sort(v2,
decreasing = FALSE, na.last = TRUE)
length(v2)
# ATTENTION A TRIER
POUR EVITER L'ERREUR
#Cbar
= mean(v2)/ (2/n(n-1))* sum(vi*(n-i) == A TRIER !
Cbar=moy/(
(2/(length(v2)*(length(v2)-1))) * 1.66994E+11 )
kpwm=log(2)/log(Cbar)
cpwm=(moy^3/gamma(1+(3/kpwm)))^(1/3)
kpwm;cpwm
#-l3-Equivalent
Energy Method
kee=1/(sum((frq$mids^(kmv+0.09))*log(frq$mids)*frq$density)/sum((frq$mids^(kmv+0.09))*frq$density)
-sum(log(frq$mids)*frq$density)/sum(frq$density))
#cee=((moy^3)/gamma(1+(3/kee)))^(1/3)
cee=((moy^3)/gamma(1+(3/kmm)))^(1/3)
kee;cee
#-l4-Alternative
maximum likelihood method
kaml=((pi/sqrt(6))*((length(v2)*(length(v2)-1))/(
(length(v2)*sum(log(v2)^2))-(sum(log(v2))^2))) )^(1/2)
caml=(sum(v2^kaml)/length(v2))^(1/kaml)
kaml;caml
#-n-Multi-Objective
Moments (MUOM) or Bayesian Method
str(v2)
require(ForestFit)
fitbayesWeibull(V_80,
n.burn=5, n.simul=15)
#fitbayesWeibull(V_80,
n.burn=2, n.simul=5)alpha|beta|mu
3.217599 11.0072 -0.06914994
#fitbayesWeibull(V_80,
n.burn=2, n.simul=7)alpha|beta|mu
3.292163 11.16194 -0.1932478
#fitbayesWeibull(V_80,
n.burn=5, n.simul=15)alpha|beta|mu
3.560549 11.81863 -0.728216
#fitbayesWeibull(V_80,
n.burn=20, n.simul=50) alpha|beta|mu
4.01669 13.10108 -1.882221
kb1=3.217599;
cb1=11.0072 ;kb2=3.292163; cb2=11.16194
;kb=3.560549; cb=11.81863
;kb4=4.01669; cb4=13.10108
#
#
RESULT OF WEIBULL MODELISATION
y=hist(v2,
freq=FALSE, col="blue", main="",
xlab="");print(y);dev.off() #breaks=60
#
weibull_ej=(kej/cej)*((y$mids/cej)^(kej-1))*exp(-((y$mids/cej)^kej)) #Short Way
FC_ej=1-exp(-((y$mids/cej)^kej))
#
weibull_mv=(kmv/cmv)*((y$mids/cmv)^(kmv-1))*exp(-((y$mids/cmv)^kmv)) #Short Way
FC_mv=1-exp(-((y$mids/cmv)^kmv))
#
weibull_mm=(kmm/cmm)*((y$mids/cmm)^(kmm-1))*exp(-((y$mids/cmm)^kmm)) #Short Way
FC_mm=1-exp(-((y$mids/cmm)^kmm))
#
weibull_wasp=(kwasp/cwasp)*((y$mids/cwasp)^(kwasp-1))*exp(-((y$mids/cwasp)^kwasp)) #Short Way
FC_wasp=1-exp(-((y$mids/cwasp)^kwasp))
#
weibull_pd=(kpd/cpd)*((y$mids/cpd)^(kpd-1))*exp(-((y$mids/cpd)^kpd)) #Short Way
FC_pd=1-exp(-((y$mids/cpd)^kpd))
#
weibull_mq=(kmq/cmq)*((y$mids/cmq)^(kmq-1))*exp(-((y$mids/cmq)^kmq)) #Short Way
FC_mq=1-exp(-((y$mids/cmq)^kmq))
#
weibull_eml=(keml/ceml)*((y$mids/ceml)^(keml-1))*exp(-((y$mids/ceml)^keml)) #Short Way
FC_eml=1-exp(-((y$mids/ceml)^keml))
#
weibull_cf=(kcf/ccf)*((y$mids/ccf)^(kcf-1))*exp(-((y$mids/ccf)^kcf)) #Short Way
FC_cf=1-exp(-((y$mids/ccf)^kcf))
#
weibull_mml=(kmml/cmml)*((y$mids/cmml)^(kmml-1))*exp(-((y$mids/cmml)^kmml)) #Short Way
FC_mml=1-exp(-((y$mids/cmml)^kmml))
#
weibull_wls=(kwls/cwls)*((y$mids/cwls)^(kwls-1))*exp(-((y$mids/cwls)^kwls)) #Short Way
FC_wls=1-exp(-((y$mids/cwls)^kwls))
#
weibull_ls=(kls/cls)*((y$mids/cls)^(kls-1))*exp(-((y$mids/cls)^kls)) #Short Way
FC_ls=1-exp(-((y$mids/cls)^kls))
#
weibull_pwm=(kpwm/cpwm)*((y$mids/cpwm)^(kpwm-1))*exp(-((y$mids/cpwm)^kpwm)) #Short Way
FC_pwm=1-exp(-((y$mids/cpwm)^kpwm))
#
weibull_ee=(kee/cee)*((y$mids/cee)^(kee-1))*exp(-((y$mids/cee)^kee)) #Short Way
FC_ee=1-exp(-((y$mids/cee)^kee))
#
weibull_aml=(kaml/caml)*((y$mids/caml)^(kaml-1))*exp(-((y$mids/caml)^kaml)) #Short Way
FC_aml=1-exp(-((y$mids/caml)^kaml))
#
weibull_b=(kb/cb)*((y$mids/cb)^(kb-1))*exp(-((y$mids/cb)^kb)) #Short Way
FC_b=1-exp(-((y$mids/cb)^kb))
#
weibull_qm=(kqm/cqm)*((y$mids/cqm)^(kqm-1))*exp(-((y$mids/cqm)^kqm)) #Short Way
FC_qm=1-exp(-((y$mids/cqm)^kqm))
# 7 - Goodness-of-fit
estimation for Accuracy:
RMSE =
sqrt(sum((y$density-weibull_qm)^2)/length(y$density))
R2 =
1-(sum((y$density-weibull_qm)^2)/sum((y$density-mean(y$density) )^2))
coe =
sum((weibull_qm-mean(y$density))^2)/sum((y$density-mean(y$density))^2)
IA =
1-sum(abs(y$density-weibull_qm))/(sum(abs(y$density-mean(weibull_qm))+abs(weibull_qm-mean(weibull_qm))))
Chi2 = sum((y$density-weibull_qm)^2/weibull_qm)
mae =
sum(abs(y$density-weibull_qm))/length(weibull_qm)
RRMSE =
sqrt(sum((y$density-weibull_qm)^2)/length(y$density)) / mean(weibull_qm)
MAPE =
1*(sum(abs((y$density-weibull_qm)/weibull_qm))/ length(y$density))
#
# qm
#STOP REPLACE
rbind(RMSE,R2,coe,IA,Chi2,mae,
RRMSE, MAPE)
#
#"mge"
for 'maximum goodness-of-fit estimation
#"CvM",
"KS", "AD", "ADR", "ADL",
"AD2R", "AD2L",
mgedist(V_60,
distr="weibull", gof = "ADL", start = NULL, fix.arg = NULL,
optim.method = "default")
# The mgedist function numerically maximizes
goodness-of-fit:or minimizes a goodness-of-fit distance coded by the argument
gof.
# One may use one of the classical distances
defined in Stephens (1986)
# the Cramer-von Mises distance
("CvM")
# the Kolmogorov-Smirnov distance
("KS")
# the Anderson-Darling distance
("AD")
# which gives more weight to the tails of the
distribution, or one of the variants of this last distance proposed by Luceno
(2006).
# the right-tail AD ("ADR")
# the left-tail AD ("ADL")
#
#
Distribution and Cumulative Diagram
#POUT=0.5*1.225*(cmm^3)*gamma((kmm+3)/kmm);
POUT
#
ej mv
mm wasp pd
mq eml cf mml
wls ls pwm ee aml b
y=hist(v2,
freq=FALSE,breaks = "Sturges") #breaks=60
#weibullmm=(kmm/cmm)*((v2/cmm)^(kmm-1))*exp(-((v2/cmm)^kmm)) # Long Way
weibull=(kmq/cmq)*((y$mids/cmq)^(kmq-1))*exp(-((y$mids/cmq)^kmq)) # Short Way
FCmq=1-exp(-((y$mids/cmq)^kmq))
print(y)
cbind(y$density,y$mids)
#
cbind(weibull_ej,weibull_mv,weibull_mm,weibull_wasp,weibull_pd,weibull_mq,weibull_eml,weibull_cf,weibull_mml,weibull_wls,weibull_ls,weibull_pwm,weibull_ee,weibull_aml,weibull_b)
cbind(FC_ej,FC_mv,FC_mm,FC_wasp,FC_pd,FC_mq,FC_eml,FC_cf,FC_mml,FC_wls,FC_ls,FC_pwm,FC_ee,FC_aml,FC_b)
#
#
Transform Distribution ti wind speed
o_0.5=rep(0.5, each=25
)
o_1.5=rep(1.5, each=404
)
o_2.5=rep(2.5, each=1460
)
o_3.5=rep(3.5, each=3371
)
o_4.5=rep(4.5, each=6205
)
o_5.5=rep(5.5, each=9872
)
o_6.5=rep(6.5, each=14084
)
o_7.5=rep(7.5, each=18331
)
o_8.5=rep(8.5, each=21932
)
o_9.5=rep(9.5, each=24170
)
o_10.5=rep(10.5, each=24494
)
o_11.5=rep(11.5, each=22732
)
o_12.5=rep(12.5, each=19211
)
o_13.5=rep(13.5, each=14677
)
o_14.5=rep(14.5, each=10055
)
o_15.5=rep(15.5, each=6121
)
o_16.5=rep(16.5, each=3279
)
o_17.5=rep(17.5, each=1529
)
o_18.5=rep(18.5, each=614
)
o_19.5=rep(19.5, each=210
)
o_20.5=rep(20.5, each=60
)
o_21.5=rep(21.5, each=14
)
#
mids=c(o_0.5,o_1.5,o_2.5,o_3.5,o_4.5,o_5.5,o_6.5,o_7.5,o_8.5,o_9.5,o_10.5,o_11.5,o_12.5,o_13.5,o_14.5,o_15.5,o_16.5,o_17.5,o_18.5,o_19.5,o_20.5,o_21.5)
sd(mids);mean(mids);sd(mids)/mean(mids)
# table(obs)
#
#
OTHER CARACTERISTIQUE
weibullmq=(kmq/cmq)*((v2/cmq)^(kmq-1))*exp(-((v2/cmq)^kmq))
#
aa=cbind(table(v2))[1:length(cbind(table(v2)))] # bb=aa/sum(aa)
cc=cbind(table(weibullmq))[1:length(cbind(table(weibullmq)))]
write.table(aa,
"data.txt", row.names=FALSE, col.names=FALSE)
write.table(cc,
"data.txt", row.names=FALSE, col.names=FALSE)
cbind(table(v2))
# 8
- WIND ROSE FOR WIND DIRECTION DIAGRAM:
data1<-read.csv(file("clipboard"),header=T,sep="\t",
dec=",",row.names=1)
str(data1)
attach(data1)
#
data1<-read.csv(file("clipboard"),header=T,sep="\t",
dec=",")
#
"right", "left", "top", "bottom"
names(data1)
#
require(openair)
windRose(data1,
ws = "V_40", wd ="DIR_40", ws.int = 2,
paddle = FALSE, border = FALSE,
breaks = c(0, 4, 8, 12, 16, 21),
key.position = "bottom",
col
=c("cyan","green","yellow","orange",
"red"),
grid.line = list(value =5, lty = 1,
lwd=3, col = "grey"), annotate = TRUE,
key.header = "Wind Speed",
angle.scale = -45 )
#
#
ir=read.table(file("clipboard"),
header=TRUE, sep="\t",dec=",")
#
ir=read.table(file("clipboard"),
header=TRUE, sep="\t",dec=",",row.names=1)
#
str(ir);
attach(ir);names(ir)
#
MONTH HOURS VALUE
X1=Day
X2=Month
X3=V_80
library(ggplot2);ggp
<- ggplot(ir, aes(X1, X2)) +
geom_tile(aes(fill = X3),cex=0.01);ggp
ggp
+ scale_fill_gradient(low =
c("blue3","blue","green3","green"),
high =
c("yellow","red","red3","brown"))
#https://statisticsglobe.com/heatmap-in-r
#
#
example model VADeaths
VADeath=ir
VADeath=as.matrix(VADeath)
class(VADeath)
library(latticeExtra)
#
A function generating colors
cols<-function(n)
{
colorRampPalette(c("red",
"yellow","green","blue"))(200) # 20 distinct
colors
}
#
The plot
cloud(VADeath,
panel.3d.cloud = panel.3dbars, col="white", # white borders for bars
xbase = 1, ybase = 2, zlim = c(0,
max(VADeath)),
# No space around the bars
scales = list(arrows = FALSE, just =
"right"), main=NULL,xlab = NULL, ylab = NULL,
col.facet = level.colors(VADeath, at =
do.breaks(range(VADeath), 10),
col.regions =
cols, #
color ramp for filling the bars
colors = TRUE),
colorkey = list(col = cols, at =
do.breaks(range(VADeath), 10)),
screen = list(z = 65, x = -65))
#
#
#
WIND POWER DENSITY MONTHLY
rho=1.225
#kg/m3
#PD=rho*
(sum(v2^3)/length(v2))/2 = PD/A (W/M2)
PDA
= (rho* (mean(v2^3)))/2; PDA
# 9 - CAPACITY FACTOR or
INTERMITTENCE FACTOR MONTHLY :
k=kmm;
c=cmm
vi=3;
vr=11.5; vo=25;
Pout= exp(-((vi/c)^k))
- exp(-((vr/c)^k))
Pr=((vr/c)^k) -
((vi/c)^k)
CF = (Pout/Pr) -
exp(-(vo/c)^k); CF
#
#
MONTLHY CAPACITY FACTOR :
data=read.table(file('clipboard'),
header=T, sep="\t", dec=",")
str(data)
View(data)
#
data1=subset(data,data$Time>=
6 & data$Time< 19)
write.table(data1,
"data.txt", row.names=FALSE, col.names=FALSE)
#
data2=subset(data,data$Time== 18)
write.table(data2[,5],
"data.txt", row.names=FALSE, col.names=FALSE)
summary(data2)
#
data2=subset(data,data$Month== 12 )
write.table(data2[,5],
"data.txt", row.names=FALSE, col.names=FALSE)
summary(data2)
#
data=read.table(file('clipboard'),
header=T, sep="\t", dec=",")
str(data)
attach(data)
#View(data)
#
v2=V_80
cbind(quantile(v2))
#
Q1 = 5.7616033 # 25%
Q2 = 8.4119409 # 50%
Q3 = 10.4861181 # 75%
# kmq=1.573/log(Q3/Q1)
kmq=log(log(1/4)/log(3/4))/log(Q3/Q1);kmq
cmq=Q2/log(2)^(1/kmq);cmq
# 10 - Wind Solar geospatial distribution:
local_options
<- options()
library(sf)
library(dplyr)
library(ggplot2)
library(h3jsr)
options(stringsAsFactors
= FALSE)
#
#
sCRIPT :
https://cran.r-project.org/web/packages/h3jsr/vignettes/intro-to-h3jsr.html
#
WIND DATA :
https://globalwindatlas.info/en
#
SOLAR DATA : https://globalsolaratlas.info/map
#
SOLAR ENERGY ANALYSIS
#
# Data satellite
#
https://globalsolaratlas.info/download/djibouti
#
https://re.jrc.ec.europa.eu/pvg_tools/en/tools.html#api_5.1
#
https://nsrdb.nrel.gov/data-viewer
#
https://www.soda-pro.com/web-services/radiation/helioclim-1
#
https://cds.climate.copernicus.eu/cdsapp#!/yourrequests?tab=form
#
https://re.jrc.ec.europa.eu/pvg_tools/en/tools.html
# 11 - EXTRACTION NETCDF - OPEN GRIB and NETCDF:
library(ncdf4)
library(raster)
library(rgdal)
library(ggplot2)
library(ncdf4)
library(ncdf4.helpers)
library(PCICt)
library("lubridate")
#
getwd()
#
setwd("C:/Abdi-Basid
ADAN/0.Doc.OnGoing/2.Energy II/Solar Data CERD/z Djibouti Airort for Data
Validataion/ERA5")
#
nc_fname
<- "2021ARTA.nc"
nc_ds
<- nc_open(nc_fname); print(nc_ds )
#
# AFTER:
short----
dim_lon
<- ncvar_get(nc_ds, "longitude")
dim_lat
<- ncvar_get(nc_ds, "latitude")
dim_time
<- ncvar_get(nc_ds, "time")
dim_var1
<- ncvar_get(nc_ds, "msdwswrf")
dim_var2
<- ncvar_get(nc_ds, "msdrswrf")
#
#
t_units <- ncatt_get(nc_ds, "time", "units")
#
t_ustr <- strsplit(t_units$value, " ")
#
t_dstr <- strsplit(unlist(t_ustr)[3], "-")
#
date <- ymd(t_dstr) + dseconds(dim_time)
#
nc_df <- data.frame(cbind(dim_var1, dim_var2))
print(nc_ds)
write.table(dim_var1,
"2022- DOW.XLS", row.names=FALSE, sep="\t")
getwd()
#
getwd()
setwd("C:/Abdi-Basid
ADAN/0.Doc.OnGoing/2.Energy II/Solar Data CERD/z Djibouti Airort for Data
Validataion/ERA5")
#
GRIB<-brick("0f190f5-47ef-4c23-aca7-ba0a2497d9f8.grib")
GRIB<-as.array(GRIB)
write.table(GRIB,
"data.xlsx",row.names=FALSE, col.names=FALSE)
#
#
nc_data
<-
nc_open('adaptor.mars.internal-1676403515.8398063-23591-7-728b49b6-b956-4fff-86f8-d18a466de5ff.nc')
GRIB<-as.array(nc_data)
#
lon
<- ncvar_get(GRIB, varid = "longitude")
lat
<- ncvar_get(GRIB, varid = "latitude")
GRIB$dim$time$units
#
var1<-
ncvar_get(GRIB, "msdrswrf");var1_time <- nc.get.time.series(GRIB,v
= "var1",time.dim.name = "time")
var2<-
ncvar_get(GRIB, "msdwswrf");var2_time <- nc.get.time.series(GRIB,v
= "var2",time.dim.name = "time")
#
write.table(var1,
"data.csv",row.names=FALSE, col.names=FALSE)
#https://cran.r-project.org/web/packages/futureheatwaves/vignettes/starting_from_netcdf.html#:~:text=You%20can%20read%20netCDF%20data,connection%20to%20a%20netCDF%20file.
#https://help.marine.copernicus.eu/en/articles/6328012-how-to-convert-netcdf-to-csv-using-r
#https://rpubs.com/boyerag/297592
# 12 - TECHNO ECONOMIC ANALYSIS:
#
#
COST OF PV SOLAR [CRYST SILLICONE]
#
SP
= 10*10^3 # Solar Nominal Power in kW
CFS
= 0.81 # Capacity Factor
SI
=2363.253 # Solar Irradiance
n
= 0.152 # Electricity Efficiency
H
= 8760
A
= (SP*CFS*H) / (n*SI) ; round(A, 3) # AREA_m²
#
Eg=SI*n*CFS*A;
round(Eg, 3) # PVoutput_kWh
(10*10^3)*10*365 # Validation Output
#
UP=
2021.30 # 1130 # Cost Unite Price
I0=UP*10*10^3 # Investment expenditures
COM=0.015*I0 # Annual operation cost in $ in year
Eg # Annual electricity output
in kWh in year
i=
0.095 # Discounting rate #
https://banque-centrale.dj/wp-content/uploads/2022/12/Rapport-annuel-2021-BCD.pdf
T=
25 # Economic lifetime in
year
#
COMt
= (COM/(1+i)^1) + (COM/(1+i)^2) + (COM/(1+i)^3) + (COM/(1+i)^4) + (COM/(1+i)^5) +
(COM/(1+i)^6) + (COM/(1+i)^7) + (COM/(1+i)^8) + (COM/(1+i)^9) + (COM/(1+i)^10) +
(COM/(1+i)^11) + (COM/(1+i)^12) +
(COM/(1+i)^13) + (COM/(1+i)^14) + (COM/(1+i)^15) +
(COM/(1+i)^16) + (COM/(1+i)^17) +
(COM/(1+i)^18) + (COM/(1+i)^19) + (COM/(1+i)^20) +
(COM/(1+i)^21) + (COM/(1+i)^22) +
(COM/(1+i)^23) + (COM/(1+i)^24) + (COM/(1+i)^25)
round(COMt,3)
#
deg
= 0.9/100
Eg=SI*n*CFS*A;
round(Eg, 3)
Egt
= ((Eg*(1-deg)^0)/(1+i)^1) + ((Eg*(1-deg)^1)/(1+i)^2) + ((Eg*(1-deg)^2)/(1+i)^3) + ((Eg*(1-deg)^3)/(1+i)^4) + ((Eg*(1-deg)^4)/(1+i)^5) +
((Eg*(1-deg)^5)/(1+i)^6) + ((Eg*(1-deg)^6)/(1+i)^7) + ((Eg*(1-deg)^7)/(1+i)^8) + ((Eg*(1-deg)^8)/(1+i)^9) + ((Eg*(1-deg)^9)/(1+i)^10) +
((Eg*(1-deg)^10)/(1+i)^11) +
((Eg*(1-deg)^11)/(1+i)^12) + ((Eg*(1-deg)^12)/(1+i)^13) +
((Eg*(1-deg)^13)/(1+i)^14) + ((Eg*(1-deg)^14)/(1+i)^15) +
((Eg*(1-deg)^15)/(1+i)^16) +
((Eg*(1-deg)^16)/(1+i)^17) + ((Eg*(1-deg)^17)/(1+i)^18) +
((Eg*(1-deg)^18)/(1+i)^19) + ((Eg*(1-deg)^19)/(1+i)^20) +
((Eg*(1-deg)^20)/(1+i)^21) +
((Eg*(1-deg)^21)/(1+i)^22) + ((Eg*(1-deg)^22)/(1+i)^23) +
((Eg*(1-deg)^23)/(1+i)^24) + ((Eg*(1-deg)^24)/(1+i)^25)
round(Egt,3)
#
LCOEpv=
(I0 + COMt)/Egt ;round(LCOEpv,3)
#
#
https://sci-hub.st/https://doi.org/10.1016/j.desal.2020.114627
#
COST OF CSP SOLAR [CRS]
#
SP
= 10*10^3 #
Solar Nominal Power in kW
CFS
= 0.86 #(0.45+0.95)/2 # 0.616 #
Capacity Factor
SI
=2350.833 #
Solar Irradiance
n
= (8+24/2) /100 #
Electricity Efficiency
H
= 8760
A
= (SP*CFS*H) / (n*SI) ; round(A, 3) #AREA_m²
#
Eg=SI*n*CFS*A;
round(Eg, 3) # CSPoutput_kWh
(10*10^3)*10*365 # Validation Output
#
#
UP
= 3674.36
I0=UP*10*10^3 # Investment expenditures CAPEX
COM=0.02*I0 # Annual operation cost in $ in year
Eg # Annual electricity output in
kWh in year
i=
0.095 # Discounting rate #
https://banque-centrale.dj/wp-content/uploads/2022/12/Rapport-annuel-2021-BCD.pdf
T=
25 # Economic lifetime in
year
#
COMt
= (COM/(1+i)^1) + (COM/(1+i)^2) + (COM/(1+i)^3) + (COM/(1+i)^4) + (COM/(1+i)^5) +
(COM/(1+i)^6) + (COM/(1+i)^7) + (COM/(1+i)^8) + (COM/(1+i)^9) + (COM/(1+i)^10) +
(COM/(1+i)^11) + (COM/(1+i)^12) +
(COM/(1+i)^13) + (COM/(1+i)^14) + (COM/(1+i)^15) +
(COM/(1+i)^16) + (COM/(1+i)^17) +
(COM/(1+i)^18) + (COM/(1+i)^19) + (COM/(1+i)^20) +
(COM/(1+i)^21) + (COM/(1+i)^22) +
(COM/(1+i)^23) + (COM/(1+i)^24) + (COM/(1+i)^25)
round(COMt,3)
#
deg
= 0.2/100
Eg=SI*n*CFS*A;
round(Eg, 3)
Egt
= ((Eg*(1-deg)^0)/(1+i)^1) + ((Eg*(1-deg)^1)/(1+i)^2) + ((Eg*(1-deg)^2)/(1+i)^3) + ((Eg*(1-deg)^3)/(1+i)^4) + ((Eg*(1-deg)^4)/(1+i)^5) +
((Eg*(1-deg)^5)/(1+i)^6) + ((Eg*(1-deg)^6)/(1+i)^7) + ((Eg*(1-deg)^7)/(1+i)^8) + ((Eg*(1-deg)^8)/(1+i)^9) + ((Eg*(1-deg)^9)/(1+i)^10) +
((Eg*(1-deg)^10)/(1+i)^11) +
((Eg*(1-deg)^11)/(1+i)^12) + ((Eg*(1-deg)^12)/(1+i)^13) +
((Eg*(1-deg)^13)/(1+i)^14) + ((Eg*(1-deg)^14)/(1+i)^15) +
((Eg*(1-deg)^15)/(1+i)^16) +
((Eg*(1-deg)^16)/(1+i)^17) + ((Eg*(1-deg)^17)/(1+i)^18) +
((Eg*(1-deg)^18)/(1+i)^19) + ((Eg*(1-deg)^19)/(1+i)^20) +
((Eg*(1-deg)^20)/(1+i)^21) +
((Eg*(1-deg)^21)/(1+i)^22) + ((Eg*(1-deg)^22)/(1+i)^23) +
((Eg*(1-deg)^23)/(1+i)^24) + ((Eg*(1-deg)^24)/(1+i)^25)
round(Egt,3)
#
LCOEcrs=
(I0 + COMt)/Egt ;round(LCOEcrs,3)
#
#
https://sci-hub.st/https://doi.org/10.1016/j.enpol.2010.01.041
#
https://sci-hub.st/10.1016/j.rser.2019.109279 (page 5)
#
https://sci-hub.st/https://doi.org/10.1016/j.rser.2012.11.082
#
https://sci-hub.st/http://dx.doi.org/10.2139/ssrn.2050351
#
#
COST OF CSP SOLAR [PTC]
SP
= 10*10^3 #
Solar Nominal Power in kW
CFS
= 0.80# (0.45+0.95)/2 # 0.616 #
Capacity Factor
SI
=2350.833 #
Solar Irradiance
n
= (10+20/2) /100 #
Electricity Efficiency
H
= 8760
A
= (SP*CFS*H) / (n*SI) ; round(A, 3) #AREA_m²
#
Eg=SI*n*CFS*A;
round(Eg, 3) # CSPoutput_kWh
(10*10^3)*10*365 # Validation Output
#
UP
= 3674.36
I0=UP*10*10^3 # Investment expenditures
COM=0.02*I0 # Annual operation cost in $ in year
Eg # Annual electricity output in
kWh in year
i=
0.095 # Discounting rate #
https://banque-centrale.dj/wp-content/uploads/2022/12/Rapport-annuel-2021-BCD.pdf
T=
25 # Economic lifetime in
year
#
COMt
= (COM/(1+i)^1) + (COM/(1+i)^2) + (COM/(1+i)^3) + (COM/(1+i)^4) + (COM/(1+i)^5) +
(COM/(1+i)^6) + (COM/(1+i)^7) + (COM/(1+i)^8) + (COM/(1+i)^9) + (COM/(1+i)^10) +
(COM/(1+i)^11) + (COM/(1+i)^12) +
(COM/(1+i)^13) + (COM/(1+i)^14) + (COM/(1+i)^15) +
(COM/(1+i)^16) + (COM/(1+i)^17) +
(COM/(1+i)^18) + (COM/(1+i)^19) + (COM/(1+i)^20) +
(COM/(1+i)^21) + (COM/(1+i)^22) +
(COM/(1+i)^23) + (COM/(1+i)^24) + (COM/(1+i)^25)
round(COMt,3)
#
deg
= 0.2/100
Eg=SI*n*CFS*A;
round(Eg, 3)
Egt
= ((Eg*(1-deg)^0)/(1+i)^1) + ((Eg*(1-deg)^1)/(1+i)^2) + ((Eg*(1-deg)^2)/(1+i)^3) + ((Eg*(1-deg)^3)/(1+i)^4) + ((Eg*(1-deg)^4)/(1+i)^5) +
((Eg*(1-deg)^5)/(1+i)^6) + ((Eg*(1-deg)^6)/(1+i)^7) + ((Eg*(1-deg)^7)/(1+i)^8) + ((Eg*(1-deg)^8)/(1+i)^9) + ((Eg*(1-deg)^9)/(1+i)^10) +
((Eg*(1-deg)^10)/(1+i)^11) +
((Eg*(1-deg)^11)/(1+i)^12) + ((Eg*(1-deg)^12)/(1+i)^13) +
((Eg*(1-deg)^13)/(1+i)^14) + ((Eg*(1-deg)^14)/(1+i)^15) +
((Eg*(1-deg)^15)/(1+i)^16) +
((Eg*(1-deg)^16)/(1+i)^17) + ((Eg*(1-deg)^17)/(1+i)^18) +
((Eg*(1-deg)^18)/(1+i)^19) + ((Eg*(1-deg)^19)/(1+i)^20) +
((Eg*(1-deg)^20)/(1+i)^21) +
((Eg*(1-deg)^21)/(1+i)^22) + ((Eg*(1-deg)^22)/(1+i)^23) +
((Eg*(1-deg)^23)/(1+i)^24) + ((Eg*(1-deg)^24)/(1+i)^25)
round(Egt,3)
#
LCOEptc=
(I0 + COMt)/Egt ;round(LCOEptc,3)
#
#
COST OF PV-CSP SOLAR [PV-CRS]
#
SPcrs
= 5*10^3;SPpv = 5*10^3 # Solar
Nominal Power in kW
CFS
= 0.9 #
Capacity Factor
DNI
=2350.833; GHI=2363.253 # Solar
Irradiance
ncrs
= (8+24/2) /100; npv = 0.152 # Electricity Efficiency
H
= 8760
A
= ((SPcrs+SPpv)*CFS*H) / ((ncrs*DNI)+(npv*GHI)/2) ; round(A, 3) #AREA_m²
#
Eg=
((DNI*ncrs)+(GHI*npv)/2)* CFS*A; round(Eg, 3) # CSPoutput_kWh
(10*10^3)*10*365 # Validation
Output
#
UPcrs
= 3674.36; UPpv = 2021.30
I0crs=(UPcrs*5*10^3);
I0pv=(UPpv*5*10^3);I0=I0crs+I0pv #
Investment expenditures
COMcrs=0.02*I0crs;COMpv=0.015*I0pv;COM=COMpv+COMcrs # Annual operation cost in $ in year
Eg # Annual electricity output in
kWh in year
i=
0.095 # Discounting rate #
https://banque-centrale.dj/wp-content/uploads/2022/12/Rapport-annuel-2021-BCD.pdf
T=
25 # Economic lifetime in
year
#
COMt
= (COM/(1+i)^1) + (COM/(1+i)^2) + (COM/(1+i)^3) + (COM/(1+i)^4) + (COM/(1+i)^5) +
(COM/(1+i)^6) + (COM/(1+i)^7) + (COM/(1+i)^8) + (COM/(1+i)^9) + (COM/(1+i)^10) +
(COM/(1+i)^11) + (COM/(1+i)^12) +
(COM/(1+i)^13) + (COM/(1+i)^14) + (COM/(1+i)^15) +
(COM/(1+i)^16) + (COM/(1+i)^17) +
(COM/(1+i)^18) + (COM/(1+i)^19) + (COM/(1+i)^20) +
(COM/(1+i)^21) + (COM/(1+i)^22) +
(COM/(1+i)^23) + (COM/(1+i)^24) + (COM/(1+i)^25)
round(COMt,3)
#
deg
= (0.2+0.9)/2/100
Eg=
((DNI*ncrs)+(GHI*npv)/2)* CFS*A; round(Eg, 3)
Egt
= ((Eg*(1-deg)^0)/(1+i)^1) + ((Eg*(1-deg)^1)/(1+i)^2) + ((Eg*(1-deg)^2)/(1+i)^3) + ((Eg*(1-deg)^3)/(1+i)^4) + ((Eg*(1-deg)^4)/(1+i)^5) +
((Eg*(1-deg)^5)/(1+i)^6) + ((Eg*(1-deg)^6)/(1+i)^7) + ((Eg*(1-deg)^7)/(1+i)^8) + ((Eg*(1-deg)^8)/(1+i)^9) + ((Eg*(1-deg)^9)/(1+i)^10) +
((Eg*(1-deg)^10)/(1+i)^11) +
((Eg*(1-deg)^11)/(1+i)^12) + ((Eg*(1-deg)^12)/(1+i)^13) +
((Eg*(1-deg)^13)/(1+i)^14) + ((Eg*(1-deg)^14)/(1+i)^15) +
((Eg*(1-deg)^15)/(1+i)^16) +
((Eg*(1-deg)^16)/(1+i)^17) + ((Eg*(1-deg)^17)/(1+i)^18) +
((Eg*(1-deg)^18)/(1+i)^19) + ((Eg*(1-deg)^19)/(1+i)^20) +
((Eg*(1-deg)^20)/(1+i)^21) +
((Eg*(1-deg)^21)/(1+i)^22) + ((Eg*(1-deg)^22)/(1+i)^23) +
((Eg*(1-deg)^23)/(1+i)^24) + ((Eg*(1-deg)^24)/(1+i)^25)
round(Egt,3)
#
LCOEcsp.pv=
(I0 + COMt)/Egt ;round(LCOEcsp.pv,3)
#
COST OF Wind Turbine
#
BEST C and K with RMSE/COR/MBE...etc.
c_scale=
11.42328
k_shape=
3.399165
#
Caracteristic Wind Turbine
cutin=
4
cutout=
25
ratedpower=
10
#
Capacity Factor
CFW=(exp(-((cutin/c_scale)^k_shape))-exp(-((ratedpower/c_scale)^k_shape)))/((ratedpower/c_scale)^k_shape-(cutin/c_scale)^k_shape)-exp(-((cutout/c_scale)^k_shape));
round(CFW, 3)
#
Energy Output
NominalPower
= 5200 #kW
TimeW
= 20
Egw=
8760*TimeW*NominalPower*CFW; round(Egw, 3)
#
#
Cost Analysis
UPw=1600 # $/kW
instCost=0.3 # 30%
COMw=0.25 # 25%
it=0.087 #Interest rate #
https://banque-centrale.dj/wp-content/uploads/2022/12/Rapport-annuel-2021-BCD.pdf
LCOEwind=((NominalPower*UPw+(instCost*(UPw*NominalPower)))*(1+(COMw*(((1+it)^TimeW)-1)/(it*(it+1)^TimeW))))/(Egw);
round(LCOEwind,3)
#
https://sci-hub.se/10.1007/3-540-30906-3
#|1]
yearly cost of operation of the project NPV
: yearly car/n sinon accumulated
CI
= 1600*3400*4 #
initial costs
CAPEX
= 28346000
m
= 3.5/100 #
Annual operation and maintenance costs
I= 12.50/100 #
real rate of interest
n
= 20 # life of the system
#
NPVc
= (CAPEX) * ( (1+m)* ( (((1+I)^n) -
1) /
(I*((1+I)^n)) ) ); round(NPVc,
3)
#
#
#|
Accumulated present value of all benefits :
Ep
= 0.117 #
Electricity price $ per kWh
I1
= 7/100 #
interest rate
I= 5/100
# real rate of interest
If= 3/100
# Inflation
es= 2/100
# real rate of interest
e
= (1 + es) * (1 + If) -1;e #
Apparent rate of escalation
Id
= ((1+ I1) / (1+ I) ) -1;Id # Real rate of discount, adjusted for
inflation and escalation
n
= 20
cf
= 0.25 # capacity factor
PW
= 600 # NOMINAL POWER
AEp
= PW*8760*cf;AEp # annual energy
production AEp= 53416220
#
BA
= (Ep*AEp) *( ( (((1+Id)^n) - 1) / (Id*((1+Id)^n)) ) ); round(BA ,3)
#
#| Net Present Value :
NPV
= BA
- NPVc; round(NPV,3)
#
#|
Benefit cost ratio :
BCR
= BA / (NPVc) ; round(BCR,3)
# A project is acceptable if BCR is greater
than 1.
#
#|
Pay back period :
m1
= 2/100
Id
= 5/100
CI= 2200000
Ep= 7358400
AEp= 0.05
pb = - (log( 1 - (
(Id*CI)/( (Ep*AEp)-(m1*CI) ) ) ) / log(1+Id) )
; round(pb,3)
#
#|2]
TRI IRR #| Internal rate of return :
data
= read.table(file("clipboard"),header=TRUE, sep="\t",
dec=".", row.names=1)
str(data)
attach(data)
dim(data)
head(data,5)
names(data)
#
#
Calculating IRR in R :
#
library(jrvFinance) # This package has a the irr formula to
solve our problem
library(tidyquant) # general R quant package
library(DT) # package to display pretty Data
tables
library(tibble)
library(dplyr)
#
project1_cf
<- tibble(Year = 1:length(Ci),cf = c(Ci) )
project1_cf
%>%
DT::datatable(rownames = FALSE,caption =
"Project 1")
irr1
<- project1_cf %>%
select(cf) %>%
.[[1]] %>%
irr()
irr_tbl
<- tibble(Name = c("Project 1"),
IRR = c(irr1))
irr_tbl
%>%
datatable(caption = "Internal rate of
returns for the two projects.")
#
Newton-Raphson method, IRR : https://rpubs.com/aaronsc32/newton-raphson-method
#
https://www.codingfinance.com/post/2018-03-20-irr/
#|
Declining balance depreciation
#
https://sci-hub.se/10.1007/3-540-30906-3
rm(list=ls())
#-
HHV
= 39.44 # HHV:MJ = KWh/Kg 142 39.44
LHV
= 33.33 # LHV:MJ = KWh/Kg 120
33.33
#-
#
Masse dihydrogene H2:
CF_
= 0.7284 # % WIND TURBINE
Eop_= 33182035
# KWh/year 5200 kW/unit
LCOE
= 0.054 # $/kWh
Costelty=
LCOE*Eop_ ;round(Costelty,3) # $
#-
Eelzer= 54 # KWh/Kg
effRect
= 0.9 # rectifier
efficiency %
MH2=
(Eop_ / Eelzer)*effRect ; round(MH2,3) #
kg/year
MH2/0.08988 # Nm3/year |
Kg/h = Nm3/h
#
Energy Output of the hydrogen production system
H2output=
MH2*142 # MJ/Year
AVdenswind=831.1741828 # W/m²
areaswep=12644 # m²
H2input=
(AVdenswind*8760/1000)*areaswep
effH2=((H2output/1000)/(H2input*
0.0036 ))*100; round(effH2,3) # %
0.0036GJ/kWh
#-
Eelzer= 54
# KWh/Kg
UCostelzer
= 900 # $/KW
RPelzer
= 185 # kW
Lfelzer
= 20 # year
effelzer= (LHV/Eelzer);round(effelzer,3) # %
#-
effRect
= 0.9 # rectifier efficiency %
UCostRect=
130*1.19 # $/kW
LftRect= 10 # Years
CostRect=RPelzer*UCostRect;
round(CostRect,3) # $
#-
Costelzer
= ((UCostelzer*MH2*Lfelzer*Eelzer)/(Lfelzer*8760*CF_*effelzer))+
((0.4*UCostelzer*RPelzer)+(0.12*UCostelzer*RPelzer)+(0.04*UCostelzer*RPelzer)+(2*(CostRect+(0.04*CostRect))))
;round(Costelzer ,3)
#-
LCOEH2=
(Costelty + Costelzer)/(Lfelzer*MH2); round(LCOEH2,3)# $/Kg
#
#
https://sci-hub.se/http://dx.doi.org/10.1016/j.desal.2017.07.006
#
https://sci-hub.st/https://doi.org/10.1016/j.ijhydene.2020.07.050
#
https://sci-hub.se/https://doi.org/10.1016/j.ijhydene.2019.05.077
#
https://doi.org/10.1016/j.renene.2019.09.079
#
COST H2 Compressions
#
1Kg H2 = 11.13 NM3 (20°C / 1 atm).
effcomp=0.95 # % compression efficiency
dens= 36 # kg/m3 density of the compressed hydrogen at 800 bar, 25
C
QH2=MH2*effcomp/dens;
round(QH2,3) # volume m3/year of
compressed hydrogen
#
Totcost=1730000 # $ PLUS Gas holder |
2800 Nm3 capacity
#
QH2/2800 # Number of Gas Holder
#
1.05 kWh/kg H2 20 bar to 350 bar
and 1.36 kWh/kg H2 for 700 bar
https://www.hydrogen.energy.gov/pdfs/9013_energy_requirements_for_hydrogen_gas_compression.pdf
Ucostcomp=
15000 # $
Scalfact=0.9 #
COMcomp=4/100 # %
Encomp=
(0.7+1)/2 # kWh/kg
RPcomp=
10 # kW
effcomp=0.7 # %
liftcoomp=
20 # year
Costcomp=
Ucostcomp* ( ((MH2*Encomp)/8760)/RPcomp
)^Scalfact +
(0.04*(Ucostcomp*(((MH2*Encomp)/8760)/RPcomp )^Scalfact)); round(Costcomp,3)
#
#
CGH2 storage Hydrogen Storage - above ground type I vessels
capstg=
MH2*effcomp # MH2 kg/year
capstg1=
(MH2*142*0.277778)/360 # Mj TO
kWh/year
Ucoststg=
15.4 # $/kWh (10-19.7)
#
Coststg=Ucoststg*(capstg1/2); round(Coststg,3)
Coststg=
(14.95*MH2)/2 # $/kgH2
# 459*capstg
# USD/kg storage
# 800*capstg/2 # USD/kg storage
LCOEH2C=(Costelty
+ Costelzer + Costcomp+Coststg
)/(Lfelzer*MH2); round(LCOEH2C,3)# $/Kg
#
https://www.mdpi.com/1996-1073/15/17/6467
#
https://sci-hub.se/https://doi.org/10.1016/j.ijhydene.2006.05.009
#
https://sci-hub.se/https://doi.org/10.1016/j.ijhydene.2019.05.077
#
https://sci-hub.se/https://doi.org/10.1016/0360-3199(86)90104-7
#
https://sci-hub.se/10.1016/j.ijhydene.2010.11.090
#
https://sci-hub.se/https://doi.org/10.1016/j.enconman.2021.114125
#https://reader.elsevier.com/reader/sd/pii/S0306261920315750?token=44695E71F9780105912DA4318AA8D47ADE8966578337F50A45CFC055A3FA97AECD491DA1BFB4146EE978EA55D95268B1&originRegion=eu-west-1&originCreation=20230308185325
# 15 - COST OF RO:
Reversis Osmosis:
FreshH20=((1/0.08988)*MH2)/1000;
round(FreshH20,3) # m3/year
MH2*10.6 # 10.6 kg for 1kg H2
FreshH20/365 # m3/day
FreshH20/8760 # m3/day
EltyRO=
4.38*FreshH20 # KWh/m3 to kWh
LftRO=
25 # Years
#
CostRO=81000 # $
#
UcostRO= 2400
# ($/m3/d)
Hprod=FreshH20/8760 #
Hourly production in m3/hours
CostRO=24*UcostRO*
Hprod; round(CostRO,3) # $/m3
#
chro
=8760*0.03*Hprod # annual cost of the
chemicals
lro
=8760*0.05*Hprod # annual cost of
labours
rcro
=(0.2*(0.4*CostRO))+(0.1*(0.15*CostRO))+(0.1*(0.15*CostRO)) # annual cost of
replacement parts
COMRO=chro+lro+rcro #
tankcost=
2000 # $ 20m3 tank
FreshH20
#
int=8.7/100 # interest rate % 2021
idp=9.5/100 # discount rate % 2021
ifl=2.5/100 # inflation rate % 2021
i=(idp-ifl)/(1+ifl)
# weighted average cost of capital
CRF
=(i*((1+i)^LftRO))/((1+i)-1); round(CRF,3) # real discount rate
#
https://banque-centrale.dj/wp-content/uploads/2022/12/Rapport-annuel-2021-BCD.pdf
#
CosteltyRO=
LCOE*EltyRO # Cost electricity
produced/year
AProd=FreshH20 # annual water production of the
plant (m3 /year)
#
LCOERO=((CostRO+tankcost)*CRF
+(COMRO+(CosteltyRO)) )/(AProd*LftRO) ; round(LCOERO,3)#$/m3
LCOERO1=
(CostRO+COMROT)/AProdT; round(LCOERO1,3)#$/m3
#
COMROT=
(COMRO/(1+int)^1)+(COMRO/(1+int)^2)+(COMRO/(1+int)^3)+(COMRO/(1+int)^4)+(COMRO/(1+int)^5)
+
(COMRO/(1+int)^6)+(COMRO/(1+int)^7)+(COMRO/(1+int)^8)+(COMRO/(1+int)^9)+(COMRO/(1+int)^10) +
(COMRO/(1+int)^11)+(COMRO/(1+int)^12)+(COMRO/(1+int)^13)+(COMRO/(1+int)^14)+(COMRO/(1+int)^15) +
(COMRO/(1+int)^16)+(COMRO/(1+int)^17)+(COMRO/(1+int)^18)+(COMRO/(1+int)^19)+(COMRO/(1+int)^20) +
(COMRO/(1+int)^21)+(COMRO/(1+int)^22)+(COMRO/(1+int)^23)+(COMRO/(1+int)^24)+(COMRO/(1+int)^25)
#
AProdT=
(AProd/(1+int)^1)+(AProd/(1+int)^2)+(AProd/(1+int)^3)+(AProd/(1+int)^4)+(AProd/(1+int)^5)
+
(AProd/(1+int)^6)+(AProd/(1+int)^7)+(AProd/(1+int)^8)+(AProd/(1+int)^9)+(AProd/(1+int)^10) +
(AProd/(1+int)^11)+(AProd/(1+int)^12)+(AProd/(1+int)^13)+(AProd/(1+int)^14)+(AProd/(1+int)^15) +
(AProd/(1+int)^16)+(AProd/(1+int)^17)+(AProd/(1+int)^18)+(AProd/(1+int)^19)+(AProd/(1+int)^20) +
(AProd/(1+int)^21)+(AProd/(1+int)^22)+(AProd/(1+int)^23)+(AProd/(1+int)^24)+(AProd/(1+int)^25)
#
Costreverosmo=
((CostRO+tankcost)*CRF +(COMRO+(CosteltyRO) ))
#
NegliROcost= (Costelzer/CostRO)*100;
round(NegliROcost,3) # under 1%
CostH2O=
LCOERO1*FreshH20; round(CostH2O,3)
LCOEH2C1=(Costelty
+ Costelzer + Costcomp+Coststg+CostH2O
)/(Lfelzer*MH2); round(LCOEH2C1,3)# $/Kg
#
#
http://dx.doi.org/10.1016/j.desal.2017.07.006
#
https://www.mdpi.com/2071-1050/11/6/1691
#
https://sci-hub.se/https://doi.org/10.1016/j.ijhydene.2018.02.144
# 16 - COST OF Ammonia
NH3 Synthesis Loop – Haber Bosch synthesis:
#
IH2= 177 #
kg of H2 = 1kg NH3 mdpi
IN2= 823 #
kg of N2 = 1kg NH3 mdpi
MAH2=
MH2/IH2; round(MAH2,3) #
Apport pour transformation H2
MAN2=
(0.823*MAH2)/0.177; round(MAN2,3) # Apport pour transformation N2
MNH3=round(MAH2,3) #
kg NH3/year
#
#
Synthesis Loop – Haber Bosch synthesis
(HBS) :
MNH3/8760 # Kg/NH3/h
#
TonNH3=IH2*IN2; round(TonNH3,3) #
145,671 kg/H2-N2/ = 1000 kg NH3
UCostNH3=
3500 # US$/(kgNH3/h)
# UCostNH3= 378 ($/TON NH3)
h=24
CostNH3=UCostNH3*(MNH3/h)
# US$
CostNH3=UCostNH3*(MNH3/1000)
COMNH3=0.02*CostNH3 #
US$
ELTNH3=
0.64*MNH3 # kWh/Kg
CosteltyNH3=LCOE*ELTNH3 #
US$
lftHN3=30 # Year
idp=9.5/100 # discount rate % 2021
effNH3
= (0.5+0.8)/2 # Capacity factor
#
COMNH3T=
(COMNH3/(1+idp)^1)+(COMNH3/(1+idp)^2)+(COMNH3/(1+idp)^3)+(COMNH3/(1+idp)^4)+(COMNH3/(1+idp)^5)
+
(COMNH3/(1+idp)^6)+(COMNH3/(1+idp)^7)+(COMNH3/(1+idp)^8)+(COMNH3/(1+idp)^9)+(COMNH3/(1+idp)^10) +
(COMNH3/(1+idp)^11)+(COMNH3/(1+idp)^12)+(COMNH3/(1+idp)^13)+(COMNH3/(1+idp)^14)+(COMNH3/(1+idp)^15) +
(COMNH3/(1+idp)^16)+(COMNH3/(1+idp)^17)+(COMNH3/(1+idp)^18)+(COMNH3/(1+idp)^19)+(COMNH3/(1+idp)^20) +
(COMNH3/(1+idp)^21)+(COMNH3/(1+idp)^22)+(COMNH3/(1+idp)^23)+(COMNH3/(1+idp)^24)+(COMNH3/(1+idp)^25) +
(COMNH3/(1+idp)^26)+(COMNH3/(1+idp)^27)+(COMNH3/(1+idp)^28)+(COMNH3/(1+idp)^29)+(COMNH3/(1+idp)^30)
#
MNH3T=
(MNH3/(1+idp)^1)+(MNH3/(1+idp)^2)+(MNH3/(1+idp)^3)+(MNH3/(1+idp)^4)+(MNH3/(1+idp)^5) +
(MNH3/(1+idp)^6)+(MNH3/(1+idp)^7)+(MNH3/(1+idp)^8)+(MNH3/(1+idp)^9)+(MNH3/(1+idp)^10) +
(MNH3/(1+idp)^11)+(MNH3/(1+idp)^12)+(MNH3/(1+idp)^13)+(MNH3/(1+idp)^14)+(MNH3/(1+idp)^15) +
(MNH3/(1+idp)^16)+(MNH3/(1+idp)^17)+(MNH3/(1+idp)^18)+(MNH3/(1+idp)^19)+(MNH3/(1+idp)^20) +
(MNH3/(1+idp)^21)+(MNH3/(1+idp)^22)+(MNH3/(1+idp)^23)+(MNH3/(1+idp)^24)+(MNH3/(1+idp)^25) +
(MNH3/(1+idp)^26)+(MNH3/(1+idp)^27)+(MNH3/(1+idp)^28)+(MNH3/(1+idp)^29)+(MNH3/(1+idp)^30)
#
CosteltyNH3T=
(CosteltyNH3/(1+idp)^1)+(CosteltyNH3/(1+idp)^2)+(CosteltyNH3/(1+idp)^3)+(CosteltyNH3/(1+idp)^4)+(CosteltyNH3/(1+idp)^5) +
(CosteltyNH3/(1+idp)^6)+(CosteltyNH3/(1+idp)^7)+(CosteltyNH3/(1+idp)^8)+(CosteltyNH3/(1+idp)^9)+(CosteltyNH3/(1+idp)^10) +
(CosteltyNH3/(1+idp)^11)+(CosteltyNH3/(1+idp)^12)+(CosteltyNH3/(1+idp)^13)+(CosteltyNH3/(1+idp)^14)+(CosteltyNH3/(1+idp)^15) +
(CosteltyNH3/(1+idp)^16)+(CosteltyNH3/(1+idp)^17)+(CosteltyNH3/(1+idp)^18)+(CosteltyNH3/(1+idp)^19)+(CosteltyNH3/(1+idp)^20) +
(CosteltyNH3/(1+idp)^21)+(CosteltyNH3/(1+idp)^22)+(CosteltyNH3/(1+idp)^23)+(CosteltyNH3/(1+idp)^24)+(CosteltyNH3/(1+idp)^25) +
(CosteltyNH3/(1+idp)^26)+(CosteltyNH3/(1+idp)^27)+(CosteltyNH3/(1+idp)^28)+(CosteltyNH3/(1+idp)^29)+(CosteltyNH3/(1+idp)^30)
#
Cryogenic distillation - Air Separation Unit (ASU):
IH2= 177 #
kg of H2 = 1kg NH3 mdpi
IN2= 823 #
kg of N2 = 1kg NH3 mdpi
#
MNH3N2= MH2/IN2; round(MNH3,3) # Kg/NH3/Year
MAN2=
(0.823*MAH2)/0.177 # Apport pour
transformation N2
MNH3N2=round(MAN2,3)
#
ELTN2=
0.64*MNH3N2 # kWh/kgNH3
CosteltyN2=LCOE*ELTN2 #
US$
idp=9.5/100 # discount rate % 2021
lftN2=30 # Year
UCostN2=
(3500/2) # US$/(kgNH3/h) en considerons le NH3/2 VS 150$
IN
https://authors.library.caltech.edu/113944/1/cost-and-performance-targets-for-fully-electrochemical-ammonia-production-under-flexible-operation.pdf
CostN2=UCostN2*(MNH3N2/h) #
US$
COMN2=0.02*CostN2 # US$
#
https://www.frontiersin.org/articles/10.3389/fmech.2020.00021/full
#
https://sci-hub.se/https://doi.org/10.1016/j.ijhydene.2019.11.028
#
https://www.sciencedirect.com/science/article/pii/S2589004222009968
#
COMN2T=
(COMN2/(1+idp)^1)+(COMN2/(1+idp)^2)+(COMN2/(1+idp)^3)+(COMN2/(1+idp)^4)+(COMN2/(1+idp)^5)
+
(COMN2/(1+idp)^6)+(COMN2/(1+idp)^7)+(COMN2/(1+idp)^8)+(COMN2/(1+idp)^9)+(COMN2/(1+idp)^10) +
(COMN2/(1+idp)^11)+(COMN2/(1+idp)^12)+(COMN2/(1+idp)^13)+(COMN2/(1+idp)^14)+(COMN2/(1+idp)^15) +
(COMN2/(1+idp)^16)+(COMN2/(1+idp)^17)+(COMN2/(1+idp)^18)+(COMN2/(1+idp)^19)+(COMN2/(1+idp)^20) +
(COMN2/(1+idp)^21)+(COMN2/(1+idp)^22)+(COMN2/(1+idp)^23)+(COMN2/(1+idp)^24)+(COMN2/(1+idp)^25) +
(COMN2/(1+idp)^26)+(COMN2/(1+idp)^27)+(COMN2/(1+idp)^28)+(COMN2/(1+idp)^29)+(COMN2/(1+idp)^30)
#
MNH3N2T=
(MNH3N2/(1+idp)^1)+(MNH3N2/(1+idp)^2)+(MNH3N2/(1+idp)^3)+(MNH3N2/(1+idp)^4)+(MNH3N2/(1+idp)^5) +
(MNH3N2/(1+idp)^6)+(MNH3N2/(1+idp)^7)+(MNH3N2/(1+idp)^8)+(MNH3N2/(1+idp)^9)+(MNH3N2/(1+idp)^10) +
(MNH3N2/(1+idp)^11)+(MNH3N2/(1+idp)^12)+(MNH3N2/(1+idp)^13)+(MNH3N2/(1+idp)^14)+(MNH3N2/(1+idp)^15) +
(MNH3N2/(1+idp)^16)+(MNH3N2/(1+idp)^17)+(MNH3N2/(1+idp)^18)+(MNH3N2/(1+idp)^19)+(MNH3N2/(1+idp)^20) +
(MNH3N2/(1+idp)^21)+(MNH3N2/(1+idp)^22)+(MNH3N2/(1+idp)^23)+(MNH3N2/(1+idp)^24)+(MNH3N2/(1+idp)^25) +
(MNH3N2/(1+idp)^26)+(MNH3N2/(1+idp)^27)+(MNH3N2/(1+idp)^28)+(MNH3N2/(1+idp)^29)+(MNH3N2/(1+idp)^30)
#
CosteltyN2T=
(CosteltyN2/(1+idp)^1)+(CosteltyN2/(1+idp)^2)+(CosteltyN2/(1+idp)^3)+(CosteltyN2/(1+idp)^4)+(CosteltyN2/(1+idp)^5) +
(CosteltyN2/(1+idp)^6)+(CosteltyN2/(1+idp)^7)+(CosteltyN2/(1+idp)^8)+(CosteltyN2/(1+idp)^9)+(CosteltyN2/(1+idp)^10) +
(CosteltyN2/(1+idp)^11)+(CosteltyN2/(1+idp)^12)+(CosteltyN2/(1+idp)^13)+(CosteltyN2/(1+idp)^14)+(CosteltyN2/(1+idp)^15) +
(CosteltyN2/(1+idp)^16)+(CosteltyN2/(1+idp)^17)+(CosteltyN2/(1+idp)^18)+(CosteltyN2/(1+idp)^19)+(CosteltyN2/(1+idp)^20) +
(CosteltyN2/(1+idp)^21)+(CosteltyN2/(1+idp)^22)+(CosteltyN2/(1+idp)^23)+(CosteltyN2/(1+idp)^24)+(CosteltyN2/(1+idp)^25) +
(CosteltyN2/(1+idp)^26)+(CosteltyN2/(1+idp)^27)+(CosteltyN2/(1+idp)^28)+(CosteltyN2/(1+idp)^29)+(CosteltyN2/(1+idp)^30)
#
#
https://sci-hub.st/https://doi.org/10.1016/j.ijhydene.2020.07.050
#
https://reader.elsevier.com/reader/sd/pii/S0196890422011918?token=A7785FFA567B7BFE5F34C496E49417342B715E93B33961256F86B51C894B84662FDDBCA93C60A5720683E967E037D768&originRegion=eu-west-1&originCreation=20230302190319
#
https://reader.elsevier.com/reader/sd/pii/S0306261920315750?token=C64A094323493FDA541D94EE5057A3AE54BB3F890BFC8705092E40383E4B84FD63B4C2A313FB3FDF4739C794ABCB60DA&originRegion=eu-west-1&originCreation=20230302185312
#
https://sci-hub.se/10.3390/chemengineering3040087
#
https://sci-hub.se/https://doi.org/10.1016/j.renene.2020.05.041
#
https://sci-hub.st/https://doi.org/10.1016/j.est.2020.102201
#
https://doi.org/10.1016/j.apenergy.2019.114135
#
https://doi.org/10.1016/j.jclepro.2020.121627
#
https://sci-hub.se/https://doi.org/10.1016/j.compchemeng.2020.106785
#
https://reader.elsevier.com/reader/sd/pii/S019689042200108X?token=C09A58ACD295C3B3536C09776BB9024F90FF5557B2787E74DFF8DCE9A75432492405ABAC53A8F6B741F50AFFE8A922B5&originRegion=eu-west-1&originCreation=20230228200117
#
https://sci-hub.se/https://doi.org/10.1016/j.ijhydene.2021.05.203
#
#
COMPRESSION OF NH3 COST AND CAPACITY ANALYSIS
Ucostcomp=
15000 # $
Scalfact=0.9 #
COMcomp=4/100 # %
Encomp=
(0.7+1)/2 # kWh/kg
RPcomp=
10 # kW
effcomp=0.7 # %
Costcomp=
Ucostcomp* ( ((MH2*Encomp)/8760)/RPcomp
)^Scalfact + (0.04*Costcomp); round(Costcomp,3)
#
Ammonia Storage Tank – low temperature refrigerated storage
UCostNH3Stg
= 82
# USD/TNH3
CosteltyNH3stg= (0.03*LCOE*(MNH3+MNH3N2) ) #kWh/kg NH3
COMNH3stg= (0.02*((MNH3+MNH3N2)/1000)*UCostNH3Stg )
#
CostNH3Stg = ((MNH3/1000)*UCostNH3Stg) + CosteltyNH3stg + COMNH3stg;
round(CostNH3Stg,3)
CostNH3Stg=
0.54*MNH3
#
CostNH3StgT=
(CostNH3Stg/(1+idp)^1)+(CostNH3Stg/(1+idp)^2)+(CostNH3Stg/(1+idp)^3)+(CostNH3Stg/(1+idp)^4)+(CostNH3Stg/(1+idp)^5) +
(CostNH3Stg/(1+idp)^6)+(CostNH3Stg/(1+idp)^7)+(CostNH3Stg/(1+idp)^8)+(CostNH3Stg/(1+idp)^9)+(CostNH3Stg/(1+idp)^10) +
(CostNH3Stg/(1+idp)^11)+(CostNH3Stg/(1+idp)^12)+(CostNH3Stg/(1+idp)^13)+(CostNH3Stg/(1+idp)^14)+(CostNH3Stg/(1+idp)^15) +
(CostNH3Stg/(1+idp)^16)+(CostNH3Stg/(1+idp)^17)+(CostNH3Stg/(1+idp)^18)+(CostNH3Stg/(1+idp)^19)+(CostNH3Stg/(1+idp)^20) +
(CostNH3Stg/(1+idp)^21)+(CostNH3Stg/(1+idp)^22)+(CostNH3Stg/(1+idp)^23)+(CostNH3Stg/(1+idp)^24)+(CostNH3Stg/(1+idp)^25) +
(CostNH3Stg/(1+idp)^26)+(CostNH3Stg/(1+idp)^27)+(CostNH3Stg/(1+idp)^28)+(CostNH3Stg/(1+idp)^29)+(CostNH3Stg/(1+idp)^30)
#
46600*(MNH3^ 0.8636) + 536.9
#
182 day = 0.54$/kg NH3 et 14.95$/kgH2
#
#
https://reader.elsevier.com/reader/sd/pii/S0360128517302320?token=F66F9D6F6DE7B21170FF3C07E6565C42054D4773AA7DF24650D4111F20930ED4C3C2042C92C500634EEAECE69783E0BB&originRegion=eu-west-1&originCreation=20230308200723
#
https://reader.elsevier.com/reader/sd/pii/S0196890422011918?token=4370033D9407F0EA47D1EDA63800964875414F1656D45067BA68A0FAF42204D0D5A6A065931A74834D21E9DCABFA9F87&originRegion=eu-west-1&originCreation=20230304200434
#
https://reader.elsevier.com/reader/sd/pii/S0306261920315750?token=0FA270D57D4552998DC154169C907445F196FC1AAE6ABC12840BD4AB7E92603E8429A0D9699E666378BCE6BB15DC1EFE&originRegion=eu-west-1&originCreation=20230304200644
#
https://sci-hub.se/https://doi.org/10.1016/j.ijhydene.2018.06.121
#
LCOENH3=(
CostNH3 + CosteltyNH3T + COMNH3T + COMN2T + CostN2 + CosteltyN2T + CostNH3StgT
+ (2*Costcomp) )/ (MNH3T)
#
LCOENH3=( CostNH3 + CosteltyNH3T + COMNH3T + COMN2T + CostN2 + CosteltyN2T +
CostNH3Stg + (2*Costcomp) )/ (MNH3*lftHN3)
round(LCOENH3,3)
# $ 700 - 1400 per tonne a
#
https://reader.elsevier.com/reader/sd/pii/S2589004222009968?token=2FB83A58CD910EDBB392DC03F9F1BC7ED0F8FE32529AEC36B706AE03B186BD9A62FA0DE9D5EAB8E901AFE34EBA8273C3&originRegion=eu-west-1&originCreation=20230306123649
#
https://energypost.eu/renewable-ammonias-role-in-reducing-dependence-on-gas/#:~:text=Today's%20cost%20of%20renewable%20ammonia,USD%20610%2Ft%20by%202050.
# 17 - LH2-COST
Liquefaction of hydrogen cycle LHG # LNG = Fischer-Tropsch :
EltyLH2=
11*MH2 # kWh
CosteltyLH2=LCOE*EltyLH2 #
US$
idp=9.5/100 # discount rate % 2021
lftLH2=30 # Year
CapacbaseLH2=30000 # kg/day
capitbaseLH2=
40000000 # US$
scalfact=0.57 #
CostLH2=
capitbaseLH2*((MH2/365)/CapacbaseLH2)^scalfact
; round(CostLH2,3)
COMLH2=(4/100)
*(COMLH2*(capitbaseLH2*((MH2/365)/CapacbaseLH2)^scalfact ))
effLH2=(0.3+0.84)/2 # liquefaction efficiency 84- 30 %
ProdLH2=effLH2*MH2
#
https://www1.eere.energy.gov/hydrogenandfuelcells/analysis/pdfs/paster_h2_delivery.pdf
#
https://global.kawasaki.com/en/corp/rd/magazine/176/pdf/n176en10.pdf
#
CosteltyLH2T=
(CosteltyLH2/(1+idp)^1)+(CosteltyLH2/(1+idp)^2)+(CosteltyLH2/(1+idp)^3)+(CosteltyLH2/(1+idp)^4)+(CosteltyLH2/(1+idp)^5)
+
(CosteltyLH2/(1+idp)^6)+(CosteltyLH2/(1+idp)^7)+(CosteltyLH2/(1+idp)^8)+(CosteltyLH2/(1+idp)^9)+(CosteltyLH2/(1+idp)^10) +
(CosteltyLH2/(1+idp)^11)+(CosteltyLH2/(1+idp)^12)+(CosteltyLH2/(1+idp)^13)+(CosteltyLH2/(1+idp)^14)+(CosteltyLH2/(1+idp)^15) +
(CosteltyLH2/(1+idp)^16)+(CosteltyLH2/(1+idp)^17)+(CosteltyLH2/(1+idp)^18)+(CosteltyLH2/(1+idp)^19)+(CosteltyLH2/(1+idp)^20) +
(CosteltyLH2/(1+idp)^21)+(CosteltyLH2/(1+idp)^22)+(CosteltyLH2/(1+idp)^23)+(CosteltyLH2/(1+idp)^24)+(CosteltyLH2/(1+idp)^25) +
(CosteltyLH2/(1+idp)^26)+(CosteltyLH2/(1+idp)^27)+(CosteltyLH2/(1+idp)^28)+(CosteltyLH2/(1+idp)^29)+(CosteltyLH2/(1+idp)^30)
#
#
COMPRESSION OF LH2 COST AND CAPACITY ANALYSIS
Ucostcomp=
15000 # $
Scalfact=0.9 #
COMcomp=
4/100 # %
Encomp=
(0.7+1)/2 # kWh/kg
RPcomp=
10 # kW
effcomp=0.7 # %
Costcomp=
Ucostcomp* ( ((MH2*Encomp)/8760)/RPcomp
)^Scalfact + (0.04*Costcomp); round(Costcomp,3)
#
#
LH2 storage Hydrogen Storage - above ground type I vessels
#
capstg= MH2*effcomp # MH2
kg/year
#
capstg1= (MH2*142*0.277778)/360 # Mj
TO kWh/year
#
Ucoststg= 15.4 #
$/kWh (10-19.7)
#
Coststg=Ucoststg*(capstg1/2); round(Coststg,3)
#
STOCKAGE OF LH2
#*#
TankLH2=
650000 #$ LH2 tank cost
LH2stg= 90 # $/kgH2
COMstgLH2=4/100
#
coststgLH2=LH2stg*MH2+(LH2stg*MH2*COMstgLH2); round(coststgLH2,3)
coststgLH2
= 1.2* (ProdLH2*142*0.277778)/360
#
coststgLH2T=
(coststgLH2/(1+idp)^1)+(coststgLH2/(1+idp)^2)+(coststgLH2/(1+idp)^3)+(coststgLH2/(1+idp)^4)+(coststgLH2/(1+idp)^5)
+
(coststgLH2/(1+idp)^6)+(coststgLH2/(1+idp)^7)+(coststgLH2/(1+idp)^8)+(coststgLH2/(1+idp)^9)+(coststgLH2/(1+idp)^10) +
(coststgLH2/(1+idp)^11)+(coststgLH2/(1+idp)^12)+(coststgLH2/(1+idp)^13)+(coststgLH2/(1+idp)^14)+(coststgLH2/(1+idp)^15) +
(coststgLH2/(1+idp)^16)+(coststgLH2/(1+idp)^17)+(coststgLH2/(1+idp)^18)+(coststgLH2/(1+idp)^19)+(coststgLH2/(1+idp)^20) +
(coststgLH2/(1+idp)^21)+(coststgLH2/(1+idp)^22)+(coststgLH2/(1+idp)^23)+(coststgLH2/(1+idp)^24)+(coststgLH2/(1+idp)^25) +
(coststgLH2/(1+idp)^26)+(coststgLH2/(1+idp)^27)+(coststgLH2/(1+idp)^28)+(coststgLH2/(1+idp)^29)+(coststgLH2/(1+idp)^30)
#
#
https://sci-hub.se/https://doi.org/10.1016/j.ijhydene.2012.07.019
#
https://sci-hub.se/https://doi.org/10.1016/j.ijhydene.2021.05.203
#
https://www.mdpi.com/1996-1073/15/17/6467
#
https://sci-hub.st/https://doi.org/10.1016/S0360-3199(97)00101-8
#
https://sci-hub.st/https://doi.org/10.1016/j.ijhydene.2020.07.050
#
https://sci-hub.se/https://doi.org/10.1016/j.ijhydene.2006.05.009
#
https://sci-hub.se/https://doi.org/10.1016/j.ijrefrig.2019.11.004
#
https://www.idealhy.eu/uploads/documents/IDEALHY_XX_Energie-Symposium_2013_web.pdf
#
https://iea.blob.core.windows.net/assets/a02a0c80-77b2-462e-a9d5-1099e0e572ce/IEA-The-Future-of-Hydrogen-Assumptions-Annex.pdf
#
COMLH2T=
(COMLH2/(1+idp)^1)+(COMLH2/(1+idp)^2)+(COMLH2/(1+idp)^3)+(COMLH2/(1+idp)^4)+(COMLH2/(1+idp)^5)
+
(COMLH2/(1+idp)^6)+(COMLH2/(1+idp)^7)+(COMLH2/(1+idp)^8)+(COMLH2/(1+idp)^9)+(COMLH2/(1+idp)^10) +
(COMLH2/(1+idp)^11)+(COMLH2/(1+idp)^12)+(COMLH2/(1+idp)^13)+(COMLH2/(1+idp)^14)+(COMLH2/(1+idp)^15) +
(COMLH2/(1+idp)^16)+(COMLH2/(1+idp)^17)+(COMLH2/(1+idp)^18)+(COMLH2/(1+idp)^19)+(COMLH2/(1+idp)^20) +
(COMLH2/(1+idp)^21)+(COMLH2/(1+idp)^22)+(COMLH2/(1+idp)^23)+(COMLH2/(1+idp)^24)+(COMLH2/(1+idp)^25) +
(COMLH2/(1+idp)^26)+(COMLH2/(1+idp)^27)+(COMLH2/(1+idp)^28)+(COMLH2/(1+idp)^29)+(COMLH2/(1+idp)^30)
#
#
ProdLH2T=
(ProdLH2/(1+idp)^1)+(ProdLH2/(1+idp)^2)+(ProdLH2/(1+idp)^3)+(ProdLH2/(1+idp)^4)+(ProdLH2/(1+idp)^5) +
(ProdLH2/(1+idp)^6)+(ProdLH2/(1+idp)^7)+(ProdLH2/(1+idp)^8)+(ProdLH2/(1+idp)^9)+(ProdLH2/(1+idp)^10) +
(ProdLH2/(1+idp)^11)+(ProdLH2/(1+idp)^12)+(ProdLH2/(1+idp)^13)+(ProdLH2/(1+idp)^14)+(ProdLH2/(1+idp)^15) +
(ProdLH2/(1+idp)^16)+(ProdLH2/(1+idp)^17)+(ProdLH2/(1+idp)^18)+(ProdLH2/(1+idp)^19)+(ProdLH2/(1+idp)^20) +
(ProdLH2/(1+idp)^21)+(ProdLH2/(1+idp)^22)+(ProdLH2/(1+idp)^23)+(ProdLH2/(1+idp)^24)+(ProdLH2/(1+idp)^25) +
(ProdLH2/(1+idp)^26)+(ProdLH2/(1+idp)^27)+(ProdLH2/(1+idp)^28)+(ProdLH2/(1+idp)^29)+(ProdLH2/(1+idp)^30)
#
#
LCOELH2= ( CostLH2 + coststgLH2+ CosteltyLH2+ COMLH2T )/(ProdLH2T) ;
round(LCOELH2,3)
LCOELH2=
( CostLH2 + coststgLH2T + CosteltyLH2T + COMLH2T )/(ProdLH2T) ;
round(LCOELH2,3)
# cost of LH2 cargo USD$30/kg
# $ 14.25 per kilogram of hydrogen
#
PURIFICATION SYSTEM H2 NH3 LH2
#
H2purification=
1.1 # kWh/kgH2
#https://iea.blob.core.windows.net/assets/a02a0c80-77b2-462e-a9d5-1099e0e572ce/IEA-The-Future-of-Hydrogen-Assumptions-Annex.pdf
# 18 - CO2 -
CORBONE EMISSION SAVED AND ECONOMIC :
EFfuel=
0.277 # CO2_fuel-oil kCO2/kWh
EFngas=
0.20 # CO2_natural gas kCO2/kWh
EFcoal=0.8 # CO2_coal t/MWh
Prodtotkwh= # Yearly production in kWh
Totemfuel= (EFfuel*Prodtotkwh )/1000 # TonnesCO2/Year
#
PxCO2_2017=
5 # 2017 CO2 prices (USD/tCO2)
PxCO2_2030=
100 # 2030 CO2 prices (USD/tCO2)
PTCO2_2017=
PxCO2_2017* Totemfuel # USD CO2
PTCO2_2030=
PxCO2_2030* Totemfuel # USD CO2
#
#
https://iea.blob.core.windows.net/assets/a02a0c80-77b2-462e-a9d5-1099e0e572ce/IEA-The-Future-of-Hydrogen-Assumptions-Annex.pdf
#
https://sci-hub.se/https://doi.org/10.1016/j.renene.2019.09.079
#
https://reader.elsevier.com/reader/sd/pii/S0360319922016019?token=E9EEE5B9DEB8EB04524A6903FE2F24E1AED1A971306E8F07C54F604FE192B8BF1A6D54C55601BB498F1F6CE5870D5926&originRegion=eu-west-1&originCreation=20230307183207
# 19 - Transport Cost OF
NH3/ LH2/ Sea / Rail/ TRUCK:
CostTrucks=
(4+12)/2 # 4 - 12$/kg
CostTruckDistrbLH2
= 0.13
# Distribution US$/(kg*100km)
CostTruckDistrbNH3
= 0.12
# Distribution US$/(kg*100km)
CostPipeline
= 4 # < 2
$/kg
RailcostGH2=
21681 # Rail shipment to
staging area ($/km)
RailcostlH2=
4152
#
int=8.7/100 # interest rate % 2021
idp=9.5/100 # discount rate % 2021
ifl=2.5/100 # inflation rate % 2021
i=(idp-ifl)/(1+ifl)
# weighted average cost of capital
CRF=(i*((1+i)^shiplife))/((1+i)-1);
round(CRF,3) # real discount rate/ annuity factor
#
shipcpcost= 39.2*10^6
# EURO
shipopex= 3.5/100
# %
unload_upoadtime= 2 #
day
avaibilifacrtor= 0.95 # %
speed= 16 # KNOTS
fuelconsm=
0.0082 # kWhth/DWT-km
fuelprice=(20+80)/2 # €EURO/MWhth 20-80
cargoshare= 0.9
# %
distance=
1000 # km
shiplife=
25 # year
Shipcapacity
= 20600 # m3
#
LCOEshipNH3=
(
(shipcpcost*(CRF+shipopex))/(365*avaibilifacrtor*Shipcapacity)/(2*distance+(unload_upoadtime*speed)/speed) ) + (
(fuelconsm*2*distance*fuelprice)/cargoshare )
round(LCOEshipNH3,3)
*1.06 # $/tonnes NH3
# 1 € = 1.06 # (07/03/2023)
#
#
JAMILA LH2 carrier ship
shipcpcost1= 500*10^6
# EURO
shipopex1= 2/100
# %
unload_upoadtime1= 1 #
day
avaibilifacrtor1= 0.95 # %
speed1= 20 # KNOTS
fuelconsm1=
0.0082 # kWhth/DWT-km
fuelprice1=(20+80)/2 # €EURO/MWhth 20-80
cargoshare1= 0.9
# %
distance1=
1000 # km
shiplife1=
30 # year
Shipcapacity1
= (1136000/1000)*11.126 # tonne to m3 LH2 tanker ship
#
LCOEshipLH2=
(
(shipcpcost1*(CRF+shipopex1))/(365*avaibilifacrtor1*Shipcapacity1)/(2*distance1+(unload_upoadtime1*speed1)/speed1) ) + (
(fuelconsm1*2*distance1*fuelprice1)/cargoshare1 )
round(LCOEshipLH2,3)
*1.06 # $/tonnes NH3
#
CargoshipLH2= 6 # USD$/kg
#
#
https://reader.elsevier.com/reader/sd/pii/S0306261920315750?token=9E119D358BBF9F9935E10039D15435B83C0811AFDE0AED6A8761B47BC3B9F0A74358E047096B65408529EF6C1CF32976&originRegion=eu-west-1&originCreation=20230307184433
#
https://sci-hub.se/https://doi.org/10.1016/j.ijhydene.2021.05.002
#
https://sci-hub.se/https://doi.org/10.1016/j.ijhydene.2021.05.203
#
https://reader.elsevier.com/reader/sd/pii/S0360319922028038?token=AB7838DD3E2866AE23C6804236873880FAC598F888A89DCF166E2DFD0A36748A972FE5C3D4DC7D0E1554E11C2051E9F1&originRegion=eu-west-1&originCreation=20230307182317
#
https://www1.eere.energy.gov/hydrogenandfuelcells/analysis/pdfs/paster_h2_delivery.pdf
#
https://sci-hub.st/https://doi.org/10.1016/j.ijhydene.2020.07.050
#
https://reader.elsevier.com/reader/sd/pii/S0360319922016019?token=5FCE186935791E627AA17267A617E55237367543CE46E25052D7E89E2787884DAECFAC677CB891F2F023BF1D3611E148&originRegion=eu-west-1&originCreation=20230302185054
#
https://doi.org/10.1016/j.ijhydene.2022.06.168
#
https://sci-hub.st/https://doi.org/10.1016/j.apenergy.2019.114135
#
https://reader.elsevier.com/reader/sd/pii/S036031992203659X?token=3124A5D1ADC71A4112A734F2012D0A2D41D99B6984C6A1F5F210BF577D498B20655FC98163C6C09CEB341278AA667F37&originRegion=eu-west-1&originCreation=20230307185136
#
Pipeline capital costs ($/km) $1869 #
#
DiamPip= # 0-20 inch diameter in inches
costpip= 1869 (DiamPip)^2 # USD
$/km
round(costpip,3)
#
https://sci-hub.se/https://doi.org/10.1016/j.ijhydene.2006.05.009
#
NH3 and H2 Fuel Cell Power Generator
#
BENEFIT and Economic Risk OF TRANSPORT NH3/LN2
# 20 - GEOTHERMAL ENERGY ASSESSMENT:
# USGS VOLUMETRIC METHOD WITH MONTE CARLO
SIMULATION
#Interpolation lineaire
#http://www.iotafinance.com/Formule-Interpolation-Lineaire.html
rm(list=ls())
x=276.8; x1=275; x2=280; y1=5946.4; y2=6416.4
y= (y1+
((x-x1)/(x2-x1))* (y2-y1)) ;y
rm(list=ls())
#
Initial Condition
A= 3.25*10e+5
h= 1175
piw= 973
cw= 4500
pir= 2500
cr= 875
p= 0.0505
ti= 306
tf= 110
rf= 0.125
lf= 0.935
ls= 25
* 365.25 *24*3600
eff= 0.255
#
# USGS VOLUMETRIC METHOD FOR CAPACITY
#Diametre
of Well m
300
#Area m? 70 685.835
#Triangular
#Thickness m 2 000
#Triangular
#Fluid
Density kg/m3
890
#Fluid
specific Heat Capacity J/kg?C 4 800
#Rock
Density kg/m3 2 670
#Rock
Specific Heat Capacity J/kg?C 900 #
Triangular
#ReferenceTemperature
?C 280 # Triangular
#Final
Temperature ?C 40
#Pororsity
-- 0.1 #Lognormal
#Well
Volum m3 141 371 669.412
#Rock
Volumetric Heat specific J/m3?C 2 403 000.000
#Fluid
Volumetric Heat specific J/m3?C 4 272 000.000
#Temperature
of Well ?C
240.000
#Rock
Energy MJ
73 378 682 264.721
#Fluid
Energy MJ
14 494 554 521.426
#Total
Energy MJ
87 873 236 786.148
#Recovery
Factor %
0.20 # Uniform
#Conversion
Efficiency % 0.110
#Load
Factor %
0.950 # Triangular
#Life
time yr 25
#Life
time s 788 940 000
#Potential
Geothermal Capacity MW
2.579
#
#A=70685.835;
h=2000; piw=890; cw=4800; pir=2670; cr=900; p=0.1; ti=280;
tf=40;rf=0.2;lf=0.95; ls=25*365.25*24*3600; eff=0.11
#Qr
= A*h*(ti-tf)*((1-p)*pir*cr); Qw =
A*h*(ti-tf)*(p*piw*cw)
#Qt=((Qr+Qw)/1000000);
Qt
#PPG=(Qt*rf*eff)/(lf*ls);
PPG
#A=1146681;
h=800; piw=1126; cw=4500; pir=2750; cr=875; p=0.03; ti=320;
tf=105;rf=0.175;lf=0.925; ls= 25 *
365.25 *24*3600; eff=0.12
#Qr
= A*h*(ti-tf)*((1-p)*pir*cr); Qw =
A*h*(ti-tf)*(p*piw*cw)
#Qt=((Qr+Qw)/1000000);
Qt
#PPG=(Qt*rf*eff)/(lf*ls);
PPG
#
#
RESULTAT METHODE VOLUMETRQIUE:
#*-*-*-
10^6 = 10e+5 = 1e+6
A=3.25*10e+5;
h=1175; piw=973; cw=4500; pir=2500; cr=875; p=0.0505; ti=306;
tf=110;rf=0.125;lf=0.935; ls= 25 *
365.25 *24*3600; eff=0.255
Qr
= A*h*(ti-tf)*((1-p)*pir*cr); Qw =
A*h*(ti-tf)*(p*piw*cw)
Qt=((Qr+Qw)/1000000);
Qt
PPG=(Qt*rf*eff)/(lf*ls);
PPG
w=(Qw/1000000)
/Qt;w*100 ; round(w*PPG,3)
r=(Qr/1000000)
/Qt;r*100 ; round(r*PPG,3)
PPG=(((Qt))*rf*eff)/(lf*ls);
PPG
#
#SIMULATION
#set.seed(123)
set.seed(12345)
#
1
area=runif(1000000,
min=2.5 , max=4)
mode
<- function(v1) {
uniqv <- unique(v1)
uniqv[which.max(tabulate(match(v1, uniqv)))]
}; v1 <-area
require(EnvStats);
sarea=rtri(1000000, min = min(v1), max = max(v1), mode = mode(v1))
round(summary(sarea),3)
#
set.seed(12345)
# 2
thickness=runif(1000000,
min=850 , max=1500)
mode
<- function(v2) {
uniqv <- unique(v2)
uniqv[which.max(tabulate(match(v2, uniqv)))]
}; v2
<-thickness
require(EnvStats);
sthickness=rtri(1000000, min = min(v2), max = max(v2), mode = mode(v2))
round(summary(sthickness),3)
#
3
#Fluid
Density kg/m3 : Constant
973
#
4
#
Fluid specific Heat Capacity J/kg?C: Constant
4500
#
5
#
Rock Density kg/m3 : Constant
2500
#
set.seed(12345)
#
6
rockheat=runif(1000000,
min=850 , max=900)
mode
<- function(v3) {
uniqv <- unique(v3)
uniqv[which.max(tabulate(match(v3, uniqv)))]
}; v3
<-rockheat
require(EnvStats);
srockheat=rtri(1000000, min = min(v3), max = max(v3), mode = mode(v3))
round(summary(srockheat),3)
set.seed(12345)
#
7
reftemp=runif(1000000,
min=253 , max=359)
mode
<- function(v5) {
uniqv <- unique(v5)
uniqv[which.max(tabulate(match(v5, uniqv)))]
};
v5 <-reftemp
require(EnvStats);
sreftemp=rtri(1000000, min = min(v5), max = max(v5), mode = mode(v5))
round(summary(sreftemp),3)
#
#
8
#Final
Temperature ?C : Constant
110
set.seed(12345)
#
9
require(stats)
por=runif(1000000,
min=0.01, max=0.1) # 0.001 to 0.1 max =3 en porosity
spor=rlnorm(1000000,
meanlog = mean(log(por)), sdlog = sd(log(por)))
round(summary(spor),3)
#
set.seed(12345)
#
10
recovfact=runif(1000000,
min=0.05 , max=0.2)
mode
<- function(v4) {
uniqv <- unique(v4)
uniqv[which.max(tabulate(match(v4, uniqv)))]
}; v4
<-recovfact
require(EnvStats);
srecovfact=rtri(1000000, min = min(v4), max = max(v4), mode = mode(v4))
round(summary(recovfact),3)
#
set.seed(12345)
#
11
reconff=runif(1000000,
min=0.11 , max=0.40)
mode
<- function(v8) {
uniqv <- unique(v8)
uniqv[which.max(tabulate(match(v8, uniqv)))]
};
v8 <-reconff
require(EnvStats);
sreconff=rtri(1000000, min = min(v8), max = max(v8), mode = mode(v8))
round(summary(sreconff),3)
#
set.seed(12345)
#
12
loadfac=runif(1000000,
min=0.92 , max=0.95)
mode
<- function(v7) {
uniqv <- unique(v7)
uniqv[which.max(tabulate(match(v7, uniqv)))]
}; v7 <-loadfac
require(EnvStats);
sloadfac=rtri(1000000, min = min(v7), max = max(v7), mode = mode(v7))
round(summary(sloadfac),3)
ANOMLALY
SIMULATION| GRAPHICS ANALYSIS OF MONTE CARLO|
# 1
sar=hist(sarea,freq=FALSE,
breaks = 139, col = "steelblue", xlab="Area m?",
ylab="Distribution Probvability (%)", main=NA);dev.off() #cbind(sar$mids,sar$density)
cbind(quantile(sarea,
probs = c(0.05, 0.95)))
cuts
<- cut(sar$breaks, c(-Inf,2.616823,
3.686680 ,Inf))
plot(sar,freq=F,
border = "green",
col=c("red","blue","red")[cuts],xlab="Area of
Geothermal in m?", ylab="Distribution Probvability (%)",
main=NA)
par(new=TRUE);plot(sar,freq=F, border = "green",
col=c("red","blue","red")[cuts],xlab="Area of
Geothermal in m?", ylab="Distribution Probvability (%)",
main=NA)
library(lattice);
histogram(~sarea,breaks = 1390, col = "blue", xlab=NA, ylab=NA,
main=NA)
#grid(col="black",
lwd=1, lty= 1)
# 2
sth=hist(sthickness,freq=FALSE,
breaks = 139, col = "steelblue", xlab=NA, ylab=NA, main=NA);dev.off()
cbind(quantile(sthickness,
probs = c(0.05, 0.95)))
cuts
<- cut(sth$breaks, c(-Inf, 9800.1583 , 14306.6290
,Inf))
plot(sth,
freq=F, border = "green",
col=c("red","blue","red")[cuts],xlab="Thickness
of Geothermal in m",
ylab="Distribution Probvability (%)", main=NA)
par(new=TRUE);plot(sth,freq=F, border = "green",
col=c("red","blue","red")[cuts],xlab="Thickness
of Geothermal in m", ylab="Distribution
Probvability (%)", main=NA)
library(lattice);
histogram(~sthickness,breaks = 1309, col = "blue", xlab=NA, ylab=NA,
main=NA)
#grid(col="black",
lwd=1, lty= 1)
#cbind(sth$mids,sth$density)
# 3
srec=hist(recovfact
,freq=FALSE, breaks = 139, col = "steelblue", xlab=NA, ylab=NA,
main=NA);dev.off()
cbind(quantile(recovfact,
probs = c(0.05, 0.95)))
cuts
<- cut(srec$breaks, c(-Inf, 0.050750115 ,
0.19249012 ,Inf))
plot(srec,
freq=F, border = "green",
col=c("red","blue","red")[cuts],xlab="Recovery
Factor of Geothermal",
ylab="Distribution Probvability (%)", main=NA)
par(new=TRUE);plot(srec,
freq=F, border = "green",
col=c("red","blue","red")[cuts],xlab="Recovery
Factor of Geothermal",
ylab="Distribution Probvability (%)", main=NA)
library(lattice);
histogram(~recovfact,breaks = 139, col = "blue", xlab=NA, ylab=NA,
main=NA)
#grid(col="black",
lwd=1, lty= 1)
#cbind(sth$mids,sth$density) cbind(srec$mids,sro$density)
#
4
sro=hist(srockheat,freq=FALSE,
breaks = 139, col = "steelblue", xlab=NA, ylab=NA, main=NA);dev.off()
cbind(quantile(srockheat,
probs = c(0.05, 0.95)))
cuts
<- cut(sro$breaks, c(-Inf, 8013.5114 ,
882.1791 ,Inf))
plot(sro,freq=F, border = "green",
col=c("red","blue","red")[cuts],xlab="Heat
Specific of Rock of Geothermal in
J/kg?C", ylab="Distribution Probvability (%)", main=NA)
par(new=TRUE);plot(sro,freq=F, border = "green",
col=c("red","blue","red")[cuts],xlab="Heat
Specific of Rock of Geothermal in J/kg?C",
ylab="Distribution Probvability (%)", main=NA)
library(lattice);
histogram(~srockheat,breaks = 139, col = "blue", xlab=NA, ylab=NA,
main=NA)
#cbind(sro$mids,sro$density)
# 5
sref=hist(sreftemp,freq=FALSE,
breaks = 139, col = "steelblue", xlab=NA, ylab=NA, main=NA);dev.off()
cbind(quantile(sreftemp,
probs = c(0.05, 0.95)))
cuts
<- cut(sref$breaks, c(-Inf,2606.3791 , 3309.4234 ,Inf))
plot(sref,freq=F, border = "green",
col=c("red","blue","red")[cuts],xlab="Reference
Temperature of Geothermal in ?C",
ylab="Distribution Probvability (%)", main=NA)
par(new=TRUE);plot(sref,freq=F, border = "green",
col=c("red","blue","red")[cuts],xlab="Reference
Temperature of Geothermal in ?C",
ylab="Distribution Probvability (%)", main=NA)
library(lattice);
histogram(~srockheat,breaks = 1309, col = "blue", xlab=NA, ylab=NA,
main=NA)
#cbind(sref$mids,sref$density)
# 6
sporo=hist(spor,freq=FALSE,
breaks = 1390, col = "steelblue", xlab=NA, ylab=NA,
main=NA);dev.off()
cbind(quantile(spor,
probs = c(0.05, 0.95)))
cuts
<- cut(sporo$breaks, c(-Inf, 0.01806123
, 0.12488512 ,Inf))
plot(sporo,
freq=F, border = "green",
col=c("red","blue","red")[cuts],xlab="Porosity
for Geothermal",
ylab="Distribution Probvability (%)", main=NA)
par(new=TRUE);plot(sporo,freq=F, border = "green",
col=c("red","blue","red")[cuts],xlab="Porosity
for Geothermal", ylab="Distribution
Probvability (%)", main=NA)
library(lattice);
histogram(~spor,breaks = 139, col = "blue", xlab=NA, ylab=NA,
main=NA)
#cbind(sporo$mids,sporo$density)
# 7
slfact=hist(sloadfac,freq=FALSE,
breaks = 139, col = "steelblue", xlab=NA, ylab=NA, main=NA);dev.off()
cbind(quantile(sloadfac,
probs = c(0.05, 0.95)))
cuts
<- cut(slfact$breaks, c(-Inf,
0.9264786 , 0.9482947
,Inf))
plot(slfact,freq=F, border = "green",
col=c("red","blue","red")[cuts],xlab="Load
Factor for Geothermal",
ylab="Distribution Probvability (%)", main=NA)
par(new=TRUE);plot(slfact,freq=F, border = "green",
col=c("red","blue","red")[cuts],xlab="Load
Factor for Geothermal", ylab="Distribution
Probvability (%)", main=NA)
library(lattice);
histogram(~sloadfac,breaks = 139, col = "blue", xlab=NA, ylab=NA,
main=NA)
#cbind(sporo$mids,sporo$density)
#cbind(slfac$mids,slfac$density)
# 8
ssreconff=hist(sreconff,freq=FALSE,
breaks = 139, col = "steelblue", xlab=NA, ylab=NA, main=NA);dev.off()
cbind(quantile(sreconff,
probs = c(0.05, 0.95)))
cuts
<- cut(ssreconff$breaks, c(-Inf, 0.15074837 ,
0.35059197 ,Inf))
plot(ssreconff,freq=F, border = "green",
col=c("red","blue","red")[cuts],xlab="conversion
Efficiency for Geothermal", ylab="Distribution
Probvability (%)", main=NA)
par(new=TRUE);plot(ssreconff,
freq=F, border = "green",
col=c("red","blue","red")[cuts],xlab="conversion
Efficiency for Geothermal",
ylab="Distribution Probvability (%)", main=NA)
library(lattice);
histogram(~sreconff,breaks = 139, col = "blue", xlab=NA, ylab=NA,
main=NA)
#cbind(ssreconff,sporo$density)
#cbind(ssreconff,slfac$density)
#SGS
VOLUMETRIC | MONTE CARLO METHOD FOR CAPACITY
*
set.seed(12345)
SQr
= sarea*(10e5)*sthickness*(sreftemp-tf)*((1-spor)*pir*srockheat); SQw =
sarea*sthickness*(sreftemp-tf)*(spor*piw*cw)
SQt=((SQr+SQw)/1000000)
summary(SQr)
summary(SQw)
summary(SQt)
SPPG=(SQt*recovfact* sreconff )/(sloadfac*ls) # sreconff
#eff
round(cbind(summary(SPPG)),
3)
round(kurtosis(SPPG),
3)
round(skewness(SPPG),3)
round(sd(SPPG),
3)
round(var(SPPG),
3)
round(cbind(quantile(SPPG,
probs =
c(0.05,0.10,0.15,0.20,0.25,0.30,0.324,0.35,0.40,0.45,0.50,0.55,0.60,0.65,0.70,0.75,0.80,0.85,
0.90,0.95))), 3)
#
DENSITY GEOTHERMAL
quantile(SPPG,
probs = 0.10)
p10=28.385
p10=28.761
mostlikelyarea
=3.25
p10/mostlikelyarea
summary(data.frame(SPPG,sarea,sthickness,sreftemp,spor,srockheat,recovfact,sloadfac,sreconff))
#
#
Histogram uni/biways
#https://www.r-bloggers.com/2014/09/5-ways-to-do-2d-histograms-in-r/
#https://stackoverflow.com/questions/21858394/partially-color-histogram-in-r
smw=hist(SPPG,
freq=FALSE, breaks = 139, xlab=NA, ylab=NA, main=NA, col
="blue",border = "red", plot=T) # density = 10
lines(density(SPPG),lwd
= 1, col = "green")
cbind(smw$mids,smw$density)
cbind(quantile(SPPG,
probs = c(0.05, 0.95)))
cuts
<- cut(smw$breaks, c(-Inf, 203.46199 , 1108.80007
,Inf))
plot(smw,freq=FALSE,
border = "green",
col=c("red","blue","red")[cuts], main=NA)
par(new=TRUE);
plot(smw,freq=FALSE, border = "green",
col=c("red","blue","red")[cuts], main=NA)
par(new=TRUE);
plot(smw$mids,freq=FALSE,smw$density,type="b", lty=1, lwd=0.5,
axe=FALSE, pch=20, xlab=NA, ylab=NA, main=NA, col="red", cex=1)
# LEGEND
plot(smw$mids,freq=FALSE,smw$density,type="b",
lty=1, lwd=0.5, axe=FALSE, pch=20, xlab=NA, ylab=NA, main=NA,
col="white", cex=1)
legend("topright",
legend=c("Density Function (%)"),text.font=15,
col=c("red"), lty=1, pch=15,
lwd =1, cex=1,
box.lty=2, box.lwd=2,
box.col="white",bg="white" )
legend("topleft",
legend=c("Range: 5%-95%","Range: 0%-5% and
95%-100%"),text.font=15,
fill=c("blue","red"),border = "green",
box.lty=2, box.lwd=2, box.col="white",bg="white" )
#
Method 2 Histogram
#abline(v=c(0.8530387,5.6167172))
x11()
library(lattice)
histogram(~SPPG,breaks
= 139, col = "blue", xlab=NA, ylab=NA, main=NA)
#
Method 3 Histogram
smw=hist(SPPG,
freq=FALSE, breaks = 139, xlab=NA, ylab=NA, main=NA, col
="purple3",border = "yellow", plot=T) # density = 10
cbind(quantile(SPPG,
probs = c(0.1, 0.5,0.90)))
abline(v=28.76130,
lwd=0.5, col="darkgreen",lty=1) #legend( 13.48386, 0.018
,"5%= 13.48", cex=0.65,bg="white")
abline(v=69.36526,
lwd=0.5, col="darkgreen",lty=1)
abline(v=140.76479,
lwd=0.5, col="darkgreen",lty=1)
#Cumulative
Distribution
#https://www.jarad.me/courses/stat587Eng/labs/lab03/lab03.html
#csppg=ecdf(SPPG) cumsum(x) cumprod(x) cummax(x) cummin(x)
#hist(cumsum(smw$density),
freq=FALSE, breaks = 139, xlab=NA, ylab=NA, main=NA, col
="blue",border = "red", plot=T)
#X11()
plot(rev(sort(smw$mids)),rev(sort(cumsum(smw$density)))/10)
plot(sort(smw$mids),sort(cumsum(smw$density))/10)
plot(sort(smw$mids),rev(sort(cumsum(smw$density)))/10,type='b',
lty=1, pch=15, col='red')
cbind(sort(smw$mids),rev(sort(cumsum(smw$density)))/10)
cbind(quantile(SPPG,
probs = c(0.05, 0.90)))
#
SENSITIVITY OF MONTE CARLO METHOD
data=data.frame(SPPG,sarea,sthickness,sreftemp,spor,srockheat,recovfact,sloadfac,sreconff)
summary(data)
cbind(cor(data)[,
1])
require('Ternary');
require(ggplot2); require(ggtern)
#data1=sample(1:5,data,
replace =FALSE)
data1=data[1:5000,]
#data2=scale(data1)
data3=data.frame(data1)
summary(data3)
#
TERNARY PLOT SENSITIVITY
#https://stackoverflow.com/questions/32390466/ternary-plot-and-filled-contour-ggtern
library(ggtern)
ggtern(data
= data3,aes(x = sarea,y =sthickness, z = recovfact)) +
geom_interpolate_tern(aes(value=SPPG,colour=..level..),bins=95) +
geom_point(aes(color=SPPG),size=25) +
geom_text(aes(label=round(SPPG,0)),size=1) +
theme_bw() +
theme(legend.position=c(0,1),
legend.justification=c(0,1)) +
scale_colour_gradient(low='green',high='red')
+
labs( title = "", colour =
"")
#
library(ggtern)
plot
<- ggtern(data = data1, aes(x = spor , y = sreftemp , z = sloadfac)) +
geom_point(aes(fill = SPPG),
size = 6,
shape = 22,
color = "red") +
ggtitle("SPPG") +
labs(fill = "SPPG") +
theme_rgbw() +
theme(legend.position = c(0,1),
legend.justification = c(1, 1))
plot
df
= data.frame(x = sarea,
y = sthickness,
z = recovfact,
value = SPPG )
ggtern(df,aes(x,y,z))
+
geom_hex_tern(bins=5,aes(value=value,fill=..count..))
library(ggtern)
library(ggalt)
data("Fragments")
base
= ggtern(Fragments,aes(Qm,Qp,Rf+M,fill=GrainSize,shape=GrainSize)) +
theme_bw() +
theme_legend_position('tr') +
geom_encircle(alpha=0.5,size=1) +
geom_point() +
labs(title
= "Example Plot",
subtitle = "using
geom_encircle")
print(base)
library(ggtern)
set.seed(1)
df
= data.frame(x=data1$spor,y=data1$sreftemp,z=data1$sloadfac)
base = ggtern(data=df,aes(x,y,z)) + geom_point()
base1
= base + geom_Tmark(color='red') + labs(title="Tmark")
base2
= base + geom_Lmark(color='blue') + labs(title="Lmark")
base3
= base + geom_Rmark(color='green') + labs(title="Rmark")
base4
= base + geom_crosshair_tern(color='black') + labs(title="Crosshair")
grid.arrange(base1,base2,base3,base4)
#SPIDER
PLOT SENSITIVITY
data=data.frame(SPPG,sarea,sthickness,sreftemp,spor,srockheat,recovfact,sloadfac,sreconff)
round(cbind(quantile(data$SPPG,
probs = c(0.10))), 3)
#TORNADO
PLOT SENSITIVITY
#
data3=data.frame(data1); summary(data3)
#EXCEL/MATLAB
BETTER VISUALIZE
#
SUBSURFACE COST ANALYSIS OG GETHERMAL
#Drilling
Cost
5.355*10^5*1*log( 25000
) + (0.2414*1*( 25000^2 )) + (1.061*10^6)
#Completion
Cost
((1.072*(10^-7))*( 25000^2
) ) +((2.3*(10^-3)* 25000
)-0.62)
library(psych)
describe(g)
#
item name ,item number, nvalid, mean, sd,
#
median, mad, min, max, skew, kurtosis, se
#library(Hmisc)
#describe(data)
sapply(g,quantile)
sapply(g,range)
sapply(g,sd)
# MONTE CARLO
SIMULATION LCOE 6CENTRALES ROD
#Overnight
Capital Cost / Investissement Cost ($/KW)
rm(list=ls())
rm(list=ls())
set.seed(2021)
IC=94743327.5163
ICs=runif(1000000,
min=(IC+(IC*-0.3)), max=(IC+(IC*+0.3)))
sIC
<- rnorm(ICs, mean = mean(ICs) , sd = sd(ICs) )
#Operation&Maintenance
Cost ($)
OM=c(4899024.70,4354688.62,3870834.33,3440741.63,3058437.00,2718610.67,2416542.82,2148038.06,1909367.16,1697215.26,1508635.78,1341009.58,1192008.52,1059563.13,941833.89,837185.68,744165.05,661480.04,587982.26,522650.90,464578.58,412958.74,367074.43,326288.38,290034.12 )
OMs=runif(1000000,
min= min(OM), max=max(OM))
sOM<-
rnorm(OMs, mean = mean(OMs) , sd = sd(OMs) )
#Interest
Rate (%)
IR=0.1087
sIR=runif(1000000,
min=(IR+(IR*-0.3)), max=(IR+(IR*+0.3)))
#Load
Factor (%)
LF=
0.9
sLF=runif(1000000,min=(LF+(LF*-0.3)),
max=(LF+(LF*+0.10)))
#Life
Time (yr)
LT=25
sLT=runif(1000000,
min=(LT+(LT*-0.3)),max=(LT+(LT*+0.3)))
#Eouput
E=c(212302061.95,188712943.96,167744839.07,149106523.62,132539132.11,117812561.87,104722277.22,93086468.64,82743527.68,73549802.38,65377602.12,58113424.10,51656376.98,45916779.54,40814915.15,36279924.57,32248821.84,28665619.42,25480550.59,22649378.30,20132780.72,17895805.08,15907382.29,14139895.37,12568795.89)
Es=runif(1000000, min= min(E), max=max(E))
sE<-
rnorm(Es, mean = mean(Es) , sd = sd(Es) )
#Results
of Simulation Monte Carlo
sLCOE
= (sIC+((sOM/(1+0.125)^sLF)))/(30294.244*8760*sLF); summary(sLCOE)
#prop.table(sLCOE)
#d=data.frame(sLCOE); getwd()
#write.table(d,
file="data.txt", sep="\t")
#Graphic Anaysis
#Test Histogramme MC
avec possibilit? changement simulation pour une bonne repart
require(ggplot2); g=sLCOE
hist(g,prob=TRUE,
breaks=139,xalb=NA, ylab=NA, main=NA)
h=hist(g,breaks=139,prob=TRUE,
xalb=NA, ylab=NA, main=NA);h
#5
TIMES ,xaxt="n",
yaxt="n"
plot(-1,-1,xlab=NA,ylab=NA,xlim=c(0.015,0.105),
ylim=c(0,30.20) )
#Ecart
la fenetre
grid(col="grey2",
lty="solid", lwd=0.1);par(new=T)
#grid(NULL, NA)
#ECARTER LE GRAPH POUR
AFFICHAGE #breaks="FD"
par(new=T);{hist(g,add=TRUE,
breaks=139,prob=T,border="yellow",col="blue3",
main=NA,xlab="n",ylab="n",axes=F)}
lines(density(g),
col='red', lty=1, lwd=1)
#QUANTILE
MONTE CARLO LCOE RESULT
round(cbind(quantile(g,c(0.05,0.50,0.95)))
, 5)
numb1
<- cbind(quantile(g,c(0.05,0.50,0.95)));
library(scales);cbind(scientific(numb1, digits = 3))
q1= 0.0248;
q2= 0.0424; q3= 0.0716
abline(v=q1,
lwd=0.5, col="darkred",lty=6)
#legend(q1, 9e-04 ,
"5%=1.31e+03",cex=0.75,bg="white")
#abline(v=q2,
lwd=0.5, col="darkblue",lty=6) #legend(q2, 70
,"50%=2.04e+03"
,cex=0.75,bg="white")
abline(v=
q3, lwd=0.5, col="darkgreen",lty=6)
#legend(q3, 70
,"95%=3.18e+03",cex=0.75,bg="white")
round(summary(g),5);round(sd(g),5)
#2ND
POSS
barplot(h$density~h$mids,
col="blue3", xlab="", ylab="")
d=data.frame(h$density,h$mids)
write.table(d,
"d.txt", sep="\t")
#Recuperer le
Graphique
#
#require
(dplyr)
#g%>%count()
#h=hist(g
, prob=T, xalb=NA, ylab=NA, main=NA); dev.off(); h
round(cbind(median
(sIC)),3)
round(cbind(median(sOM)),3)
round(cbind(median(sIR)),3)
round(cbind(median(sCF)),3)
round(cbind(median(sLT)),3)
g=sLCOE;
round(cbind(summary(g)), 3); round(sd(g), 3)
#
CORRELATION ANALYSIS
data=data.frame(sIC,
sOM, sIR, sCF, sLT, sLCOE)
#cor(data,
na.rm=T,use="complete.obs","pairwise.complete.obs",method="pearson")
cor(data,
method = c("pearson", "kendall", "spearman"))
mcor=cor(data,
use = "complete.obs")
mcor=cor(data)#[,1:20]
dim(data)
x
= mcor
library(corrplot)
#?full?,
?lower?, ?upper?
col
<- colorRampPalette(c("#BB4444", "#EE9988",
"#FFFFFF", "#77AADD", "#4477AA"))
corrplot(mcor,
method="color", col=col(200) ,
type="full",
addCoef.col = "black",
order="hclust")
#library(corrr)
#library(tidyverse)
#mcor2%>%
#correlate()
%>%
#network_plot(min_cor
= .2)
sLCOE
= (sIC *
(1+(sOM*(((1+sIR)^sLT)-1)/(IR*(1+IR)^sLT))))
/ (Rp*sCF*8760*sLT) ;
summary(sLCOE)
cor(data.frame(sIC,
sOM, sIR, sCF, sLT, sLCOE))
# sLCOE
#sIC 0.4246583
#sOM 0.2866273
#sIR 0.6175135
#sCF -0.4351828
#sLT -0.3119388
#INCERTITUDE
QUANTITATIF
cbind(sapply(data.frame(sIC,
sOM, sIR, sCF, sLT, sLCOE), FUN=sd))
res.aov
<- aov(sLCOE ~ sIC+sOM+sIR+sCF+sLT);summary(res.aov)
59.71+26.39
+13.07+62.71 +38.04+9.98
38.04/
(59.71+26.39 +13.07+62.71 +38.04+9.98)
#
sensitivity Analysis
#1
- True value with percentage variation between -20% to +20% Linear graph
#2
- Tornado Graph -20% to +20%
#https://www.youtube.com/watch?v=U3hTbYnTGGM
#3-
Contour Graph Boostrapping Sample
#
sI sOM
sIR sCF sLT
#https://plotly.com/r/contour-plots/
x=sample(sIC
,5 , replace=F)
y=sample(sIR
,5, replace=F)
z=sample(sLCOE
,5 , replace=F)
#data.frame(sIC,
sOM, sIR, sCF, sLT, sLCOE)
quantile(sCF)
quantile(sIC)
quantile(sLCOE)
x=c(0.5947349,0.7219041,0.8490959,0.9767852,1.1045023)
y=c(399127.8,4593045.4,5200151.7,5809260.4,9527693.8)
z=c(0.003743991,0.032106886,0.042723404,0.056482419,0.182222300
)
#'type', 'visible',
'showlegend', 'legendgroup', 'opacity', 'name', 'uid', 'ids', 'customdata',
'meta', 'hoverinfo', 'hoverlabel', 'stream', 'transforms', 'uirevision', 'z',
'x', 'x0', 'dx', 'y', 'y0', 'dy', 'xperiod', 'yperiod', 'xperiod0', 'yperiod0',
'xperiodalignment', 'yperiodalignment', 'text', 'hovertext', 'transpose',
'xtype', 'ytype', 'zhoverformat', 'hovertemplate', 'hoverongaps',
'connectgaps', 'fillcolor', 'autocontour', 'ncontours', 'contours', 'line',
'zauto', 'zmin', 'zmax', 'zmid', 'colorscale', 'autocolorscale',
'reversescale', 'showscale', 'colorbar', 'coloraxis', 'xcalendar', 'ycalendar',
'xaxis', 'yaxis', 'idssrc', 'customdatasrc', 'metasrc', 'hoverinfosrc', 'zsrc',
'xsrc', 'ysrc', 'textsrc', 'hovertextsrc', 'hovertemplatesrc', 'key', 'set',
'frame', 'transforms', '_isNestedKey', '_isSimpleKey', '_isGraticule', '_bbox'
df <-
data.frame(x=x,y=y,z=z);library(plotly);p <- plot_ly(data = df, x=~x,y=~y,
z=~z, type = "contour", colorscale='Jet',cex=0.5,contours =
list(showlabels = T));p
#
BIC=sample(sIC
, 30, replace=F)
BIR=sample(sIR
, 30, replace=F)
BLCOE=sample(sLCOE
,900 , replace=F)
library(plotly)
fig
<- plot_ly(
x = BIC,
y = BIR,
z = matrix(BLCOE, nrow = 30, ncol = 30),
colorscale = 'Jet',
type
= "contour" , contours = list(showlabels = F), line = list(smoothing
= 2),autocontour = T
)
fig
<- fig %>% colorbar(title = "LCOE ($/KWh)")
fig
#
BLCOE=sample(sLCOE
,25 , replace=FALSE)
library(plotly)
fig
<- plot_ly(
type = 'contour',
z = matrix(c(BLCOE), nrow=5, ncol=5),
colorscale = 'Jet',
autocontour = F,
contours = list(
start
= 0,
end = 8,
size = 2
)
)
fig
#
#http://www.sthda.com/french/wiki/ggplot2-couleurs-changer-les-couleurs-automatiquement-et-manuellement-logiciel-r-et-visualisation-de-donnees
abline(v=c(4.5,5,5.5,6),col='red',lwd=2)
hp<-qplot(x
=g, bins=139,fill=..density.., geom="histogram"); hp
hp+scale_fill_gradient(low="blue",
high="red")
hp+theme(panel.background
= element_rect())
require(lattice)
histogram(~
sIC,breaks=139,col="blue",border =
"yellow",main="",xlab="Monte Carlo Simulation of
Capital Cost ($)")
rm(list=ls())
r=read.table(file("clipboard"),
header=T, sep="\t",dec=",",row.names=1)
str(r); summary(r)
#Interpolation
Lineaire ou affine #FORMULE
TAYLOR-YOUNG: y1+ ( (xr-x1) * (
(y2-y1)/(x1-x2)))
#geothermal
gradient:
xr=5000; x1=1187;
x2=650; y1=86.23;y2=39.27
yr = y1 + (y2-y1)
* ( (xr-x1)/(x2-x1) ); yr
# ENTRY VALUE/PARAMETER
#low-temperature
geothermal: Volumetric method, and low enthalpy
#Thermal
energy for a liquid dominated reservoir is as follows:
#it
can be assumed that the heat capacity and temperature are homogeneous in the xy
plane and are only dependent on depth
#
#
THERMAL ENERGY CALCULATION
#
Total thermal energy (kJ/kg) | QT(kJ/kg)
#
Heat in rock Or Water (kJ/kg) | Q(kJ/kg)
#
Area of the reservoir(m2) | Ar(m2) 3
#
Average thickness of the reservoir (m) | H(m) 1500
#
Specific heat of rock at reservoir conditions(kJ/kgK) | CR(J/kg) 900
#
Specific heat of water at reservoir conditions(kJ/kgK) | CW(J/kg) 4800
#
Porosity
| P 0.10
#
Average temperature of the reservoir(?C) | Ti(?C) 323.70
#
Final or abandonment temperature (?C) | Tf 40
#
Rock or Water density (kg/m3) | Phir(kg/m3) 2870
/ 890
# Degre Celsisu en
Kelvin 0?C = 273.15K | 0?C =255.372?F (D?gr? Fahrenheit)
Ar=3000000
;Hr=1500; PhiR=2870; CR=900; PhiW=890;CW=4800;P=0.10;Ti=280; Tf=40
#
Qr
= Ar*Hr*((PhiR*CR)*(1-P)*(Ti-Tf));Qr
Qw
= Ar*Hr*((PhiW*CW)*(P)*(Ti-Tf)) ;Qw
#
POTENTIAL GEOTHERMAL #1KJ=0.000277778
KWh
QT
= Qr + Qw; QT
#POWER
PLANT SIZE
#Power
potential (MWe) | P
#Recovery
factor | Rf
#Conversion
efficiency | Ce
#Plant
factor | Pf
#Economic
life | Lf
Rf=0.1;Ce=0.4;Pf=0.95;Lf=25
PG= ((QT/1000000)*Rf*Ce)/(Pf*(Lf*8760*3600));PG
#
GEOTHERMAL SIMULATION MONTE CARLO :
set.seed(2021)
#require(triangle)
library(metRology);
require(graphics)
Ars=runif(1000000,
min=2000000,max=8000000)
getmode
<- function(v) {
uniqv <- unique(v)
uniqv[which.max(tabulate(match(v, uniqv)))]}
v
<-Ars; a=min(v); b=max(v); c=getmode(v)
Ars1=rtri(1000000,a,b,c)
;Ar;summary(Ars1)
Hrs=runif(1000000,
min=1000,max=2000)
getmode1
<- function(v1) {
uniqv1 <- unique(v1)
uniqv1[which.max(tabulate(match(v1,
uniqv1)))]}
v1
<-Hrs; a1=min(v1); b1=max(v1); c1=getmode1(v1)
Hrs1=rtri(1000000,a1,b1,c1);Hr;summary(Hrs1)
Tis=runif(1000000,
min=265,max=290)
getmode2
<- function(v2) {
uniqv2 <- unique(v2)
uniqv2[which.max(tabulate(match(v2,
uniqv2)))]}
v2 <-Tis;
a2=min(v2); b2=max(v2); c2=getmode2(v2)
Tis1=rtri(1000000,a2,b2,c2)
;Ti;summary(Tis1)
Rfs=runif(1000000,
min=0.05,max=0.2)
getmode3
<- function(v3) {
uniqv3 <- unique(v3)
uniqv3[which.max(tabulate(match(v3,
uniqv3)))]}
v3
<-Rfs; a3=min(v3); b3=max(v3); c3=getmode3(v3)
Rfs1=rtri(1000000,a3,b3,c3)
;Rf;summary(Rfs1)
CRs=runif(1000000,
min=800,max=1000)
getmode4
<- function(v4) {
uniqv4 <- unique(v4)
uniqv4[which.max(tabulate(match(v4,
uniqv4)))]}
v4
<-CRs; a4=min(v4); b4=max(v4); c4=getmode4(v4)
CRs1=rtri(1000000,a4,b4,c4)
;CR;summary(CRs1)
#Tfs =runif(10000,
min=(Tf+(Tf*-0.999)),max=(Tf+(Tf*+0.999)))
#LFs =runif(10000,
min=(Lf+(Lf*-0.999)),max=(Lf+(Lf*+0.999)))
#PhiWs =runif(10000,
min=(PhiW+(PhiW*-0.999)),max=(PhiW+(PhiW*+0.999)))
#PhiRs =runif(10000,
min=(PhiR+(PhiR*-0.999)),max=(PhiR+(PhiR*+0.999)))
#CWs =runif(10000,
min=(CW+(CW*-0.999)),max=(CW+(CW*+0.999)))
#Ps =runif(10000,
min=(P+(P*-0.999)),max=(P+(P*+0.999)))
#Ces =runif(10000,
min=(Ce+(Ce*-0.999)),max=(Ce+(Ce*+0.999)))
#Pfs =runif(10000,
min=(Pf+(Pf*-0.999)),max=(Pf+(Pf*+0.999)))
#RESULTS
Qrs1
= Ars1*Hrs1*((PhiR*CRs1)*(1-P)*(Tis1-Tf));Qws1 =
Ars1*Hrs1*((PhiW*CW)*(P)*(Tis1-Tf))
QTs1=Qrs1+Qws1
#POTENTIAL
GEOTHERMAL #1KJ=0.000277778 KWh
PGs= ((QTs1/1000000)*Rfs1*Ce)/(Pf*Lf*8760*3600)
summary(PGs)
#Graphic Anaysis
#Test Histogramme MC
avec possibilit? changement simulation pour une bonne repart
require(ggplot2); g=PGs
hist(g,prob=TRUE,
breaks=139,xalb=NA, ylab=NA, main=NA)
h=hist(g,breaks=139,prob=TRUE,
xalb=NA, ylab=NA, main=NA);h
#5
TIMES ,xaxt="n",
yaxt="n"
plot(-1,-1,xlab=NA,ylab=NA,xlim=c(0.015,0.105),
ylim=c(0,30.20) )
#Ecart
la fenetre
grid(col="grey2",
lty="solid", lwd=0.1);par(new=T)
#grid(NULL, NA)
#ECARTER LE GRAPH POUR
AFFICHAGE #breaks="FD"
par(new=T);{hist(g,add=TRUE,
breaks=139,prob=T,border="yellow",col="blue3",
main=NA,xlab="n",ylab="n",axes=F)}
lines(density(g),
col='red', lty=1, lwd=1)
#QUANTILE
MONTE CARLO LCOE RESULT
#numb1
<- cbind(quantile(g,c(0.05,0.50,0.95)));
library(scales);cbind(scientific(numb1, digits = 3))
round(cbind(quantile(g,c(0.05,0.50,0.95)))
, 5)
q1= 0.0248;
q2= 0.0424; q3= 0.0716
abline(v=q1,
lwd=0.5, col="darkred",lty=6)
#legend(q1, 9e-04 ,
"5%=1.31e+03",cex=0.75,bg="white")
#abline(v=q2,
lwd=0.5, col="darkblue",lty=6) #legend(q2, 70
,"50%=2.04e+03"
,cex=0.75,bg="white")
abline(v=
q3, lwd=0.5, col="darkgreen",lty=6)
#legend(q3, 70
,"95%=3.18e+03",cex=0.75,bg="white")
round(summary(g),5);round(sd(g),5)
#2ND
POSS
barplot(h$density~h$mids,
col="blue3", xlab="", ylab="")
d=data.frame(h$density,h$mids)
write.table(d,
"d.txt", sep="\t")
# MONTE CARLO
SIMULATION LCOE 6CENTRALES ROD
#
#
CAPITAL COST LOG NORMAL
IC=41600000;
IC
ICs=runif(1000000,
min=(IC+(IC*-0.3)), max=(IC+(IC*+0.3)) )
sIC
<- rlnorm(ICs, mean = mean(log(ICs)) , sd = sd(log(ICs)) )
#
INFLATION RATE NORMAL
ir
= 0.033
irs=runif(1000000,
min=(ir+(ir*-0.3)), max=(ir+(ir*+0.3)) )
sir
<- rnorm(irs, mean = mean(irs) , sd = sd(irs) )
#
DISCOUNT RATE NORMAL
dr
= 0.125
drs=runif(1000000,
min=(dr+(dr*-0.3)), max=(dr+(dr*+0.3)) )
sdr
<- rnorm(drs, mean = mean(drs) , sd = sd(drs) )
# OM COST LOGNORMAL
# SIMULATION UNE ET
UNE SEULE FOIS PAR PARAMETRE DANS LEQUATION
OM=
(0.06*IC)/( ((1+sample(sir,1, replace =F)
)/(1+sample(sdr,1, replace =F)) )^1)+
(0.06*IC)/( ((1+sample(sir,1, replace =F)
)/(1+sample(sdr,1, replace =F)) )^2)+
(0.06*IC)/( ((1+sample(sir,1, replace =F)
)/(1+sample(sdr,1, replace =F)) )^3)+
(0.06*IC)/( ((1+sample(sir,1, replace =F)
)/(1+sample(sdr,1, replace =F)) )^4)+
(0.06*IC)/( ((1+sample(sir,1, replace =F)
)/(1+sample(sdr,1, replace =F)) )^5)+
(0.06*IC)/( ((1+sample(sir,1, replace =F)
)/(1+sample(sdr,1, replace =F)) )^6)+
(0.06*IC)/( ((1+sample(sir,1, replace =F)
)/(1+sample(sdr,1, replace =F)) )^7)+
(0.06*IC)/( ((1+sample(sir,1, replace =F)
)/(1+sample(sdr,1, replace =F)) )^8)+
(0.06*IC)/( ((1+sample(sir,1, replace =F)
)/(1+sample(sdr,1, replace =F)) )^9)+
(0.06*IC)/( ((1+sample(sir,1, replace =F)
)/(1+sample(sdr,1, replace =F)) )^10)+
(0.06*IC)/( ((1+sample(sir,1, replace =F)
)/(1+sample(sdr,1, replace =F)) )^11)+
(0.06*IC)/( ((1+sample(sir,1, replace =F)
)/(1+sample(sdr,1, replace =F)) )^12)+
(0.06*IC)/( ((1+sample(sir,1, replace =F)
)/(1+sample(sdr,1, replace =F)) )^13)+
(0.06*IC)/( ((1+sample(sir,1, replace =F)
)/(1+sample(sdr,1, replace =F)) )^14)+
(0.06*IC)/( ((1+sample(sir,1, replace =F)
)/(1+sample(sdr,1, replace =F)) )^15)+
(0.06*IC)/( ((1+sample(sir,1, replace =F)
)/(1+sample(sdr,1, replace =F)) )^16)+
(0.06*IC)/( ((1+sample(sir,1, replace =F)
)/(1+sample(sdr,1, replace =F)) )^17)+
(0.06*IC)/( ((1+sample(sir,1, replace =F)
)/(1+sample(sdr,1, replace =F)) )^18)+
(0.06*IC)/( ((1+sample(sir,1, replace =F)
)/(1+sample(sdr,1, replace =F)) )^19)+
(0.06*IC)/( ((1+sample(sir,1, replace =F)
)/(1+sample(sdr,1, replace =F)) )^20); OM
OMs=runif(1000000,
min=(OM+(OM*-0.3)), max=(OM+(OM*+0.3)) )
sOM
<- rnorm(OMs, mean = mean((OMs)) , sd = sd((OMs)) )
#
CAPACITY FACTOR UNIFORM
CF=0.387121134174565
; CF
sCF=runif(1000000,
min=(CF+(CF*-0.3)) , max=(CF+(CF*+0.3)) )
#
DEAGRADATION UNIFORM
DR=0.04;
DR
sDR=runif(1000000,
min=(DR+(DR*-0.3)) , max=(DR+(DR*+0.3)) )
#
ENERGY OUTPUT
EO1=
((sCF *20000*8760 )/ (1+0)^1) +
((sCF *20000*8760 )/ (1+0)^2) +
((sCF *20000*8760 )/ (1+0)^3) +
((sCF *20000*8760 )/ (1+0)^4) +
((sCF *20000*8760 )/ (1+0)^5) +
((sCF *20000*8760 )/ (1+0)^6) +
((sCF *20000*8760 )/ (1+0)^7) +
((sCF *20000*8760 )/ (1+0)^8) +
((sCF *20000*8760 )/ (1+0)^9) +
((sCF *20000*8760 )/ (1+0)^10) +
((sCF *20000*8760 )/ (1+0)^11) +
((sCF *20000*8760 )/ (1+0)^12) +
((sCF *20000*8760 )/ (1+0)^13) +
((sCF *20000*8760 )/ (1+0)^14) +
((sCF *20000*8760 )/ (1+0)^15) +
((sCF *20000*8760 )/ (1+0)^16) +
((sCF *20000*8760 )/ (1+0)^17) +
((sCF *20000*8760 )/ (1+0)^18) +
((sCF *20000*8760 )/ (1+0)^19) +
((sCF *20000*8760 )/ (1+0)^20)
EO2=
((sCF *20000*8760 )/ (1+sDR )^1) +
((sCF *20000*8760 )/ (1+sDR )^2) +
((sCF *20000*8760 )/ (1+sDR )^3) +
((sCF *20000*8760 )/ (1+sDR )^4) +
((sCF *20000*8760 )/ (1+sDR )^5) +
((sCF *20000*8760 )/ (1+sDR )^6) +
((sCF *20000*8760 )/ (1+sDR )^7) +
((sCF *20000*8760 )/ (1+sDR )^8) +
((sCF *20000*8760 )/ (1+sDR )^9) +
((sCF *20000*8760 )/ (1+sDR )^10) +
((sCF *20000*8760 )/ (1+sDR )^11) +
((sCF *20000*8760 )/ (1+sDR )^12) +
((sCF *20000*8760 )/ (1+sDR )^13) +
((sCF *20000*8760 )/ (1+sDR )^14) +
((sCF *20000*8760 )/ (1+sDR )^15) +
((sCF *20000*8760 )/ (1+sDR )^16) +
((sCF *20000*8760 )/ (1+sDR )^17) +
((sCF *20000*8760 )/ (1+sDR )^18) +
((sCF *20000*8760 )/ (1+sDR )^19) +
((sCF *20000*8760 )/ (1+sDR )^20)
# IMPACT ENVIRONNEMENT
COST SCENARIOS
#
LIFE TIME UNIFORM
#LF=20;LF
#LFs=runif(1000000,
min=(LF+(LF*-0.3)) , max=(LF+(LF*+0.3)) )
#sLF=runif(1000000,
min=(LF+(LF*-0.3)) , max=(LF+(LF*+0.3)) )
# EQUATION DECOMPOSITE
# IMPACT
ENVIRONNEMENTAL UNIFORM
IE=36.3; IE
sIE=runif(1000000,
min=(IE+(IE*-0.3)) , max=(IE+(IE*+0.3)) )
#
EMISSION FACTOR DIESEL UNIFORM
EFD=0.277;
EFD
sEFD=runif(1000000,
min=(EFD+(EFD*-0.3)) , max=(EFD+(EFD*+0.3)) )
#
EMISSION FACTOR GAS UNIFORM
EFG=0.2;
EFG
sEFG=runif(1000000,
min=(EFG+(EFG*-0.3)) , max=(EFD+(EFG*+0.3)) )
#GARDANT LE CAS D NUL
POUR LE COUT ENVIRONNEMENT
IED=
(((sEFD*EO1)/1000)*sIE) /((1+sir)/(1+sdr)
^1) +
(((sEFD*EO1)/1000)*sIE) /((1+sir)/(1+sdr)
^2) +
(((sEFD*EO1)/1000)*sIE) /((1+sir)/(1+sdr)
^3) +
(((sEFD*EO1)/1000)*sIE) /((1+sir)/(1+sdr)
^4) +
(((sEFD*EO1)/1000)*sIE) /((1+sir)/(1+sdr)
^5) +
(((sEFD*EO1)/1000)*sIE) /((1+sir)/(1+sdr)
^6) +
(((sEFD*EO1)/1000)*sIE) /((1+sir)/(1+sdr)
^7) +
(((sEFD*EO1)/1000)*sIE) /((1+sir)/(1+sdr)
^8) +
(((sEFD*EO1)/1000)*sIE) /((1+sir)/(1+sdr)
^9) +
(((sEFD*EO1)/1000)*sIE) /((1+sir)/(1+sdr)
^10) +
(((sEFD*EO1)/1000)*sIE) /((1+sir)/(1+sdr)
^11) +
(((sEFD*EO1)/1000)*sIE) /((1+sir)/(1+sdr)
^12) +
(((sEFD*EO1)/1000)*sIE) /((1+sir)/(1+sdr)
^13) +
(((sEFD*EO1)/1000)*sIE) /((1+sir)/(1+sdr)
^14) +
(((sEFD*EO1)/1000)*sIE) /((1+sir)/(1+sdr)
^15) +
(((sEFD*EO1)/1000)*sIE) /((1+sir)/(1+sdr)
^16) +
(((sEFD*EO1)/1000)*sIE) /((1+sir)/(1+sdr)
^17) +
(((sEFD*EO1)/1000)*sIE) /((1+sir)/(1+sdr)
^18) +
(((sEFD*EO1)/1000)*sIE) /((1+sir)/(1+sdr)
^19) +
(((sEFD*EO1)/1000)*sIE) /((1+sir)/(1+sdr)
^20)
IEG=
(((sEFG*EO2)/1000)*sIE)
/((1+sir)/(1+sdr)^1) +
(((sEFG*EO2)/1000)*sIE) /((1+sir)/(1+sdr)
^2) +
(((sEFG*EO2)/1000)*sIE) /((1+sir)/(1+sdr)
^3) +
(((sEFG*EO2)/1000)*sIE) /((1+sir)/(1+sdr)
^4) +
(((sEFG*EO2)/1000)*sIE) /((1+sir)/(1+sdr)
^5) +
(((sEFG*EO2)/1000)*sIE) /((1+sir)/(1+sdr)
^6) +
(((sEFG*EO2)/1000)*sIE) /((1+sir)/(1+sdr)
^7) +
(((sEFG*EO2)/1000)*sIE) /((1+sir)/(1+sdr)
^8) +
(((sEFG*EO2)/1000)*sIE) /((1+sir)/(1+sdr)
^9) +
(((sEFG*EO2)/1000)*sIE) /((1+sir)/(1+sdr)
^10) +
(((sEFG*EO2)/1000)*sIE) /((1+sir)/(1+sdr)
^11) +
(((sEFG*EO2)/1000)*sIE) /((1+sir)/(1+sdr)
^12) +
(((sEFG*EO2)/1000)*sIE) /((1+sir)/(1+sdr)
^13) +
(((sEFG*EO2)/1000)*sIE) /((1+sir)/(1+sdr)
^14) +
(((sEFG*EO2)/1000)*sIE) /((1+sir)/(1+sdr)
^15) +
(((sEFG*EO2)/1000)*sIE) /((1+sir)/(1+sdr)
^16) +
(((sEFG*EO2)/1000)*sIE) /((1+sir)/(1+sdr)
^17) +
(((sEFG*EO2)/1000)*sIE) /((1+sir)/(1+sdr)
^18) +
(((sEFG*EO2)/1000)*sIE) /((1+sir)/(1+sdr) ^19) +
(((sEFG*EO2)/1000)*sIE) /((1+sir)/(1+sdr)
^20)
# Non Reutilistion
dans une simulation
#
PARAMETRE FIXED CONSIDERED
#
Turbine Capacity
#
Rotor diameter
#
Number of Turbine
#
Tower concept
#
Weibull k factor
#
shear exponent
#
Altitude
#
Air density
#
Cut in wind speed
#
Cut out wind speed
#
Energy loses
#
Availability
#
Net aep MWh/year
#_____________________________________________________________________________________________________________
# LCOE SIMULATION
MONTE CARLO
#-------------------------------------------------------------------------------------------------------------
sLCOE1
=(sIC + sOM) / EO1
#
sLCOE2
=(sIC + sOM) / EO2
sLCOE3
=(sIC + sOM-IED) / EO1
sLCOE4
=(sIC + sOM-IED) / EO2
sLCOE5
=(sIC + sOM-IEG) / EO1
sLCOE6 =(sIC +
sOM-IEG) / EO2
#UNE et UNE seule fois
pour eviter un effet de camouflage dans la distribution des autres parametres
#library(psych)
#describe(sLCOE1)
#c("item",
"name" ,"item number", "nvalid",
"mean", "sd","median", "mad",
"min", "max", "skew", "kurtosis",
"se"))
#sLCOE1=runif(1000000,
min=min(LCOE1s), max=max(LCOE1s) )
#VERIFICATION
cbind(summary(sIC))
#appartenance 41 600 000
cbind(summary(sOM))
#appartenance 137 611 390
cbind(summary(EO1))
#appartenance 1 457 709 447
cbind(summary(sLCOE1))
cbind(summary(sLCOE2))
cbind(summary(sLCOE3))
cbind(summary(sLCOE4))
cbind(summary(sLCOE5))
#a=
sIC+ ( (0.06*ICs)/(((1+sir)/(1+sdr))^1)
+
(0.06*ICs)/(((1+sir)/(1+sdr))^2)+
(0.06*ICs)/(((1+sir)/(1+sdr))^3)+
(0.06*ICs)/(((1+sir)/(1+sdr))^4)+
(0.06*ICs)/(((1+sir)/(1+sdr))^5)+
(0.06*ICs)/(((1+sir)/(1+sdr))^6)+
(0.06*ICs)/(((1+sir)/(1+sdr))^7)+
(0.06*ICs)/(((1+sir)/(1+sdr))^8)+
(0.06*ICs)/(((1+sir)/(1+sdr))^9)+
(0.06*ICs)/(((1+sir)/(1+sdr))^10)+
(0.06*ICs)/(((1+sir)/(1+sdr))^11)+
(0.06*ICs)/(((1+sir)/(1+sdr))^12)+
(0.06*ICs)/(((1+sir)/(1+sdr))^13)+
(0.06*ICs)/(((1+sir)/(1+sdr))^14)+
(0.06*ICs)/(((1+sir)/(1+sdr))^15)+
(0.06*ICs)/(((1+sir)/(1+sdr))^16)+
(0.06*ICs)/(((1+sir)/(1+sdr))^17)+
(0.06*ICs)/(((1+sir)/(1+sdr))^18)+
(0.06*ICs)/(((1+sir)/(1+sdr))^19)+
#(0.06*ICs)/(((1+sir)/(1+sdr))^20) )
#b= (sCF*20000*8760) /((1+0)^1) +
(sCF*20000*8760) /((1+0)^2)+
(sCF*20000*8760) /((1+0)^3)+
(sCF*20000*8760) /((1+0)^4)+
(sCF*20000*8760) /((1+0)^5)+
(sCF*20000*8760) /((1+0)^6)+
(sCF*20000*8760) /((1+0)^7)+
(sCF*20000*8760) /((1+0)^8)+
(sCF*20000*8760) /((1+0)^9)+
(sCF*20000*8760) /((1+0)^10)+
(sCF*20000*8760) /((1+0)^11)+
(sCF*20000*8760) /((1+0)^12)+
(sCF*20000*8760) /((1+0)^13)+
(sCF*20000*8760) /((1+0)^14)+
(sCF*20000*8760) /((1+0)^15)+
(sCF*20000*8760) /((1+0)^16)+
(sCF*20000*8760) /((1+0)^17)+
(sCF*20000*8760) /((1+0)^18)+
(sCF*20000*8760) /((1+0)^19)+
#(sCF*20000*8760) /((1+0)^20)
#k=a/b
# GRAPH RESULT LCOE SIMATION 1000 000 ITERATION BY DEFAULT
require(ggplot2)
#hp<-qplot(x
=sLCOE1, fill=..count.., geom="histogram");
hp+scale_fill_gradient(low="red",
high="green")+theme_classic() + theme_linedraw() # +geom_density(alpha=.2, fill="#FF6666") +theme_linedraw() +theme_light()
hist(sLCOE1 , prob=T,
xalb=NA, ylab=NA, main=NA)
#Qualité de
l'histogramme MC avec possibilité changement simulation pour une bonne repart.
plot(-1,-1,xlim=c(0.05,0.29),
ylim=c(0,13),xlab="YOBOKI Wind LCOE ($/KWh)",ylab="Probability
density function (%)")
#Ecart
la fenetre
grid(col="grey2",
lty="solid", lwd=0.1)
#grid(NULL, NA)
#5
TIMES
par(new=T)
plot(-1,-1,xlim=c(0.05,0.29),
ylim=c(0,13),xlab="YOBOKI Wind LCOE ($/KWh)",ylab="Probability
density function (%)")
#ECARTER LE GRAPH POUR
AFFICHAGE
#breaks="FD"
par(new=T)
{hist(sLCOE1,add=TRUE,
prob=T,border="yellow", breaks=50,col="blue3",
main=NA,xlab=NA,ylab=NA,axes=FALSE)}
lines(density(sLCOE1),
col='red', lty=1, lwd=1)
#QUANTILE
MONTE CARLO LCOE RESULT
cbind(quantile(sLCOE1,c(0.05,0.50,0.95)))
numb1
<- cbind(quantile(sLCOE1,c(0.05,0.50,0.95)));
library(scales);scientific(numb1, digits = 3)
q1=0.09896579
abline(v=q1,
lwd=0.5, col="darkred",lty=6)
#legend(q1, 70 ,"5%=
3.718e-4",cex=0.75,bg="white")
q2=
0.14247902
#abline(v=q2,
lwd=0.5, col="darkblue",lty=6)
#legend(q2, 70
,"50%= 2.342e-3"
,cex=0.75,bg="white")
q3=0.20895879
abline(v=
q3, lwd=0.5, col="darkgreen",lty=6)
#legend(q3,
70
,"95%=4.314e-3",cex=0.75,bg="white")
cbind(round(summary(sLCOE1),4));round(sd(sLCOE1),4)
#LEGEND
GRAPH
plot(-1,-1,xlim=c(0.05,0.25),
ylim=c(0,30),xlab="YOBOKI Wind LCOE ($/KWh)",ylab="Probability
density function (%)")
legend("topright",c("Degrdataion
(%) "),text.font=c(2),fill=c(topo.colors(500)), bty="n" )
legend("right",c("Density"),text.font=c(2),col='red',
lty=5, lwd=3, bty="n" )
#library(wesanderson);
names(wes_palettes)
#wes_palette("Zissou1",
10, type = "continuous")) #heat.colors(n), terrain.colors(n),
topo.colors(n), et cm.colors(n)
#hist(sLCOE,xlim=c(0,0.10),
ylim=c(0,75),breaks=170, prob=T, main=NA,xlab=" LCOE ($/KW) ", ylab=NA, col=
heat.colors(70),border="darkslategrey")
#require(lattice)
#histogram(~sLCOE,xlim=c(0,0.10),breaks=170,
prob=T, main=NA,xlab=" LCOE ($/KW)
", ylab=NA, col= heat.colors(70),border="darkslategrey")
#
#
GRAPH RANK CORRELATION SENSITIVITY
#
rc=data.frame(sLCOE1,sIC,
sir, sdr, sCF, sDR, sOM, sIE, sEFD, sEFG)
sp=cor(rc,rc$sLCOE1,method="spearman");sp
#method="spearman", alternative="two.sided"
# Non log ni centrée
reduire
# Graph avec Matlab
#
colfunc<-colorRampPalette(c("red","yellow","springgreen","royalblue"))
#COLORATION
plot(-100,100,
xlim=c(-10, 10), xlab= "Rank Correlation",
yaxt="n",xaxt="n" ,ylab=NA)
par(new=TRUE)
#
barplot(c(sp),horiz=T, col=colfunc(7))
#
grid(NULL,NA, col = "gray", lty = "dotted", lwd =
par("lwd"), equilogs = TRUE) # NULL OR NA OR c()
#CAN
USE EXCEL GRAPH
# GRAPH
PLOT LINE SENSITYVITY
pl=data.frame(median(sIC),median(sir),median(sdr),median(sCF),median(sDR),median(sOM));cbind(pl)
median(sIC)+
( median(sIC)*-0.15 )
median(sir)+
( median(sir)*-0.15 )
median(sdr)+
( median(sdr)*-0.15 )
median(sDR)+
( median(sDR)*-0.15 )
median(sCF)+
( median(sCF)*-0.15 )
#CAN
USE EXCEL Determinist(BETTER) or Stochastic
#
Better use mean in the literrature
#apply(),
lapply(), sapply(), tapply()
cbind(sapply(rc,
median))
#
TORNADO DIAGRAM SENSITYVITY
#
With Standard Deviation
library(ggplot2)
library(plyr)
library(dplyr)
library(tidyverse)
library(likert)
data(pisaitems)
#items28 <- pisaitems[, substr(names(pisaitems), 1, 5) == "ST24Q"]
p
<- likert(items28) ; plot(p)
sd(sIC)
sd(sir)
sd(sdr)
sd(sDR)
sd(sCF)
sd(sOM)
#https://www.youtube.com/watch?v=U3hTbYnTGGM
#https://www.youtube.com/watch?v=J9RZWI9cq4Y
# COUNTOUR DIAGRAM SENSITYVITY
#
sIC, sir, sdr, sCF, sDR, sOM
a
= sdr
b
= sir
c
= sLCOE1
x=c(min(a),min(a),min(a),median(a),median(a),median(a),max(a),max(a),max(a))
y=c(min(b),min(b),min(b),median(b),median(b),median(b),max(b),max(b),max(b))
z=c(min(c),min(c),min(c),median(c),median(c),median(c),max(c),max(c),max(c))
df <-
data.frame(x=x,y=y,z=z)
library(plotly)
p
<- plot_ly(data = df, x=~x,y=~y, z=~z, type = "contour",
colorscale='Jet');p
#
BASELINE CASE
rm(list=ls())
data=
read.table(file('clipboard'),header=T, sep="\t",dec=',')
str(data)
#
View(data)
summary(data)
data2=data[data$W90>=1
,]
summary(data2)
library(ggplot2)
library(ggthemes)
library(viridis)
library(scales)
library(tidyr)
attach(data)
gg
<- ggplot(data , aes(x=hour, y=month, fill = W85)) +
geom_tile(color = "white", size =
0.1) +
scale_x_discrete(expand=c(0,0)) +
scale_y_discrete(expand=c(0,0)) +
scale_fill_viridis(name="# of
calls", option = "magma") +
coord_equal() +
labs(x="hour", y=NULL,
title=sprintf("",stationid)) +
theme_tufte(base_family="Helvetica") +
theme(axis.text.x = element_text(angle = 45,
vjust = 1, hjust = 1))
gg
#infemo
viridis cividis rocket mako plasma
magma turbo
library(ggplot2)
p
<- ggplot(data2, aes(hour,month, fill = W90)) +
geom_tile(colour = "white") + scale_fill_gradient(low="blue",
high="green") +
xlab("") + ylab("") + ggtitle("") +
labs(fill = "wind speed (m/s)")
p
#low=red
medium=purple high = blue
#http://www.columbia.edu/~sg3637/blog/Time_Series_Heatmaps.html
#method
2 ggplot
p
<- ggplot(data,aes(x=hour,y=month,fill=W90))+
geom_tile()
p
#save
plot to working directory ggsave(p,filename="measles-basic.png")
#https://www.royfrancis.com/a-guide-to-elegant-tiled-heatmaps-in-r-2019/
ggp
<- ggplot(data2, aes(hour, month)) +
geom_tile(aes(fill = W90))
ggp
+ scale_fill_gradient(low = "green", high = "blue")
#https://statisticsglobe.com/heatmap-in-r
library(ggplot2)
library(viridis)
#
plot
ggplot(data,
aes(hour, month, fill=w80m)) +
geom_raster() +
coord_fixed(expand = TRUE) +
scale_fill_viridis()
X11()
ggplot(data,
aes(hour, month, fill=w80m)) +
geom_raster(interpolate = TRUE) +
coord_fixed(expand = FALSE) +
scale_fill_viridis()
statno
<-unique(data$stationid)
library(ggplot2)
library(dplyr)
# easier data wrangling
library(viridis)
# colour blind friendly palette, works in B&W also
library(Interpol.T)
# will generate a large dataset on
initial load
library(lubridate)
# for easy date manipulation
library(ggExtra)
# because remembering ggplot theme options is beyond me
library(tidyr)
names(data)
p
<-ggplot(data,aes(day,hour,fill=W90))+
geom_tile(color= "white",size=0.1)
+
scale_fill_viridis(name="",option
="C")
p
<-p + facet_grid(year~month)
p
<-p + scale_y_continuous(trans = "reverse", breaks =
unique(data$hour))
p
<-p + scale_x_continuous(breaks =c(1,10,20,31))
p
<-p + theme_minimal(base_size = 7)
p
<-p + labs(title= paste(""), x="Day",
y="Hour")
p
<-p + theme(legend.position = "bottom")+
theme(plot.title=element_text(size = 14))+
theme(axis.text.y=element_text(size=6)) +
theme(strip.background =
element_rect(colour="white"))+
theme(plot.title=element_text(hjust=0))+
theme(axis.ticks=element_blank())+
theme(axis.text=element_text(size=7))+
theme(legend.title=element_text(size=7))+
theme(legend.text=element_text(size=6))+
removeGrid()
p
library(ggplot2)
library(dplyr)
# easier data wrangling
library(viridis)
# colour blind friendly palette, works in B&W also
library(Interpol.T)
# will generate a large dataset on
initial load
library(lubridate)
# for easy date manipulation
library(ggExtra)
# because remembering ggplot theme options is beyond me
library(tidyr)
data
<- data(Trentino_hourly_T,package = "Interpol.T")
names(h_d_t)[1:5]<-
c("stationid","date","hour","temp","flag")
df <- tbl_df(h_d_t)
%>%
filter(stationid
=="T0001")
df
<- df %>% mutate(year = year(date),
month = month(date,
label=TRUE),
day = day(date))
df$date<-ymd(df$date)
# not necessary for plot but
#useful
if you want to do further work with the data
#cleanup
rm(list=c("h_d_t","mo_bias","Tn","Tx",
"Th_int_list","calibration_l",
"calibration_shape","Tm_list"))
#create
plotting df
df
<-df %>% select(stationid,day,hour,month,year,temp)%>%
fill(temp) #optional - see note below
View(df)
statno
<-unique(df$stationid)
#
Plotting starts here
p
<-ggplot(df,aes(day,hour,fill=temp))+
geom_tile(color= "white",size=0.1)
+
scale_fill_viridis(name="Hrly Temps
C",option ="C")
p
<-p + facet_grid(year~month)
p
<-p + scale_y_continuous(trans = "reverse", breaks =
unique(df$hour))
p
<-p + scale_x_continuous(breaks =c(1,10,20,31))
p
<-p + theme_minimal(base_size = 8)
p
<-p + labs(title= paste("Hourly Temps - Station",statno),
x="Day", y="Hour Commencing")
p
<-p + theme(legend.position = "bottom")+
theme(plot.title=element_text(size = 14))+
theme(axis.text.y=element_text(size=6)) +
theme(strip.background =
element_rect(colour="white"))+
theme(plot.title=element_text(hjust=0))+
theme(axis.ticks=element_blank())+
theme(axis.text=element_text(size=7))+
theme(legend.title=element_text(size=8))+
theme(legend.text=element_text(size=6))+
removeGrid()#ggExtra
p
#awesomeness
library("lattice")
#
Dummy data
data
<- expand.grid(X=hour, Y=month)
##
Try it out
levelplot(w80m
~ X*Y, data=data
,xlab="X",main="")
#
3) Air Passengers #3
heatmap.2(air_data,
trace = "none",
xlab = "month",
ylab = "year",
main = "Air Passengers #3",
density.info = "histogram",
dendrogram = "column",
keysize = 1.8)
#
#
BIG Manipulation Data
#
https://rpubs.com/justmarkham/dplyr-tutorial
#
load packages
suppressMessages(library(dplyr))
library(hflights)
#
explore data
data(hflights)
head(hflights)
#
convert to local data frame
flights
<- tbl_df(hflights)
#
printing only shows 10 rows and as many columns as can fit on your screen
flights
#
youcan specify that you want to see more rows
print(flights,
n=20)
#
convert to a normal data frame to see all of the columns
data.frame(head(flights))
#
base R approach to view all flights on January 1
flights[flights$Month==1
& flights$DayofMonth==1, ]
#
dplyr approach
#
note: you can use comma or ampersand to represent AND condition
filter(flights,
Month==1, DayofMonth==1)
#
use pipe for OR condition
filter(flights,
UniqueCarrier=="AA" | UniqueCarrier=="UA")
#
you can also use %in% operator
filter(flights,
UniqueCarrier %in% c("AA", "UA"))
#
base R approach to select DepTime, ArrTime, and FlightNum columns
flights[,
c("DepTime", "ArrTime", "FlightNum")]
#
dplyr approach
select(flights,
DepTime, ArrTime, FlightNum)
#
use colon to select multiple contiguous columns, and use `contains` to match
columns by name
#
note: `starts_with`, `ends_with`, and `matches` (for regular expressions) can
also be used to match columns by name
select(flights,
Year:DayofMonth, contains("Taxi"), contains("Delay"))
#
nesting method to select UniqueCarrier and DepDelay columns and filter for
delays over 60 minutes
filter(select(flights,
UniqueCarrier, DepDelay), DepDelay > 60)
#
chaining method
flights
%>%
select(UniqueCarrier, DepDelay) %>%
filter(DepDelay > 60)
#
create two vectors and calculate Euclidian distance between them
x1
<- 1:5; x2 <- 2:6
sqrt(sum((x1-x2)^2))
#
chaining method
(x1-x2)^2
%>% sum() %>% sqrt()
#
base R approach to select UniqueCarrier and DepDelay columns and sort by
DepDelay
flights[order(flights$DepDelay),
c("UniqueCarrier", "DepDelay")]
#
dplyr approach
flights
%>%
select(UniqueCarrier, DepDelay) %>%
arrange(DepDelay)
#
use `desc` for descending
flights
%>%
select(UniqueCarrier, DepDelay) %>%
arrange(desc(DepDelay))
#
base R approach to create a new variable Speed (in mph)
flights$Speed
<- flights$Distance / flights$AirTime*60
flights[,
c("Distance", "AirTime", "Speed")]
#
dplyr approach (prints the new variable but does not store it)
flights
%>%
select(Distance, AirTime) %>%
mutate(Speed = Distance/AirTime*60)
#
store the new variable
flights
<- flights %>% mutate(Speed = Distance/AirTime*60)
#
base R approaches to calculate the average arrival delay to each destination
head(with(flights,
tapply(ArrDelay, Dest, mean, na.rm=TRUE)))
head(aggregate(ArrDelay
~ Dest, flights, mean))
#
dplyr approach: create a table grouped by Dest, and then summarise each group
by taking the mean of ArrDelay
flights
%>%
group_by(Dest) %>%
summarise(avg_delay = mean(ArrDelay,
na.rm=TRUE))
#
for each carrier, calculate the percentage of flights cancelled or diverted
flights
%>%
group_by(UniqueCarrier) %>%
summarise_each(funs(mean), Cancelled,
Diverted)
#
for each carrier, calculate the minimum and maximum arrival and departure
delays
flights
%>%
group_by(UniqueCarrier) %>%
summarise_each(funs(min(., na.rm=TRUE),
max(., na.rm=TRUE)), matches("Delay"))
#
for each day of the year, count the total number of flights and sort in
descending order
flights
%>%
group_by(Month, DayofMonth) %>%
summarise(flight_count = n()) %>%
arrange(desc(flight_count))
#
rewrite more simply with the `tally` function
flights
%>%
group_by(Month, DayofMonth) %>%
tally(sort = TRUE)
#
for each destination, count the total number of flights and the number of
distinct planes that flew there
flights
%>%
group_by(Dest) %>%
summarise(flight_count = n(), plane_count =
n_distinct(TailNum))
#
for each destination, show the number of cancelled and not cancelled flights
flights
%>%
group_by(Dest) %>%
select(Cancelled) %>%
table() %>%
head()
#
for each carrier, calculate which two days of the year they had their longest
departure delays
#
note: smallest (not largest) value is ranked as 1, so you have to use `desc` to
rank by largest value
flights
%>%
group_by(UniqueCarrier) %>%
select(Month, DayofMonth, DepDelay) %>%
filter(min_rank(desc(DepDelay)) <= 2)
%>%
arrange(UniqueCarrier, desc(DepDelay))
#
rewrite more simply with the `top_n` function
flights
%>%
group_by(UniqueCarrier) %>%
select(Month, DayofMonth, DepDelay) %>%
top_n(2) %>%
arrange(UniqueCarrier, desc(DepDelay))
#
for each month, calculate the number of flights and the change from the
previous month
flights
%>%
group_by(Month) %>%
summarise(flight_count = n()) %>%
mutate(change = flight_count -
lag(flight_count))
#
rewrite more simply with the `tally` function
flights
%>%
group_by(Month) %>%
tally() %>%
mutate(change = n - lag(n))
#
randomly sample a fixed number of rows, without replacement
flights
%>% sample_n(5)
#
randomly sample a fraction of rows, with replacement
flights
%>% sample_frac(0.25, replace=TRUE)
#
base R approach to view the structure of an object
str(flights)
#
dplyr approach: better formatting, and adapts to your screen width
glimpse(flights)
#
connect to an SQLite database containing the hflights data
my_db
<- src_sqlite("my_db.sqlite3")
#
connect to the "hflights" table in that database
flights_tbl
<- tbl(my_db, "hflights")
#
example query with our data frame
flights
%>%
select(UniqueCarrier, DepDelay) %>%
arrange(desc(DepDelay))
#
identical query using the database
flights_tbl
%>%
select(UniqueCarrier, DepDelay) %>%
arrange(desc(DepDelay))
#
send SQL commands to the database
tbl(my_db,
sql("SELECT * FROM hflights LIMIT 100"))
#
ask dplyr for the SQL commands
flights_tbl
%>%
select(UniqueCarrier, DepDelay) %>%
arrange(desc(DepDelay)) %>%
explain()
#
#
https://rpubs.com/justmarkham/dplyr-tutorial
#
Annexe of R programm Excution
attach(data)
names(data)
library(plot3D)
x
<- Temperature...C.
y
<- Wind.speed..80m.
z
<- Pression
#using
rgl
scatter3D(x=x,
y=y, z=z, bty = "b2", pch =
20, cex = 2, ticktype = "detailed")
#“b”,
“b2”, “f”, “g”, “bl”, “bl2”, “u”, “n”
#DIURNAL
MEAN HOURS PER MONTH
# J1(31)
F(28/29) M1(31) A1(30) M2(31) J2(30) J3(31) A2(31) S(30) O(31) N(30)
D(31)
jan=c(dj1,dj2,dj3,dj4,dj5,dj6,dj7,dj8,dj9,dj10,dj11,dj12,dj13,dj14,dj15,dj16,dj17,dj18,dj19,dj20,dj21,dj22,dj23,dj24,dj25,dj26,dj27,dj28,dj29,dj30,dj31)
feb=c(df1,df2,df3,df4,df5,df6,df7,df8,df9,df10,df11,df12,df13,df14,df15,df16,df17,df18,df19,df20,df21,df22,df23,df24,df25,df26,df27,df28)
mar=c(dm1,dm2,dm3,dm4,dm5,dm6,dm7,dm8,dm9,dm10,dm11,dm12,dm13,dm14,dm15,dm16,dm17,dm18,dm19,dm20,dm21,dm22,dm23,dm24,dm25,dm26,dm27,dm28,dm29,dm30,dm31)
apr=c(da1,da2,da3,da4,da5,da6,da7,da8,da9,da10,da11,da12,da13,da14,da15,da16,da17,da18,da19,da20,da21,da22,da23,da24,da25,da26,da27,da28,da29,da30)
mai=c(dmm1,dmm2,dmm3,dmm4,dmm5,dmm6,dmm7,dmm8,dmm9,dmm10,dmm11,dmm12,dmm13,dmm14,dmm15,dmm16,dmm17,dmm18,dmm19,dmm20,dmm21,dmm22,dmm23,dmm24,dmm25,dmm26,dmm27,dmm28,dmm29,dmm30,dmm31)
jun=c(djj1,djj2,djj3,djj4,djj5,djj6,djj7,djj8,djj9,djj10,djj11,djj12,djj13,djj14,djj15,djj16,djj17,djj18,djj19,djj20,djj21,djj22,djj23,djj24,djj25,djj26,djj27,djj28,djj29,djj30)
jul=c(jd1,jd2,jd3,jd4,jd5,jd6,jd7,jd8,jd9,jd10,jd11,jd12,jd13,jd14,jd15,jd16,jd17,jd18,jd19,jd20,jd21,jd22,jd23,jd24,jd25,jd26,jd27,jd28,jd29,jd30,jd31)
aou=c(da1,da2,da3,da4,da5,da6,da7,da8,da9,da10,da11,da12,da13,da14,da15,da16,da17,da18,da19,da20,da21,da22,da23,da24,da25,da26,da27,da28,da29,da30,da31)
sep=c(dsep1,dsep2,dsep3,dsep4,dsep5,dsep6,dsep7,dsep8,dsep9,dsep10,dsep11,dsep12,dsep13,dsep14,dsep15,dsep16,dsep17,dsep18,dsep19,dsep20,dsep21,dsep22,dsep23,dsep24,dsep25,dsep26,dsep27,dsep28,dsep29,dsep30)
oct=c(do1,do2,do3,do4,do5,do6,do7,do8,do9,do10,do11,do12,do13,do14,do15,do16,do17,do18,do19,do20,do21,do22,do23,do24,do25,do26,do27,do28,do29,do30,do31)
nov=c(dn1,dn2,dn3,dn4,dn5,dn6,dn7,dn8,dn9,dn10,dn11,dn12,dn13,dn14,dn15,dn16,dn17,dn18,dn19,dn20,dn21,dn22,dn23,dn24,dn25,dn26,dn27,dn28,dn29,dn30)
dec=c(dd1,dd2,dd3,dd4,dd5,dd6,dd7,dd8,dd9,dd10,dd11,dd12,dd13,dd14,dd15,dd16,dd17,dd18,dd19,dd20,dd21,dd22,dd23,dd24,dd25,dd26,dd27,dd28,dd29,dd30,dd31)
rbind(mean(jan),mean(feb),mean(mar),mean(apr),mean(mai),mean(jun),mean(jul),mean(aou),mean(sep),mean(oct),mean(nov),mean(dec))
mean(data$w80)
rbind(min(jan),min(feb),min(mar),min(apr),min(mai),min(jun),min(jul),min(aou),min(sep),min(oct),min(nov),min(dec))
min(data$w80)
rbind(max(jan),max(feb),max(mar),max(apr),max(mai),max(jun),max(jul),max(aou),max(sep),max(oct),max(nov),max(dec))
max(data$w80)
var=c(jan,feb,mar,apr,mai,jun,jul,aou,sep,oct,nov,dec)
sea=c(mean(jan),mean(feb),mean(mar),mean(apr),mean(mai),mean(jun),mean(jul),mean(aou),mean(sep),mean(oct),mean(nov),mean(dec))
write.table(jan,"jan.txt")
write.table(feb,"feb.txt")
write.table(mar,"mar.txt")
write.table(apr,"apr.txt")
write.table(mai,"mai.txt")
write.table(jun,"jun.txt")
write.table(jul,"jul.txt")
write.table(aou,"aou.txt")
write.table(sep,"sep.txt")
write.table(oct,"oct.txt")
write.table(nov,"nov.txt")
write.table(dec,"dec.txt")
plot(var,
type="l")
plot(sea,
type="l")
boxplot(jan,feb,mar,apr,mai,jun,jul,aou,sep,oct,nov,dec,
col=rainbow(12) )
qj=cbind(quantile(jan,
probs = c(0.1,0.25,0.75, 0.9)))
qf=cbind(quantile(feb,
probs = c(0.1,0.25,0.75, 0.9)))
qm=cbind(quantile(mar,
probs = c(0.1,0.25,0.75, 0.9)))
qa=cbind(quantile(apr,
probs = c(0.1,0.25,0.75, 0.9)))
qm1=cbind(quantile(mai,
probs = c(0.1,0.25,0.75, 0.9)))
qj=cbind(quantile(jun,
probs = c(0.1,0.25,0.75, 0.9)))
qjj=cbind(quantile(jul,
probs = c(0.1,0.25,0.75, 0.9)))
qaa=cbind(quantile(aou,
probs = c(0.1,0.25,0.75, 0.9)))
qs=cbind(quantile(sep,
probs = c(0.1,0.25,0.75, 0.9)))
qo=cbind(quantile(oct,
probs = c(0.1,0.25,0.75, 0.9)))
qn=cbind(quantile(nov,
probs = c(0.1,0.25,0.75, 0.9)))
qd=cbind(quantile(dec,
probs = c(0.1,0.25,0.75, 0.9)))
q=cbind(c(qj,qf,qm,qa,qm1,qj,qjj,qaa,qs,qo,qn,qd));q
quan=read.csv(file("clipboard"),header=T,sep="\t",
dec=".",row.names=1);str(quan)
plot(sea,
type="l")
plot(-1,-1,xlim=c(0,12),
ylim=c(5,15),xlab="Month",ylab="Average Wind speed(m/s)")
grid(col="black",
lty="solid", lwd=1.5)
par(new=TRUE);plot(sea,lwd=1.5,lty=1,pch=20,type="b",
axes=F,ylab=NA,xlab=NA)
par(new=TRUE);plot(quan$q0.1,
type="l",lty=2,lwd=3,col="red", axes=F,
ylab=NA,xlab=NA);par(new=TRUE);plot(quan$q0.9,
type="l",lty=2,lwd=3,col="red",
axes=F,ylab=NA,xlab=NA)
par(new=TRUE);plot(quan$q0.25,
type="l",lty=3,lwd=3,col="blue", axes=F,
ylab=NA,xlab=NA);par(new=TRUE);plot(quan$q0.75,
type="l",lty=3,lwd=3,col="blue",
axes=F,ylab=NA,xlab=NA)
#TIMES
SERIES ANALYSIS
ts
<- ts(var, frequency=30, start=c(2015))
plot.ts(ts)
tsdec<-
decompose(ts)
plot(tsdec)
wmjan=c(mean(c(dj1,dj2,dj3,dj4,dj5,dj6,dj7)),mean(c(dj8,dj9,dj10,dj11,dj12,dj13,dj14)),mean(c(dj15,dj16,dj17,dj18,dj19,dj20,dj21)),mean(c(dj22,dj23,dj24,dj25,dj26,dj27,dj28,dj29,dj30,dj31)))
wmfeb=c(mean(c(df1,df2,df3,df4,df5,df6,df7)),mean(c(df8,df9,df10,df11,df12,df13,df14)),mean(c(df15,df16,df17,df18,df19,df20,df21)),mean(c(df22,df23,df24,df25,df26,df27,df28)))
wmmar=c(mean(c(dm1,dm2,dm3,dm4,dm5,dm6,dm7)),mean(c(dm8,dm9,dm10,dm11,dm12,dm13,dm14)),mean(c(dm15,dm16,dm17,dm18,dm19,dm20,dm21)),mean(c(dm22,dm23,dm24,dm25,dm26,dm27,dm28,dm29,dm30,dm31)))
wmapr=c(mean(c(da1,da2,da3,da4,da5,da6,da7)),mean(c(da8,da9,da10,da11,da12,da13,da14)),mean(c(da15,da16,da17,da18,da19,da20,da21)),mean(c(da22,da23,da24,da25,da26,da27,da28,da29,da30)))
wmmai=c(mean(c(dmm1,dmm2,dmm3,dmm4,dmm5,dmm6,dmm7)),mean(c(dmm8,dmm9,dmm10,dmm11,dmm12,dmm13,dmm14)),mean(c(dmm15,dmm16,dmm17,dmm18,dmm19,dmm20,dmm21)),mean(c(dmm22,dmm23,dmm24,dmm25,dmm26,dmm27,dmm28,dmm29,dmm30,dmm31)))
wmjun=c(mean(c(djj1,djj2,djj3,djj4,djj5,djj6,djj7)),mean(c(djj8,djj9,djj10,djj11,djj12,djj13,djj14)),mean(c(djj15,djj16,djj17,djj18,djj19,djj20,djj21)),mean(c(djj22,djj23,djj24,djj25,djj26,djj27,djj28,djj29,djj30)))
wmjul=c(mean(c(jd1,jd2,jd3,jd4,jd5,jd6,jd7)),mean(c(jd8,jd9,jd10,jd11,jd12,jd13,jd14)),mean(c(jd15,jd16,jd17,jd18,jd19,jd20,jd21)),mean(c(jd22,jd23,jd24,jd25,jd26,jd27,jd28,jd29,jd30,jd31)))
wmaou=c(mean(c(da1,da2,da3,da4,da5,da6,da7)),mean(c(da8,da9,da10,da11,da12,da13,da14)),mean(c(da15,da16,da17,da18,da19,da20,da21)),mean(c(da22,da23,da24,da25,da26,da27,da28,da29,da30,da31)))
wmsep=c(mean(c(dsep1,dsep2,dsep3,dsep4,dsep5,dsep6,dsep7)),mean(c(dsep8,dsep9,dsep10,dsep11,dsep12,dsep13,dsep14)),mean(c(dsep15,dsep16,dsep17,dsep18,dsep19,dsep20,dsep21)),mean(c(dsep22,dsep23,dsep24,dsep25,dsep26,dsep27,dsep28,dsep29,dsep30)))
wmoct=c(mean(c(do1,do2,do3,do4,do5,do6,do7)),mean(c(do8,do9,do10,do11,do12,do13,do14)),mean(c(do15,do16,do17,do18,do19,do20,do21)),mean(c(do22,do23,do24,do25,do26,do27,do28,do29,do30,do31)))
wmnov=c(mean(c(dn1,dn2,dn3,dn4,dn5,dn6,dn7)),mean(c(dn8,dn9,dn10,dn11,dn12,dn13,dn14)),mean(c(dn15,dn16,dn17,dn18,dn19,dn20,dn21)),mean(c(dn22,dn23,dn24,dn25,dn26,dn27,dn28,dn29,dn30)))
wmdec=c(mean(c(dd1,dd2,dd3,dd4,dd5,dd6,dd7)),mean(c(dd8,dd9,dd10,dd11,dd12,dd13,dd14)),mean(c(dd15,dd16,dd17,dd18,dd19,dd20,dd21)),mean(c(dd22,dd23,dd24,dd25,dd26,dd27,dd28,dd29,dd30,dd31)))
wmvar=c(wmjan,wmfeb,wmmar,wmapr,wmmai,wmjun,wmjul,wmaou,wmsep,wmoct,wmnov,wmdec)
plot(wmvar,
type="l")
plot(-1,-1,xlim=c(0,60),
ylim=c(0,16),xlab="Month",ylab="Average Wind speed(m/s)")
grid(col="black",
lty="solid", lwd=1.5)
par(new=TRUE);plot(wmvar,lwd=1.5,lty=1,pch=20,type="b",col="red",
axes=F,ylab=NA,xlab=NA)
#
J1(31) F(28/29) M1(31) A1(30) M2(31) J2(30) J3(31) A2(31) S(30) O(31) N(30)
D(31)
dim(data) # NEED 52560
j1=data[c(1:4464),]
f2=data[c(4465:8497),]
m3=data[c(8498:12962),]
a4=data[c(12963:17283),]
m5=data[c(17284:27748),]
wsj=data[c(1:4464),]
wsjj=data[c(1:4320),]
wsao=data[c(1:4464),]
wssep=data[c(1:4464),]
wso=data[c(1:4320),]
wsn=data[c(1:4464),]
wsd=data[c(1:4320),]
write.table(j1,"j1.txt")
#
#
WIND ROSE DIAGRAM :
goubet<-read.csv(file("clipboard"),header=T,sep="\t",
dec=",",row.names=1)
#goubet<-read.csv(file("clipboard"),header=T,sep="\t",
dec=",")
#
"right", "left", "top", "bottom"
summary(w60)
require(openair)
windRose(data,
ws = "w60", wd ="d60",
paddle = F, border = T,
breaks = c(0, 4, 8, 12, 16, 21),
key.position = "bottom",
col =c( "blue",
"purple", "pink","red", "darkred"),
grid.line = list(value = 5, lty = 1,
lwd=3, col = "black"), annotate = TRUE,
key.header = "Wind Speed",
angle.scale = 35)
#WindRose.R
#
POTENTIAL AREA ASSESSMENT
#WIND
DENSITY POWER
rho=1.225
#kg/m3
#PD=rho*
(sum(v2^3)/length(v2))/2 = PD/A (W/M2)
PDA
= (rho* (mean(v2^3)))/2; PDA
Radius=sqrt(10024/pi);Radius
Diam=
2*Radius; Diam # 112.9732
#POWER
CAPTUTRED
cp=(0.35+0.45)/2
PC=0.5*rho*Radius^2*cp*(v2^3)
plot(PC,
type="l")
#
pot<-read.csv(file("clipboard"),header=T,sep="\t",
dec=",",row.names=1)
str(pot)
dim(pot)
summary(pot)
cbind(summary(pot1$Extract_tif12_Band_1))
attach(pot)
names(pot)
#400-500 6.8 - 7.3
#500-600 7.3 - 7.7
#600-800 7.7 – 8.5
#>
800 > 8.5
#23703 # dim(pot)
a=WS[WS>
6.8 & WS < 7.29 ]
b=WS[WS>
7.299 & WS < 7.69 ]
c=WS[WS>
7.699 & WS < 8.499 ]
d=WS[WS>
85 ]
z=WS[WS<6.8]
A=PD[PD>
400 & PD< 499 ]
B=PD[PD>
499.9 & PD< 599.9]
C=PD[PD>
500.9 & PD< 800 ]
D=PD[PD>
800 ]
1825.99 #km2 ARTA
#CAPACITY
FACTOR INTERMITTENCE FACTOR
k=kmm;
c=cmm
vi=3;
vr=11.5; vo=25;
Pout= exp(-((vi/c)^k))
- exp(-((vr/c)^k))
Pr=((vr/c)^k) -
((vi/c)^k)
CF = (Pout/Pr) -
exp(-(vo/c)^k); CF
#
# WEIBULL DISTRIBUTION
#EXTRAPOLATION
WIND SPEED | WIND SHEAR COEFICCIENT
#names(data)
#v1=w60
#length(v1)
#h1=60;
h2=90
#Methodology
1:
#alpha=(0.37-(0.088*log(mean(v1))))/(1-(0.088*log(h1/10)));alpha
#v2=v1*((h2/h1)^alpha);mean(v2)
#write.table(v2,"data.txt")
#Methodology
2 :
#v2=(v1*((h2/h1)^(1/7))); ko=2.93 ; co=10.07
#c80=co*(80/40)^(0.37-(0.088*log(co)))/(1-0.088*log(80/10));
c80
#k80=ko*(
(1-(0.088*log(40/10)))/(1-(0.088*log(80/10))) ); k80 ;c80
#WEIBULL
AND RAYLEIGH DISTRIBUTION :
moy=mean(v2)
sd=(sd(v2)*length(v2))/(length(v2)-1)
count=data.frame(table(v2))
#
Kurtosis & Skewness
skew=sum((v2-moy)^3/sd^3)/(length(v2)-1)
kurt=sum((((v2-moy)^4)/(sd^4))-3)/(length(v2)-1)
min=min(v2)
max=max(v2)
rbind(c("Statistic
of v2"),moy,sd,skew,kurt,min,max)
#
After Result of Paralmeter find it
#Wind
Speed Probability WEIBULL
k;kmm;kmv;kwasp
c;cmm;cmv;cwasp
kp=k;
cp=c
vmp=cp*
((1-(1/kp))^(1/kp)) ;round(vmp,3)
vmaxe=cp*
((1+(2/kp))^(1/kp)) ;round(vmaxe,3)
vmw=cp*gamma((1+(1/kp))) ;round(vmw,3)
#
#GRAPHIQUE
POWER/ENERGY DENSITY TURBINE WITH R
LIBRARY #
#doi:10.3390/app8101757
#
k;kmm;kmv;kwasp #
c;cmm;cmv;cwasp #
kp=k;
cp=c #
#
#
DENSITY in term of area m² #
rho=1.225
#kg/m3 #
PDW
= (rho* (cp^3)*gamma((kp+3)/kp) ) /2; PDW #
PDA
= (rho* (mean(v2^3)))/2; PDA #
#
-2First Group Estimation Weibull Distribution
#Empirique
de Jestus
kej=(sd/moy)^-1.086
cej=moy/gamma((1+(1/kej)))
#Maximum-Likelihood
Method
kmv=1/(sum(v2^(kej+0.09)*log(v2))/sum(v2^(kej+0.09))
-sum(log(v2))/length(v2))
cmv=(sum(v2^kmv)/length(v2))^(1/kmv)
#Power-Density
Method OR Energy pattern factor method
E=(sum(v2^3)/length(v2))/moy^3
kpd=1+(3.69/E^2)
cpd=moy/gamma((1+(1/kpd)))
#Curving-Fitting
Method
kcf=(0.9874/(sd/moy))^1.0983
ccf=moy/gamma((1+(1/kcf)))
#require(ForestFit)
#n<-100;
alpha<-2; beta<-2; theta<-3
#data<-rweibull(n,shape=alpha,scale=beta)+theta
#
rbind(kej,kmv,kpd,kcf,cej,cmv,cpd,ccf)
#Empirical
method of Justus/ moment method
cej;kej
cmm=11.391
; kmm=2.681
mean(v2);
cmm*gamma(1+(1/kmm)); sd(v2); cmm*
sqrt(gamma(1+(2/kmm))-(gamma(1+(1/kmm))^2 ))
#Multi-Objective
Moments (MUOM)
#kmm=(sd/moy)^-1.086
#cmm=moy/gamma((1+(1/kmm)))
#L1=1/3;L2=1/3;L3=1/3
#k=2.645224;
c=10.2183
#L1*(c*gamma(1+(1/k))-mean(v2))^2
+ L2*(c^2*gamma(1+(2/k))-mean(v2^2))^2
+
L3*(c^3*gamma(1+(3/k))-mean(v2^3))^2
#k=2.68012;
c=10.2201
#L1*(c*gamma(1+(1/k))-mean(v2))^2
+ L2*(c^2*gamma(1+(2/k))-mean(v2^2))^2
+
L3*(c^3*gamma(1+(3/k))-mean(v2^3))^2
#k=2.69;
c=10.20
#L1*(c*gamma(1+(1/k))-mean(v2))^2
+ L2*(c^2*gamma(1+(2/k))-mean(v2^2))^2
+
L3*(c^3*gamma(1+(3/k))-mean(v2^3))^2
#
-3-> > > Second Group Estimation Weibull Distribution
#Median
and Quartiles Method
cbind(quantile(v2))
Q0
Q1 = 7.0880821 # 25%
Q3 = 13.2096076 # 75%
Q2 = 10.3099377 # 50%
Q4
#kmq=1.573/log(Q3/Q1)
kmq=log(log(1/4)/log(3/4))/log(Q3/Q1)
cmq=Q2/log(2)^(1/kmq)
#*====================*Least
square Method Or Graphical method
F=1-exp(-(v2/(cmm+0.09))^(kmm+0.09))
x = log(v2)
y =log(-log(1-F))
ls=lm(y~x);summary(ls)
kls= 2.781e+00
Intercept= -6.752e+00
cls=exp(-(Intercept/kls))
#Modified
maximum likelihood Method
frq=hist(v2);
dev.off()
#kmml=1/(sum((frq$mids^(kmv+0.09))*log(frq$mids)*frq$density)/sum((frq$mids^(kmv+0.09))*frq$density)
-sum(log(frq$mids)*frq$density)/sum(frq$density))
#cmml=(sum(frq$mids^kmml*frq$density)/sum(frq$density))^(1/kmml)
kmml=sum(frq$mids^(kmv+0.09)*log(frq$mids)*frq$density)/((sum(frq$mids^(kmv+0.09)*frq$density))-
(sum(log(frq$mids)*frq$density)/sum(frq$density)))
cmml=((1/sum(frq$density))*sum(frq$mids^kmml*frq$density))^(1/kmml)
#Empirical
method of lysen (EML)
keml=(sd/moy)^-1.086
ceml=moy/gamma(1+(1/keml))
ceml2=mean(v2)*(0.568+(0.433/keml))^(-(1/keml))
#__________________________________________
rbind(kmq,keml,kls,kmml,k,
cmq,ceml,cls,cmml,c)
#-3->
> > Third Group Estimation Weibull Distribution
#Equivalent
Energy Method
kee=1/(sum((frq$mids^(kmv+0.09))*log(frq$mids)*frq$density)/sum((frq$mids^(kmv+0.09))*frq$density)
-sum(log(frq$mids)*frq$density)/sum(frq$density))
#cee=((moy^3)/gamma(1+(3/kee)))^(1/3)
cee=((moy^3)/gamma(1+(3/kmm)))^(1/3)
#Probability
weighted moments Method(based on power density method)
#sort(x,
decreasing = FALSE, na.last = TRUE)
#vi=sort(v2,
decreasing = FALSE, na.last = TRUE)
# ATTENTION A TRIER
POUR EVITER L'ERREUR
#Cbar
= mean(v2)/ (2/n(n-1))* sum(vi*(n-i) == A TRIER !
Cbar=moy/(
(2/(length(v2)*(length(v2)-1))) * 1.05801E+11 )
kpwm=log(2)/log(Cbar)
cpwm=(moy^3/gamma(1+(3/kpwm)))^(1/3)
#*====================*WAsP
Method
F=1-exp(-(mean(v2)/(cmm+0.05))^(kmm+0.05))
cwasp=(sum(v2^3)/(length(v2)*gamma((3/(kmm+0.05))+1)))^(1/3)
X=1-mean(F)
w1=-log(X)
#log(w1)==log((moy/cwasp)^k)
#log((moy/cwasp)^k)=k*log(moy)-log(cwasp)=k*log(moy/cwasp)
kwasp
= log(w1)/log(moy/cwasp)
#z=1-F;
w=-log(z);w
#x=(mean(v2)/((sum(v2^3))/(length(v2)*gamma((3/kmm)+1))^(1/3)))^2.61;
x
#*====================*Weighted
Least Square Method
F=1-exp(-(v2/(cmm+0.09))^(kmm+0.09))
x = log(v2)
y =log(-log(1-F))
w=((1-F)*log(1-F))^2
library(MASS)
summary(rlm(y~x,weights
= 1/w))
kwls= 2.780600e+00
Intercept= -6.752000e+00
cwls=exp(-(Intercept/kwls))
#
rbind(kee,kpwm,kwasp,kwls,cee,cpwm,cwasp,cwls)
#OTHER
POSSIBILITY OF WEIBULL
#temp
<- dput(temp)
#"mle",
"mme", "qme", "mge", "mse"
#
Fitting method:
#"mme"
for 'moment matching estimation'
#mmedist(v2,
"weibull", order, start = NULL, fix.arg = NULL, optim.method =
"default")
library(fitdistrplus)
x3
<- rbeta(v2,shape1=cmq, shape2=kmq)
mmedist(x3,
"beta")$estimate
# "mse" for 'maximum spacing
estimation
fitdist(v2,
distr = "weibull", method = "mle")
#------------"mle"
for 'maximum likelihood estimation
mledist(v2,
distr="weibull", start = NULL, fix.arg = NULL, optim.method =
"default")$estimate
fitdist(v2,
distr = "weibull", method = "mle")
#-------------"qme"
for 'quantile matching estimation
qmedist(V_60,
"weibull", probs=c(1/3, 2/3))$estimate
#------------"mge"
for 'maximum goodness-of-fit estimation
#"CvM",
"KS", "AD", "ADR", "ADL",
"AD2R", "AD2L",
mgedist(V_60,
distr="weibull", gof = "ADL", start = NULL, fix.arg = NULL,
optim.method = "default")
# The mgedist function numerically maximizes
goodness-of-fit:or minimizes a goodness-of-fit distance coded by the argument
gof.
# One may use one of the classical distances
defined in Stephens (1986)
# the Cramer-von Mises distance
("CvM")
# the Kolmogorov-Smirnov distance
("KS")
# the Anderson-Darling distance
("AD")
#which
gives more weight to the tails of the distribution, or one of the variants of
this last distance proposed by Luceno (2006).
# the right-tail AD ("ADR")
# the left-tail AD ("ADL")
require(MASS)
library(fitdistrplus)
fit.weibull
<- fitdist(V_60, distr = "weibull", method = "mle",
lower = c(0, 0))
fit.weibull2
<- fitdist(V_60, distr = "weibull", method = "mse",
lower = c(0, 0))
#fit.gamma
<- fitdist(temp, distr = "gamma", method = "mle", lower
= c(0, 0), start = list(scale = 1, shape = 1))
#fit.weibull
<- fitdist(temp, distr = "weibull", method = "mle",
lower = c(0, 0))
#fit.gamma
<- fitdist(temp, distr = "gamma", method = "mle", lower
= c(0, 0), start = list(scale = 1, shape = 1))
plot(fit.weibull)
#plot(fit.gamma)
gofstat(list(fit.weibull,
fit.weibull2))
# ESTIMATION OTHER WEIBULL 2
#https://rdrr.io/cran/Temporal/man/fit.Weibull.html
#library(Temporal)
#
Generate Weibull data with 20% censoring
#data
= genData(n=1e3,dist="weibull",theta=c(2,2),p=0.2);
#
Estimate
#fit
= fitParaSurv(time=data$time,status=data$status,dist="weibull")
#BOOSTRAPE
SUIMULATION ESTIMATION
#Boodist
#CREATION
OF FREQUENCYS RELATIVE OF WIND SPEED M/S
#using
Excel lead to replace by element specific and not by number
#data$Variable[data$Variable<=100]<-1
#data$Variable[data$Variable
%in%
c("maison","appart","truc")]<-"habitat"
goubet<-read.csv(file("clipboard"),header=T,sep="\t",
dec=",",row.names=1)
str(goubet);
attach(goubet); names(goubet)
effectif<-table(V_60);
cbind(effectif)
frequence<-(effectif)/length(V_60);
cbind(frequence)
# data$V_60[data$V_60== ]<-
#
GOBAAD STATION
#################
data$v2[data$v2== 0.4
]<- 1.113932e-02
data$v2[data$v2== 0.5
]<- 3.970328e-03
data$v2[data$v2== 0.6
]<- 3.708959e-03
data$v2[data$v2== 0.7
]<- 4.007667e-03
data$v2[data$v2== 0.8
]<- 4.468175e-03
data$v2[data$v2== 0.9
]<- 4.455729e-03
data$v2[data$v2== 1
]<- 4.754437e-03
data$v2[data$v2== 1.1
]<- 5.015807e-03
data$v2[data$v2== 1.2
]<- 5.351853e-03
data$v2[data$v2== 1.3
]<- 6.111070e-03
data$v2[data$v2== 1.4
]<- 7.106763e-03
data$v2[data$v2== 1.5
]<- 6.795609e-03
data$v2[data$v2== 1.6
]<- 7.704179e-03
data$v2[data$v2== 1.7
]<- 7.803749e-03
data$v2[data$v2== 1.8
]<- 8.027780e-03
data$v2[data$v2== 1.9
]<- 8.239365e-03
data$v2[data$v2== 2
]<- 8.674981e-03
data$v2[data$v2== 2.2
]<- 1.030543e-02
data$v2[data$v2== 2.3
]<- 9.409305e-03
data$v2[data$v2== 2.4
]<- 1.026809e-02
data$v2[data$v2== 2.5
]<- 1.061658e-02
data$v2[data$v2== 2.6
]<- 1.044234e-02
data$v2[data$v2== 2.7
]<- 1.138825e-02
data$v2[data$v2== 2.8
]<- 1.145048e-02
data$v2[data$v2== 2.9
]<- 1.258308e-02
data$v2[data$v2== 3
]<- 1.257063e-02
data$v2[data$v2== 3.1
]<- 1.258308e-02
data$v2[data$v2== 3.2
]<- 1.255819e-02
data$v2[data$v2== 3.3
]<- 1.316805e-02
data$v2[data$v2== 3.4
]<- 1.375302e-02
data$v2[data$v2== 3.5
]<- 1.279466e-02
data$v2[data$v2== 3.6
]<- 1.374057e-02
data$v2[data$v2== 3.7
]<- 1.323028e-02
data$v2[data$v2== 3.8
]<- 1.448734e-02
data$v2[data$v2== 3.9
]<- 1.346676e-02
data$v2[data$v2== 4
]<- 1.483584e-02
data$v2[data$v2== 4.1
]<- 1.449979e-02
data$v2[data$v2== 4.2
]<- 1.494785e-02
data$v2[data$v2== 4.3
]<- 1.457447e-02
data$v2[data$v2== 4.4
]<- 1.513454e-02
data$v2[data$v2== 4.5
]<- 1.584397e-02
data$v2[data$v2== 4.6
]<- 1.550793e-02
data$v2[data$v2== 4.7
]<- 1.603067e-02
data$v2[data$v2== 4.8
]<- 1.583153e-02
data$v2[data$v2== 4.9
]<- 1.569462e-02
data$v2[data$v2== 5
]<- 1.588131e-02
data$v2[data$v2== 5.1
]<- 1.524656e-02
data$v2[data$v2== 5.2
]<- 1.497274e-02
data$v2[data$v2== 5.3
]<- 1.461180e-02
data$v2[data$v2== 5.4
]<- 1.454957e-02
data$v2[data$v2== 5.5
]<- 1.519677e-02
data$v2[data$v2== 5.6
]<- 1.448734e-02
data$v2[data$v2== 5.7
]<- 1.350409e-02
data$v2[data$v2== 5.8
]<- 1.431310e-02
data$v2[data$v2== 5.9
]<- 1.213502e-02
data$v2[data$v2== 6
]<- 1.290668e-02
data$v2[data$v2== 6.1
]<- 1.311826e-02
data$v2[data$v2== 6.2
]<- 1.269509e-02
data$v2[data$v2== 6.3
]<- 1.171185e-02
data$v2[data$v2== 6.4
]<- 1.186120e-02
data$v2[data$v2== 6.5
]<- 1.115177e-02
data$v2[data$v2== 6.6
]<- 1.059169e-02
data$v2[data$v2== 6.7
]<- 1.081572e-02
data$v2[data$v2== 6.8
]<- 9.994275e-03
data$v2[data$v2== 6.9
]<- 9.608443e-03
data$v2[data$v2== 7
]<- 9.160381e-03
data$v2[data$v2== 7.1
]<- 9.770244e-03
data$v2[data$v2== 7.2
]<- 9.658228e-03
data$v2[data$v2== 7.3
]<- 8.625196e-03
data$v2[data$v2== 7.4
]<- 8.674981e-03
data$v2[data$v2== 7.5
]<- 7.940657e-03
data$v2[data$v2== 7.6
]<- 7.915764e-03
data$v2[data$v2== 7.7
]<- 7.915764e-03
data$v2[data$v2== 7.8
]<- 7.554825e-03
data$v2[data$v2== 7.9
]<- 7.641949e-03
data$v2[data$v2== 8
]<- 7.604610e-03
data$v2[data$v2== 8.1
]<- 7.231225e-03
data$v2[data$v2== 8.2
]<- 6.696040e-03
data$v2[data$v2== 8.3
]<- 6.123516e-03
data$v2[data$v2== 8.4
]<- 5.650561e-03
data$v2[data$v2== 8.5
]<- 6.036393e-03
data$v2[data$v2== 8.6
]<- 5.438976e-03
data$v2[data$v2== 8.7
]<- 5.401638e-03
data$v2[data$v2== 8.8
]<- 5.376746e-03
data$v2[data$v2== 8.9
]<- 5.040699e-03
data$v2[data$v2== 9
]<- 5.177607e-03
data$v2[data$v2== 9.1
]<- 5.003360e-03
data$v2[data$v2== 9.2
]<- 4.393498e-03
data$v2[data$v2== 9.3
]<- 4.331267e-03
data$v2[data$v2== 9.4
]<- 4.169467e-03
data$v2[data$v2== 9.5
]<- 4.418390e-03
data$v2[data$v2== 9.6
]<- 3.771190e-03
data$v2[data$v2== 9.7
]<- 3.796082e-03
data$v2[data$v2== 9.8
]<- 3.920544e-03
data$v2[data$v2== 9.9
]<- 4.231698e-03
data$v2[data$v2== 10
]<- 3.211112e-03
data$v2[data$v2== 10.1
]<- 2.987081e-03
data$v2[data$v2== 10.2
]<- 2.812834e-03
data$v2[data$v2== 10.3
]<- 3.310681e-03
data$v2[data$v2== 10.4
]<- 2.949742e-03
data$v2[data$v2== 10.5
]<- 2.738157e-03
data$v2[data$v2== 10.6
]<- 2.787942e-03
data$v2[data$v2== 10.7
]<- 2.837727e-03
data$v2[data$v2== 10.8
]<- 2.314988e-03
data$v2[data$v2== 10.9
]<- 2.252757e-03
data$v2[data$v2== 11
]<- 2.128295e-03
data$v2[data$v2== 11.1
]<- 2.128295e-03
data$v2[data$v2== 11.2
]<- 2.115849e-03
data$v2[data$v2== 11.3
]<- 1.941603e-03
data$v2[data$v2== 11.4
]<- 1.468648e-03
data$v2[data$v2== 11.5
]<- 1.530879e-03
data$v2[data$v2== 11.6
]<- 1.356633e-03
data$v2[data$v2== 11.7
]<- 1.555771e-03
data$v2[data$v2== 11.8
]<- 1.431310e-03
data$v2[data$v2== 11.9
]<- 1.294402e-03
data$v2[data$v2== 12
]<- 1.306848e-03
data$v2[data$v2== 12.1
]<- 1.095263e-03
data$v2[data$v2== 12.2
]<- 1.169940e-03
data$v2[data$v2== 12.3
]<- 1.232171e-03
data$v2[data$v2== 12.4
]<- 9.832475e-04
data$v2[data$v2== 12.5
]<- 1.157494e-03
data$v2[data$v2== 12.6
]<- 9.334628e-04
data$v2[data$v2== 12.7
]<- 8.961243e-04
data$v2[data$v2== 12.8
]<- 7.716626e-04
data$v2[data$v2== 12.9
]<- 1.033032e-03
data$v2[data$v2== 13
]<- 8.090011e-04
data$v2[data$v2== 13.1
]<- 6.596470e-04
data$v2[data$v2== 13.2
]<- 6.223085e-04
data$v2[data$v2== 13.3
]<- 6.596470e-04
data$v2[data$v2== 13.4
]<- 6.720932e-04
data$v2[data$v2== 13.5
]<- 5.600777e-04
data$v2[data$v2== 13.6
]<- 4.729545e-04
data$v2[data$v2== 13.7
]<- 5.102930e-04
data$v2[data$v2== 13.8
]<- 2.862619e-04
data$v2[data$v2== 13.9
]<- 2.613696e-04
data$v2[data$v2== 14
]<- 4.107236e-04
data$v2[data$v2== 14.1
]<- 2.738157e-04
data$v2[data$v2== 14.2
]<- 2.364772e-04
data$v2[data$v2== 14.3
]<- 2.115849e-04
data$v2[data$v2== 14.4
]<- 1.618002e-04
data$v2[data$v2== 14.5
]<- 1.244617e-04
data$v2[data$v2== 14.6
]<- 9.956936e-05
data$v2[data$v2== 14.7
]<- 6.223085e-05
data$v2[data$v2== 14.8
]<- 8.712319e-05
data$v2[data$v2== 14.9
]<- 7.467702e-05
data$v2[data$v2== 15
]<- 4.978468e-05
data$v2[data$v2== 15.1
]<- 1.369079e-04
data$v2[data$v2== 15.2
]<- 6.223085e-05
data$v2[data$v2== 15.3
]<- 4.978468e-05
data$v2[data$v2== 15.4
]<- 3.733851e-05
data$v2[data$v2== 15.5
]<- 4.978468e-05
data$v2[data$v2== 15.6
]<- 6.223085e-05
data$v2[data$v2== 15.7
]<- 2.489234e-05
data$v2[data$v2== 15.8
]<- 1.244617e-05
data$v2[data$v2== 15.9
]<- 2.489234e-05
data$v2[data$v2== 16
]<- 3.733851e-05
data$v2[data$v2== 16.1
]<- 2.489234e-05
data$v2[data$v2== 16.2
]<- 4.978468e-05
data$v2[data$v2== 16.3
]<- 1.244617e-05
data$v2[data$v2== 16.4
]<- 3.733851e-05
data$v2[data$v2== 16.5
]<- 2.489234e-05
data$v2[data$v2== 16.6
]<- 1.244617e-05
data$v2[data$v2== 16.7
]<- 2.489234e-05
data$v2[data$v2== 16.8
]<- 1.244617e-05
data$v2[data$v2== 17.3
]<- 1.244617e-05
data$v2[data$v2== 17.5
]<- 2.489234e-05
data$v2[data$v2== 17.9
]<- 1.244617e-05
data$v2[data$v2== 18.1
]<- 1.244617e-05
data$v2[data$v2== 18.9
]<- 1.244617e-05
data$v2[data$v2== 20.3
]<- 1.244617e-05
data$v2[data$v2== 21.5
]<- 1.244617e-05
data=data.frame(data$v2)
write.table(data,
"exportR.txt")
getwd() # setwd()
data<-read.csv(file("clipboard"),header=T,sep="\t",
dec=",",row.names=1)
str(data);
str(data)
#
GOUBBET STATION
goubet$F_60[goubet$F_60==0.4 ]<- 3.986314e-03
goubet$F_60[goubet$F_60==0.5 ]<- 1.151360e-03
goubet$F_60[goubet$F_60==0.6 ]<- 1.031880e-03
goubet$F_60[goubet$F_60==0.7 ]<- 9.015370e-04
goubet$F_60[goubet$F_60==0.8 ]<- 1.042742e-03
goubet$F_60[goubet$F_60==0.9 ]<- 1.238256e-03
goubet$F_60[goubet$F_60==1 ]<- 1.118775e-03
goubet$F_60[goubet$F_60==1.1 ]<- 1.238256e-03
goubet$F_60[goubet$F_60==1.2 ]<- 1.292565e-03
goubet$F_60[goubet$F_60==1.3 ]<- 1.422908e-03
goubet$F_60[goubet$F_60==1.4 ]<- 1.336013e-03
goubet$F_60[goubet$F_60==1.5 ]<- 1.227394e-03
goubet$F_60[goubet$F_60==1.6 ]<- 1.629284e-03
goubet$F_60[goubet$F_60==1.7 ]<- 1.813936e-03
goubet$F_60[goubet$F_60==1.8 ]<- 1.857383e-03
goubet$F_60[goubet$F_60==1.9 ]<- 1.911693e-03
goubet$F_60[goubet$F_60==2 ]<- 2.139793e-03
goubet$F_60[goubet$F_60==2.1 ]<- 2.270135e-03
goubet$F_60[goubet$F_60==2.2 ]<- 2.563406e-03
goubet$F_60[goubet$F_60==2.3 ]<- 2.204964e-03
goubet$F_60[goubet$F_60==2.4 ]<- 2.737197e-03
goubet$F_60[goubet$F_60==2.5 ]<- 2.519959e-03
goubet$F_60[goubet$F_60==2.6 ]<- 2.856677e-03
goubet$F_60[goubet$F_60==2.7 ]<- 3.356324e-03
goubet$F_60[goubet$F_60==2.8 ]<- 3.215120e-03
goubet$F_60[goubet$F_60==2.9 ]<- 3.269429e-03
goubet$F_60[goubet$F_60==3 ]<- 3.660457e-03
goubet$F_60[goubet$F_60==3.1 ]<- 3.660457e-03
goubet$F_60[goubet$F_60==3.2 ]<- 3.584424e-03
goubet$F_60[goubet$F_60==3.3 ]<- 4.257861e-03
goubet$F_60[goubet$F_60==3.4 ]<- 4.018900e-03
goubet$F_60[goubet$F_60==3.5 ]<- 4.399066e-03
goubet$F_60[goubet$F_60==3.6 ]<- 4.757508e-03
goubet$F_60[goubet$F_60==3.7 ]<- 4.638027e-03
goubet$F_60[goubet$F_60==3.8 ]<- 4.974746e-03
goubet$F_60[goubet$F_60==3.9 ]<- 5.029056e-03
goubet$F_60[goubet$F_60==4 ]<- 5.354912e-03
goubet$F_60[goubet$F_60==4.1 ]<- 5.344050e-03
goubet$F_60[goubet$F_60==4.2 ]<- 5.550426e-03
goubet$F_60[goubet$F_60==4.3 ]<- 5.626460e-03
goubet$F_60[goubet$F_60==4.4 ]<- 5.865421e-03
goubet$F_60[goubet$F_60==4.5 ]<- 6.202140e-03
goubet$F_60[goubet$F_60==4.6 ]<- 6.386792e-03
goubet$F_60[goubet$F_60==4.7 ]<- 6.788682e-03
goubet$F_60[goubet$F_60==4.8 ]<- 6.734372e-03
goubet$F_60[goubet$F_60==4.9 ]<- 6.289035e-03
goubet$F_60[goubet$F_60==5 ]<- 6.636615e-03
goubet$F_60[goubet$F_60==5.1 ]<- 6.832129e-03
goubet$F_60[goubet$F_60==5.2 ]<- 7.223158e-03
goubet$F_60[goubet$F_60==5.3 ]<- 7.559876e-03
goubet$F_60[goubet$F_60==5.4 ]<- 7.299191e-03
goubet$F_60[goubet$F_60==5.5 ]<- 6.908163e-03
goubet$F_60[goubet$F_60==5.6 ]<- 7.581600e-03
goubet$F_60[goubet$F_60==5.7 ]<- 7.896595e-03
goubet$F_60[goubet$F_60==5.8 ]<- 7.559876e-03
goubet$F_60[goubet$F_60==5.9 ]<- 7.299191e-03
goubet$F_60[goubet$F_60==6 ]<- 7.092815e-03
goubet$F_60[goubet$F_60==6.1 ]<- 7.679357e-03
goubet$F_60[goubet$F_60==6.2 ]<- 7.244881e-03
goubet$F_60[goubet$F_60==6.3 ]<- 7.549014e-03
goubet$F_60[goubet$F_60==6.4 ]<- 7.777114e-03
goubet$F_60[goubet$F_60==6.5 ]<- 7.440395e-03
goubet$F_60[goubet$F_60==6.6 ]<- 7.016782e-03
goubet$F_60[goubet$F_60==6.7 ]<- 7.603324e-03
goubet$F_60[goubet$F_60==6.8 ]<- 7.092815e-03
goubet$F_60[goubet$F_60==6.9 ]<- 7.635909e-03
goubet$F_60[goubet$F_60==7 ]<- 7.494705e-03
goubet$F_60[goubet$F_60==7.1 ]<- 7.885733e-03
goubet$F_60[goubet$F_60==7.2 ]<- 8.613480e-03
goubet$F_60[goubet$F_60==7.3 ]<- 8.113833e-03
goubet$F_60[goubet$F_60==7.4 ]<- 8.146418e-03
goubet$F_60[goubet$F_60==7.5 ]<- 8.570032e-03
goubet$F_60[goubet$F_60==7.6 ]<- 7.635909e-03
goubet$F_60[goubet$F_60==7.7 ]<- 7.896595e-03
goubet$F_60[goubet$F_60==7.8 ]<- 8.515723e-03
goubet$F_60[goubet$F_60==7.9 ]<- 7.907457e-03
goubet$F_60[goubet$F_60==8 ]<- 8.309347e-03
goubet$F_60[goubet$F_60==8.1 ]<- 8.689513e-03
goubet$F_60[goubet$F_60==8.2 ]<- 8.895889e-03
goubet$F_60[goubet$F_60==8.3 ]<- 8.906751e-03
goubet$F_60[goubet$F_60==8.4 ]<- 9.362950e-03
goubet$F_60[goubet$F_60==8.5 ]<- 9.362950e-03
goubet$F_60[goubet$F_60==8.6 ]<- 9.688807e-03
goubet$F_60[goubet$F_60==8.7 ]<- 8.819856e-03
goubet$F_60[goubet$F_60==8.8 ]<- 9.764840e-03
goubet$F_60[goubet$F_60==8.9 ]<- 9.895183e-03
goubet$F_60[goubet$F_60==9 ]<- 9.992940e-03
goubet$F_60[goubet$F_60==9.1 ]<- 9.395536e-03
goubet$F_60[goubet$F_60==9.2 ]<- 1.006897e-02
goubet$F_60[goubet$F_60==9.3 ]<- 9.558464e-03
goubet$F_60[goubet$F_60==9.4 ]<- 1.026449e-02
goubet$F_60[goubet$F_60==9.5 ]<- 9.656221e-03
goubet$F_60[goubet$F_60==9.6 ]<- 9.938630e-03
goubet$F_60[goubet$F_60==9.7 ]<- 9.286917e-03
goubet$F_60[goubet$F_60==9.8 ]<- 9.721392e-03
goubet$F_60[goubet$F_60==9.9 ]<- 9.873459e-03
goubet$F_60[goubet$F_60==10 ]<- 8.863303e-03
goubet$F_60[goubet$F_60==10.1
]<- 9.906045e-03
goubet$F_60[goubet$F_60==10.2
]<- 9.916907e-03
goubet$F_60[goubet$F_60==10.3
]<- 9.286917e-03
goubet$F_60[goubet$F_60==10.4
]<- 9.960354e-03
goubet$F_60[goubet$F_60==10.5
]<- 9.058817e-03
goubet$F_60[goubet$F_60==10.6
]<- 1.010156e-02
goubet$F_60[goubet$F_60==10.7
]<- 8.678651e-03
goubet$F_60[goubet$F_60==10.8
]<- 8.722099e-03
goubet$F_60[goubet$F_60==10.9
]<- 8.874165e-03
goubet$F_60[goubet$F_60==11 ]<- 8.287623e-03
goubet$F_60[goubet$F_60==11.1
]<- 8.950198e-03
goubet$F_60[goubet$F_60==11.2
]<- 7.896595e-03
goubet$F_60[goubet$F_60==11.3
]<- 9.004508e-03
goubet$F_60[goubet$F_60==11.4
]<- 7.820562e-03
goubet$F_60[goubet$F_60==11.5
]<- 8.287623e-03
goubet$F_60[goubet$F_60==11.6
]<- 8.450551e-03
goubet$F_60[goubet$F_60==11.7
]<- 8.852441e-03
goubet$F_60[goubet$F_60==11.8
]<- 9.352088e-03
goubet$F_60[goubet$F_60==11.9
]<- 8.982784e-03
goubet$F_60[goubet$F_60==12 ]<- 8.950198e-03
goubet$F_60[goubet$F_60==12.1
]<- 8.841579e-03
goubet$F_60[goubet$F_60==12.2
]<- 8.787270e-03
goubet$F_60[goubet$F_60==12.3
]<- 8.472275e-03
goubet$F_60[goubet$F_60==12.4
]<- 9.167436e-03
goubet$F_60[goubet$F_60==12.5
]<- 8.374518e-03
goubet$F_60[goubet$F_60==12.6
]<- 8.689513e-03
goubet$F_60[goubet$F_60==12.7
]<- 8.765546e-03
goubet$F_60[goubet$F_60==12.8
]<- 8.472275e-03
goubet$F_60[goubet$F_60==12.9
]<- 7.896595e-03
goubet$F_60[goubet$F_60==13 ]<- 8.222452e-03
goubet$F_60[goubet$F_60==13.1
]<- 8.070385e-03
goubet$F_60[goubet$F_60==13.2
]<- 6.984196e-03
goubet$F_60[goubet$F_60==13.3
]<- 6.451963e-03
goubet$F_60[goubet$F_60==13.4
]<- 7.494705e-03
goubet$F_60[goubet$F_60==13.5
]<- 6.669201e-03
goubet$F_60[goubet$F_60==13.6
]<- 6.126107e-03
goubet$F_60[goubet$F_60==13.7
]<- 6.527997e-03
goubet$F_60[goubet$F_60==13.8
]<- 6.245587e-03
goubet$F_60[goubet$F_60==13.9
]<- 5.832835e-03
goubet$F_60[goubet$F_60==14 ]<- 5.724217e-03
goubet$F_60[goubet$F_60==14.1
]<- 5.702493e-03
goubet$F_60[goubet$F_60==14.2
]<- 5.191984e-03
goubet$F_60[goubet$F_60==14.3
]<- 5.311465e-03
goubet$F_60[goubet$F_60==14.4
]<- 4.388204e-03
goubet$F_60[goubet$F_60==14.5
]<- 4.942160e-03
goubet$F_60[goubet$F_60==14.6
]<- 4.018900e-03
goubet$F_60[goubet$F_60==14.7
]<- 4.008038e-03
goubet$F_60[goubet$F_60==14.8
]<- 3.573562e-03
goubet$F_60[goubet$F_60==14.9
]<- 3.486667e-03
goubet$F_60[goubet$F_60==15 ]<- 3.204258e-03
goubet$F_60[goubet$F_60==15.1
]<- 3.258567e-03
goubet$F_60[goubet$F_60==15.2
]<- 3.269429e-03
goubet$F_60[goubet$F_60==15.3
]<- 3.139087e-03
goubet$F_60[goubet$F_60==15.4
]<- 2.987020e-03
goubet$F_60[goubet$F_60==15.5
]<- 2.031174e-03
goubet$F_60[goubet$F_60==15.6
]<- 2.672025e-03
goubet$F_60[goubet$F_60==15.7
]<- 2.204964e-03
goubet$F_60[goubet$F_60==15.8
]<- 1.966002e-03
goubet$F_60[goubet$F_60==15.9
]<- 1.955140e-03
goubet$F_60[goubet$F_60==16 ]<- 1.748764e-03
goubet$F_60[goubet$F_60==16.1
]<- 1.803074e-03
goubet$F_60[goubet$F_60==16.2
]<- 1.651007e-03
goubet$F_60[goubet$F_60==16.3
]<- 1.303427e-03
goubet$F_60[goubet$F_60==16.4
]<- 1.292565e-03
goubet$F_60[goubet$F_60==16.5
]<- 1.422908e-03
goubet$F_60[goubet$F_60==16.6
]<- 1.118775e-03
goubet$F_60[goubet$F_60==16.7
]<- 1.183946e-03
goubet$F_60[goubet$F_60==16.8
]<- 9.341226e-04
goubet$F_60[goubet$F_60==16.9
]<- 9.341226e-04
goubet$F_60[goubet$F_60==17 ]<- 7.494705e-04
goubet$F_60[goubet$F_60==17.1
]<- 6.951610e-04
goubet$F_60[goubet$F_60==17.2
]<- 5.756802e-04
goubet$F_60[goubet$F_60==17.3
]<- 6.734372e-04
goubet$F_60[goubet$F_60==17.4
]<- 4.887851e-04
goubet$F_60[goubet$F_60==17.5
]<- 4.236138e-04
goubet$F_60[goubet$F_60==17.6
]<- 3.258567e-04
goubet$F_60[goubet$F_60==17.7
]<- 3.149948e-04
goubet$F_60[goubet$F_60==17.8
]<- 4.236138e-04
goubet$F_60[goubet$F_60==17.9
]<- 2.498235e-04
goubet$F_60[goubet$F_60==18 ]<- 3.149948e-04
goubet$F_60[goubet$F_60==18.1
]<- 3.041329e-04
goubet$F_60[goubet$F_60==18.2
]<- 2.715473e-04
goubet$F_60[goubet$F_60==18.3
]<- 2.824092e-04
goubet$F_60[goubet$F_60==18.4
]<- 1.086189e-04
goubet$F_60[goubet$F_60==18.5
]<- 1.520665e-04
goubet$F_60[goubet$F_60==18.6
]<- 2.063759e-04
goubet$F_60[goubet$F_60==18.7
]<- 2.280997e-04
goubet$F_60[goubet$F_60==18.8
]<- 2.172378e-04
goubet$F_60[goubet$F_60==18.9
]<- 1.955140e-04
goubet$F_60[goubet$F_60==19 ]<- 1.520665e-04
goubet$F_60[goubet$F_60==19.1
]<- 1.086189e-04
goubet$F_60[goubet$F_60==19.2
]<- 5.430946e-05
goubet$F_60[goubet$F_60==19.3
]<- 5.430946e-05
goubet$F_60[goubet$F_60==19.4
]<- 3.258567e-05
goubet$F_60[goubet$F_60==19.5
]<- 2.172378e-05
goubet$F_60[goubet$F_60==19.9
]<- 1.086189e-05
goubet$F_60[goubet$F_60==20.3
]<- 1.086189e-05
goubet$F_60[goubet$F_60==20.8
]<- 1.086189e-05
data=data.frame(goubet$F_60)
write.table(data,
"exportR.txt")
getwd() # setwd()
r<-read.csv(file("clipboard"),header=T,sep="\t",
dec=",",row.names=1)
str(r)
#
NEW QUICK WAY
POUT=0.5*1.225*(cmm^3)*gamma((kmm+3)/kmm);
POUT
y=hist(v2,
freq=TRUE) #breaks=60
#kmm kmv
kpd kcf kmq
keml kls kmml
kee kpwm kwasp kwls
#weibullmm=(kmm/cmm)*((v2/cmm)^(kmm-1))*exp(-((v2/cmm)^kmm)) #Long Way
hist(v2,breaks
= "Sturges", freq=F)
summary(v2)
cbind(y$density)
cbind(y$mids)
cbind(y$counts)
#cbind(y$breaks)
###
weibullj=(kmm/cmm)*((y$mids/cmm)^(kmm-1))*exp(-((y$mids/cmm)^kmm)) #Short Way
cbind(weibullj)
weibullmv=(kmv/cmv)*((y$mids/cmv)^(kmv-1))*exp(-((y$mids/cmv)^kmv))
weibullwasp=(kwasp/cwasp)*((y$mids/cwasp)^(kwasp-1))*exp(-((y$mids/cwasp)^kwasp))
weibullmmn=(k/c)*((y$mids/c)^(k-1))*exp(-((y$mids/c)^k))
###
weibullp=(kpd/cpd)*((y$mids/cpd)^(kpd-1))*exp(-((y$mids/cpd)^kpd))
weibullf=(kcf/ccf)*((y$mids/ccf)^(kcf-1))*exp(-((y$mids/ccf)^kcf))
weibullq=(kmq/cmq)*((y$mids/cmq)^(kmq-1))*exp(-((y$mids/cmq)^kmq))
weibulll=(keml/ceml)*((y$mids/ceml)^(keml-1))*exp(-((y$mids/ceml)^keml))
weibulls=(kls/cls)*((y$mids/cls)^(kls-1))*exp(-((y$mids/cls)^kls))
weibullmm=(kmml/cmml)*((y$mids/cmml)^(kmml-1))*exp(-((y$mids/cmml)^kmml))
weibulle=(kee/cee)*((y$mids/cee)^(kee-1))*exp(-((y$mids/cee)^kee))
weibullw=(kpwm/cpwm)*((y$mids/cpwm)^(kpwm-1))*exp(-((y$mids/cpwm)^kpwm))
weibullwa=(kwasp/cwasp)*((y$mids/cwasp)^(kwasp-1))*exp(-((y$mids/cwasp)^kwasp))
weibullwl=(kwls/cwls)*((y$mids/cwls)^(kwls-1))*exp(-((y$mids/cwls)^kwls))
FCm=1-exp(-((y$mids/cmm)^kmm))
FCv=1-exp(-((y$mids/cmv)^kmv))
FCwa=1-exp(-((y$mids/cwasp)^kwasp))
FCmm=1-exp(-((y$mids/c)^k))
cbind(y$mids,y$density,weibullm,weibullv,weibullwa,weibullmm,
FCm, FCv,FCwa,FCmm)
FCp=1-exp(-((y$mids/cpd)^kpd))
FCf=1-exp(-((y$mids/ccf)^kcf))
cbind(y$mids,y$density,weibullm,weibullv,weibullp,weibullf,
weibullmse, FCm, FCv,FCp,FCf,Fmse)
#Weibull
MSE
k=mean(kmm,
kmv, kpd,kcf)+0.15; k
c=mean(cmm,
cmv, cpd,kccf)+0.19; c
weibullmse=(k/c)*((y$mids/c)^(k-1))*exp(-((y$mids/c)^k))
Fmse=1-exp(-((y$mids/c)^k))
#1.810703e-07
MSE
= (sum(weibullmse-y$density)^2)/length(weibullmse); MSE
rmse=sqrt(sum((y$density-weibullmse)^2)/length(y$density));
rmse
R2=
1-(sum((y$density-weibullmse)^2)/sum((y$density-mean(y$density) )^2)); R2
# AUTOMATIC EN HAUT
FONCTION PAR DEFAUT
#Weibull Hybrid
# V=0 supérieure ou
égale à 15%.
# ffo=fvo
# weibull=
(1-ffo)*(kmm/cmm)*((y$mids/cmm)^(kmm-1))*exp(-((y$mids/cmm)^kmm))
#
#GENERAL
RESULT
rbind(kmm,kmv,kpd,kcf,cmm,cmv,cpd,ccf)
rbind(kmq,keml,kls,kmml,k,
cmq,ceml,cls,cmml,c)
rbind(kee,kpwm,kwasp,kwls,cee,cpwm,cwasp,cwls)
weib=weibullej
R2=
1-(sum((y$density-weib)^2)/sum((y$density-mean(y$density) )^2))
MAE=sum(abs((y$density-weib)/1))/length(weib)
round(RMSE,5);
round(R2,5);round(MAE,5)
#weibullej weibullmm weibullmv weibullwasp
weibullmq weibulleml weibullpd
rbind(kej,kmv,kpd,keml,kwasp,kmq,kmm,
cmm, cmq, cwasp, cej,cmv,cpd,ceml2)
y=hist(v2,
prob=F); dev.off() # breaks=85
cbind(
y$mids,y$density)
ceml=ceml2
#weibullej weibullmm weibullmv weibullwasp
weibullmq weibulleml weibullpd
weibullej=(kej/cej)*((y$mids/cej)^(kej-1))*exp(-((y$mids/cej)^kej)) #Short Way
weibullmm=(kmm/cmm)*((y$mids/cmm)^(kmm-1))*exp(-((y$mids/cmm)^kmm)) #Short Way
weibullmv=(kmv/cmv)*((y$mids/cmv)^(kmv-1))*exp(-((y$mids/cmv)^kmv))
weibullwasp=(kwasp/cwasp)*((y$mids/cwasp)^(kwasp-1))*exp(-((y$mids/cwasp)^kwasp))
weibullmq=(kmq/cmq)*((y$mids/cmq)^(kmq-1))*exp(-((y$mids/cmq)^kmq))
weibulleml=(keml/ceml)*((y$mids/ceml)^(keml-1))*exp(-((y$mids/ceml)^keml))
weibullpd=(kpd/cpd)*((y$mids/cpd)^(kpd-1))*exp(-((y$mids/cpd)^kpd))
cbind(
y$mids,y$density,weibullej,weibullmm,weibullmv,weibullwasp,weibullmq,weibulleml,weibullpd)
FCej=1-exp(-((y$mids/cej)^kej))
FCmm=1-exp(-((y$mids/cmm)^kmm))
FCmv=1-exp(-((y$mids/cmv)^kmv))
FCwasp=1-exp(-((y$mids/cwasp)^kwasp))
FCmq=1-exp(-((y$mids/cmq)^kmq))
FCeml=1-exp(-((y$mids/ceml)^keml))
FCpd=1-exp(-((y$mids/cpd)^kpd))
cbind(
y$mids,y$density,FCej,FCmm,FCmv,FCwasp,FCmq,FCeml,FCpd)
rbind(kej,kmv,kpd,keml,kwasp,kmq,kmm,
cmm, cmq, cwasp, cej,cmv,cpd,ceml2)
cbind(round(c(kej,kmv,kpd,keml,kwasp,kmq,kmm,
cmm, cmq, cwasp, cej,cmv,cpd,ceml2),3))
#weibullej weibullmm weibullmv weibullwasp
weibullmq weibulleml weibullpd
RMSEej=sqrt(sum((y$density-weibullej)^2)/length(y$density))
RMSEmm=sqrt(sum((y$density-weibullmm)^2)/length(y$density))
RMSEmv=sqrt(sum((y$density-weibullmv)^2)/length(y$density))
RMSEwasp=sqrt(sum((y$density-weibullwasp)^2)/length(y$density))
RMSEmq=sqrt(sum((y$density-weibullmq)^2)/length(y$density))
RMSEeml=sqrt(sum((y$density-weibulleml)^2)/length(y$density))
RMSEpd=sqrt(sum((y$density-weibullpd)^2)/length(y$density))
round(RMSEpd,5 )
R2ej=
1-(sum((y$density-weibullej)^2)/sum((y$density-mean(y$density) )^2))
R2mm=
1-(sum((y$density-weibullmm)^2)/sum((y$density-mean(y$density) )^2))
R2mv=
1-(sum((y$density-weibullmv)^2)/sum((y$density-mean(y$density) )^2))
R2wasp=
1-(sum((y$density-weibullwasp)^2)/sum((y$density-mean(y$density) )^2))
R2mq=
1-(sum((y$density-weibullmq)^2)/sum((y$density-mean(y$density) )^2))
R2eml=
1-(sum((y$density-weibulleml)^2)/sum((y$density-mean(y$density) )^2))
R2pd=
1-(sum((y$density-weibullpd)^2)/sum((y$density-mean(y$density) )^2))
round(R2pd,5 )
rmse1=sqrt(sum((y$density-weibullm)^2)/length(y$density))
rmse2=sqrt(sum((y$density-weibullv)^2)/length(y$density))
rmse3=sqrt(sum((y$density-weibullp)^2)/length(y$density))
rmse4=sqrt(sum((y$density-weibullf)^2)/length(y$density))
rmse5=sqrt(sum((y$density-weibullq)^2)/length(y$density))
rmse6=sqrt(sum((y$density-weibulll)^2)/length(y$density))
rmse7=sqrt(sum((y$density-weibulls)^2)/length(y$density))
rmse8=sqrt(sum((y$density-weibullmm)^2)/length(y$density))
rmse9=sqrt(sum((y$density-weibulle)^2)/length(y$density))
rmse10=sqrt(sum((y$density-weibullw)^2)/length(y$density))
rmse11=sqrt(sum((y$density-weibullwa)^2)/length(y$density))
rmse12=sqrt(sum((y$density-weibullwl)^2)/length(y$density))
rbind(rmse1,rmse2,rmse3,rmse4,rmse5,rmse6,rmse7,rmse8,rmse9,rmse10,rmse11,rmse12)
R2m1=
1-(sum((y$density-weibullm)^2)/sum((y$density-mean(y$density) )^2))
R2m2=
1-(sum((y$density-weibullv)^2)/sum((y$density-mean(y$density) )^2))
R2m3=
1-(sum((y$density-weibullp)^2)/sum((y$density-mean(y$density) )^2))
R2m4=
1-(sum((y$density-weibullf)^2)/sum((y$density-mean(y$density) )^2))
R2m5=
1-(sum((y$density-weibullq)^2)/sum((y$density-mean(y$density) )^2))
R2m6=
1-(sum((y$density-weibulll)^2)/sum((y$density-mean(y$density) )^2))
R2m7=
1-(sum((y$density-weibulls)^2)/sum((y$density-mean(y$density) )^2))
R2m8=
1-(sum((y$density-weibullmm)^2)/sum((y$density-mean(y$density) )^2))
R2m9=
1-(sum((y$density-weibulle)^2)/sum((y$density-mean(y$density) )^2))
R2m10=
1-(sum((y$density-weibullw)^2)/sum((y$density-mean(y$density) )^2))
R2m11=
1-(sum((y$density-weibullwa)^2)/sum((y$density-mean(y$density) )^2))
R2m12=
1-(sum((y$density-weibullwl)^2)/sum((y$density-mean(y$density) )^2))
rbind(R2m1,R2m2,R2m3,R2m4,R2m5,R2m6,R2m7,R2m8,R2m9,R2m10,R2m11,R2m12)
barplot(y$density~y$mids,
col="blue3", xlab="", ylab="")
par(new=T);
plot(weibullm~y$mids, type="b", pch=19, col="red",
axes=FALSE, add=T, xlan=NA, ylab=NA)
par(new=T);
plot(weibullmse~y$mids, type="b", pch=20, col="green",
axes=FALSE, add=T, xlan=NA, ylab=NA)
#
-4-Fitted Weibull Distribution
#s=dweibull(V_60,
shape=kmm, scale = cmm)
weibullnm=(k/c)*((v2/c)^(k-1))*exp(-((v2/c)^k))
weibullmm=(kmm/cmm)*((v2/cmm)^(kmm-1))*exp(-((v2/cmm)^kmm))
weibullmv=(kmv/cmv)*(v2/cmv)^(kmv-1)*exp(-((v2/cmv)^kmv))
weibullpd=(kpd/cpd)*(v2/cpd)^(kpd-1)*exp(-((v2/cpd)^kpd))
weibullcf=(kcf/ccf)*(v2/ccf)^(kcf-1)*exp(-((v2/ccf)^kcf))
weibullkmq=(kmq/cmq)*(v2/cmq)^(kmq-1)*exp(-((v2/cmq)^kmq))
weibulleml=(keml/ceml)*(v2/ceml)^(keml-1)*exp(-((v2/ceml)^keml))
weibullls=(kls/cls)*(v2/cls)^(kls-1)*exp(-((v2/cls)^kls))
weibullmml=(kmml/cmml)*(v2/cmml)^(kmml-1)*exp(-((v2/cmml)^kmml))
weibullee=(kee/cee)*(v2/cee)^(kee-1)*exp(-((v2/cee)^kee))
weibullpwm=(kpwm/cpwm)*(v2/cpwm)^(kpwm-1)*exp(-((v2/cpwm)^kpwm))
weibullwasp=(kwasp/cwasp)*(v2/cwasp)^(kwasp-1)*exp(-((v2/cwasp)^kwasp))
weibullwls=(kwls/cwls)*(v2/cwls)^(kwls-1)*exp(-((v2/cwls)^kwls))
#data=data.frame(weibullmm,weibullmv,weibullpd,weibullcf,weibullkmq,weibulleml)
#write.table(data,"exportR.txt")
FCmm=1-exp(-((v2/cmm)^kmm))
FCmv=1-exp(-((v2/cmv)^kmv))
FCpd=1-exp(-((v2/cpd)^kpd))
FCcf=1-exp(-((v2/ccf)^kcf))
FCkmq=1-exp(-((v2/cmq)^kmq))
FCeml=1-exp(-((v2/ceml)^keml))
FCls=1-exp(-((v2/cls)^kls))
FCmml=1-exp(-((v2/cmml)^kmml))
FCee=1-exp(-((v2/cee)^kee))
FCpwm=1-exp(-((v2/cpwm)^kpwm))
FCwasp=1-exp(-((v2/cwasp)^kwasp))
FCwls=1-exp(-((v2/cwls)^kwls))
#data=data.frame(FCmm,FCmv,FCpd,FCcf,FCkmq,FCeml)
#write.table(data,"exportRFC.txt")
#QUALITY
MODEL FIT OF DISTRIBUTION
a=hist(weibullmmn); dev.off()
b=hist(weibullmv); dev.off()
c=hist(weibullj); dev.off()
d=hist(weibullwasp);
dev.off()
y=hist(v2, prob=T)
Fq=y$density
w=weibullj
mbemm=sum(Fq-w)/length(Fq);mbemm
R2mm=1-sum((Fq-w)^2)/sum((Fq-moy)^2);
R2mm
#FREQUENCY
OF WIND SPEED
names(r)
Fq=data$F_40
#COEFFICIENT
OD DETERMINATION
a=sum((Fq-mean(v2))^2)
bmm=sum((Fq-weibullmm)^2)
bmv=sum((Fq-weibullmv)^2)
bpd=sum((Fq-weibullpd)^2)
bcf=sum((Fq-weibullcf)^2)
bkmq=sum((Fq-weibullkmq)^2)
beml=sum((Fq-weibulleml)^2)
bls=sum((Fq-weibullls)^2)
bmml=sum((Fq-weibullmml)^2)
bee=sum((Fq-weibullee)^2)
bpwm=sum((Fq-weibullpwm)^2)
bwasp=sum((Fq-weibullwasp)^2)
bwls=sum((Fq-weibullwls)^2)
coefdetmm=(a-bmm)/a
coefdetmv=(a-bmv)/a
coefdetpd=(a-bpd)/a
coefdetcf=(a-bcf)/a
coefdetkmq=(a-bkmq)/a
coefdeteml=(a-beml)/a
coefdetls=(a-bls)/a
coefdetmml=(a-bmml)/a
coefdetee=(a-bee)/a
coefdetpwm=(a-bpwm)/a
coefdetwasp=(a-bwasp)/a
coefdetwls=(a-bwls)/a
R2mm=1-sum((Fq-weibullmm)^2)/sum((Fq-moy)^2)
R2mv=1-sum((Fq-weibullmv)^2)/sum((Fq-moy)^2)
R2pd=1-sum((Fq-weibullpd)^2)/sum((Fq-moy)^2)
R2cf=1-sum((Fq-weibullcf)^2)/sum((Fq-moy)^2)
R2kmq=1-sum((Fq-weibullkmq)^2)/sum((Fq-moy)^2)
R2eml=1-sum((Fq-weibulleml)^2)/sum((Fq-moy)^2)
R2ls=1-sum((Fq-weibullls)^2)/sum((Fq-moy)^2)
R2mml=1-sum((Fq-weibullmml)^2)/sum((Fq-moy)^2)
R2ee=1-sum((Fq-weibullee)^2)/sum((Fq-moy)^2)
R2pwm=1-sum((Fq-weibullpwm)^2)/sum((Fq-moy)^2)
R2wasp=1-sum((Fq-weibullwasp)^2)/sum((Fq-moy)^2)
R2wls=1-sum((Fq-weibullwls)^2)/sum((Fq-moy)^2)
rmsemm=sqrt(sum((weibullmm-F_40)^2)/length(F_40))
#ROOT
MEAN SQUARE ERROR / DEVIATION
#RMSD=RMSES
rmsemm=sqrt(sum((weibullmm-Fq)^2)/length(Fq))
rmsemv=sqrt(sum((weibullmv-Fq)^2)/length(Fq))
rmsepd=sqrt(sum((Fq-weibullpd)^2)/length(Fq))
rmsecf=sqrt(sum((Fq-weibullcf)^2)/length(Fq))
rmsekmq=sqrt(sum((Fq-weibullkmq)^2)/length(Fq))
rmseeml=sqrt(sum((Fq-weibulleml)^2)/length(Fq))
rmsels=sqrt(sum((Fq-weibullls)^2)/length(Fq))
rmsemml=sqrt(sum((Fq-weibullmml)^2)/length(Fq))
rmseee=sqrt(sum((Fq-weibullee)^2)/length(Fq))
rmsepwm=sqrt(sum((Fq-weibullpwm)^2)/length(Fq))
rmsewasp=sqrt(sum((Fq-weibullwasp)^2)/length(Fq))
rmsewls=sqrt(sum((Fq-weibullwls)^2)/length(Fq))
#NRMD=RMSD/moy
NRMDmm=rmsemm/moy
NRMDmv=rmsemv/moy
NRMDpd=rmsepd/moy
NRMDcf=rmsecf/moy
NRMDkmq=rmsekmq
/moy
NRMDeml=rmseeml/moy
NRMDee=rmseee/moy
NRMDpwm=rmsepwm/moy
NRMDwasp=rmsewasp/moy
NRMDwls=rmsewls/moy
#MEAN
BIAIS ERROR
mbemm=sum(Fq-weibullmm)/length(Fq)
mbemv=sum(Fq-weibullmv)/length(Fq)
mbepd=sum(Fq-weibullpd)/length(Fq)
mbecf=sum(Fq-weibullcf)/length(Fq)
mbekmq=sum(Fq-weibullkmq)/length(Fq)
mbeeml=sum(Fq-weibulleml)/length(Fq)
mbels=sum(Fq-weibullls)/length(Fq)
mbemml=sum(Fq-weibullmml)/length(Fq)
mbeee=sum(Fq-weibullee)/length(Fq)
mbepwm=sum(Fq-weibullpwm)/length(Fq)
mbewasp=sum(F-weibullwasp)/length(Fq)
mbewls=sum(Fq-weibullwls)/length(Fq)
#MEAN
ABSOLUTE ERROR = MEAN ABSOLUTE BIAIS ERROR
maemm=sum(abs(weibullmm-Fq))/length(Fq)
maemv=sum(abs(weibullmv-Fq))/length(Fq)
maepd=sum(abs(weibullpd-Fq))/length(Fq)
maecf=sum(abs(weibullcf-Fq))/length(Fq)
maekmq=sum(abs(weibullkmq-Fq))/length(Fq)
maeeml=sum(abs(weibulleml-Fq))/length(Fq)
maels=sum(abs(weibullls-Fq))/length(Fq)
maemml=sum(abs(weibullmml-Fq))/length(Fq)
maeee=sum(abs(weibullee-Fq))/length(Fq)
maepwm=sum(abs(weibullpwm-Fq))/length(Fq)
maewasp=sum(abs(weibullwasp-Fq))/length(Fq)
maewls=sum(abs(weibullwls-Fq))/length(Fq)
#COEFFICIENT
OF EFFEICIENCY
coemm=sum((weibullmm-mean(v2))^2)/sum((Fq-mean(v2))^2)
coemv=sum((weibullmv-mean(v2))^2)/sum((Fq-mean(v2))^2)
coepd=sum((weibullpd-mean(v2))^2)/sum((Fq-mean(v2))^2)
coecf=sum((weibullcf-mean(v2))^2)/sum((Fq-mean(v2))^2)
coekmq=sum((weibullkmq-mean(v2))^2)/sum((Fq-mean(v2))^2)
coeeml=sum((weibulleml-mean(v2))^2)/sum((Fq-mean(v2))^2)
coels=sum((weibullls-mean(v2))^2)/sum((Fq-mean(v2))^2)
coemml=sum((weibullmml-mean(v2))^2)/sum((Fq-mean(v2))^2)
coeee=sum((weibullee-mean(v2))^2)/sum((Fq-mean(v2))^2)
coepwm=sum((weibullpwm-mean(v2))^2)/sum((Fq-mean(v2))^2)
coewasp=sum((weibullwasp-mean(v2))^2)/sum((Fq-mean(v2))^2)
coewls=sum((weibullwls-mean(v2))^2)/sum((Fq-mean(v2))^2)
#MEAN
ABSOLUTE POURCENTAGE ERREOR MEAN ABSOLUTE RELATIVE ERROR. MAPE = MARE
mapemm=sum(abs((weibullmm-Fq)/Fq))/length(Fq)
mapemv=sum(abs((weibullmv-Fq)/Fq))/length(Fq)
mapepd=sum(abs((weibullpd-Fq)/Fq))/length(Fq)
mapecf=sum(abs((weibullcf-Fq)/Fq))/length(Fq)
mapekmq=sum(abs((weibullkmq-Fq)/Fq))/length(Fq)
mapeeml=sum(abs((weibulleml-Fq)/Fq))/length(Fq)
mapels=sum(abs((weibullls-Fq)/Fq))/length(Fq)
mapemml=sum(abs((weibullmml-Fq)/Fq))/length(Fq)
mapeee=sum(abs((weibullee-Fq)/Fq))/length(Fq)
mapepwm=sum(abs((weibullpwm-Fq)/Fq))/length(Fq)
mapewasp=sum(abs((weibullwasp-Fq)/Fq))/length(Fq)
mapewls=sum(abs((weibullwls-Fq)/Fq))/length(Fq)
#
IA INDICE
#with
higher values manifesting better agreement between the distribution and
observations.
IAmm
=sum(abs(weibullmm-Fq))/(sum(abs(weibullmm-mean(Fq))+abs(Fq-mean(Fq))))
IAmv
=sum(abs(weibullmv-Fq))/(sum(abs(weibullmv-mean(Fq))+abs(Fq-mean(Fq))))
IApd
=sum(abs(weibullpd-Fq))/(sum(abs(weibullpd-mean(Fq))+abs(Fq-mean(Fq))))
IAcf
=sum(abs(weibullcf-Fq))/(sum(abs(weibullcf-mean(Fq))+abs(Fq-mean(Fq))))
IAkmq
=sum(abs(weibullkmq-Fq))/(sum(abs(weibullkmq-mean(Fq))+abs(Fq-mean(Fq))))
IAeml
=sum(abs(weibulleml-Fq))/(sum(abs(weibulleml-mean(Fq))+abs(Fq-mean(Fq))))
IAls
=sum(abs(weibullls-Fq))/(sum(abs(weibullls-mean(Fq))+abs(Fq-mean(Fq))))
IAmml=
sum(abs(weibullmml-Fq))/(sum(abs(weibullmml-mean(Fq))+abs(Fq-mean(Fq))))
IAee
=sum(abs(weibullee-Fq))/(sum(abs(weibullee-mean(Fq))+abs(Fq-mean(Fq))))
IAee
=sum(abs(weibullee-Fq))/(sum(abs(weibullee-mean(Fq))+abs(Fq-mean(Fq))))
IApwm
=sum(abs(weibullpwm-Fq))/(sum(abs(weibullpwm-mean(Fq))+abs(Fq-mean(Fq))))
IAwasp
=sum(abs(weibullwasp-Fq))/(sum(abs(weibullwasp-mean(Fq))+abs(F-mean(Fq))))
IAwls
=sum(abs(weibullwls-Fq))/(sum(abs(weibullwls-mean(Fq))+abs(Fq-mean(Fq))))
#
RELATIVE ROOT MEAN SQUARE ERROR RRMSE
#Best
for RRMSE < 0.1 *** Good for 0.1 <
RRMSE <0.2
#Fair
for 0.2 < RRMSE <0.3 *** Poor for RRMSE >0.3.
RRMSEmm
= sqrt(sum((weibullmm-Fq)^2)/ length(Fq))/(sum(Fq)/length(Fq))
RRMSEmv
= sqrt(sum((weibullmv-Fq)^2)/ length(Fq))/(sum(Fq)/length(Fq))
RRMSEpd
= sqrt(sum((weibullpd-Fq)^2)/ length(Fq))/(sum(Fq)/length(Fq))
RRMSEcf
= sqrt(sum((weibullcf-Fq)^2)/ length(Fq))/(sum(Fq)/length(Fq))
RRMSEkmq
= sqrt(sum((weibullkmq-Fq)^2)/ length(Fq))/(sum(Fq)/length(Fq))
RRMSEeml
= sqrt(sum((weibulleml-Fq)^2)/ length(Fq))/(sum(Fq)/length(Fq))
RRMSEls
= sqrt(sum((weibullls-Fq)^2)/ length(Fq))/(sum(Fq)/length(Fq))
RRMSEmml
= sqrt(sum((weibullmml-Fq)^2)/ length(Fq))/(sum(Fq)/length(Fq))
RRMSEee
= sqrt(sum((weibullee-Fq)^2)/ length(Fq))/(sum(Fq)/length(Fq))
RRMSEpwm
= sqrt(sum((weibullpwm-Fq)^2)/ length(Fq))/(sum(Fq)/length(Fq))
RRMSEwasp
= sqrt(sum((weibullwasp-Fq)^2)/ length(Fq))/(sum(Fq)/length(Fq))
RRMSEwls
= sqrt(sum((weibullwls-Fq)^2)/ length(Fq))/(sum(Fq)/length(Fq))
coemm=sum((weibullmm-mean(v2))^2)/sum((Fq-mean(v2))^2)
#ROOT
MEAN SUQARE ERROR 2
#RMSE
with Average Value of Measure Data.
RMSREmm= sqrt(sum(((Fq-weibullmm)/Fq)^2)/length(Fq))
RMSREmv= sqrt(sum(((Fq-weibullmv)/Fq)^2)/length(Fq))
RMSREpd= sqrt(sum(((Fq-weibullpd)/Fq)^2)/length(Fq))
RMSREcf= sqrt(sum(((Fq-weibullcf)/Fq)^2)/length(Fq))
RMSREkmq= sqrt(sum(((Fq-weibullkmq)/Fq)^2)/length(Fq))
RMSREeml= sqrt(sum(((Fq-weibulleml)/Fq)^2)/length(Fq))
RMSREls= sqrt(sum(((Fq-weibullls)/Fq)^2)/length(Fq))
RMSREmml= sqrt(sum(((Fq-weibullmml)/Fq)^2)/length(Fq))
RMSREee= sqrt(sum(((Fq-weibullee)/Fq)^2)/length(Fq))
RMSREpwm= sqrt(sum(((Fq-weibullpwm)/Fq)^2)/length(Fq))
RMSREwasp= sqrt(sum(((Fq-weibullwasp)/Fq)^2)/length(Fq))
RMSREwls= sqrt(sum(((Fq-weibullwls)/Fq)^2)/length(Fq))
#
MAXIMUM ABSOLUTE RELATIVE ERROR
erMAXmm
= max(abs((mean(Fq)-mean(weibullmm))/mean(Fq)))
erMAXmv
= max(abs((mean(Fq)-mean(weibullmv))/mean(Fq)))
erMAXpd
= max(abs((mean(Fq)-mean(weibullpd))/mean(Fq)))
erMAXcf
= max(abs((mean(Fq)-mean(weibullcf))/mean(Fq)))
erMAXkmq
= max(abs((mean(Fq)-mean(weibullkmq))/mean(Fq)))
erMAXeml
= max(abs((mean(Fq)-mean(weibulleml))/mean(Fq)))
erMAXls
= max(abs((mean(Fq)-mean(weibullls))/mean(Fq)))
erMAXmml
= max(abs((mean(Fq)-mean(weibullmml))/mean(Fq)))
erMAXee
= max(abs((mean(Fq)-mean(weibullee))/mean(Fq)))
erMAXpwm
= max(abs((mean(Fq)-mean(weibullpwm))/mean(Fq)))
erMAXwasp
= max(abs((mean(Fq)-mean(weibullwasp))/mean(Fq)))
erMAXwls
= max(abs((mean(Fq)-mean(weibullwls))/mean(Fq)))
#
ROOT PERCENTAGE ERROR
rpemm=((weibullmm-Fq)/Fq)*100
rpemv=((weibullmv-Fq)/Fq)*100
rpepd=((weibullpd-Fq)/Fq)*100
rpecf=((weibullcf-Fq)/Fq)*100
rpekmq=((weibullkmq-Fq)/Fq)*100
rpeeml=((weibulleml-Fq)/Fq)*100
rpels=((weibullls-Fq)/Fq)*100
rpemml=((weibullmml-Fq)/Fq)*100
rpeee=((weibullee-Fq)/Fq)*100
rpepwm=((weibullpwm-Fq)/Fq)*100
rpewasp=((weibullwasp-Fq)/Fq)*100
rpewls=((weibullwls-Fq)/Fq)*100
#data.frame(rpemm,rpepd,rpecf,rpekmq,rpeeml,rpeee,rpepwm,rpemml,rpeee,rpepwm,rpewasp,rpewls)
# RESULTATS
rbind(kmm,kmv,kpd,kcf,cmm,cmv,cpd,ccf)
rbind(kmq,keml,kls,kmml,
k,cmq,ceml,cls,cmml,c)
rbind(kee,kpwm,kwasp,kwls,cee,cpwm,cwasp,cwls)
mmedist(x3,
"beta")$estimate #moment matching
estimation
fitdist(v2,
distr = "weibull", method = "mse") #maximum spacing estimation
fitdist(v2,
distr = "weibull", method = "mle") #maximum likelihood estimation
qmedist(v2,
"weibull", probs=c(1/3, 2/3))$estimate #quantile matching estimation
#Maximum
goodness-of-fit estimation Stephens (1986)
mgedist(v2,
distr="weibull", gof = "CvM")$estimate #Cramer-von Mises distance (CvM)
mgedist(v2,
distr="weibull", gof = "KS")$estimate #Kolmogorov-Smirnov distance (KS)
mgedist(v2,
distr="weibull", gof = "AD")$estimate #Anderson-Darling distance (AD)
#
Maximum goodness-of-fit estimation Luceno (2006)
mgedist(v2,
distr="weibull", gof = "ADL")$estimate #Anderson-Darling distance Left (ADL)
mgedist(v2,
distr="weibull", gof = "AD2R")$estimate #Anderson-Darling
distance 2 Right(AD2R)
mgedist(v2,
distr="weibull", gof = "AD2L")$estimate #Anderson-Darling
distance 2 Left (AD2L)
mgedist(v2,
distr="weibull", gof = "ADR")$estimate #Anderson-Darling distance Right (ADR)
rbind(coefdetmm,coefdetmv,coefdetpd,coefdetcf,coefdetkmq,coefdeteml,coefdetls,coefdetmml,coefdetee,coefdetpwm,coefdetwasp,coefdetwls)
rbind(R2mm,R2mv,R2pd,R2cf,R2kmq,R2eml,R2ls,R2mml,R2ee,R2pwm,R2wasp,R2wls)
rbind(rmsemm,rmsemv,rmsepd,rmsecf,rmsekmq,rmseeml,rmsels,rmsemml,rmseee,rmsepwm,rmsewasp,rmsewls)
rbind(mbemm,mbemv,mbepd,mbecf,mbekmq,mbeeml,mbels,mbemml,mbeee,mbepwm,mbewasp,mbewls)
rbind(maemm,maemv,maepd,maecf,maekmq,maeeml,maels,maemml,maeee,maepwm,maewasp,maewls)
rbind(coemm,coemv,coepd,coecf,coekmq,coeeml,coels,coemml,coeee,coepwm,coewasp,coewls)
rbind(mapemm,mapemv,mapepd,mapecf,mapekmq,mapeeml,mapels,mapemml,mapeee,mapepwm,mapewasp,mapewls)
rbind(IAmm,IAmv,IApd,IAcf,IAkmq,IAeml,IAls,IAmml,IAee,IApwm,IAwasp,IAwls)
rbind(RRMSEmm,RRMSEmv,RRMSEpd,RRMSEcf,RRMSEkmq,RRMSEeml,RRMSEls,RRMSEmml,RRMSEee,RRMSEpwm,RRMSEwasp,RRMSEwls)
rbind(RMSREmm,RMSREmv,RMSREpd,RMSREcf,RMSREkmq,RMSREeml,RMSREls,RMSREmml,RMSREee,RMSREpwm,RMSREwasp,RMSREwls)
rbind(erMAXmm,erMAXmv,erMAXpd,erMAXcf,erMAXkmq,erMAXeml,erMAXls,erMAXmml,erMAXee,erMAXpwm,erMAXwasp,erMAXwls)
rbind(NRMDmm,NRMDmv,NRMDpd,NRMDcf,NRMDkmq,NRMDeml,NRMDee,NRMDpwm,NRMDwasp,NRMDwls)
#GRAPH
GROUP 1
#layout(c(1,2))
#par(mfrow=c(1,2))
a=hist(weibullmmn); dev.off()
b=hist(weibullmv); dev.off()
c=hist(weibullj); dev.off()
d=hist(weibullwasp);
dev.off()
a=hist(weibullnm);
dev.off()
b=hist(weibullmv);
dev.off()
m=hist(weibullmm);
dev.off()
k=hist(weibullwasp);
dev.off()
c=hist(weibullpd);
dev.off()
d=hist(weibullcf);
dev.off()
e=hist(weibullkmq);
dev.off()
f=hist(weibulleml);
dev.off()
g=hist(weibullls);
dev.off()
h=hist(weibullmml);
dev.off()
i=hist(weibullee);
dev.off()
j=hist(weibullpwm);
dev.off()
l=hist(weibullwls);
dev.off()
m=hist(weibullmm);
dev.off()
#col=terrain.colors(5))
#col=topo.colors(500)
#col=cm.colors(5))
#col=rainbow(5))
#col=heat.colors(5)
a=hist(weibullmmn); dev.off()
b=hist(weibullmv); dev.off()
c=hist(weibullj); dev.off()
d=hist(weibullwasp);
dev.off()
y=hist(v2, prob=T)
plot(-1,-1,xlim=c(0,22),
ylim=c(0,7),xlab="Wind speed(m/s)",ylab="Probability density
function (%)")
grid(col="black",
lty="solid", lwd=1.5)
#abline(h=0,
lty=2); abline(v=0, lty=2)
#require(graphics)
#grid(5,6,col
= "lightgray", lty = "dotted",lwd = par("lwd"),
equilogs =F)
par(new=T);hist(v2,
col= "yellow" ,main=NA,
xlab=NA,ylab=NA,axes=FALSE,border="red")
#
http://www.stat.columbia.edu/~tzheng/files/Rcolor.pdf
#
heat.colors(4, alpha=1) topo.colors(200)
#
hsv(h = 1, s = 0.8, v = 0.9)
#
xfit<-seq(min(v2),max(v2),length=40)
#
yfit<-dnorm(xfit,mean=mean(v2),sd=sd(v2)) #lines(xfit, yfit,
col="blue", lwd=2)
par(new=T);plot(y$mids,weibullmmn,type="b",
pch=15,lty=1, lwd=2,cex=1,col="red",axes=FALSE,add=T,ylab=NA,xlab=NA)
par(new=T);plot(y$mids,weibullmv,type="b",
pch=16,lty=1,
lwd=2,cex=1,col="mediumblue",axes=FALSE,add=T,ylab=NA,xlab=NA)
par(new=T);plot(y$mids,weibullj,type="b",
pch=17,lty=1,
lwd=2,cex=1,col="deeppink",axes=FALSE,add=T,ylab=NA,xlab=NA)
par(new=T);plot(y$mids,weibullwasp,type="b",
pch=20,lty=1,
lwd=2,cex=1,col="cyan",axes=FALSE,add=T,ylab=NA,xlab=NA)
data.frame(weibullmmn,weibullmv,weibullj,weibullwasp,y$mids,y$density)
plot(-1,-1,xlim=c(0,20),
ylim=c(0,20),xlab="",ylab="")
legend("topright",c("Moment
Method" , "Maximum
Likelihood",
"Empirical Method of
Jestus", "WAsP Method"),
lty=c(1,1,1,1),
col=c("red",
"mediumblue", "deeppink", "cyan"),
lwd=c(2,2,2,2), bty="n",
cex=c(1,1,1,1),
pch=c(15,16,17,20) )
#CUMULATIVE
FUNCTION DISTRIBUTION
#FCmm=1-exp(-((v2/cmm)^kmm)) # Long Way
FCmmn=1-exp(-((y$mids/c)^k)) # Short Way
FCmv=1-exp(-((y$mids/cmv)^kmv))
FCj=1-exp(-((y$mids/cmm)^kmm))
FCwasp=1-exp(-((y$mids/cwasp)^kwasp))
data.frame(FCmmn,FCmv,FCj,FCwasp,y$mids,y$density)
plot(y$mids,FCmm,type="b",
pch=15,lty=1, lwd=2,cex=1,col="red")
par(new=T)
plot(-1,-1,xlim=c(0,22),
ylim=c(0,1),xlab="Wind speed(m/s)",ylab="Cumulative distribution
function (%)")
grid(col="black",
lty="solid", lwd=1.5)
par(new=T);plot(y$mids,FCmmn,type="b",
pch=15,lty=1, lwd=2,cex=1,col="red",axes=FALSE,add=T,ylab=NA,xlab=NA)
par(new=T);plot(y$mids,FCmv,type="b",
pch=16,lty=1,
lwd=2,cex=1,col="mediumblue",axes=FALSE,add=T,ylab=NA,xlab=NA)
par(new=T);plot(y$mids,FCj,type="b",
pch=17,lty=1,
lwd=2,cex=1,col="deeppink",axes=FALSE,add=T,ylab=NA,xlab=NA)
par(new=T);plot(y$mids,FCwasp,type="b",
pch=20,lty=1,
lwd=2,cex=1,col="darkgoldenrod1",axes=FALSE,add=T,ylab=NA,xlab=NA)
barplot(y$density~y$mids,
col="blue3", xlab="", ylab="")
par(new=T);
plot(weibullm~y$mids, type="b", pch=19, col="red",
axes=FALSE, add=T, xlan=NA, ylab=NA)
par(new=T)
plot(y$mids,weibullmm,type="b",
pch=20,lty=1, lwd=2,cex=1,col="red",axes=FALSE,add=T,ylab=NA,xlab=NA)
#pch=20
plot(v2,weibullmm,pch=3,cex=0,col="red",axes=FALSE,add=T,ylab=NA,xlab=NA)
par(new=T)
curve(dweibull(x,kmm,
cmm), lty=1,lwd=2,col=" gold4", add=T)
par(new=T)
plot(v2,weibullmv,pch=4,cex=0,col="darkmagenta",axes=FALSE,add=T,ylab=NA,xlab=NA)
x=b$density
curve(dweibull(x,
kmv, cmv), lty=1,lwd=2,col="
hotpink1 ", add=T)
par(new=T)
plot(v2,weibullpd,pch=0,cex=0,col="
yellow",axes=FALSE,add=T,ylab=NA,xlab=NA)
x=c$density
curve(dweibull(x,
kpd, cpd), lty=1,lwd=2,col="
yellow ", add=T)
par(new=T)
plot(v2,weibullcf,pch=1,cex=0,col="magenta4",axes=FALSE,add=T,ylab=NA,xlab=NA)
x=d$density
curve(dweibull(x,
kcf, ccf), lty=1,lwd=2,col="
lightsalmon ", add=T)
par(new=TRUE)
plot(v2,weibullkmq,pch=3,cex=0,col="orange",axes=FALSE,add=T,ylab=NA,xlab=NA)
x=e$density
curve(dweibull(x,
kmq, cmq), lty=1,lwd=2,col= " red2
", add=T)
par(new=T)
plot(v2,weibulleml,pch=4,cex=0,col="brown",axes=FALSE,add=T,ylab=NA,xlab=NA)
x=f$density
curve(dweibull(x,
keml, ceml), lty=1,lwd=2,col=
" paleturquoise1 "
, add=T)
par(new=T)
plot(v2,weibullls,pch=0,cex=0,col="yellow",axes=FALSE,add=T,ylab=NA,xlab=NA)
x=g$density
curve(dweibull(x,
kls, cls), lty=1,lwd=2,col="
mediumblue ", add=T)
par(new=T)
plot(v2,weibullmml,pch=3,cex=0,col="red",axes=FALSE,add=T,ylab=NA,xlab=NA)
x=h$density
curve(dweibull(x,
kmml, cmml), lty=1,lwd=2,col="
turquoise1 ", add=T)
par(new=T)
plot(v2,weibullee,pch=3,cex=0,col="red",axes=FALSE,add=T,ylab=NA,xlab=NA)
x=i$density
curve(dweibull(x,
kee, cee), lty=1,lwd=2,col="
green1 ", add=T)
par(new=T)
plot(v2,weibullpwm,pch=4,cex=0,col="green",axes=FALSE,add=T,ylab=NA,xlab=NA)
x=j$density
curve(dweibull(x,
kpwm, cpwm), lty=1,lwd=2,
col=" snow3 ", add=T)
par(new=T)
plot(v2,weibullwasp,pch=0,cex=0,col="yellow",axes=FALSE,add=T,ylab=NA,xlab=NA)
x=k$density
curve(dweibull(x,
kwasp, cwasp), lty=1,lwd=2, col= "
mediumorchid1 ", add=T)
par(new=T)
plot(v2,weibullwls,pch=1,cex=0,col="purple",axes=FALSE,add=T,ylab=NA,xlab=NA)
x=l$density
curve(dweibull(x,
kwls, cwls), lty=1,lwd=2, col= "
chocolate1 ", add=T)
plot(-1,-1,xlim=c(0,20),
ylim=c(0,20),xlab="",ylab="")
legend("topright",c(
"Empirical Method of Jestus","Maximum Likelihood",
"Quartiles
Method","Empirical Method of Lysen",
"Graphical
Method","Modified Maximum Likelihood",
"Equivalent Energy
Method","Probability Weighted Moments Method",
"WAsP
Method","Weighted Least Square Method"),
lty=c(1,1,1,1,1,1,1,1,1,1),
col=c("gold4",
"hotpink1", "yellow",
"lightsalmon","red2","paleturquoise1",
"mediumblue","
turquoise1",
"green1","snow3","mediumorchid1",
"chocolate1"),
lwd=c(5,5,5,5,5,5,5,5,5,5),
bty="n", cex=1.8)
plot(-1,-1,xlim=c(0,20),
ylim=c(0,20),xlab="",ylab="")
legend("top",c("Vm
=9.08 m/s","sd = 3.71","skew = -0.08","kurt =
-0.65", "min =0.4m/s", "max = 20.8m/s" ),
cex=1.7,bg="white",box.col="black")
#horiz=T
#png(filename="tes.png",width=5000,height=3205,units="px")
#legend("bottomleft",
inset=.02, title="Number of Cylinders",
#c("4","6","8"),
fill=topo.colors(3), horiz=TRUE, cex=0.8
#NEW
WEIBULL DISTRIBUTION
#https://stackoverrun.com/fr/q/10266756
#data<-read.csv(file("clipboard"),header=T,sep="\t",
dec=",")
#names(data);
attach(data)
#set.seed(1938)
#X=seq(0,100,length.out=1000)
#Y=cumsum(rnorm(1000))
#a2
<- data.frame(year = X, values = Y)
#require(ggplot2)
#ggplot(a2,
aes(x = year, y = values, color = values )) +
# geom_line(size = 0.5) +
# geom_smooth(aes(color=..y..), size=1.5,
se=FALSE) +
# scale_colour_gradient2(low =
"blue", mid = "yellow" , high = "red",
#
midpoint=median(a2$values)) +
# theme_bw()
x=hist (V_60); x
#APPUREMENT DE LA BASE
table(V_40 > V_30)
F=18135
T=62211
Tt=F+T; FT=T/Tt*100;
FF=F/Tt*100;
cbind(FT,FF)
nd=V_40
> V_30
data=data.frame(nd,
V_40, V_30)
write.table(data,
"data.txt", sep="\t")
#dput(goubet,
file = "",control = c("keepNA", "keepInteger",
"niceNames", "showAttributes"))
#dget(file,
keep.source = FALSE)
#WindRose.R
goubet<-read.csv(file("clipboard"),header=T,sep="\t",
dec=",",row.names=1)
#data(wind_data)
require(windrose)
wind_rose
<- windrose(goubet, spd = w60, dir = d60)
plot(wind_rose)
#
Programm Initiaisation
plot.windrose
<- function(data,
spd,
dir,
spdres = 2,
dirres = 30,
spdmin = 2,
spdmax = 20,
spdseq = NULL,
palette =
"YlGnBu",
countmax = NA,
debug = 0){
# Look to see what data was passed in to the
function
if (is.numeric(spd) & is.numeric(dir)){
# assume that we've been given vectors of
the speed and direction vectors
data <- data.frame(spd = spd,
dir = dir)
spd = "spd"
dir = "dir"
} else if (exists("data")){
# Assume that we've been given a data
frame, and the name of the speed
# and direction columns. This is the format
we want for later use.
}
# Tidy up input data ----
n.in <- NROW(data)
dnu <- (is.na(data[[spd]]) |
is.na(data[[dir]]))
data[[spd]][dnu] <- NA
data[[dir]][dnu] <- NA
# figure out the wind speed bins ----
if (missing(spdseq)){
spdseq <- seq(spdmin,spdmax,spdres)
} else {
if (debug >0){
cat("Using custom speed bins
\n")
}
}
# get some information about the number of
bins, etc.
n.spd.seq <- length(spdseq)
n.colors.in.range <- n.spd.seq - 1
# create the color map
spd.colors <-
colorRampPalette(brewer.pal(min(max(3,
n.colors.in.range),
min(9,
n.colors.in.range)),
palette))(n.colors.in.range)
if
(max(data[[spd]],na.rm = TRUE) > spdmax){
spd.breaks <- c(spdseq,
max(data[[spd]],na.rm =
TRUE))
spd.labels <-
c(paste(c(spdseq[1:n.spd.seq-1]),
'-',
c(spdseq[2:n.spd.seq])),
paste(spdmax,
"-",
max(data[[spd]],na.rm
= TRUE)))
spd.colors <- c(spd.colors, "grey50")
} else{
spd.breaks <- spdseq
spd.labels <-
paste(c(spdseq[1:n.spd.seq-1]),
'-',
c(spdseq[2:n.spd.seq]))
}
data$spd.binned <- cut(x = data[[spd]],
breaks = spd.breaks,
labels = spd.labels,
ordered_result = TRUE)
# clean up the data
data. <- na.omit(data)
# figure out the wind direction bins
dir.breaks <- c(-dirres/2,
seq(dirres/2, 360-dirres/2,
by = dirres),
360+dirres/2)
dir.labels <-
c(paste(360-dirres/2,"-",dirres/2),
paste(seq(dirres/2, 360-3*dirres/2, by =
dirres),
"-",
seq(3*dirres/2,
360-dirres/2, by = dirres)),
paste(360-dirres/2,"-",dirres/2))
# assign each wind direction to a bin
dir.binned <- cut(data[[dir]],
breaks = dir.breaks,
ordered_result = TRUE)
levels(dir.binned) <- dir.labels
data$dir.binned <- dir.binned
# Run debug if required ----
if (debug>0){
cat(dir.breaks,"\n")
cat(dir.labels,"\n")
cat(levels(dir.binned),"\n")
}
# deal with change in ordering introduced
somewhere around version 2.2
if(packageVersion("ggplot2") >
"2.2"){
cat("Hadley broke my code\n")
data$spd.binned = with(data,
factor(spd.binned, levels = rev(levels(spd.binned))))
spd.colors = rev(spd.colors)
}
# create the plot ----
p.windrose <- ggplot(data = data,
aes(x = dir.binned,
fill = spd.binned))
+
geom_bar() +
scale_x_discrete(drop = FALSE,
labels = waiver()) +
coord_polar(start = -((dirres/2)/360) *
2*pi) +
scale_fill_manual(name = "Wind Speed
(m/s)",
values = spd.colors,
drop = FALSE) +
theme(axis.title.x
= element_blank())
# adjust axes if required
if (!is.na(countmax)){
p.windrose <- p.windrose +
ylim(c(0,countmax))
}
# print the plot
print(p.windrose)
# return the handle to the wind rose
return(p.windrose)
}
#Fin
Programm
goubet<-read.csv(file("clipboard"),header=T,sep="\t",
dec=",",row.names=1)
attach(goubet)
require(ggplot2)
require(RColorBrewer)
p2 <-
plot.windrose(spd = V_60,
dir = DIR_60)
p2 + theme_bw()
p2 <-
plot.windrose(spd = V_60,
dir = DIR_60,
spdseq =
c(0,3,6,9,12,15,18,21))
p2 + theme_bw()
# R.4.02
Version
goubet<-read.csv(file("clipboard"),header=T,sep="\t",
dec=",",row.names=1)
#Rorganisation
data before on N S E W
require(climatol)
data(windfr)
rosavent(windfr,
4, 4, ang=-3*pi/16, main="Annual windrose")
attach(goubet)
names(goubet)
#https://randroll.wordpress.com/2018/08/30/a-wind-rose-with-openair-package/
library(openair)
windRose(goubet,
ws = "V", wd = "D", statistic = "prop.count",
angle =25)
windRose(goubet,
ws = "V_60", wd = "DIR_60")
windRose(goubet,
ws = "V_60", wd ="DIR_60",paddle = F, border = T)
windRose(goubet,
ws = "V_60", wd ="DIR_60",
paddle = F, border = T,
breaks = c(0, 4, 8, 12, 16),
key.position = 'right')
library(viridis)
windRose(goubet,
ws = "W", wd ="D",
paddle = F, border = F,
breaks = c(0, 4, 8, 12, 16),
key.position = 'bottom',
col =rev(viridis(5)), type='X' ) #
classes
goubet<-read.csv(file("clipboard"),header=T,sep="\t",
dec=",")
#
"right", "left", "top", "bottom"
windRose(goubet,
ws = "W", wd ="D",
paddle = F, border = T,
breaks = c(0, 4, 8, 12, 16),
key.position = "bottom",
col =c("red",
"orange", "yellow", "green",
"darkgreen"),type = 'X',
grid.line = list(value = 10, lty = 1,
col = "blue"), annotate = TRUE, angle.scale =315,
key.header = "Wind Speed",
angle.scale = 45)
windRose(goubet,
ws = "V_60", wd ="DIR_60",
paddle = F, border = T,
breaks = c(0, 0.5, 2.4, 3.6, 5.7, 8.8,
11.1),
key.position = 'right',
type = 'daylight')
windRose(goubet,type
= "year")
windRose(gru,
ws = 'ws', wd = 'wd',
paddle = F, border = T,
breaks = c(0, 0.5, 2.4, 3.6, 5.7, 8.8,
11.1),
type = 'month',
grid.line = 10, # show grid line each 10%
annotate = F) # Don't display mean and calm
#https://randroll.wordpress.com/2018/08/30/a-wind-rose-with-openair-package/
polarFreq(mydata)
#
wind frequencies by year
if
(FALSE) polarFreq(mydata, type = "year")
#
mean SO2 by year, showing only bins with at least 2 points
if
(FALSE) polarFreq(mydata, pollutant = "so2", type = "year",
statistic = "mean", min.bin = 2)
#
weighted mean SO2 by year, showing only bins with at least 2 points
if
(FALSE) polarFreq(mydata, pollutant = "so2", type = "year",
statistic = "weighted.mean",
min.bin = 2)
#windRose
for just 2000 and 2003 with different colours
if
(FALSE) polarFreq(subset(mydata, format(date, "%Y") %in% c(2000,
2003)),
type = "year",
cols = "jet")
#
user defined breaks from 0-700 in intervals of 100 (note linear scale)
if
(FALSE) polarFreq(mydata, breaks = seq(0, 700, 100))
#
more complicated user-defined breaks - useful for highlighting bins
#
with a certain number of data points
if
(FALSE) polarFreq(mydata, breaks = c(0, 10, 50, 100, 250, 500, 700))
#
source contribution plot and use of offset option
if
(FALSE) polarFreq(mydata, pollutant = "pm25", statistic
="weighted.mean", offset = 50, ws.int = 25, trans = FALSE)
#https://davidcarslaw.github.io/openair/reference/polarFreq.html
polarPlot(openair::mydata,
pollutant = "nox")
if
(FALSE) {
# polarPlots by year on same scale
polarPlot(mydata, pollutant =
"so2", type = "year", main = "polarPlot of so2")
# set minimum number of bins to be used to
see if pattern remains similar
polarPlot(mydata, pollutant =
"nox", min.bin = 3)
# plot by day of the week
polarPlot(mydata, pollutant =
"pm10", type = "weekday")
# show the 95% confidence intervals in the
surface fitting
polarPlot(mydata, pollutant =
"so2", uncertainty = TRUE)
# Pair-wise statistics
# Pearson correlation
polarPlot(mydata, pollutant =
c("pm25", "pm10"), statistic = "r")
# Robust regression slope, takes a bit of
time
polarPlot(mydata, pollutant =
c("pm25", "pm10"), statistic = "robust.slope")
# Least squares regression works too but it
is not recommended, use robust
# regression
# polarPlot(mydata, pollutant =
c("pm25", "pm10"), statistic = "slope")
}
#https://davidcarslaw.github.io/openair/reference/polarPlot.html
#
windRose in 10 degree intervals with gridlines and width adjusted
if
(FALSE) {
windRose(goubet, angle = 10, width = 0.2,
grid.line = 1)
}
# pollutionRose of nox
pollutionRose(goubet,
pollutant = "nox")
if
(FALSE) {
pollutionRose(mydata, pollutant =
"pm10", type = "year", statistic = "prop.mean")
}
##
example of comparing 2 met sites
##
first we will make some new ws/wd data with a postive bias
mydata$ws2
= mydata$ws + 2 * rnorm(nrow(mydata)) + 1
mydata$wd2
= mydata$wd + 30 * rnorm(nrow(mydata)) + 30
##
need to correct negative wd
id
<- which(mydata$wd2 < 0)
mydata$wd2[id]
<- mydata$wd2[id] + 360
##
results show postive bias in wd and ws
pollutionRose(mydata,
ws = "ws", wd = "wd", ws2 = "ws2", wd2 =
"wd2")
#https://davidcarslaw.github.io/openair/reference/windRose.html
#
first create a true POSIXCT timestamp from the date and hour columns
data.in$timestamp
<- as.POSIXct(paste0(data.in$date, " ", data.in$hr),
tz = "GMT",
format =
"%m/%d/%Y %H:%M")
#
Convert the time stamp to years and months
data.in$Year
<- as.numeric(format(data.in$timestamp, "%Y"))
data.in$month
<- factor(format(data.in$timestamp, "%B"),
levels = month.name)
#
recreate p.wr2, so that includes the new data
p.wr2
<- plot.windrose(data = data.in,
spd = "ws.80",
dir = "wd.80")
#
now generate the faceting
p.wr3
<- p.wr2 + facet_wrap(~month,
ncol = 3)
#
and remove labels for clarity
p.wr3
<- p.wr3 + theme(axis.text.x = element_blank(),
axis.title.x =
element_blank())
#https://stackoverflow.com/questions/17266780/wind-rose-with-ggplot-r
#
POSSIBILITY OF GRAPH WIND
ROSE
library(clifro)
wind_df
= data.frame(wind_speeds = c(rweibull(80, 2, 4), rweibull(20, 3, 9)),
wind_dirs = c(rnorm(80,
135, 55), rnorm(20, 315, 35)) %% 360,
station =
rep(rep(c("Station A", "Station B"), 2),
rep(c(40,
10), each = 2)))
with(wind_df,
windrose(wind_speeds, wind_dirs))
with(wind_df,
windrose(wind_speeds, wind_dirs,
speed_cuts = c(3, 6, 9,
12),
legend_title =
"Wind Speed\n(m/s)",
legend.title.align = .5,
ggtheme =
"bw",
col_pal =
"Greys"))
with(wind_df,
windrose(wind_speeds, wind_dirs, "Artificial Auckland Wind"))
with(wind_df,
windrose(wind_speeds, wind_dirs, station, n_col = 2))
library(ggplot2)
ggsave("my_windrose.png")
##
End(Not run)
# HISTOGRAM 2
#https://bio304-class.github.io/bio304-fall2017/ggplot-bivariate.html
require(tidyverse)
setosa
<- filter(iris, Species == "setosa")
dim(setosa)
setosa.or.virginica
<- filter(iris, Species == "setosa" | Species ==
"virgnica")
dim(setosa.or.virginica)
big.setosa
<- filter(iris, Species == "setosa" & Sepal.Width > 3.5)
dim(big.setosa)
ggplot(setosa) +
geom_point(aes(x = Sepal.Length, y =
Sepal.Width))
p
<- ggplot(setosa, mapping = aes(x = Sepal.Length, y = Sepal.Width))
p
+ geom_point()
p
+ geom_point() + theme_bw()
p
+ geom_point() + theme_classic()
p
+ geom_point() + theme_classic() + theme(aspect.ratio = 1)
my.theme
<- theme_classic() +
theme(aspect.ratio = 1)
sepal.labels
<- labs(x = "Sepal Length (cm)", y = "Sepal Width (cm)",
title = "Relationship
between Sepal Length and Width",
caption = "data from
Anderson (1935)")
p
+
geom_point() +
sepal.labels + labs(subtitle = "I.
setosa data only") +my.theme
p
+
geom_jitter() + # using geom_jitter to avoid overplotting of
points
geom_smooth() +
sepal.labels + labs(subtitle = "I.
setosa data only") +
my.theme
p
+
geom_jitter() + # using geom_jitter to avoid overplotting of
points
geom_smooth(method = "lm", color =
"red") + # using linear model ("lm")
sepal.labels + labs(subtitle = "I.
setosa data only") +
my.theme
#Bivariate density plots
p
<- ggplot(setosa, mapping = aes(x = Sepal.Length, y = Sepal.Width))
p
+
stat_density_2d(aes(fill = ..level..), geom =
"polygon") +
sepal.labels + labs(subtitle = "I.
setosa data only") +
my.theme
p
+
stat_density_2d(aes(fill = ..level..), geom =
"polygon") +
# lavenderblush is the HTML standard name for
a light purplish-pink color
scale_fill_continuous(low="lavenderblush",
high="red") +
sepal.labels + labs(subtitle = "I.
setosa data only") +
my.theme
p
+
geom_density2d() +
sepal.labels + labs(subtitle = "I.
setosa data only") +
my.theme
p
+
geom_density_2d() +
geom_jitter(alpha=0.35) +
sepal.labels + labs(subtitle = "I.
setosa data only") +
my.theme
all.length.vs.width
<- ggplot(iris, aes(x = Sepal.Length, y = Sepal.Width))
all.length.vs.width
+
geom_point(aes(color = Species, shape =
Species), size = 2, alpha = 0.6) +
sepal.labels + labs(subtitle = "All
species") +
my.theme
#
HISTOGRAM
#
Color housekeeping
library(RColorBrewer)
rf
<- colorRampPalette(rev(brewer.pal(11,'Spectral')))
r
<- rf(32)
#
Create normally distributed data for plotting
x
<- rnorm(mean=1.5, 5000)
y
<- rnorm(mean=1.6, 5000)
df
<- data.frame(x,y)
#
Plot
plot(df,
pch=16, col='black', cex=0.5)
library(gplots)
#
Default call
h2
<- hist2d(df)
#
OPTION 1: hexbin from package 'hexbin'
library(hexbin)
#
Create hexbin object and plot
h
<- hexbin(df)
plot(h)
plot(h,
colramp=rf)
#
hexbinplot function allows greater flexibility
hexbinplot(y~x,
data=df, colramp=rf)
#
Setting max and mins
hexbinplot(y~x,
data=df, colramp=rf, mincnt=2, maxcnt=60)
#
Scaling of legend - must provide both trans and inv functions
hexbinplot(y~x,
data=df, colramp=rf, trans=log, inv=exp)
#
Coarser binsizing and add colouring
h2
<- hist2d(df, nbins=25, col=r)
#
Scaling with log as before
h2
<- hist2d(df, nbins=25, col=r, FUN=function(x) log(length(x)))
#
OPTION 3: stat_bin2d from package 'ggplot'
library(ggplot2)
#
Default call (as object)
p
<- ggplot(df, aes(x,y))
h3
<- p + stat_bin2d()
h3
#
Default call (using qplot)
qplot(x,y,data=df,
geom='bin2d')
#
Add colouring and change bins
h3
<- p + stat_bin2d(bins=25) + scale_fill_gradientn(colours=r)
h3
#
Log scaling
h3
<- p + stat_bin2d(bins=25) + scale_fill_gradientn(colours=r,
trans="log")
h3
#
OPTION 4: kde2d from package 'MASS'
#
Not a true heatmap as interpolated (kernel density estimation)
library(MASS)
#
Default call
k
<- kde2d(df$x, df$y)
image(k,
col=r)
#
Adjust binning (interpolate - can be computationally intensive for large
datasets)
k <- kde2d(df$x,
df$y, n=200)
image(k,
col=r)
#
Addendum: 2D Histogram + 1D on sides (from Computational ActSci w R) #######
#http://books.google.ca/books?id=YWcLBAAAQBAJ&pg=PA60&lpg=PA60&dq=kde2d+log&source=bl&ots=7AB-RAoMqY&sig=gFaHSoQCoGMXrR9BTaLOdCs198U&hl=en&sa=X&ei=8mQDVPqtMsi4ggSRnILQDw&redir_esc=y#v=onepage&q=kde2d%20log&f=false
h1
<- hist(df$x, breaks=25, plot=F)
h2
<- hist(df$y, breaks=25, plot=F)
top
<- max(h1$counts, h2$counts)
k <- kde2d(df$x,
df$y, n=25)
# margins
oldpar <- par()
par(mar=c(3,3,1,1))
layout(matrix(c(2,0,1,3),2,2,byrow=T),c(3,1),
c(1,3))
image(k,
col=r) #plot the image
par(mar=c(0,2,1,0))
barplot(h1$counts,
axes=F, ylim=c(0, top), space=0, col='red')
par(mar=c(2,0,0.5,1))
barplot(h2$counts,
axes=F, xlim=c(0, top), space=0, col='red', horiz=T)
#https://www.r-bloggers.com/5-ways-to-do-2d-histograms-in-r/
library(squash)
set.seed(123)
x
<- rnorm(10000)
y
<- rnorm(10000) + x
hist2(x,
y)
##
pseudo-log-scale color breaks:
hist2(x,
y, breaks = prettyLog, key.args = list(stretch = 4))
##
log-scale color breaks; the old way using 'base'
##
(notice box removal to make space for the vertical color key)
hist2(x,
y, base = 2, key = vkey, nz = 5, bty = 'l')
install.packages("devtools")
library(devtools)
install_github("easyGgplot2",
"kassambara")
library(easyGgplot2)
#
Multiple histograms on the same plot
#
Color the histogram plot by the groupName "sex"
ggplot2.histogram(data=weight,
xName='weight',
groupName='sex',
legendPosition="top")
#
Histogram plots with semi-transparent fill.
#
alpha is the transparency of the overlaid color
ggplot2.histogram(data=weight,
xName='weight',
groupName='sex',
legendPosition="top",
alpha=0.5 )
#
Histogram plots with mean lines
ggplot2.histogram(data=weight,
xName='weight',
groupName='sex',
legendPosition="top",
alpha=0.5, addDensity=TRUE,
addMeanLine=TRUE,
meanLineColor="white", meanLineSize=1.5)
library(MASS)
set.seed(101)
my_data
<- rnorm(250, mean=1, sd=0.45) #
unkonwn distribution parameters
fit
<- fitdistr(V_60, densfun="weibull") # we assume my_data ~ Normal(?,?)
fit
hist(V_60,
pch=20, breaks="sturges", prob=T, main="",
col="green")
x11()
a=hist(weibullmm)
x=a$density
curve(dweibull(x,
2.6, 10.21), lty=1,col="blue",
add=T,pch=2)
b=hist(V_60)
plot(a$density,b$density,type='l')
lowess","supsmu","raw","intervals
plsmo(weibullmm,
y=V_60, "lowess",type="b")
log_likelihood
<- function(params) { -sum(dnorm(my_data, params[1], params[2], log=TRUE)) }
fit2
<- optim(c(0,1), log_likelihood) #
c(0,1) are just initial guesses
fit2
hist(my_data,
pch=20, breaks=25, prob=TRUE)
curve(dnorm(x,
fit2$par[1], fit2$par[2]), col="blue", lwd=6, add=T) #
optim fit
curve(dnorm(x,
fit$estimate[1], fit$estimate[2]), col="red", lwd=2, add=T) # fitdistr fit
hist(V_60)
a=dweibull(V_60,
shape=2.645224, scale = 10.218302, log = FALSE)
plot(a,
V_60, type="b")
h<-hist(weibullmm,breaks=15)
xhist<-c(min(h$breaks),h$breaks)
yhist<-c(0,h$density,0)
xfit<-seq(min(V_60),max(V_60),length=40)
yfit<-dnorm(xfit,mean=mean(V_60),sd=sd(V_60))
plot(xhist,yhist,type="s",ylim=c(0,max(yhist,yfit)),
main="Normal pdf and
histogram",
add=T)
lines(xfit,yfit,
col="red")
library(MASS)
set.seed(101)
my_data
<- rnorm(250, mean=1, sd=0.45) #
unkonwn distribution parameters
fit
<- fitdistr(my_data, densfun="normal") # we assume my_data ~ Normal(?,?)
fit
hist(my_data,
pch=20, breaks=25, prob=TRUE, main="")
curve(dnorm(x,
fit$estimate[1], fit$estimate[2]), col="red", lwd=2, add=T)
library(MASS)
set.seed(101)
my_data
<- rnorm(250, mean=1, sd=0.45) #
unkonwn distribution parameters
fit
<- fitdistr(V_60, densfun="normal") # we assume my_data ~ Normal(?,?)
fit
hist(V_60,
pch=20, breaks=10, prob=TRUE, main="")
curve(dnorm(x,
fit$estimate[1], fit$estimate[2]), col="red", lwd=2, add=T)
curve(dweibull(x,
2.93, 10.07, log=F),
col="blue", lwd=6, add=T) # optim fit
dweibull(x,
2.93, 10.07, log=F)
library(fitdistrplus)
fit_w <- fitdist(V_60, "weibull")
fitdistr(V_60,densfun=dweibull,start=list(scale=1,shape=2))##
fitting
#
WEIBULL ASSESMMENT WIND SPEED OF GOUBET
data=write.table(weibullmm,
"data.txt")
goubet<-read.csv(file("clipboard"),header=T,sep="\t",
dec=",",row.names=1)
attach(goubet)
str(goubet)
names(goubet)
dir()
#sample<-
rweibull(V_60, shape=2.645224 , scale =
10.2183) +0
#sqrt(sum((sample-V_60)^2)/length(V_60))#
RMSE
#sum((emp-weib)^2)/length(emp) # MINIMIM SQUARE ERROR
#The
WEIBULL Distribution
kmm=(sd/mean(V_60))^-1.086
cmm=moy/gamma((1+(1/kmm)))
weibullmm=(kmm/cmm)*(V_60/cmm)^(kmm-1)*exp(-((V_60/cmm)^kmm))
#The
RAYLEIGH Distribution
#install.packages("VGAM")
#require(VGAM)
#drayleigh(x,
scale = 1, log = FALSE)
#ray
= ((pi*V_60)/
(2*(mean(V_60)^2))) * exp(-(pi/4)*((V_60/mean(V_60))^2))
rayleigh
= (pi/2) * (V_60/ (mean(V_60)^2)) * exp(
(-pi/4)* (V_60/mean(V_60))^2)
#The LOGNORMAL
Distribution
#log(x) = ln(x) / ln(10)
ou lnx = logx x ln 10
require(stats)
#dlnorm(x,
meanlog = 0, sdlog = 1, log = FALSE)
lognormal
= (1/(V_60*sd(log(V_60))*sqrt(2*pi) )) *(exp( -(log(V_60/mean(log(V_60)))
^2) / (2*(sd(log(V_60))^2 ))) )
#The
GAMMA Distribution
gamma=((
(V_60 ^(kmm-1)) / ( (cmm^kmm ) *
gamma(kmm) )) ) * (exp(-V_60/cmm))
#The
Burr distribution
#The
Frechet distribution
#The
Gumbel distribution
#The
extremum distribution
#hist(V_60,
prob=T)
a=hist(weibullmm,
prob=T); dev.off()
b=hist(lognormal,
prob=T); dev.off()
c=hist(rayleigh,
prob=T); dev.off()
d=hist(MSEF,
prob=T); dev.off()
e=hist(gamma,
prob=T); dev.off()
dat=cbind(a$density,b$density,c$density,d$density,e$density);
colnames(dat) <- c("weib", "log", "ray",
"mse","gamma"); dat
#col=terrain.colors(5)) or
col=topo.colors(500)
plot(-1,-1,xlim=c(0,22),
ylim=c(0,12),xlab="Wind speed(m/s)",ylab="Probability density
function (%)")
grid(col="darkgrey",
lty="solid", lwd=0.1)
par(new=T)
hist(V_60,
prob=T, col= "cornsilk",main=NA,
xlab=NA,ylab=NA,axes=FALSE,border="blue")
par(new=T)
plot(V_60,weibullmm,pch=3,cex=0.0,col="red",axes=FALSE,add=T,ylab=NA,xlab=NA)
x=a$density
par(new=T)
curve(dweibull(x,kmm,
cmm), lty=1,lwd=2,axes=FALSE, col="red",add=T,xlab="",
ylab="")
require(VGAM)
par(new=T)
plot(V_60,rayleigh,pch=3,cex=0.0,col="red",axes=FALSE,add=T,ylab=NA,xlab=NA)
x=c$density
par(new=T)
curve(drayleigh(x,
scale=7.2), lty=1,lwd=2,col="blue3", axes=FALSE, add=T,
xlab="", ylab="")
#curve(dweibull(x,2,cmm),
lty=1,lwd=2,axes=FALSE, col="blue",add=T,xlab="",
ylab="")
#par(new=T)
#curve(dgenray(x,
scale = cmm, shape=kmm, log = FALSE),
lty=1,lwd=2,col="orange", add=T)
#https://clayford.github.io/dwir/dwr_12_generating_data.html
#hist(rayleigh,
freq=FALSE)
X
<- seq(min(V_60),max(V_60), length=92065) # x
#Y
<- dnorm(X, mean = mean(rayleigh), sd = sd(rayleigh)) # f(x) = dnorm
# verification avec la
moyenne de la distribution de la vitesse à goubet?
# A revoir le
trde vde fdte le pour a dstributin
#par(new=T)
#lines(X,Y,type =
"l", col="orange", axes=FALSE, xlab=NA, ylab=NA) # plot
(x,y) coordinates as a "blue" line ("l")
#par(new=T)
#plot(X,Y,type =
"l", col="orange", axes=FALSE, xlab=NA, ylab=NA) # plot
(x,y) coordinates as a "blue" line ("l")
par(new=T)
plot(V_60,lognormal,pch=3,cex=0.0,col="red",axes=FALSE,add=T,ylab=NA,xlab=NA)
x=b$density
par(new=T)
curve(dlnorm(x,
meanlog=2.17, sdlog=0.114, log=F),
lty=1,lwd=2,col="chartreuse3",add=T, axes=FALSE, xlab=NA, ylab=NA)
#par(new=T)
#curve(dlnorm(x,
meanlog = mean(log(V_60)), sdlog = sd(log(V_60)),log =T),
lty=1,lwd=2,col="green",add=T, axes=FALSE)
par(new=T)
plot(V_60,MSEF,pch=3,cex=0.0,col="red",axes=FALSE,add=T,ylab=NA,xlab=NA)
x=d$density
par(new=T)
curve(dweibull(x,
kmm, cmm),axes=FALSE, lty=1,lwd=2,col="cyan",add=T, xlab=NA, ylab=NA)
par(new=T)
plot(V_60,gamma,pch=3,cex=0.0,col="red",axes=FALSE,add=T,ylab=NA,xlab=NA)
x=e$density
par(new=T)
curve(dweibull(x,
kmm, cmm),axes=FALSE, lty=1,lwd=2,col="yellow",add=T, xlab=NA,
ylab=NA)
plot(-1,-1,xlim=c(0,20),
ylim=c(0,20),xlab="",ylab="")
legend("topright",c(
"Weibull",
"Rayleigh",
"Lognormal",
"MSE-Weibull"),
lty=c(1,1,1,3),
col=c("red",
"blue3","chartreuse3","cyan"),
lwd=c(5,5,5,5), bty="n",
cex=1.8)
plot(-1,-1,xlim=c(0,20),
ylim=c(0,20),xlab="",ylab="")
legend("top",c("Vm
=9.08 m/s","sd = 3.71","skew = -0.08","kurt =
-0.65", "min =0.4m/s", "max = 20.8m/s" ),
cex=1.7,bg="white",box.col="black")
FCmm=1-exp(-((V_60/cmm)^kmm))
plot(V_60,
FCmm, pch=20, ylab="Cumulative distribution function",
xlab="Wind speed (m/s)")
grid()
par(new=TRUE)
#
MATHEMATIC AND PHYSIC ENERGY WIND SPEED ASSESMENT
rm(list=ls());
rm(list=ls()); rm(list=ls())
pd<-read.csv(file("clipboard"),header=T,sep="\t",
dec=",",row.names=1)
attach(pd);
str(pd); names(pd)
#
v2= goubet
#EXTRAPOLATION
OF WIND SPEED BY COEFFICIENT OF SHEAD
v1=v2;
h1= 40; h2= 100
alpha=
(0.37 -( 0.088 * log(v1) )) / (1-0.088 * log( h1/ 10))
v2
= v1*((h2/h1)^alpha)
#POWER
density
Yoboki=1.127139204;
Gobaad=1.159309632
PetitBara=1.173332799; Moulhoulé=1.157087117; KhorAngar=1.15
#air
density = 1.255 kg/m^3
PD
= 1/2 * (Yoboki)*(mean (v2)^3)
mean
(v2); PD
#PARAMETER
OF WEIBULL KC
kmm=(sd(v2)/mean(v2))^-1.086
; kmm
cmm=mean(v2)/gamma((1+(1/kmm)));
cmm
#CAPACITY
FACTOR INTERMITTENCE FACTOR
k=kmm;
c=cmm
vi=4; vr=12; vo=25;
Pout= exp(-((vi/c)^k))
- exp(-((vr/c)^k))
Pr=((vr/c)^k) -
((vi/c)^k)
CF = (Pout/Pr) -
exp(-(vo/c)^k); CF
#AIR
DENSITY ( gasparf=287j/kg.K with mean
monthly)
#robar=mean(pres)/(mean(temp)*287)
#robar
#Most
probable wind speed:
Vp= ((kmm-1)/kmm)^(1/kmm); Vp
#Ideal
wind speed :
Vid= cmm*(((kmm+2)/kmm )^(1/kmm)); Vid
#Kinetic
energy resulting:
KE
= 1/2* (1.225) * 6263 *
(V_60^3)
#Cumulative
distribution function (CDF):
F= 1- exp(-
((V_60/cmm)^kmm) )
plot(V_60,F,
type ="p", col="blue")
#
Or ecd()
#MOST
PROBABLE WIND SPEED
MPWS=cmm*( (1-(1/kmm))^(1/kmm) )
MPWS
#
MAXIMUM ENERGY CARRING WIND SPEED
MEWS=cmm*( (1-(2/kmm))^(1/kmm) )
MEWS
#POWER
density of weibull
PDw=
1/2 * PH*c^3 * gamma(1+ (3/k))
#ENERGY
density for a duration t
E=
PDw * t
#AIR
density/ gas constant =287 J/kg.K.
p=
average / (averagetemp * gasconstant)
#POWER
P actually produced at time t
Pt = Pr*
(vt²-vci²)/(vr²-vci²)
pr=1/2 * ph * A*CP*
Vr^3
# Si (vci
vt vr)
#Annual
energy production (AEP):
EOUT
= 8760 * sum cut-outàcut-in ( Fequency distribution *wind power)
#Energy
POWER output
E=
sum(Pi*T)
EWT=nbturbine
* PN*CF*365*24
#CAPACITY
FACTOR
CF = E/Pr * T* N
CF = EOUT/Er
#
ECONOMY and FINANCE
#
data=write.table(weibullmm, "data.txt")
#
ECONOMIC WIND SPEED ASSESMENT
#
CAPACITY FACTOR
k=(sd(V_60)/mean(V_60))^-1.086
c=mean(V_60)/gamma((1+(1/k)))
vi=3; vr=13; vo=25;
Pout= exp(-((vi/c)^k))
- exp(-((vr/c)^k))
Pr=((vr/c)^k) -
((vi/c)^k)
CF = (Pout/Pr) -
exp(-(vo/k)^k); CF
CF=0.43784975
#PRESENT
VALUE COST: Ahmed (2012)/Renewable and
Sustainable Energy Reviews (12.110)
I=
1600*2500*40+(1600*2500*40*0.3)#Total investment cost (I)
COM=0.25*I #Annual operation and maintenance costs
T=
20 #lifetime of Turbine
i=0.024 #inflation rate
r=0.12 #interest rate
S=0.10
*I #scrap value
PVC = I
+ (COM *((1+i)/(r-i)))* (
1-((1+i)/(1+r))^T)- (S*((1+i)/(1+r))^T)
E
= 40*2500*365*24*20*CF # GWh/year
#
rbind(I,
COM, T, i, r, S, E, PVC)
LCOE1
= PVC
/ E ; LCOE1 # $/KWh
#AVERAGE
oF Levelized Cost of Wind Energy: (Alfawzan and all 2019)
CC=
1477 #Total capital cost per
unit: ($/KW)
IR=
0.024 #Inflation rate (%)
DR=
0.12 #Discount rate (%)
Dr= 0
#Debt ratio (%)
Dir= 0
#Debt interest rate (%)
Dt= 0
#Debt term (y)
Eev= 0
#Electricity export escalating rate
(%)
CRF=(DR*((1+DR)^T))/(((1+DR)^T)-1) #Capital recovery factor(__)
T=
20 #Time of operation (yr)
CFOM=58 #Fixed cost per unit of power: ($/KW/yr )
CVOM=(2.5/100) #Variable per unit of Energy (C$ /KWh )
CF
= 0.4378496
#
rbind(CC,IR,
DR, CRF, T, CFOM, CVOM, CF)
LCOE2 =(((CC * CRF)
+ CFOM)/ (CF*8760)) + (CVOM/(1)); LCOE2
#Levelized
Cost of Wind Energy: (Razaei and all 2020)
#
ASSESMENT FINANCIAL AND RISK
#https://www.homerenergy.com/products/pro/docs/latest/system_fixed_operations_and_maintenace_om_cost.html
#
REAL DISCOUNT RATE
#rdr=
nomdr-inf / 1+inf #0.12
#r=read.table(file("clipboard"),
header=T, sep="\t", dec=",", row.names=1)
#attach(r);
names(r)
library(prettyR);
describe(r)
#
Intervalle de Confiance 95% 1.96
#a=mean(cost)-1.29*sd(cost)/sqrt(length(cost))
#b=mean(cost)+1.29*sd(cost)/sqrt(length(cost))
#library(binom)
#binom.confint(269,405,method="exact")
#
# MONTE CARLO SIMULATION
#Des informations de
probabilités pour UNE SIMULATION MONTE CARLO(echantillonage des probabilités)
#INVEST
COST
#CCs=runif(10000,
min=(CC-(CC*0.3)), max=(CC+(CC*0.3)))
# $/KW
IC=1600;
IC
ICs=runif(1000000,
min=700, max=1600)
sIC
<- rlnorm(ICs, mean = mean(log(ICs)), sd = sd(log(ICs)) )
x11()
#
ggplot Histogramme
hp<-qplot(x
=sIC, fill=..count.., geom="histogram");
hp+scale_fill_gradient(low="red",
high="green")+theme_classic() + theme_linedraw() # +
theme_linedraw() + theme_light()
hist(sIC
, prob=T, xalb=NA, ylab=NA, main=NA, col="blue3", breaks=100)
plot(-1,-1,xlim=c(500,3500),
ylim=c(0,0.0015),xlab="$/KW",ylab="Probability density function
(%)")
grid(col="darkgrey",
lty="solid", lwd=0.1)
#grid(NULL, NA)
par(new=T)
plot(-1,-1,xlim=c(500,3500),
ylim=c(0,0.0015),xlab="$/KW",ylab="Probability density function
(%)")
par(new=T) #"FD"
{hist(sIC
, prob=T,border="blue", breaks=100,col=cm.colors(500),
main=NA,xlab=NA,ylab=NA,axes=FALSE)}
lines(density(sIC),
col='red', lty=1, lwd=1)
par(new=T);plot(ecdf(sIC),axes=NA,
xlab=NA, ylab=NA, add=TRUE, main=NA, lwd=2, col="yellow2")
#
https://stat.ethz.ch/R-manual/R-devel/library/stats/html/ecdf.html
plot(-1,-1,xlim=c(500,3500),
ylim=c(0,0.0015),xlab="$/KW",ylab="Probability density function
(%)")
legend("topright",c("Capital
Cost (K/KW)"),text.font=c(2),fill=c(cm.colors(500)), bty="n" )
legend("right",c("Density"),text.font=c(2),col='blue3',
lty=5, lwd=5, bty="n" )
#legend(0.0047,480,c("Quantiles
Adult","Quantiles Children"),text.font=c(2,2),
lwd=c(2,2),lty=c(3,1),bty="n")
#
FOUNDATION COST
FDC=0.3*IC
sFDC=runif(1000000,
min=(FDC-(FDC*0.3)), max=(FDC+(FDC*0.3))
)
#
ggplot Histogramme
hp<-qplot(x
=sFDC, fill=..count.., geom="histogram");
hp+scale_fill_gradient(low="red",
high="green")+theme_classic() + theme_linedraw() # +
theme_linedraw() + theme_light()
x11()
hist(sFDC,
prob=T, xalb=NA, ylab=NA, main=NA)
plot(-1,-1,xlim=c(0,15),
ylim=c(0,20),xlab="%",ylab="Probability density function
(%)")
grid(col="darkgrey",
lty="solid", lwd=0.1)
par(new=T)
plot(-1,-1,xlim=c(0,15),
ylim=c(0,20),xlab="%",ylab="Probability density function
(%)")
par(new=T)
{hist(sFDC
, prob=T,border="blue3",
breaks="FD",col="yellow",
main=NA,xlab=NA,ylab=NA,axes=FALSE)}
lines(density(sITR),
col='purple', lty=5, lwd=2)
par(new=T);plot(ecdf(sFDC),axes=FALSE,
xlab=NA, ylab=NA, add=TRUE, main=NA, lwd=5, col="yellow2")
plot(-1,-1,xlim=c(0,15),
ylim=c(0,20),xlab="%",ylab="Probability density function
(%)")
legend("topright",c("Foundation
Cost ($) "),text.font=c(2),fill=c(topo.colors(500)), bty="n" )
legend("right",c("Density"),text.font=c(2),col='purple',
lty=5, lwd=1, bty="n" )
#
COST O&M
#25%
all year OR 6% per year
#COM=0.06*CC;
COM
#COMs
= runif(10000, min=10.28, max=60.00)
#sCOM
<- rnorm(COMs, mean = mean(COMs), sd = sd(COMs))
# $/KW/YR
CF=runif(1000000,
min=10.28, max=60.00)
getmode
<- function(v) { uniqv <- unique(v); uniqv[which.max(tabulate(match(v,
uniqv)))]}
require(EnvStats)
CFs = runif(1000000,
min=10.28, max=60.00)
sCF <- rtri(CFs,
min = min(CFs), max = max(CFs), mode=getmode(CFs))
#
ggplot Histogramme
hp<-qplot(x
=sCF, fill=..count.., geom="histogram");
hp+scale_fill_gradient(low="red",
high="green")+theme_classic() + theme_linedraw() # +
theme_linedraw() + theme_light()
x11()
hist(sCF
, prob=T, xalb=NA, ylab=NA, main=NA)
plot(-1,-1,xlim=c(10,60),
ylim=c(0,0.04),xlab=" $/KW/YR",ylab="Probability density
function (%)")
grid(col="darkgrey",
lty="solid", lwd=0.1)
#grid(NULL, NA)
par(new=T)
plot(-1,-1,xlim=c(10,60),
ylim=c(0,0.04),xlab=" $/KW/YR",ylab="Probability density
function (%)")
par(new=T)
{hist(sCF
, prob=T,border="orange",
breaks="FD",col=terrain.colors(500),
main=NA,xlab=NA,ylab=NA,axes=FALSE)}
lines(density(sCF),
col='green', lty=5, lwd=5)
par(new=T);plot(ecdf(sCF),axes=FALSE,
xlab=NA, ylab=NA, add=TRUE, main=NA, lwd=5, col="yellow2")
plot(-1,-1,xlim=c(10,60),
ylim=c(0,0.04),xlab="$/KW",ylab="Probability density function
(%)")
legend("topright",c("Fixed
O&M cost ($/KW) "),text.font=c(2),fill=c(terrain.colors(500)),
bty="n" )
legend("right",c("Density"),text.font=c(2),col='green',
lty=5, lwd=5, bty="n" )
# $/MWh
CV=runif(1000000,
min=4.82, max=23.00)
CVs
= runif(1000000, min=4.82, max=23.00)
sCV
<- rlnorm(CVs, mean = mean(log(CVs)),
sd = sd(log(CVs)) )
#
ggplot Histogramme
hp<-qplot(x
=sCV, fill=..count.., geom="histogram");
hp+scale_fill_gradient(low="red",
high="green")+theme_classic() + theme_linedraw() # +
theme_linedraw() + theme_light()
x11()
hist(sCV
, prob=T, xalb=NA, ylab=NA, main=NA)
plot(-1,-1,xlim=c(0,80),
ylim=c(0,0.06),xlab="$/MWh",ylab="Probability density function
(%)")
grid(col="darkgrey",
lty="solid", lwd=0.1)
par(new=T)
plot(-1,-1,xlim=c(0,80),
ylim=c(0,0.06),xlab="$/MWh",ylab="Probability density function
(%)")
par(new=T)
{hist(sCV
, prob=T,border="orange", breaks="FD",col=topo.colors(500),
main=NA,xlab=NA,ylab=NA,axes=FALSE)}
lines(density(sCV),
col='purple', lty=5, lwd=2)
par(new=T);plot(ecdf(sCV),axes=FALSE,
xlab=NA, ylab=NA, add=TRUE, main=NA, lwd=5, col="yellow2")
plot(-1,-1,xlim=c(0,80),
ylim=c(0,0.06),xlab="$/MWh",ylab="Probability density function
(%)")
legend("topright",c("Variable
O&M cost ($/MWh) "),text.font=c(2),fill=c(topo.colors(500)),
bty="n" )
legend("right",c("Density"),text.font=c(2),col='purple',
lty=5, lwd=5, bty="n" )
#
The Exponential Distribution
require(stats)
dexp(x,
rate = 1, log = FALSE)
pexp(q,
rate = 1, lower.tail = TRUE, log.p = FALSE)
qexp(p,
rate = 1, lower.tail = TRUE, log.p = FALSE)
rexp(n,
rate = 1)
#FINANCIAL
INPUT
# Discount Rate
%
DR=9
DRs=runif(1000000,
min=(DR-(DR*0.3)), max=(DR+(DR*0.3)))
sDR
<- rnorm(DRs, mean = mean(DRs), sd = sd(DRs))
#
ggplot Histogramme
hp<-qplot(x
=sDR, fill=..count.., geom="histogram");
hp+scale_fill_gradient(low="red",
high="green")+theme_classic() + theme_linedraw() # +
theme_linedraw() + theme_light()
hist(sDR
, prob=T, xalb=NA, ylab=NA, main=NA)
plot(-1,-1,xlim=c(0,80),
ylim=c(0,0.06),xlab="$/MWh",ylab="Probability density function
(%)")
grid(col="darkgrey",
lty="solid", lwd=0.1)
#grid(NULL, NA)
par(new=T)
plot(-1,-1,xlim=c(0,80),
ylim=c(0,0.06),xlab="$/MWh",ylab="Probability density function
(%)")
par(new=T)
{hist(sDR
, prob=T,border="yellow", breaks="FD",col="blue",
main=NA,xlab=NA,ylab=NA,axes=FALSE)}
lines(density(sDR),
col='red', lty=5, lwd=2)
par(new=T);plot(ecdf(sDR),axes=FALSE,
xlab=NA, ylab=NA, add=TRUE, main=NA, lwd=5, col="yellow2")
plot(-1,-1,xlim=c(0,80),
ylim=c(0,0.06),xlab="$/MWh",ylab="Probability density function
(%)")
legend("topright",c("
Discount Rate (%)
"),text.font=c(2),fill=c(topo.colors(500)), bty="n" )
legend("right",c("Density"),text.font=c(2),col='red',
lty=5, lwd=5, bty="n" )
# Interest Rate
%
ITR=12
ITRs=runif(1000000,
min=(ITR-(ITR*0.3)), max=(ITR+(ITR*0.3))
)
sITR
<- rnorm(ITRs, mean = mean(ITRs), sd = sd(ITRs))
#
ggplot Histogramme
hp<-qplot(x
=sITR, fill=..count.., geom="histogram");
hp+scale_fill_gradient(low="red",
high="green")+theme_classic() + theme_linedraw() # +
theme_linedraw() + theme_light()
x11()
hist(sITR
, prob=T, xalb=NA, ylab=NA, main=NA)
plot(-1,-1,xlim=c(0,15),
ylim=c(0,20),xlab="%",ylab="Probability density function
(%)")
grid(col="darkgrey",
lty="solid", lwd=0.1)
par(new=T)
plot(-1,-1,xlim=c(0,15),
ylim=c(0,20),xlab="%",ylab="Probability density function
(%)")
par(new=T)
{hist(sITR
, prob=T,border="blue3",
breaks="FD",col="yellow",
main=NA,xlab=NA,ylab=NA,axes=FALSE)}
lines(density(sITR),
col='purple', lty=5, lwd=2)
par(new=T);plot(ecdf(sITR),axes=FALSE,
xlab=NA, ylab=NA, add=TRUE, main=NA, lwd=5, col="yellow2")
plot(-1,-1,xlim=c(0,15),
ylim=c(0,20),xlab="%",ylab="Probability density function
(%)")
legend("topright",c("Interest
Rate (%)
"),text.font=c(2),fill=c(topo.colors(500)), bty="n" )
legend("right",c("Density"),text.font=c(2),col='purple',
lty=5, lwd=1, bty="n" )
# Inflation Rate %
IFR=2.4
IFRs=runif(1000000,
min=(IFR-(IFR*0.3)), max=(IFR+(IFR*0.3)))
sIFR
<- rnorm(IFRs, mean = mean(IFRs), sd = sd(IFRs))
#
ggplot Histogramme
hp<-qplot(x
=sIFR, fill=..count.., geom="histogram");
hp+scale_fill_gradient(low="red",
high="green")+theme_classic() + theme_linedraw() # +
theme_linedraw() + theme_light()
x11()
hist(sIFR
, prob=T, xalb=NA, ylab=NA, main=NA)
plot(-1,-1,xlim=c(0,20),
ylim=c(5,15),xlab="$/MWh",ylab="Probability density function
(%)")
grid(col="darkgrey",
lty="solid", lwd=0.1)
#grid(NULL, NA)
par(new=T)
plot(-1,-1,xlim=c(0,20),
ylim=c(5,15),xlab="%",ylab="Probability density function
(%)")
par(new=T)
{hist(sIFR
, prob=T,border="red", breaks="FD",col="red",
main=NA,xlab=NA,ylab=NA,axes=FALSE)}
lines(density(sIFR),
col='red', lty=5, lwd=2)
par(new=T);plot(ecdf(sIFR),axes=FALSE,
xlab=NA, ylab=NA, add=TRUE, main=NA, lwd=5, col="yellow2")
plot(-1,-1,xlim=c(0,20),
ylim=c(5,15),xlab="$/MWh",ylab="Probability density function
(%)")
legend("topright",c("Inflation
Rate (%) "),text.font=c(2),fill=c(topo.colors(500)), bty="n" )
legend("right",c("Density"),text.font=c(2),col='red',
lty=5, lwd=3, bty="n" )
#POTENTIAL INPUT
#Capacité de facteur %
sFCF=runif(1000000,
min=26, max=52)
hist(sFCF
, prob=T, xalb=NA, ylab=NA, main=NA)
x11()
#
ggplot Histogramme
hp<-qplot(x
=sFCF, fill=..count.., geom="histogram");
hp+scale_fill_gradient(low="red",
high="green")+theme_classic() + theme_linedraw() # +
theme_linedraw() + theme_light()
plot(-1,-1,xlim=c(25,50),
ylim=c(5,15),xlab="$/MWh",ylab="Probability density function
(%)")
grid(col="darkgrey",
lty="solid", lwd=0.1)
par(new=T)
plot(-1,-1,xlim=c(0,20),
ylim=c(5,15),xlab="%",ylab="Probability density function
(%)")
par(new=T)
{hist(sIFR
, prob=T,border="red", breaks="FD",col="red",
main=NA,xlab=NA,ylab=NA,axes=FALSE)}
lines(density(sIFR),
col='red', lty=5, lwd=2)
par(new=T);plot(ecdf(sFCF),axes=FALSE,
xlab=NA, ylab=NA, add=TRUE, main=NA, lwd=5, col="yellow2")
plot(-1,-1,xlim=c(0,20),
ylim=c(5,15),xlab="$/MWh",ylab="Probability density function
(%)")
legend("topright",c("Capacité
de facteur(%) "),text.font=c(2),fill=c(topo.colors(500)),
bty="n" )
legend("right",c("Density"),text.font=c(2),col='red',
lty=5, lwd=3, bty="n" )
#Durée de vie yr
sLFT=runif(1000000,
min=15, max=20)
hist(sLFT
, prob=T, xalb=NA, ylab=NA, main=NA)
x11()
#
ggplot Histogramme
hp<-qplot(x
=sLFT, fill=..count.., geom="histogram");
hp+scale_fill_gradient(low="red",
high="green")+theme_classic() + theme_linedraw() # +
theme_linedraw() + theme_light()
plot(-1,-1,xlim=c(0,20),
ylim=c(5,15),xlab="yr",ylab="Probability density function
(%)")
grid(col="darkgrey",
lty="solid", lwd=0.1)
#grid(NULL, NA)
par(new=T)
plot(-1,-1,xlim=c(0,20),
ylim=c(5,15),xlab="%",ylab="Probability density function
(%)")
par(new=T)
{hist(sLFT
, prob=T,border="red", breaks="FD",col="red",
main=NA,xlab=NA,ylab=NA,axes=FALSE)}
lines(density(sLFT),
col='red', lty=5, lwd=2)
par(new=T);plot(ecdf(sLFT),axes=FALSE,
xlab=NA, ylab=NA, add=TRUE, main=NA, lwd=5, col="yellow2")
plot(-1,-1,xlim=c(0,20),
ylim=c(5,15),xlab="$/MWh",ylab="Probability density function
(%)")
legend("topright",c("Life
Time (yr) "),text.font=c(2),fill=c(topo.colors(500)), bty="n" )
legend("right",c("Density"),text.font=c(2),col='red',
lty=5, lwd=3, bty="n" )
#Degradation de la
production %
DGs=runif(1000000,
min=0, max=5)
sDG
<- rlnorm(DGs, mean = mean(log(DGs)),
sd = sd(log(DGs)) )
h=hist(sDG
, prob=T, xalb=NA, ylab=NA, main=NA)
x11()
#
ggplot Histogramme
hp<-qplot(x
=sDG, fill=..count.., geom="histogram");
hp+scale_fill_gradient(low="red",
high="green")+theme_classic() + theme_linedraw() # +
theme_linedraw() + theme_light()
plot(-1,-1,
xlim=c(5,50),ylim=c(0,0.8),xlab="%",ylab="Probability density
function (%)")
grid(col="darkgrey",
lty="solid", lwd=0.1)
#grid(NULL, NA)
par(new=T)
plot(-1,-1,
xlim=c(5,50),ylim=c(0,0.8),xlab="%",ylab="Probability density
function (%)")
par(new=T)
{hist(sDG
, prob=T,border="red", breaks='FD',col="red",
main=NA,xlab=NA,ylab=NA,axes=FALSE)}
lines(density(sDG),
col='red', lty=5, lwd=2)
par(new=T);plot(ecdf(sDG),axes=FALSE,
xlab=NA, ylab=NA, add=TRUE, main=NA, lwd=5, col="yellow2")
plot(-1,-1,
xlim=c(5,50),ylim=c(0,0.8),xlab="%",ylab="Probability density
function (%)")
legend("topright",c("Degrdataion
(%) "),text.font=c(2),fill=c(topo.colors(500)), bty="n" )
legend("right",c("Density"),text.font=c(2),col='red',
lty=5, lwd=3, bty="n" )
#Life-cycle
GHG emissions(g CO2eq/kWh)
sGHG=runif(1000000,
min=8.4, max=20)
hist(sGHG
, prob=T, xalb=NA, ylab=NA, main=NA)
x11()
#
ggplot Histogramme
hp<-qplot(x
=sGHG, fill=..count.., geom="histogram");
hp+scale_fill_gradient(low="red",
high="green")+theme_classic() + theme_linedraw() # +
theme_linedraw() + theme_light()
plot(-1,-1,xlim=c(0,20),
ylim=c(5,15),xlab="$/MWh",ylab="Probability density function
(%)")
grid(col="darkgrey",
lty="solid", lwd=0.1)
#grid(NULL, NA)
par(new=T)
plot(-1,-1,xlim=c(0,20),
ylim=c(5,15),xlab="%",ylab="Probability density function
(%)")
par(new=T)
{hist(sIFR
, prob=T,border="red", breaks="FD",col="red",
main=NA,xlab=NA,ylab=NA,axes=FALSE)}
lines(density(sIFR),
col='red', lty=5, lwd=2)
par(new=T);plot(ecdf(sGHG),axes=FALSE,
xlab=NA, ylab=NA, add=TRUE, main=NA, lwd=5, col="yellow2")
plot(-1,-1,xlim=c(0,20),
ylim=c(5,15),xlab="$/MWh",ylab="Probability density function
(%)")
legend("topright",c("Inflation
Rate (%) "),text.font=c(2),fill=c(topo.colors(500)), bty="n" )
legend("right",c("Density"),text.font=c(2),col='red',
lty=5, lwd=3, bty="n" )
#|
SECOND STEPS OF MC LCOE
#
ceRtainty: Certainty Equivalent in R
#install.packages("ceRtainty")
library(ceRtainty)
data("profitSWG");
profitSWG
summary(profitSWG);
names(profitSWG)
dim(profitSWG);
str(profitSWG)
#RAC doit être une
valeur relative ou absolue:
#Obtaining
the CE table
##
Computing the CE values, for a RAC range of 0.5-4.0, and Power utility
function.
certainty(data
= profitSWG, ival = 0.5, fval = 4, utility = "Power")$CE_values
#
Obtaining the RAC vector
certainty(data=profitSWG,ival=.5,fval=4,utility="Power")$RAC
##
Performing the CE plot
certainty(data=profitSWG,ival=.5,fval=4,utility="Power")$CE_plot()
#prime de risque est
une mesure à comparer entre les EC
#
Computing and storing the CE values using Power utility function
ces <- certainty(data = profitSWG, ival
= 0.5, fval = 4, utility = "Power")
ces_values <- ces$CE_values # store CE table
ces_rac <- ces$RAC # store RAC vector
#
Computing the RP values respect to SERENADE treatment
premium(tbase
= "serenade",ce_data = ces_values, rac = ces_rac, utility =
"Power")$PremiumRisk
#
Computing the RP values in percentage respect to SERENADE treatment
premium(tbase
= "serenade",ce_data = ces_values, rac = ces_rac, utility =
"Power")$PremiumRiskPer100
#
Plotting the RP absolute values
premium(tbase
= "serenade",ce_data = ces_values, rac = ces_rac, utility =
"Power")$RP_plot()
#Generating
Risk Aversion Coefficients
rac_generator(data
= profitSWG$control, ini = 0.5, fin = 4.0)
#END MC LCOE
#col=terrain.colors(5))
col=topo.colors(500)
#sIC sFDC
sCF sCV sDR
sITR sIFR sCFC
sLFT sDG sGHG
IC=1600; FD=0.3*1600;
CRF= 0.11248912; FC = 60; T=8760;
CF = 0.43784975 ;
CV=23/1000
LCOE =((((IC+(FD))*CRF
)+FC) / (T*CF)) + (CV) ; LCOE
sCRF=((sDR/100)*(((sDR/100)+1)^20))/
((((sDR/100)+1)^20 )-1)
sLCO
=( (((sIC)+ (sFDC)) * (sCRF)) + (sCF)
)/ (8760*(sFCF/100)) #*sDG without
sLCOE=
sLCO+(sCV/1000)
head(sLCOE);
tail(sLCOE)
summary(sLCOE)
#View(sLCOE)
hist(sLCOE
, prob=T, xalb=NA, ylab=NA, main=NA)
x11()
#
ggplot Histogramme
hp<-qplot(x
=sLCOE, fill=..count.., geom="histogram");
hp+scale_fill_gradient(low="red",
high="green")+theme_classic() + theme_linedraw() # +geom_density(alpha=.2, fill="#FF6666") +theme_linedraw() +theme_light()
plot(-1,-1,xlim=c(0.025,0.17),
ylim=c(0,22),xlab="Wind LCOE ($/KWh)",ylab="Probability density
function (%)")
grid(col="grey2",
lty="solid", lwd=0.1)
#grid(NULL, NA)
par(new=T)
plot(-1,-1,xlim=c(0.025,0.17),
ylim=c(0,22),xlab="Wind LCOE ($/KWh)",ylab="Probability density
function (%)")
#breaks="FD"
par(new=T)
{hist(sLCOE,add=TRUE,
prob=T,border="yellow", breaks=100,col="blue3",
main=NA,xlab=NA,ylab=NA,axes=FALSE)}
lines(density(sLCOE),
col='red', lty=1, lwd=1)
#
plot(-1,-1,xlim=c(0.025,0.17),
ylim=c(0,22),xlab="Wind LCOE ($/KWh)",ylab="Probability density
function (%)")
legend("topright",c("Degrdataion
(%) "),text.font=c(2),fill=c(topo.colors(500)), bty="n" )
legend("right",c("Density"),text.font=c(2),col='red',
lty=5, lwd=3, bty="n" )
#library(wesanderson);
names(wes_palettes)
#wes_palette("Zissou1",
10, type = "continuous")) #heat.colors(n), terrain.colors(n),
topo.colors(n), et cm.colors(n)
#hist(sLCOE,xlim=c(0,0.10),
ylim=c(0,75),breaks=170, prob=T, main=NA,xlab=" LCOE ($/KW) ", ylab=NA, col=
heat.colors(70),border="darkslategrey")
#require(lattice)
#histogram(~sLCOE,xlim=c(0,0.10),breaks=170,
prob=T, main=NA,xlab=" LCOE ($/KW)
", ylab=NA, col= heat.colors(70),border="darkslategrey")
cbind(quantile(sLCOE,c(0.05,0.50,0.95)))
numb1
<- cbind(quantile(sLCOE,c(0.05,0.50,0.95)));
library(scales);scientific(numb1, digits = 3)
e=
0.05442740
abline(v=e,
lwd=0.5, col="darkred",lty=2)
#legend(e, 70 ,"5%=
3.718e-4",cex=0.75,bg="white")
#
#f=
0.04808734
#abline(v=f,
lwd=0.5, col="darkblue",lty=2)
#legend(f, 70
,"50%= 2.342e-3"
,cex=0.75,bg="white")
#
g=0.11629905
abline(v=
g, lwd=0.5, col="darkgreen",lty=2)
#legend(g,
70
,"95%=4.314e-3",cex=0.75,bg="white")
cbind(round(summary(sLCOE),4))
round(sd(sLCOE),4)
#https://clayford.github.io/dwir/dwr_12_generating_data.html
#q
<- qnorm(p = 0.15, mean = 100, sd = 5)
#xx
<- c(seq(85,q,length.out = 100),rev(seq(85,q,length = 100)))
#yy
<- c(rep(0,100),dnorm(rev(seq(85,q,length = 100)), mean = 100, sd = 5))
#polygon(x=xx,y=yy,col="grey")
#
annotate graph
#text(x
= 93, y = 0.005,labels = pnorm(q,mean = 100,sd = 5))
#text(x
= q, y = 0.06, labels = round(q,2))
sLCOE =(((sCC * CRF) + sCFOM)/ (sCF*8760)) + (sCVOM/(1)); sLCOE
h=hist(sLCOE,
breaks='FD', freq=F)
#'FD'/text(h$mids,h$counts,labels=h$counts,
adj=c(0.5,-0.5))
plot(-1,-1
, xlim=c(0.04,0.27), ylim=c(0,25), xlab="LCOE ($/KWh)",
ylab="Frequency (%)")
grid(lty=1,
col="grey")
par(new=TRUE)
#hist(sLCOE,
breaks='FD',axes=F,
freq=F,main=NA,xlab=NA,ylab=NA,col="blue",border="red")
plot(h$mids,
h$density, , type="h", axes=FALSE,
lwd=3,col="blue3", xlab=NA, ylab=NA)
lines(density(LCOEs),
lwd=2, lty=1,col='red')
require(actuar)
quantile(sLCOE)
quantile(sLCOE, probs
= seq(0.05, 0.9, 0.01))
q=cbind(quantile(sLCOE,c(0.1,0.9)))
library(scales);scientific(q,
digits = 3)
a=0.07632508;
b=0.11637282
abline(v=a,
lwd=2, col="darkred",lty=1)
abline(v=b,
lwd=2, col="darkblue",lty=1)
legend(a, 25 ,
"10%= 0.07632508",cex=0.75,bg="white")
legend(b, 25
,"90%=0.11637282"
,cex=0.75,bg="white")
d10=sLCOE[sLCOE>=a]
d90=d10[d10<=b]
d=data.frame(d90)
write.table(d,
"data.txt")
r=read.table(file("clipboard"),
header=T, sep="\t", dec=",", row.names=1)
h=hist(r$LCOE,
freq=F, breaks=20)
plot(-1,-1
, xlim=c(0.04,0.27), ylim=c(0,25),xaxt="n", xlab="LCOE
($/KWh)", ylab="Frequency (%)")
grid(lty=1,
col="grey")
par(new=TRUE)
plot(h$mids,
h$density, type="h", axes=F, xaxt="n",
lwd=3,col="blue3", xlab=NA, ylab=NA)
#xaxt="n"
axis(1,
at=c(0.077,0.079,0.081, 0.083, 0.085, 0.087, 0.089, 0.091, 0.093, 0.095, 0.097,
0.099,
0.101, 0.103, 0.105,0.107, 0.109,
0.111, 0.113, 0.115 ),las=1, cex=.9)
barplot(h$density~h$mids,
col=cm.colors(14))
d=data.frame(h$mids,
h$density)
write.table(d,
"data.txt", sep="\t")
#RISK
AVERSION, RISK PREMIUM AND CERTAINTY EQUIVALENT
d=cbind(sLCOE);
e=cbind(sLCOE); f=cbind(sLCOE)
dd=data.frame(d[1:10000,])
library(ceRtainty)
certainty(data
= dd, ival = 0.5, fval = 4, utility = "Power")$CE_values
certainty(data=dd,ival=.5,fval=4,utility="Power")$RAC
cesdd <- certainty(data = dd, ival = 0.5,
fval = 4, utility = "Power")
ces_values <- cesdd$CE_values # store CE table
ces_rac <- cesdd$RAC # store RAC vector
#Generating
Risk Aversion Coefficients
rac_generator(data
= dd, ini = 0.5, fin = 4.0)
View(rac_generator(data
= dd, ini = 0.5, fin = 4.0))
AR=-5.158836 # HIGHER = FIRST VALUE OF ITERATION PRATT1964
RP
= (sum((d[1:10000,])/10000)) - ( (sum(
(d[1:10000,]^(1-AR)/(1-AR))*(1-AR))/(10000))^(1-AR) );RP
Ceq=
(sum((d[1:10000,])/10000)) +RP; Ceq
#Newton-Raphson
Method
##
rm(list=ls())
newton
<- function(f, tol = 1e-7, x0 = 1, N = 100){
h = 1e-7
i = 1; x1 = x0
p = numeric(N)
while (i <= N) {
df.dx = (f(x0 + h) - f(x0)) / h
x1 = (x0 - (f(x0) / df.dx))
p[i] = x1
i = i + 1
if (abs(x1 - x0) < tol) break
x0 = x1
}
return(p[1 : (i-1)])
}
##
End of the function
#
USES NEWTON RAPHSON METHOD
f
<- function(x){ 42191206.73 *(( (
(1+x)^20 ) )-1)/(x*( (1+x)^20 )
)-208000000 }
h
<- 1e-7
df.dx
<- function(x){(f(x + h) - f(x)) / h}
df.dx(1);df.dx(2)
app
<- newton(f, x0 =0.1);app
f(app[length(app)])
#
y=0.1973083
#
+(-208000000/((1+x)^0))
42191206.73
*(( ( (1+x)^20 ) )-1)/(x*( (1+x)^20 )
)-208000000
#METHODE
2 NEWTON RAPHSON
func2
<- function(x) {
(42191206.73 *((1+x)^(-20))) -7280000
}
curve(func2,
xlim=c(-5,5), col='blue', lwd=2, lty=1, ylab='f(x)');abline(h=0);abline(v=0)
uniroot(func2,
c(2,3))
(42191206.73
*((1+0.09182876)^(-20))) -7280000
newton.raphson
<- function(f, a, b, tol = 1e-5, n = 1000) {
require(numDeriv) # Package for computing
f'(x)
x0 <- a # Set start value to supplied
lower bound
k <- n # Initialize for iteration results
# Check the upper and lower bounds to see if
approximations result in 0
fa <- f(a)
if (fa == 0.0) {
return(a)
}
fb <- f(b)
if (fb == 0.0) {
return(b)
}
for (i in 1:n) {
dx <- genD(func = f, x = x0)$D[1] #
First-order derivative f'(x0)
x1 <- x0 - (f(x0) / dx) # Calculate next
value x1
k[i] <- x1 # Store x1
# Once the difference between x0 and x1
becomes sufficiently small, output the results.
if (abs(x1 - x0) < tol) {
root.approx <- tail(k, n=1)
res <- list('root approximation' =
root.approx, 'iterations' = k)
return(res)
}
# If Newton-Raphson has not yet reached
convergence set x1 as x0 and continue
x0 <- x1
}
print('Too many iterations in method')
}
newton.raphson(func2,
0.001, 3)
#https://rstudio-pubs-static.s3.amazonaws.com/205225_5991ce162f504576a84eac9c659aeaaf.html
#Or
methode TRI() excel on Cash Flow (in-out) from 0 to n
#
TAXE AND INCENTIVE STRATEGY OF DJIBOUTI
#EXCEL
DETAILS SHOW IST AWALEH
#Net
= Soustraction Ben- Cost
#NPVC
AND NPVB (#PVC)
#PVC
I=
1600*2500*40+(1600*2500*40*0.3)
COM=0.25*I;
T= 20; S=0.10 *I
ifl=0.024;
ir=0.12
#E
= 40*2500*365*24*20*CF
PVC=I+(COM*((1+ifl)/(ir-ifl)))*(1-((1+ifl)/(1+ir))^20)-(S*((1+ifl)/(1+ir))^20)
; PVC
#https://sci-hub.st/10.1115/POWER-ICOPE2017-3675
#METHDOLOGIE
I:PayBack of Rezaei and al.(2020) [Renewable Energy]
#Knowing
purhcass tarif with output energy acumulated by First year give de the benefit
#Knowing
all cost accumulated by year give the cost
#Intersection
both of them result of Pay Back
#METHDOLOGIE II:
#https://www.dolcera.com/wiki/images/Wind_power_energy.
Infl=0.024
Int=0.12
Disc=((1+Int)/(1+Infl))
-1
EUAB= 0.11 #Equivalent Uniform Annual Benefit#tarif
d'achat de l'énergie renouvelable en iran(0,13 $ kWh)
#https://www.afdb.org/fileadmin/uploads/afdb/Documents/Evaluation-Reports-_Shared-With-OPEV_/Ethiopie-Djibouti-Interconnection_%C3%A9lectrique-RAP-06-10-2011.pdf
#CUMULATIVE
CASH FLOW
r=read.table(file("clipboard"),
header=T, sep="\t", dec=",")
str(r);
attach(r); names(r)
DRc=
((1+r)/(1+i))-1; DRc
#C=(1477*100000*CRF)+
(58*100000)+(0.025*100000*8760); C
PVC=718094394
PVB=0.11*(E)
CF=
PVB-PVC
NPV=CF/((1+DRc)^t)
#https://www.journaldev.com/39620/how-to-create-an-area-plot-in-r-using-ggplot2#:~:text=The%20area%20graphs%20are%20the,points%20using%20the%20ggplot2%20package.
library(ggplot2)
library(hrbrthemes)
#reading
data into data frames
data<-
data.frame(Y, CCF)
xdata=Y;ydata=CCF
#plots
the area chart with theme, title and labels
ggplot(data,
aes(x=xdata, y=ydata))+
geom_area(fill='#142F86', alpha=1)+
geom_line(color='skyblue', size=1)+
geom_point(size=1, color='blue')+
ggtitle("Area plot using ggplot2 in
R")+
labs(x='Value', y='frequency')+
theme_ipsum()
# Changer la couleur
des traits par groupe
ggplot(df,
aes(x=weight, color=sex)) +
geom_density()
#
Ajouter les moyennes
p<-ggplot(df,
aes(x=weight, color=sex)) +
geom_density()+
geom_vline(data=mu, aes(xintercept=grp.mean,
color=sex),
linetype="dashed"); p
sp3+
theme(
# Masquer les bords des panneaux et supprimer les lignes
de grilles
panel.border
= element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
# Modifier le trait des axes
axis.line = element_line(colour =
"black")
)
#http://www.sthda.com/french/wiki/ggplot2-courbe-de-distribution-guide-de-demarrage-rapide-logiciel-r-et-visualisation-de-donnees
r=read.table(file("clipboard"),
header=T, sep="\t", dec=","); str(r); attach(r); names(r)
p<-ggplot(r,
aes(x=m, y=ws, color=ws)) + geom_point(color="blue", size=3)
p<-ggplot(r,
aes(x=m, y=ws, color=ws)) + geom_line(size=1.3)
p+
theme_bw()+scale_color_gradientn(colours = rainbow(5))
#ggplot(ToothGrowth,
aes(x=dose, y=len)) +geom_boxplot()
#hp<-qplot(x
=x, fill=..count..,
geom="histogram");hp+scale_fill_gradient(low="blue",
high="red")
#http://www.sthda.com/french/wiki/ggplot2-couleurs-changer-les-couleurs-automatiquement-et-manuellement-logiciel-r-et-visualisation-de-donnees
#https://www.datanovia.com/en/fr/blog/ggplot-background-du-theme-couleur-et-quadrillage/
#SENSITIVITY
ANALYSIS BY GRAPH
#sIC sFDC
sCF sCV sDR
sITR sIFR sCFC
sLFT sDG sGHG
#
RANK SPEARMAN SENSITYVITY
dc=data.frame(sIC
, sFDC , sCF , sCV ,
sDR , sITR , sIFR
, sFCF , sLFT
, sDG , sGHG,sCRF, sLCOE)
sp=cor(dc,dc$sLCOE,method="spearman")
#method="spearman", alternative="two.sided"
sp
cIC =
0.1232932641
cFDC =
0.0388737283
cCF =
0.0455150223
cCV =
0.1903809174
cDR =
0.0852305248
cITR =
-0.0010613671
cIFR =
-0.0004500938
cFCF =
-0.1794478264
cLFT =
0.0022432644
cDG =
-0.9347707838
sCRF =
0.0852305248
cGHG =
0.0004282596
#COLORATION
colfunc<-colorRampPalette(c("red","yellow","springgreen","royalblue"))
plot(-100,100,
xlim=c(-10, 10), xlab= "Rank Correlation",
yaxt="n",xaxt="n" ,ylab=NA)
par(new=TRUE)
barplot(c(cIC,cFDC,cCF,cCV,cDR,cITR,cIFR,cFCF,cLFT,cDG,cGHG),horiz=T,
col=colfunc(150))
grid(NULL,NA,
col = "gray", lty = "dotted", lwd = par("lwd"),
equilogs = TRUE) # NULL OR NA OR c()
# PLOT LINE SENSITYVITY
dc=data.frame(median(sIC),median(sFDC),median(sCF),median(sCV),median(sDR),median(sITR),median(sIFR),median(sFCF)
,
median(sLFT) ,median(sDG) ,median(sGHG), median(sCRF),
median(sLCOE));cbind(dc)
dc5n=(-0.05*dc)+dc;
dc5p=(0.05*dc)+dc
dc10n=(-0.10*dc)+dc;
dc10p=(0.10*dc)+dc
dc15n=(-0.15*dc)+dc;
dc15p=(0.15*dc)+dc
dc20n=(-0.20*dc)+dc;
dc20p=(0.20*dc)+dc
#
impact on LCOE one by one following the formulas and using to delete the unit by divided the
LCOE first
rbind(dc5n,dc10n,dc15n,dc20n,
dc5p,dc10p,dc15p,dc20p)
#
TORNADO DIAGRAM SENSITYVITY
https://stackoverflow.com/questions/55751978/tornado-both-sided-horizontal-bar-plot-in-r-with-chart-axes-crosses-at-a-given/55755671
library(ggplot2)
library(plyr)
library(dplyr)
library(tidyverse)
#Tornado
by percentage or by value
#Or
use Excel value positive and negative bar horizentale, and change add value by
refencies not automatical
#http://rnotr.com/likert/ggplot/barometer/likert-plots/
#https://www.r-graph-gallery.com/202-barplot-for-likert-type-items.html
library(likert)
data(pisaitems)
#items28 <- pisaitems[, substr(names(pisaitems), 1, 5) == "ST24Q"]
p
<- likert(items28)
plot(p)
#
COUNTOUR DIAGRAM SENSITYVITY
a
= sDR
b
= sCF
c = sIC
#quantile(a,
0.25) ; a25= 7.943471
#quantile(a,
0.75) ; a75= 10.04866
#quantile(b,
0.25) ; b25= 22.92599
#quantile(b,
0.75) ; b75= 38.58379
#quantile(c,
0.25) ; c25= 955.9306
#quantile(c,
0.75) ; c75= 1312.535
#x=c(min(a),min(a),min(a),a25,
a25, a25,median(a),median(a),median(a),a75, a75,a75,max(a),max(a),max(a))
#y=c(min(b),min(b),min(b),b25,b25,b25,median(b),median(b),median(b),b75,b75,b75,max(b),max(b),max(b))
#z=c(min(c),min(c),min(c),c25,c25,c25,median(c),median(c),median(c),c75,c75,c75,max(c),max(c),max(c))
x=c(min(a),min(a),min(a),median(a),median(a),median(a),max(a),max(a),max(a))
y=c(min(b),min(b),min(b),median(b),median(b),median(b),max(b),max(b),max(b))
z=c(min(c),min(c),min(c),median(c),median(c),median(c),max(c),max(c),max(c))
df <-
data.frame(x=x,y=y,z=z)
#x=c(1,1,1,2,2,2,3,3,3) y=c(0,10,20,0,10,20,0,10,20)
z=c(900,800,700,600,500,400,300,200,100)
df <- data.frame(x=x,y=y,z=z)
library(plotly)
p
<- plot_ly(data = df, x=~x,y=~y, z=~z, type = "contour",
colorscale='Jet');p
#BASELINE
CASE
DR;
FC; IC
#
Heat Map SENSITYVITY (Origin Lap)
#
a
= sDR
b
= sCF
c
= sIC
d=data.frame(a,b,c)
write.table(round(d[1:1000,],3),
sep="\t", "d.txt")
#
#
TERNARY DIAGRAM SENSITYVITY
library(plotly)
#http://www.ggtern.com/2013/12/16/pps-3-state-model/
library(ggtern);
x11()
#Create
Base Plot
base
<- ggtern(data=df,aes(x,y,z,
colour=factor(z))) +
geom_point(size=5) +
theme_rgbw() +
custom_percent("%") +
labs(colour="Initial Cost ($/KW)")
+
theme(legend.position=c(0,1),
legend.justification=c(0,1))
print(base)
#Draw
same plot above using limiting region
lim
<- base +
limit_tern(.3,.3,1)
print(lim)
library(ggtern)
plot
<- ggtern(data = df, aes(x = x, y = y, z = z)) +geom_point(aes(fill = z),
size = 4, shape = 21, color = "black") +
ggtitle("") +
labs(fill = "Initial Cost ($/KW)")
+
theme_rgbw() + theme(legend.position =
c(0,1),
legend.justification =
c(0, 1) ); plot
library("plot3D")
a
= sFCF
b
= sCRF
c
= sLCOE
scatter3D(
a, b, c,bty = "g", theta = 33, phi = 12,pch = 20,cex=1.8,
clab = c("LCOE
($/KWh)"),addlines = TRUE,ticktype = "detailed",
main = "", xlab =
"Capacity Factor (%)",
ylab ="Capital Recovery
Factor", zlab = "LCOE ($/KWH)")
#text3D(BW,
Hg, THQ, labels = rownames(t), add =
TRUE, colkey = FALSE, cex = 0.5)
#https://stackoverflow.com/questions/10879361/ternary-plot-and-filled-contour
df
<- data.frame(a, b, c, d)
ggtern(df,aes(a,c,b))
+
geom_interpolate_tern(aes(value=d,fill=..level..),
binwidth=500,
colour="white") +
geom_point(aes(fill=d),color="black",shape=21,size=3) +
scale_fill_gradient(low="yellow",high="red") +
theme(legend.position=c(0,1),legend.justification=c(0,1)) +
labs(fill="Value, d")
#https://plotly.com/r/ternary-contour/
#http://www.ggtern.com/2015/08/03/ternary-interpolation-smoothing/
#https://stackoverflow.com/questions/45818875/how-to-add-labels-on-axis-in-ternary-diagram-using-ggtern-package
#https://plotly.com/r/ternary-plots/
journalist
<- c(75,70,75,5,10,10,20,10,15,10,20)
developer
<- c(25,10,20,60,80,90,70,20,5,10,10)
designer
<- c(0,20,5,35,10,0,10,70,80,80,70)
label
<- c('point 1','point 2','point 3','point 4','point 5','point 6',
'point 7','point
8','point 9','point 10','point 11')
df
<- data.frame(journalist,developer,designer,label)
#
axis layout
axis
<- function(title) {
list(
title = title,
titlefont = list(
size = 20
),
tickfont = list(
size = 15
),
tickcolor = 'rgba(0,0,0,0)',
ticklen = 5
)
}
fig
<- df %>% plot_ly()
fig
<- fig %>% add_trace(
type = 'scatterternary',
mode = 'markers',
a = ~journalist,
b = ~developer,
c = ~designer,
text = ~label,
marker = list(
symbol = 100,
color = '#DB7365',
size = 14,
line = list('width' = 2)
)
)
fig
<- fig %>% layout(
title = "Simple Ternary Plot with
Markers",
ternary = list(
sum = 100,
aaxis = axis('Journalist'),
baxis = axis('Developer'),
caxis = axis('Designer')
)
)
fig
df
<- data.frame(a, b, c, d)
ggtern(df,aes(a,c,b))
+
geom_interpolate_tern(aes(value=d,fill=..level..),
binwidth=500,
colour="white") +
geom_point(aes(fill=d),color="black",shape=21,size=3) +
scale_fill_gradient(low="yellow",high="red") +
theme(legend.position=c(0,1),legend.justification=c(0,1)) +
labs(fill="Value, d")
library('Ternary')
TernaryPlot('a',
b', 'c',
grid.lines=5,
grid.lty='dotted',
grid.minor.lines=1,
grid.minor.lty='dotted',
point='West')
#https://stackoverflow.com/questions/27570221/how-to-make-a-ggplot2-contour-plot-analogue-to-latticefilled-contour
#define
data
x<-seq(1,11,1)
y<-seq(1,11,1)
xyz.func<-function(x,y)
{-10.4+6.53*x+6.53*y-0.167*x^2-0.167*y^2+0.0500*x*y}
#contour
plot using lattice graphics and R Color Brewer
library(lattice)
#for filled.contour()
library(RColorBrewer)
#for brewer.pal()
z.lattice<-outer(x,y,xyz.func)
filled.contour(x,y,z.lattice,nlevels=6,col=brewer.pal(6,"YlOrRd"))
#http://rrubyperlundich.blogspot.com/2011/07/r-filledcontour-plot.html
x
<- y <- 1:10 # create two vectors with the integers from 1 to 10
z
<- outer(x,y) # create a matrix as the outer product of the two vectors
filled.contour(z)
filled.contour(x=x,y=y,z,
col=heat.colors(20))
my.seq
<- seq(-pi, pi, length=50) # creating a vector as a sequence from 0 to 2*pi
with 50 entries
my.seq2
<- seq(-0.5*pi, 1.5*pi, length=50) # creating a vector as a sequence from 0
to 2*pi with 50 entries
my.matrix
<- outer(sin(my.seq),cos(my.seq2)) # creating the matrix using sin, cos and
outer
filled.contour(x=my.seq,
y=my.seq2,my.matrix, plot.title=title(main="Products Sin(x)*Cos(y) on
[-Pi,Pi]x[-0.5Pi,1.5Pi]", xlab="x", ylab="y"),
key.title=title(main="products"), col=terrain.colors(20))
#https://stackoverflow.com/questions/15869969/adding-a-color-key-to-contour-plots-in-r
library(fields)
image.plot(volcano)
contour(volcano, add =
TRUE)
#http://www.r-qualitytools.org/IMPROVE.html
#install.packages("qualityTools
")
effectPlot(fdo,
classic = TRUE)
interactionPlot(fdo)
require(qualityTools)
par(mfrow
= c(1,2))
wirePlot(A,
B, yield, data = fdo)
contourPlot(A,
B, yield, data = fdo)
#NEW
GRAPH ON CORRELATION RANK USING R
#https://datascienceplus.com/find-insights-with-ranked-cross-correlations/
#Ranked
Cross-Correlations
#devtools::install_github("laresbernardo/lares")
library(lares)
library(dplyr)
#data("starwars")
#df
<- select(starwars, -starships, -vehicles, -films)
df=c(cIC,cFDC,cCF,cCV,cDR,cITR,cIFR,cFCF,cLFT,cDG,cGHG)
corr_cross(df)
data(dft)
#
Let's get rid of some noisy columns first
dft <- select(dft, -Cabin,
-Ticket)
corr_cross(dft, top = 15)
#
Prediction
of artificial neural network of class nn
library(neuralnet)
# Split data
train_idx <- sample(nrow(iris),
2/3 * nrow(iris))
iris_train <-
iris[train_idx, ]
iris_test
<- iris[-train_idx, ]
# Binary classification
nn <- neuralnet(Species ==
"setosa" ~ Petal.Length + Petal.Width, iris_train, linear.output =
FALSE)
pred <- predict(nn, iris_test)
table(iris_test$Species ==
"setosa", pred[, 1] > 0.5)
# Multiclass classification
nn <- neuralnet((Species ==
"setosa") + (Species == "versicolor") + (Species ==
"virginica") ~
Petal.Length + Petal.Width, iris_train, linear.output = FALSE)
pred <- predict(nn, iris_test)
table(iris_test$Species,
apply(pred, 1, which.max))
#
#https://search.r-project.org/CRAN/refmans/neuralnet/html/predict.nn.html
#NEURALINK
DEEP LEARNING R :
# install package
require("neuralnet")
# creating training data set
TKS=c(20,10,30,20,80,30)
CSS=c(90,20,40,50,50,80)
Placed=c(1,0,0,0,1,1)
# Here, you will combine multiple
columns or features into a single set of data
df=data.frame(TKS,CSS,Placed)
# load library
require(neuralnet)
# fit neural network
nn=neuralnet(Placed~TKS+CSS,data=df, hidden=3,act.fct =
"logistic",
linear.output = FALSE)
# plot neural network
plot(nn)
# creating test set
TKS=c(30,40,85)
CSS=c(85,50,40)
test=data.frame(TKS,CSS)
## Prediction using neural network
Predict=compute(nn,test)
Predict$net.result
# Converting probabilities into
binary classes setting threshold level 0.5
prob <- Predict$net.result
pred <- ifelse(prob>0.5, 1,
0)
pred
#
https://www.datacamp.com/tutorial/neural-network-models-r
#
https://datascienceplus.com/neuralnet-train-and-test-neural-networks-using-r/
#
# RELATIVE IMPACT /
RELATIVE CHANGE
rim=lm(LCOEs~log(sCC,
base=10)+log(sCFOM, base =10)+log(sCVOM, base=10)+log(sDR, base=10))
summary(rim)
Initial_Cost= 0.1247363
Fix_OM= 0.0348737
Variable_OM= 0.0552038
Discount_rate= -0.0002596
plot(0,0,
xlim=c(0,0.12),ylim=c(0,1), xaxt="n",yaxt="n",xlab=NA,
ylab=NA)
grid(lty=1, col="grey");
par(new=TRUE)
barplot(c(Initial_Cost,Fix_OM,Variable_OM,Discount_rate), col=2:5,
horiz=T,
beside=T, plot = T,
legend.text=c("Initial_Cost", "Fix_OM",
"Variable_OM", "Discount_rate"))
#CUMULATIVE CASH FLOW
r=read.table(file("clipboard"), header=T, sep="\t",
dec=",")
str(r); attach(r); names(r)
DRc= ((1+r)/(1+i))-1; DRc
#C=(1477*100000*CRF)+
(58*100000)+(0.025*100000*8760); C
PVC=718094394
PVB=0.11*(E)
CF= PVB-PVC
NPV=CF/((1+DRc)^t)
#https://www.journaldev.com/39620/how-to-create-an-area-plot-in-r-using-ggplot2#:~:text=The%20area%20graphs%20are%20the,points%20using%20the%20ggplot2%20package.
library(ggplot2)
library(hrbrthemes)
#reading data into data frames
data<- data.frame(Y, CCF)
xdata=Y;ydata=CCF
#plots the area chart with theme,
title and labels
ggplot(data, aes(x=xdata,
y=ydata))+
geom_area(fill='#142F86',
alpha=1)+
geom_line(color='skyblue',
size=1)+
geom_point(size=1, color='blue')+
ggtitle("Area plot using
ggplot2 in R")+
labs(x='Value', y='frequency')+
theme_ipsum()
#CONTOUR AND TRIANGULAR PLOT
#https://plotly.com/r/contour-plots/
#df=df$z[df$z>800];df=df$z[df$z<2400]
datac=data.frame(sDR, sCFOM, sCC);
View(datac)
x=x #DR
y=y
#FOM
z=z
#CC
df <- data.frame(x=x,y=y,z=z)
#p <- plot_ly(data = df,
x=~x,y=~y, z=~z, type = "scatter3d", colorscale='Jet');p
#p <- plot_ly( x = x, y =y,
z = z, type = "contour"
);p
library(plotly)
p <- plot_ly(data = df,
x=~x,y=~y, z=~z, type = "histogram2dcontour", colorscale='Jet');p
p <- plot_ly(data =
df, x=~x,y=~y, z=~z, type = "contour", colorscale='Jet');p
fig <- plot_ly( x = x, y = y,
z = z, type = "contour"
); fig
#
EMISSION EMISSION AND ENERGY SAVED
rm(list=ls())
rm(r)
#data=write.table(datac,
"data.txt", sep="\t")
r=read.table(file("clipboard"), header=T, sep="\t",
dec=",")
str(r); attach(r); names(r)
#OTHER DISTRIBUTION FORM OF WEIBULL
data=read.table(file("clipboard"), header=T,
sep="\t", dec=".")
str(data)
data=data.frame(data)
library(ggfan)
plot(ws, type="l")
# add fan
fan(data, start=1,
anchor=ws[time(ws)==2],
type="interval",
probs=seq(5, 95, 5), ln=c(50, 80))
library(ggplot2)
ggplot(fake_df, aes(x=x,y=y))
+geom_fan()
ggplot(data, aes(x=month,y=ws))
+geom_fan()
#use precomputed quantiles -
reducing storage requirements.
intervals = 1:19/20
fake_q <- calc_quantiles(fake_df,
intervals=intervals)
fake_q <- calc_quantiles(data,
intervals=intervals)
#intervals in geom_fan must be the
same as used to compute quantiles.
p<-ggplot(fake_q,
aes(x=x,y=y, quantile=quantile)) +
geom_fan(intervals=intervals)
p
+ theme_bw()
# change the colour scale
p1=ggplot(fake_df, aes(x=x,y=y)) +
geom_fan() + scale_fill_gradient(low="red", high="pink")
p1
+ theme_bw()
library("zoo")
library("tsbugs")
library("fanplot")
plot(NULL,
main="Percentiles", xlim = c(1, 965), ylim = c(-2.5, 1.5))
fan(data = th.mcmc)
# plot
fan0(data = th.mcmc, type =
"interval", ln = c(0.5, 0.8, 0.95),
llab = TRUE, rcex = 0.6)
fan0(data = data$ws, type =
"interval", ln = c(0.5, 0.95),
llab = TRUE, rcex = 0.6)
x=data$month
y=data$ws
# Main Plot
#ylim <- c(min(y)-interval,
max(y)+interval) # account for CI when determining ylim
#plot(x, y, type="b",
pch=20, lwd=2, ylim=ylim, col="blue", xlab="Month",
ylab="Wind Speed (m/s)") # plot x and y
par(new=TRUE)
plot(x, y, type="b",
pch=19, lwd=2, col="blue", xlab="Month", ylab="Wind
Speed (m/s)") # plot x and y
grid(lty=1, col="grey")
# Values for Fake Data
#x <- 1:10 # x values
#y <- (x-1)*0.5 +
rnorm(length(x), mean=0, sd=s.e.) # generate y values
# Area plot
# Values for noise and CI size
s.e. <- 0.25 # standard error of
noise
interval <- s.e.*qnorm(0.975) #
standard error * 97.5% quantile
# Determine the x values that will
go into CI
CI.x.top <- x # x values going
forward
CI.x.bot <- rev(x) # x values
backwards
CI.x <- c(CI.x.top, CI.x.bot) #
polygons are drawn clockwise
# Determine the Y values for CI
CI.y.top <- y+interval # top of
CI
CI.y.bot <- rev(y)-interval #
bottom of CI, but rev Y!
CI.y <- c(CI.y.top,CI.y.bot) #
forward, then backward
# Add a polygon for the CI
CI.col <-
adjustcolor("blue",alpha.f=0.25) # Pick a pretty CI color
polygon(CI.x, CI.y, col=CI.col,
border=NA) # draw the polygon
CI.col <-
adjustcolor("red",alpha.f=0.01) # Pick a pretty CI color
polygon(CI.x, CI.y, col=CI.col,
border=NA) # draw the polygon
# Add legend to explain what the
arrows are
legend("topleft",
legend="", xjust=0.5, bty="n")
#legend("topleft",
legend="Arrows indicate path\nfor drawing polygon", xjust=0.5,
bty="n")
dev.off()
# Point out path of polygon
arrows(CI.x.top[1],
CI.y.top[1]+0.1, CI.x.top[3], CI.y.top[3]+0.1)
arrows(CI.x.top[5],
CI.y.top[5]+0.1, CI.x.top[7], CI.y.top[7]+0.1)
arrows(CI.x.bot[1],
CI.y.bot[1]-0.1, CI.x.bot[3], CI.y.bot[3]-0.1)
arrows(CI.x.bot[6],
CI.y.bot[6]-0.1, CI.x.bot[8], CI.y.bot[8]-0.1)
ggplot(data = data, aes(x = month,
y =ws)) +
geom_line(aes(size = ws), color =
"#FC4E07")
x <- rrayleigh(1e5, 13)
hist(x, 100, freq = FALSE)
curve(drayleigh(x, 13), 0, 60, col
= "red", add = TRUE)
hist(prayleigh(x, 13))
plot(ecdf(x))
curve(prayleigh(x, 13), 0, 60, col
= "red", lwd = 2, add = TRUE)
#Uniform Distribution
runif(n=10, min=0, max=1)
#Normal Distribution
rnorm(n=10, mean=0, sd=1)
#Binomial Distribution
rbinom(n=10, size=5, prob=0.2)
#The log-normal Distribution
rlnorm(n=10, meanlog=0, sdlog=1)
#Weibull Distribution
hist(rweibull(emp, shape=kmm, scale
= cmm))
#Exponential Distribution
rexp(n=10, rate = 1)
#Poisson Distribution
rpois(n=10, lambda=1)
#Gamma
Distribution
rgamma(n=10, shape=1, rate = 1)
#Chisquare
Distribution
rchisq(n=10, df=3, ncp=1)
#where
df is degrees of freedom, and ncp is non-centrality parameter
require("DEEVD")
y<-rweibull(V_60,1)
h<-0.79 * IQR(y) * length(y) ^
(-1/5)
mseweibull(y,200,h,"Weibull")
Fn <- ecdf(weibullmm)
plot(Fn, verticals = TRUE,
col.points = "blue",col.hor = "red", col.vert =
"bisque")
plot(Fn, verticals = TRUE,
do.points = FALSE)
require(Hmisc)
Ecdf(weibullmm, xlab="")
scat1d(weibullmm) # add rug plot
histSpike(weibullmm, add=TRUE,
frac=.15) # add spike histogram
Ecdf(weibullmm,
datadensity='density') # add rug plot
ed= Ecdf(weibullmm)
d=data.frame(ed$x)
library(edfun)
set.seed(123);x <- rnorm(1000)
x_dist <- edfun(weibullmm)
f <- x_dist$dfun
curve(f, -2,2)
set.seed(123)
x <- rnorm(1000)
x_dist <- edfun(x)
f <- x_dist$dfun
curve(f, -2,2)
f <- x_dist$pfun
curve(f, -2,2)
require(EnvStats)
x <- qemp(p = seq(0, 1, len =
92065, obs = weibullmm) )
y <- demp(x, weibullmm)
require(mltools)
dt <- data.frame(x=c(0.3, 1.3,
1.4, 3.6), y=c(1.2, 1.2, 3.8, 3.9)); dt
empirical_cdf(dt$x, ubounds=seq(1,
4, by=1.0))
#empirical_cdf(dt,
ubounds=list(x=seq(1, 4, by=1.0)))
#empirical_cdf(dt,
ubounds=list(x=seq(1, 4, by=1.0), y=seq(1, 4, by=1.0)))
"Have fun!
If you find any errors or codes that do not work,
please feel free to write to me at abdi-basid@outlook.com."
Abdi-Basid ADAN
