financeの授業のコード

library("quadprog")
### general

# loading file

csv_to_df<-function(file_path){

  matrix<-read.table(file_path, sep=',',row.names=1,header=T)

  return(matrix)

  }
### Problem 1

## making r vector (mean of rmat)

rmat_to_rvec<-function(rmat){

  rvec <- apply(rmat,2,mean)

  return(rvec)

}

## calculating T score

rmat_to_t<-function(rmat){

  result<-apply(rmat,2,

               function(vec){

                  r<-mean(vec)

                  return( mean(

                    sapply(vec,function(x){

                      return((x-r)**2)

                  })))

               })

  result<-sapply(result*(nrow(rmat))/(nrow(rmat)-1),sqrt)

   return(result)

}

# calculating cov

rmat_to_v<-function(rmat){

  # x-E(x)

  tmp<-apply(rmat,2,

        function(vec){

          r<-mean(vec)

          return(sapply(vec,function(x){

                      return(x-r)

                  }))

    

  })

  return(t(tmp)%*%tmp*(1.0/nrow(tmp))*(nrow(rmat))/(nrow(rmat)-1))

}

# calculating correlation

rmat_to_cor<-function(rmat){

  cov<-rmat_to_v(rmat)

  size<-nrow(cov)

  result<-matrix(0,size,size)

  rownames(result)<-rownames(cov)

  colnames(result)<-colnames(cov)

  for(i in 1:size){

    for(j in 1:size)

      result[i,j]=cov[i,j]/(sqrt(cov[i,i])*sqrt(cov[j,j]))

  }

  return(result)

}
problem1<-function(file_path){

  rmat<-csv_to_df(file_path)

  print("return vector")

  print(rmat_to_rvec(rmat))

  print("T")

  print(rmat_to_t(rmat))

  print("covariance")

  print(rmat_to_v(rmat))

  print("correlation")

  print(rmat_to_cor(rmat))

}
### Problem 2

# stop development

cor_nearest_select <-function(rmat,x){

  cov<-cov(rmat)

  cor<-cor(rmat)

  meigaras=colnames(cor)

  min_pair=c(meigaras[1],meigaras[2])

  for(meigara1 in meigaras){

    for(meigara2 in meigaras){

     

    }

      

  }

}
#

plot_2diagram <-function(rmat,meigara1,meigara2){

  cov=cov(rmat)

  rvec=rmat_to_rvec(rmat)

  points=matrix(NA,1000,2)

  i=1

  for(w1 in seq(0,1.0,by=0.01)){

    w2=1.0-w1

    var=cov[meigara1,meigara2]*2*w1*w2+cov[meigara1,meigara1]*w1*w1+cov[meigara2,meigara2]*w2*w2

    points[i,2]<-rvec[meigara1]*w1+rvec[meigara2]*w2

    points[i,1]<-sqrt(var)

    i=i+1

  }

  na.omit(points)

  return(points)

}
### Problem 3

rate_to_cov<-function(matrix){

  dmat <- var(matrix)

  return(dmat)

  }
solver<-function(rmat,dmat){

  

  # 

  rvec <- rmat_to_rvec(rmat)

  MIN <- min(rvec)

  MAX <- max(rvec)

  size <- nrow(dmat)# dmat size

  meigara = list(colnames(dmat))

  

  ## official description

  #min(-d^Tb+1/2b^TD^b)

  # subject to A^Tb>=b_0 (wrriten in Tex style) 

  #Dmat: matrix appering in the quadratic func to be minimized

  #dvec: vector appering in the quadratic func to be minimized

  #Amat: matrix defining the constraints

  #bvec: vector holding the value of b_0

  

  ###arguments

  ## -d^Tb

  dvec <- rep(0,size)

  ## 1/2b^TD^b

  # D(=Dmat) is given as dmat

  

  ## binding A^Tb>=b_0 where

  # e^T weight_vec >= (0,0,..)^T

  # and (1,1...)^T weight_vec >= 1

  # and weight_vec^T rvec = given r

  # Amat = A , b_0 =bvec

  # Amat is (1,1,1..)^T and e combined,bvec is (1,given r,0,0,...)^T

  

  # making e

  tmp <- matrix(0,nrow=size,ncol=size)

  diag(tmp) <- 1

  e = tmp

  # making Amat

  Amat <- cbind(rep(1,size),rvec,e)

  # making bvec

  bvec <- c(1.0, MIN, rep(0,size))

  #init setting

  sol <- solve.QP(dmat,dvec,Amat,bvec=bvec,meq=2)

  sol["return"]=MIN

  sol["meigara"]=meigara

  sol<-list(sol)

  for(iret in seq(MIN,MAX,by=0.001)){

    bvec[2] <- iret

    # store result in sol

    solution <-solve.QP(dmat,dvec,Amat,bvec=bvec,meq=2)

    solution["return"]=iret

    solution["meigara"]=meigara

    sol <- c(sol,list(solution))

    }

  return(sol)

  }
plot_curve<-function(solutions){

  #c=lapply(solution,function(ls){return(c(ls[["return"]],ls[["value"]]))})

  i=0

  curve=0

  for(sol in solutions){

    if(i==1){curve=c(sqrt(sol[["value"]]),sol[["return"]])}

    else {curve=rbind(curve, c(sqrt(sol[["value"]]),sol[["return"]]))}

    i=i+1

  }

  plot(curve)

  curve=as.matrix(curve)

  return(curve)

}
show_min_v<-function(solutions){

  min=list()

  i=1

  for(sol in solutions){

    if(i==1){min=sol}

    else{

      if(sol[["value"]]<min[["value"]]){

        min=sol

      }

    }

    i=i+1

  }

  print("==when minimum variance==")

  print("=return=")

  print(min[["return"]])

  print("=variance=")

  print(min[["value"]])

  print("=meigara=")

  print(min[["meigara"]])

  print("=weight=")

  print(min[["solution"]]*100)

}
# mapping from return_rate_csvfile  to the minimized distribution curve

min_v<-function(file_path){

  rmat.F<-csv_to_df(file_path)

  rmat.M <- as.matrix(rmat.F)

  dmat.M <- rate_to_cov(rmat.M)

  solutions=solver(rmat.M,dmat.M)

  c<-plot_curve(solutions)

  show_min_v(solutions)

  return(c)

}