library(shiny)
if (interactive()) {
# Package call
library(shiny)
library(shinydashboard)
library(tidyverse)
library(shinydashboardPlus)
header <- dashboardHeader(title = "Optimal Portfolio")
# sidebar menu
sidebar <- dashboardSidebar(
sidebarMenu(
id = "tabs",
# Charts
menuItem("Data", icon = icon("th"),
fileInput("file1", label = h4("File input"),
accept = ".csv"),
fileInput("file2", label = NULL,
accept = ".csv"),
fileInput("file3", label = NULL,
accept = ".csv"),
fileInput("file4", label = NULL,
accept = ".csv"),
fileInput("file5", label = NULL,
accept = ".csv")
),
textInput("year","투자 시작 기간", "2013"),
textInput("V0","초기 투자 금액(V0, 단위:천만원)", "1"),
sliderInput("theta0", "정기 예금 비중", 0, 1,value=0.2, step=0.05),
sliderInput("istar", "목표수익률(%)", 1, 100,value=7, step=1),
textInput("M","투자 기간(M, 단위:연)", "5"),
textInput("N","표본 크기(N, 단위:연)", "5"),
actionButton("go", label = "Go!")
)
)
body <- dashboardBody(
fluidRow(
gradientBox(title = div("Value of Optimal Portfolio",style="font-size:130%"),width=7,gradientColor = "purple", footer= plotOutput("plot", height = 270)),
gradientBox(title = div("최적 포트폴리오 판정기준(Criterion)",style="font-size:130%"),width=5, gradientColor = "maroon", footer=div(tableOutput("criterion"),style="font-size:100%"))
),
fluidRow(
gradientBox(title = div("Optimal Portfolio table",style="font-size:130%"), width=7,gradientColor = "purple", footer=div(tableOutput("thetas"),style="font-size:130%")),
gradientBox(title=div("최적 포트폴리오 실제 수익률 검정 (Validation)",style="font-size:130%"),width=5,gradientColor="green",footer=div(tableOutput("validation"),style="font-size:100%"))
)
)
# App Start
shinyApp(
ui = dashboardPage(header, sidebar, body, skin='purple'),
server = shinyServer(function(input, output){
SE <- reactive({
req(input$file1)
read.csv(input$file1$datapath)
})
KA <- reactive({
req(input$file2)
read.csv(input$file2$datapath)
})
KT <- reactive({
req(input$file3)
read.csv(input$file3$datapath)
})
GAS <- reactive({
req(input$file4)
read.csv(input$file4$datapath)
})
NAVER <- reactive({
req(input$file5)
read.csv(input$file5$datapath)
})
i <- read_csv("C:/Users/yjk9/Documents/R/이통2/project5_rshiny/ecosshiny.csv")
investor <- eventReactive(input$go, {
as.numeric(c(input$theta0,input$V0,input$istar,input$year,input$M,input$N))})
portfolio2 <- function(SE, KA, KT, GAS, NAVER,investor){
rtfx <- function(x) {
diff(x)/x[1:(length(x)-1)]
}
pit <- data.frame(p1t=(SE$High+SE$Low)/2,p2t=(KA$High+KA$Low)/2,p3t=(KT$High+KT$Low)/2,
p4t=(GAS$High+GAS$Low)/2,p5t=(NAVER$High+NAVER$Low)/2)
rit <- data.frame(date=i$Date[2:166],r0t=(((1+i$시장금리/100)^(1/12))-1)[2:166],r1t=rtfx(pit$p1t)[1:165],r2t=rtfx(pit$p2t)[1:165],
r3t=rtfx(pit$p3t)[1:165],r4t=rtfx(pit$p4t)[1:165],r5t=rtfx(pit$p5t)[1:165])
V0 <- investor[2]
m <- 12*investor[5]
n <- 12*investor[6]
i12star <- (1+investor[3]/100)^(1/12)-1
r <- i12star
rttrain <- rit %>% filter(substr(date,1,4)<investor[4],
substr(date,1,4)>=(investor[4]-investor[6]))
rttest <- rit %>% filter(substr(date,1,4)>=investor[4],
substr(date,1,4)<(investor[4]+investor[5]))
theta <- c(investor[1]+0.00001,rep((1-investor[1])/5,4))
Sharpe <- function(theta) {
theta2 <- c(theta,1-sum(theta))
rpt <- as.matrix(rttrain[,-1]) %*% matrix(theta2,ncol=1)
rp.bar <- sum(rpt)/(n)
sp <- sd(rpt[1:n])
Z <- (rp.bar - r) / sp
return(Z)
}
#https://stackoverflow.com/questions/16345271/setting-constraints-in-constroptim
constraints <- matrix(c(1, 0, 0, 0, 0,
-1, 0, 0, 0, 0,
0, 1, 0, 0, 0,
0, -1, 0, 0, 0,
0, 0, 1, 0, 0,
0, 0, -1, 0, 0,
0, 0, 0, 1, 0,
0, 0, 0, -1, 0,
0, 0, 0, 0, 1,
0, 0, 0, 0, -1,
1, 1, 1, 1, 1,
-1, -1, -1, -1, -1), ncol = 5, byrow = T)
optim.result <- constrOptim(theta, Sharpe, NULL,
ui = constraints, ci = c(investor[1],-1,0,-1,0,-1,0,-1,0,-1,0,-1), control = list(fnscale = -1))
sharpe.ratio <- round(optim.result$value,3)
theta <- c(round(optim.result$par,3),round(1-sum(optim.result$par),3))
rpt <- as.matrix(rttrain[,-1]) %*% matrix(theta,nrow=6)
criterion.mean <- mean(rpt)
criterion.sd <- sd(rpt)
annualized.expected.mean <- mean(rpt)*12
annualized.expected.sd <- sqrt(12)*sd(rpt)
rpt.star <- as.matrix(rttest[,-1]) %*% matrix(theta,nrow=6)
annualized.realized.mean <- mean(rpt.star)
annualized.realized.sd <- sqrt(12)*sd(rpt.star)
Vt <- V0 * cumprod(1 + rpt)
Vt.star <- V0 * cumprod(1 + rpt.star)
p <- ggplot(data=data.frame(Vt=c(Vt,Vt.star),t=c(1:length(Vt),1:length(Vt.star)),
label=c(rep("검정데이터",length(Vt)),rep("학습데이터",length(Vt.star)))))+
geom_line(aes(t,Vt,color=label))+
theme_bw()+theme(legend.position=c(0.15,0.87),legend.text = element_text(size=20))+
scale_color_manual(name=NULL,values=c(1,2))
thetaoutput <- data.frame(예금=theta[1],SE=theta[2],KA=theta[3],
KT=theta[4],GAS=theta[5],NAVER=theta[6],row.names="theta")
criterionoutput <- data.frame(월_평균_수익률=round(criterion.mean,4),월_수익률_표준편차=round(criterion.sd,4),
Sharpe_Ratio=round(sharpe.ratio,4),row.names=NULL)
validationoutput <- data.frame(기댓값=round(c(annualized.expected.mean,annualized.expected.sd),4),
실제값= round(c(annualized.realized.mean,annualized.realized.sd),4),
row.names=c("연 평균 수익률","연 표준편차"))
list(criterion=criterionoutput,
validation=validationoutput,
theta=thetaoutput,p=p)
}
result <- eventReactive(input$go, {
portfolio2(SE(),KA(),KT(),GAS(),NAVER(),investor())})
p <- eventReactive(input$go, {result()$p})
thetas <- eventReactive(input$go, {result()$theta})
criterion <- eventReactive(input$go, {result()$criterion})
validation <- eventReactive(input$go, {result()$validation})
output$plot <- renderPlot({ p() })
output$thetas <- renderTable({ thetas() })
output$criterion <- renderTable( {
df <- structure(list(`criterion` = structure(1:3, .Label = c("월 평균 수익률", "월 수익률 표준편차", "Sharpe Ratio"), class = "factor"),
`Value` =criterion()[1,]), class = c("tbl_df", "tbl", "data.frame"), .Names = c("Criterion", "Value") , row.names = c(NA, -3L))
}
, width = '100%'
)
output$validation <- renderTable( {
df1 <- structure(list(`aa` = structure(1:2, .Label = c("연 수익률", "연 표준편차"), class = "factor"),
`기댓값` =validation()[1,],`실제값`=validation()[2,]), class = c("tbl_df", "tbl", "data.frame"),
.Names = c("","기댓값", "실제값") , row.names = c(NA, -2L))
}
, width = '100%'
)
output$monthmean <- renderText({ criterion()[1,1] })
output$monthsd <- renderText({criterion()[1,2]})
output$Sharpe <- renderText({criterion()[1,3]})
output$expectedyearmean <- renderText({validation()[1,1]})
output$expectedyearsd <- renderText({validation()[2,1]})
output$realyearmean <- renderText({validation()[1,2]})
output$realyearsd <- renderText({validation()[2,2]})
})
)
}
shinyApp(ui = ui, server = server)