t.mon <-month(t)
t.god <-as.character(t.god)
t.mon <-as.character(t.mon)
t.f=as.factor(t.god)
t.fmon=as.factor(t.mon)
xx=data.frame(t,t.f,y=x2) # ФРЕЙМ С ДАННЫМИ ВР
xxx <-xx[,-2]
g3 <-ggplot(data= xx, aes(x=t,y=y,colour = t.f),colors = "Accent")+ geom_line(size=0.6)
g3 <-g3 + geom_smooth(colour="red",linetype=2,size=0.8, method="loess",span=0.25)
g3 <-g3 +scale_x_date(breaks = date_breaks("1 years"),labels = date_format("%Y"))
g3 <-g3 +labs(title ="Цена акций Газпрома",
x="Год", y="руб",colour = "Года")
#g3 <-g3 + theme_fivethirtyeight() +  scale_color_fivethirtyeight()
g3 <-g3 + theme_stata() + scale_colour_stata()
print(g3)
knitr::opts_chunk$set(echo = TRUE)
#======== дискретная  логистическая модель =================
library(deSolve) # решение дифф. уравнений с начальными условиями
library(ggplot2)
p_t0 <<-1
p_dt <<-1
p_tn <<-100
p_r <<-2.8
K <<-400
p_y0 <<-10
t<- seq (p_t0 ,p_tn ,p_dt)
#print(t)
n=as.integer(p_tn/p_dt)
x=numeric(n)
x[1]=p_y0
r=p_r
for(i in 1:n){
x[i+1]=x[i]*exp(r*(1-x[i]/K))
}
data_x =data.frame(t=t,x=x[1:n])
g40 <-ggplot(data=data_x, aes(x=t,y=x))
g40 <-g40 + geom_line(data=data_x,aes(x=t,y=x),
colour="red",linetype=1,size=0.8)
g40 <-g40 +labs(x = "t",y="Y",title = "ДИСКРЕТНАЯ ЛОГИСТИЧЕСКАЯ МОДЕЛЬ")
#g40 <-g40 + theme_stata() + scale_colour_stata()
#x11()
print(g40)
library(openxlsx)
library(lubridate)
library(ggthemes)
#library(timeSeries,timeDate)
library(scales)
library(plotly)
library(quantmod)
library(dplyr)
library(RColorBrewer)
require(tibble)
require(tsibble)
#ЗАГРУЗКА ИЗ EXSEL ПЕВИЧНОГО ВРЕМЕННОГО РЯДА
N=2 # номер листа с данными
#ЗАЗРУЗКА ВРЕМЕННЫХ РЯДОВ GAZP С ЛИСТА n  EXCEL =============================
x <-read.xlsx("D:/Proekt_Akz/Sys_prognoz/AkzGASP.xlsx", sheet = N)
#x
m=length(x$DATE)
date_0 = "200601"#Начальная дата исследования ВР
dat0=as.character(x$DATE)
dat0=substr(dat0,1,6)
ind_dat0 = which(dat0==date_0)# Год и месяц начала исследования ВР
tn=ind_dat0[1]#НАЧАЛЬНАЯ ТОЧКА ИССЛЕДОВАНИЯ ВРЕМЕННОГО РЯДА
God = substr(date_0,1,4)
Mes = substr(date_0,5,6)
Mes =as.integer(Mes)
#print(God)
God_n <<-God
#формирование исходной таблицы данных
x0=x[tn:m,1]
x1=x[tn:m,2]
#x1
x11=as.character(x1)
x2=x[tn:m,3]
t <-as.Date(x11,"%Y%m%d")
#t
t.god <-year(t)
t.mon <-month(t)
t.god <-as.character(t.god)
t.mon <-as.character(t.mon)
t.f=as.factor(t.god)
t.fmon=as.factor(t.mon)
xx=data.frame(t,t.f,y=x2) # ФРЕЙМ С ДАННЫМИ ВР
xxx <-xx[,-2]
g3 <-ggplot(data= xx, aes(x=t,y=y,colour = t.f),colors = "Accent")+ geom_line(size=0.6)
g3 <-g3 + geom_smooth(colour="red",linetype=2,size=0.8, method="loess",span=0.25)
g3 <-g3 +scale_x_date(breaks = date_breaks("1 years"),labels = date_format("%Y"))
g3 <-g3 +labs(title ="Цена акций Газпрома",
x="Год", y="руб",colour = "Года")
#g3 <-g3 + theme_fivethirtyeight() +  scale_color_fivethirtyeight()
g3 <-g3 + theme_stata() + scale_colour_stata()
print(g3)
knitr::opts_chunk$set(echo = TRUE)
#======== дискретная  логистическая модель =================
library(deSolve) # решение дифф. уравнений с начальными условиями
library(ggplot2)
p_t0 <<-1
p_dt <<-1
p_tn <<-100
p_r <<-2.8
K <<-400
p_y0 <<-10
t<- seq (p_t0 ,p_tn ,p_dt)
#print(t)
n=as.integer(p_tn/p_dt)
x=numeric(n)
x[1]=p_y0
r=p_r
for(i in 1:n){
x[i+1]=x[i]*exp(r*(1-x[i]/K))
}
data_x =data.frame(t=t,x=x[1:n])
g40 <-ggplot(data=data_x, aes(x=t,y=x))
g40 <-g40 + geom_line(data=data_x,aes(x=t,y=x),
colour="red",linetype=1,size=0.8)
g40 <-g40 +labs(x = "t",y="Y",title = "ДИСКРЕТНАЯ ЛОГИСТИЧЕСКАЯ МОДЕЛЬ")
#g40 <-g40 + theme_stata() + scale_colour_stata()
#x11()
print(g40)
library(openxlsx)
library(lubridate)
library(ggthemes)
#library(timeSeries,timeDate)
library(scales)
library(plotly)
library(quantmod)
library(dplyr)
library(RColorBrewer)
require(tibble)
require(tsibble)
#ЗАГРУЗКА ИЗ EXSEL ПЕВИЧНОГО ВРЕМЕННОГО РЯДА
N=2 # номер листа с данными
#ЗАЗРУЗКА ВРЕМЕННЫХ РЯДОВ GAZP С ЛИСТА n  EXCEL =============================
x <-read.xlsx("D:/Proekt_Akz/Sys_prognoz/AkzGASP.xlsx", sheet = N)
#x
m=length(x$DATE)
date_0 = "200601"#Начальная дата исследования ВР
dat0=as.character(x$DATE)
dat0=substr(dat0,1,6)
ind_dat0 = which(dat0==date_0)# Год и месяц начала исследования ВР
tn=ind_dat0[1]#НАЧАЛЬНАЯ ТОЧКА ИССЛЕДОВАНИЯ ВРЕМЕННОГО РЯДА
God = substr(date_0,1,4)
Mes = substr(date_0,5,6)
Mes =as.integer(Mes)
#print(God)
God_n <<-God
#формирование исходной таблицы данных
x0=x[tn:m,1]
x1=x[tn:m,2]
#x1
x11=as.character(x1)
x2=x[tn:m,3]
t <-as.Date(x11,"%Y%m%d")
#t
t.god <-year(t)
t.mon <-month(t)
t.god <-as.character(t.god)
t.mon <-as.character(t.mon)
t.f=as.factor(t.god)
t.fmon=as.factor(t.mon)
xx=data.frame(t,t.f,y=x2) # ФРЕЙМ С ДАННЫМИ ВР
xxx <-xx[,-2]
g3 <-ggplot(data= xx, aes(x=t,y=y,colour = t.f),colors = "Accent")+ geom_line(size=0.6)
g3 <-g3 + geom_smooth(colour="red",linetype=2,size=0.8, method="loess",span=0.25)
g3 <-g3 +scale_x_date(breaks = date_breaks("1 years"),labels = date_format("%Y"))
g3 <-g3 +labs(title ="Цена акций Газпрома",
x="Год", y="руб",colour = "Года")
#g3 <-g3 + theme_fivethirtyeight() +  scale_color_fivethirtyeight()
g3 <-g3 + theme_stata() + scale_colour_stata()
print(g3)
knitr::opts_chunk$set(echo = TRUE)
#======== дискретная  логистическая модель =================
library(deSolve) # решение дифф. уравнений с начальными условиями
library(ggplot2)
p_t0 <<-1
p_dt <<-1
p_tn <<-100
p_r <<-2.8
K <<-400
p_y0 <<-10
t<- seq (p_t0 ,p_tn ,p_dt)
#print(t)
n=as.integer(p_tn/p_dt)
x=numeric(n)
x[1]=p_y0
r=p_r
for(i in 1:n){
x[i+1]=x[i]*exp(r*(1-x[i]/K))
}
data_x =data.frame(t=t,x=x[1:n])
g40 <-ggplot(data=data_x, aes(x=t,y=x))
g40 <-g40 + geom_line(data=data_x,aes(x=t,y=x),
colour="red",linetype=1,size=0.8)
g40 <-g40 +labs(x = "t",y="Y",title = "ДИСКРЕТНАЯ ЛОГИСТИЧЕСКАЯ МОДЕЛЬ")
#g40 <-g40 + theme_stata() + scale_colour_stata()
#x11()
print(g40)
knitr::opts_chunk$set(echo = TRUE)
#======== дискретная  логистическая модель =================
library(deSolve) # решение дифф. уравнений с начальными условиями
library(ggplot2)
p_t0 <<-1
p_dt <<-1
p_tn <<-100
p_r <<-2.8
K <<-400
p_y0 <<-10
t<- seq (p_t0 ,p_tn ,p_dt)
#print(t)
n=as.integer(p_tn/p_dt)
x=numeric(n)
x[1]=p_y0
r=p_r
for(i in 1:n){
x[i+1]=x[i]*exp(r*(1-x[i]/K))
}
data_x =data.frame(t=t,x=x[1:n])
g40 <-ggplot(data=data_x, aes(x=t,y=x))
g40 <-g40 + geom_line(data=data_x,aes(x=t,y=x),
colour="red",linetype=1,size=0.8)
g40 <-g40 +labs(x = "t",y="Y",title = "ДИСКРЕТНАЯ ЛОГИСТИЧЕСКАЯ МОДЕЛЬ")
#g40 <-g40 + theme_stata() + scale_colour_stata()
#x11()
print(g40)
knitr::opts_chunk$set(echo = TRUE)
#======== дискретная  логистическая модель =================
library(deSolve) # решение дифф. уравнений с начальными условиями
library(ggplot2)
p_t0 <<-1
p_dt <<-1
p_tn <<-100
p_r <<-2.8
K <<-400
p_y0 <<-10
t<- seq (p_t0 ,p_tn ,p_dt)
#print(t)
n=as.integer(p_tn/p_dt)
x=numeric(n)
x[1]=p_y0
r=p_r
for(i in 1:n){
x[i+1]=x[i]*exp(r*(1-x[i]/K))
}
data_x =data.frame(t=t,x=x[1:n])
g40 <-ggplot(data=data_x, aes(x=t,y=x))
g40 <-g40 + geom_line(data=data_x,aes(x=t,y=x),
colour="red",linetype=1,size=0.8)
g40 <-g40 +labs(x = "t",y="Y",title = "ДИСКРЕТНАЯ ЛОГИСТИЧЕСКАЯ МОДЕЛЬ")
#g40 <-g40 + theme_stata() + scale_colour_stata()
#x11()
print(g40)
knitr::opts_chunk$set(echo = TRUE)
#======== дискретная  логистическая модель =================
library(deSolve) # решение дифф. уравнений с начальными условиями
library(ggplot2)
p_t0 <<-1
p_dt <<-1
p_tn <<-100
p_r <<-2.8
K <<-400
p_y0 <<-10
t<- seq (p_t0 ,p_tn ,p_dt)
#print(t)
n=as.integer(p_tn/p_dt)
x=numeric(n)
x[1]=p_y0
r=p_r
for(i in 1:n){
x[i+1]=x[i]*exp(r*(1-x[i]/K))
}
data_x =data.frame(t=t,x=x[1:n])
g40 <-ggplot(data=data_x, aes(x=t,y=x))
g40 <-g40 + geom_line(data=data_x,aes(x=t,y=x),
colour="red",linetype=1,size=0.8)
g40 <-g40 +labs(x = "t",y="Y",title = "ДИСКРЕТНАЯ ЛОГИСТИЧЕСКАЯ МОДЕЛЬ")
#g40 <-g40 + theme_stata() + scale_colour_stata()
#x11()
print(g40)
library(openxlsx)
library(lubridate)
library(ggthemes)
#library(timeSeries,timeDate)
library(scales)
library(plotly)
library(quantmod)
library(dplyr)
library(RColorBrewer)
require(tibble)
require(tsibble)
#ЗАГРУЗКА ИЗ EXSEL ПЕВИЧНОГО ВРЕМЕННОГО РЯДА
N=2 # номер листа с данными
#ЗАЗРУЗКА ВРЕМЕННЫХ РЯДОВ GAZP С ЛИСТА n  EXCEL =============================
x <-read.xlsx("D:/Proekt_Akz/Sys_prognoz/AkzGASP.xlsx", sheet = N)
#x
m=length(x$DATE)
date_0 = "200601"#Начальная дата исследования ВР
dat0=as.character(x$DATE)
dat0=substr(dat0,1,6)
ind_dat0 = which(dat0==date_0)# Год и месяц начала исследования ВР
tn=ind_dat0[1]#НАЧАЛЬНАЯ ТОЧКА ИССЛЕДОВАНИЯ ВРЕМЕННОГО РЯДА
God = substr(date_0,1,4)
Mes = substr(date_0,5,6)
Mes =as.integer(Mes)
#print(God)
God_n <<-God
#формирование исходной таблицы данных
x0=x[tn:m,1]
x1=x[tn:m,2]
#x1
x11=as.character(x1)
x2=x[tn:m,3]
t <-as.Date(x11,"%Y%m%d")
#t
t.god <-year(t)
t.mon <-month(t)
t.god <-as.character(t.god)
t.mon <-as.character(t.mon)
t.f=as.factor(t.god)
t.fmon=as.factor(t.mon)
xx=data.frame(t,t.f,y=x2) # ФРЕЙМ С ДАННЫМИ ВР
xxx <-xx[,-2]
g3 <-ggplot(data= xx, aes(x=t,y=y,colour = t.f),colors = "Accent")+ geom_line(size=0.6)
g3 <-g3 + geom_smooth(colour="red",linetype=2,size=0.8, method="loess",span=0.25)
g3 <-g3 +scale_x_date(breaks = date_breaks("1 years"),labels = date_format("%Y"))
g3 <-g3 +labs(title ="Цена акций Газпрома",
x="Год", y="руб",colour = "Года")
#g3 <-g3 + theme_fivethirtyeight() +  scale_color_fivethirtyeight()
g3 <-g3 + theme_stata() + scale_colour_stata()
print(g3)
knitr::opts_chunk$set(echo = TRUE)
inputPanel(
selectInput("n_breaks", label = "Number of bins:",
choices = c(10, 20, 35, 50), selected = 20),
sliderInput("bw_adjust", label = "Bandwidth adjustment:",
min = 0.2, max = 2, value = 1, step = 0.2)
)
knitr::opts_chunk$set(echo = TRUE)
library(shiny)
runApp("D:/Proekts_Model/sh_04")
knitr::opts_chunk$set(echo = TRUE)
library(shiny)
runApp("D:/Proekts_Model/sh_04")
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>"
)
knitr::opts_chunk$set(echo = TRUE)
inputPanel(
selectInput("n_breaks", label = "Number of bins:",
choices = c(10, 20, 35, 50), selected = 20),
sliderInput("bw_adjust", label = "Bandwidth adjustment:",
min = 0.2, max = 2, value = 1, step = 0.2)
)
shiny::runApp('D:/Proekts_Model/sh_05')
knitr::opts_chunk$set(echo = TRUE)
library(shiny)
source("cap_N0.R")
knitr::opts_chunk$set(echo = TRUE)
library(shiny)
source("D:/Proekts_Model/sh_05/cap_N0.R")
ui <- fluidPage(
titlePanel("Model Natural capital APK RU"),
fluidRow(
column(2,offset = 1,
h3("Param model"),
textOutput("min_max"),
textOutput("inputId"),
sliderInput("tn",
label = "Research interval Ncap years: tn",
min = 10,max = 50, value = c(43)),
sliderInput("a_pr",
label = "Limiting value of the coefficient of land productivity limit: a_pr",
min = 0.2,max =0.5 , value = c(0.5)),
sliderInput("m",
label = "Parameter that sets the law of change in the productivity coefficient: m",
min = 0.5,max = 1.5, value = c(1.45))
),
column(2,
br(),
br(),
br(),
br(),
br(),
br(),
sliderInput("kdem",
label = "Coefficient of natural strength recovery of productivity: kdem",
min = 0.2,max = 0.5, value = c(0.25)),
sliderInput("inv.0",
label = "The initial value of investment in 1 hectare thousand rubles: inv.0",
min = 10,max = 100, value = c(20)),
sliderInput("inv.n",
label = "The upper limit of investment in 1 ha thousand rubles: inv.n",
min = 50,max = 500, value = c(200))
),
column(2,
br(),
br(),
br(),
br(),
br(),
br(),
numericInput(inputId = "b.0",
label = "Initial value of the coefficient of increase in
blowing capacity due to investments: b.0",value = 1.0),
numericInput(inputId = "b.n",
label = "The upper limit of the rate of increase in purity
due to investment:  b.n",value = 1.08),
numericInput(inputId = "gamma.0",
label = "The initial value of the level of
innovativeness of investments: gamma.0",value = 0.4),
numericInput(inputId = "gamma.n",
label = "The upper limit of the level of
innovativeness of investments: gamma.n ",value = 1.0),
numericInput(inputId = "N0",
label = "The area of farmland in the Russian
Federation at t = 0 million hectares: N0 ",value = 221)
),
column(4,
h3("Plots "),
plotOutput("g102"),
#h3("Plot 2"),
plotOutput("g104")
)
)
)
# Define server logic ----
server <- function(input, output){
output$min_max <- renderText({
paste('tn=',input$tn[1],' a_pr=',input$a_pr[1],' m=', input$m[1],
' kdem=',input$kdem[1],' inv.0=',input$inv.0[1],' inv.n=',input$inv.n[1])
})
output$inputId <- renderText({
paste('b.0=',input$b.0,'b.n=',input$b.n,
'gamma.0=',input$gamma.0,'gamma.n=',input$gamma.n,' N0=',input$N0)
})
output$g102 <-renderPlot(
{
tn <<-input$tn[1]
a_pr <<-input$a_pr[1]
m <<-input$m[1]
kdem <<-input$kdem[1]
inv.0 <<-input$inv.0[1]
inv.n <<-input$inv.n[1]
b.0 <<-input$b.0
b.n <<-input$b.n
gamma.0 <<-input$gamma.0
gamma.n <<-input$gamma.n
N0 <<-input$N0
p_t0 <<-0
p_dt <<-1.0
t0=seq(p_t0,tn,p_dt)
y0=N0
out1 <- ode (y=y0,t=t0,func =f_N1,parms = NULL )
out2 <- ode (y=y0,t=t0,func =f_N2,parms = NULL )
plot(out1[,1],out1[,2],xlab = "t", ylab = "N1,N2",bg="skyblue",fg="skyblue",
type = "l", pch = 19,lwd=3,font = 2,font.axis=2,col = "red",
main = "N development scenarios in the absence of investment")
abline(h=22,lwd=4,lty="dotted",col="red")
par(new=TRUE)
plot(out2[,1],out2[,2],axes=F,xlab = "t", ylab = "N1,N2",type = "l", pch = 19,
lwd=3,font = 1,font.axis=2,col = "green")
grid(nx=as.integer(tn/5),ny=as.integer(N0/50),lty = "dotted",lwd = 0.8,col = "skyblue")
#abline(h = N0*0.1,col="red",lwd=4,lty="dotted")
legend(0.8*tn,0.9*N0,inset=.05,title="Scenarios",c("Scenario N1","Scenario N2"),
fill=c("red","green"),bg = "grey99",horiz=F,cex=0.85)
}
)
output$g104 <-renderPlot(
{
tn <<-input$tn[1]
a_pr <<-input$a_pr[1]
m <<-input$m[1]
kdem <<-input$kdem[1]
inv.0 <<-input$inv.0[1]
inv.n <<-input$inv.n[1]
b.0 <<-input$b.0
b.n <<-input$b.n
gamma.0 <<-input$gamma.0
gamma.n <<-input$gamma.n
N0 <<-input$N0
p_t0 <<-0
p_dt <<-1.0
t0=seq(p_t0,tn,p_dt)
y0=N0
out4 <- ode (y=y0,t=t0,func =f_NV1,parms = NULL )
out5 <- ode (y=y0,t=t0,func =f_NV2,parms = NULL )
plot(out4[,1],out4[,2],xlab = "t", ylab = "N1,N2",bg="skyblue",fg="skyblue",
type = "l", pch = 19,lwd=3,font = 2,font.axis=2,col = "red",
main = "Development scenarios for N with investments")
abline(h=22,lwd=4,lty="dotted",col="red")
par(new=TRUE)
plot(out5[,1],out5[,2],axes=F,xlab = "t", ylab = "N1,N2",type = "l", pch = 19,
lwd=3,font = 1,font.axis=2,col = "green")
grid(nx=as.integer(tn/5),ny=as.integer(N0/50),lty = "dotted",lwd = 0.8,col = "skyblue")
#abline(h = N0*0.1,col="red",lwd=4,lty="dotted")
legend(0.8*tn,0.9*N0,inset=.05,title="Scenarios",c("Scenario N1","Scenario N2"),
fill=c("red","green"),bg = "grey99",horiz=F,cex=0.85)
}
)
}
shinyApp(ui = ui, server = server)
library(rsconnect)
deployApp()
shiny::runApp('D:/Proekts_Model/sh_05')
shiny::runApp('D:/Proekts_Model/sh_05')
#=====Модель трансформации природного капитала АПК случай 2 ===============
library(deSolve) # решение дифф. уравнений с начальными условиями
shiny::runApp('D:/Proekts_Model/sh_06')
runApp('D:/Proekts_Model/sh_06')
shiny::runApp('D:/Proekts_Model/sh_06')
shiny::runApp('D:/Proekts_Model/sh_07')
