이론통계학: Optimal Portfolio & 투자전략 세우기

YJ K·2021년 11월 3일

최종 발표

최종 보고서

Rshiny optimal portfolio 코드입니다. 위 링크에 웹어플리케이션 구현 이미지를 첨부하였습니다.

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]})
        
    })
)

}

Run the application

shinyApp(ui = ui, server = server)

profile
Hey this is a simple portfolio of a Statistics Graduate student. Since I'm a beginner of velog my portfolio's not sophisticated yet. But I'll upload and decorate mine soon~ Just enjoy what Data Scientist dreamer's doing:) Thank you!

0개의 댓글