[Returnanalytics-commits] r3436 - in pkg/PerformanceAnalytics/sandbox: . PAshiny PAshiny/www PAshiny/www/stylesheets
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Jun 22 22:49:22 CEST 2014
Author: kecoli
Date: 2014-06-22 22:49:22 +0200 (Sun, 22 Jun 2014)
New Revision: 3436
Added:
pkg/PerformanceAnalytics/sandbox/PAshiny/
pkg/PerformanceAnalytics/sandbox/PAshiny/chooser-binding.js
pkg/PerformanceAnalytics/sandbox/PAshiny/chooser.R
pkg/PerformanceAnalytics/sandbox/PAshiny/crsp.short.6.Rdata
pkg/PerformanceAnalytics/sandbox/PAshiny/crsp.short.6.csv
pkg/PerformanceAnalytics/sandbox/PAshiny/crsp.short.Rdata
pkg/PerformanceAnalytics/sandbox/PAshiny/run.R
pkg/PerformanceAnalytics/sandbox/PAshiny/server.R
pkg/PerformanceAnalytics/sandbox/PAshiny/server_bk.R
pkg/PerformanceAnalytics/sandbox/PAshiny/table.Performance.R
pkg/PerformanceAnalytics/sandbox/PAshiny/textArea.js
pkg/PerformanceAnalytics/sandbox/PAshiny/ui.R
pkg/PerformanceAnalytics/sandbox/PAshiny/www/
pkg/PerformanceAnalytics/sandbox/PAshiny/www/chooser-binding.js
pkg/PerformanceAnalytics/sandbox/PAshiny/www/index_1.html
pkg/PerformanceAnalytics/sandbox/PAshiny/www/stylesheets/
pkg/PerformanceAnalytics/sandbox/PAshiny/www/stylesheets/jquery-ui.css
pkg/PerformanceAnalytics/sandbox/PAshiny/www/stylesheets/style.css
pkg/PerformanceAnalytics/sandbox/PAshiny/www/textarea.js
Log:
merging Kirk's github work to R-forge
Shiny interface for table.Performance.R in PAenhance
Added: pkg/PerformanceAnalytics/sandbox/PAshiny/chooser-binding.js
===================================================================
--- pkg/PerformanceAnalytics/sandbox/PAshiny/chooser-binding.js (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/PAshiny/chooser-binding.js 2014-06-22 20:49:22 UTC (rev 3436)
@@ -0,0 +1,84 @@
+(function() {
+
+function updateChooser(chooser) {
+ chooser = $(chooser);
+ var left = chooser.find("select.left");
+ var right = chooser.find("select.right");
+ var leftArrow = chooser.find(".left-arrow");
+ var rightArrow = chooser.find(".right-arrow");
+
+ var canMoveTo = (left.val() || []).length > 0;
+ var canMoveFrom = (right.val() || []).length > 0;
+
+ leftArrow.toggleClass("muted", !canMoveFrom);
+ rightArrow.toggleClass("muted", !canMoveTo);
+}
+
+function move(chooser, source, dest) {
+ chooser = $(chooser);
+ var selected = chooser.find(source).children("option:selected");
+ var dest = chooser.find(dest);
+ dest.children("option:selected").each(function(i, e) {e.selected = false;});
+ dest.append(selected);
+ updateChooser(chooser);
+ chooser.trigger("change");
+}
+
+$(document).on("change", ".chooser select", function() {
+ updateChooser($(this).parents(".chooser"));
+});
+
+$(document).on("click", ".chooser .right-arrow", function() {
+ move($(this).parents(".chooser"), ".left", ".right");
+});
+
+$(document).on("click", ".chooser .left-arrow", function() {
+ move($(this).parents(".chooser"), ".right", ".left");
+});
+
+$(document).on("dblclick", ".chooser select.left", function() {
+ move($(this).parents(".chooser"), ".left", ".right");
+});
+
+$(document).on("dblclick", ".chooser select.right", function() {
+ move($(this).parents(".chooser"), ".right", ".left");
+});
+
+var binding = new Shiny.InputBinding();
+
+binding.find = function(scope) {
+ return $(scope).find(".chooser");
+};
+
+binding.initialize = function(el) {
+ updateChooser(el);
+};
+
+binding.getValue = function(el) {
+ return {
+ left: $.makeArray($(el).find("select.left option").map(function(i, e) { return e.value; })),
+ right: $.makeArray($(el).find("select.right option").map(function(i, e) { return e.value; }))
+ }
+};
+
+binding.setValue = function(el, value) {
+ // TODO: implement
+};
+
+binding.subscribe = function(el, callback) {
+ $(el).on("change.chooserBinding", function(e) {
+ callback();
+ });
+};
+
+binding.unsubscribe = function(el) {
+ $(el).off(".chooserBinding");
+};
+
+binding.getType = function() {
+ return "shinyjsexamples.chooser";
+};
+
+Shiny.inputBindings.register(binding, "shinyjsexamples.chooser");
+
+})();
\ No newline at end of file
Added: pkg/PerformanceAnalytics/sandbox/PAshiny/chooser.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/PAshiny/chooser.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/PAshiny/chooser.R 2014-06-22 20:49:22 UTC (rev 3436)
@@ -0,0 +1,59 @@
+# TODO: Add comment
+#
+# Author: KirkLi
+###############################################################################
+
+
+chooserInput <- function(inputId, leftLabel, rightLabel, leftChoices, rightChoices,
+ size = 5, multiple = FALSE) {
+
+ leftChoices <- lapply(leftChoices, tags$option)
+ rightChoices <- lapply(rightChoices, tags$option)
+
+ if (multiple)
+ multiple <- "multiple"
+ else
+ multiple <- NULL
+
+ tagList(
+ singleton(tags$head(
+ tags$script(src="chooser-binding.js"),
+ tags$style(type="text/css",
+ HTML(".chooser-container { display: inline-block; }")
+ )
+ )),
+ div(id=inputId, class="chooser",
+ div(class="chooser-container chooser-left-container",
+ tags$select(class="left", size=size, multiple=multiple, leftChoices)
+ ),
+ div(class="chooser-container chooser-center-container",
+ icon("arrow-circle-o-right", "right-arrow fa-3x"),
+ tags$br(),
+ icon("arrow-circle-o-left", "left-arrow fa-3x")
+ ),
+ div(class="chooser-container chooser-right-container",
+ tags$select(class="right", size=size, multiple=multiple, rightChoices)
+ )
+ )
+ )
+}
+#
+#inputTextarea <- function(inputId, label="",value="", nrows=5, ncols=5) {
+# tagList(
+# singleton(tags$head(tags$script(src = "textArea.js"))),
+# tags$label(label, `for` = inputId),
+# tags$textarea(id = inputId,
+# class = "inputtextarea",
+# rows = nrows,
+# cols = ncols,
+# as.character(value))
+# )
+#}
+
+
+registerInputHandler("shinyjsexamples.chooser", function(data, ...) {
+ if (is.null(data))
+ NULL
+ else
+ list(left=as.character(data$left), right=as.character(data$right))
+ }, force = TRUE)
Property changes on: pkg/PerformanceAnalytics/sandbox/PAshiny/chooser.R
___________________________________________________________________
Added: svn:mime-type
+ text/plain
Added: pkg/PerformanceAnalytics/sandbox/PAshiny/crsp.short.6.Rdata
===================================================================
(Binary files differ)
Property changes on: pkg/PerformanceAnalytics/sandbox/PAshiny/crsp.short.6.Rdata
___________________________________________________________________
Added: svn:mime-type
+ application/octet-stream
Added: pkg/PerformanceAnalytics/sandbox/PAshiny/crsp.short.6.csv
===================================================================
--- pkg/PerformanceAnalytics/sandbox/PAshiny/crsp.short.6.csv (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/PAshiny/crsp.short.6.csv 2014-06-22 20:49:22 UTC (rev 3436)
@@ -0,0 +1,61 @@
+"","MODI","MGF","MAT","EMN","AMAT","AMGN"
+"1997-01-31",0.06542056,-0.02091743,0.01351351,-0.01131222,0.373913,0.03678161
+"1997-02-28",-0.02912281,0.006792453,-0.12,0.009153318,0.02531646,0.08425721
+"1997-03-31",-0.1090909,-0.01222641,-0.02787879,-0.01696145,-0.08395062,-0.08588957
+"1997-04-30",0.09183674,0.02584615,0.1614583,-0.05116279,0.1832884,0.05369128
+"1997-05-30",0.1005607,-0.002943396,0.07174888,0.1666667,0.1890661,0.1358811
+"1997-06-30",0.01709402,0.01592381,0.1362343,0.07462185,0.08524904,-0.1308411
+"1997-07-31",0.05042017,0.03464151,0.02583026,-0.04724409,0.2974404,0.01182796
+"1997-08-29",-0.01392,-0.01218349,-0.03776978,-0.01136364,0.02721088,-0.1572795
+"1997-09-30",0.1387755,0.01562617,-0.007252336,0.04392894,0.009271523,-0.03278688
+"1997-10-31",-0.02329749,-0.003185185,0.1735849,-0.03830645,-0.2992126,0.0273794
+"1997-11-28",0.001908257,0.006130841,0.03054662,0.01257862,-0.01123596,0.03807107
+"1997-12-31",0.005524862,0.005981308,-0.06845554,-0.006169772,-0.08712121,0.05867971
+"1998-01-30",0.02197802,0.02482243,0.08724833,0,0.08921162,-0.07621247
+"1998-02-27",0.009032258,-0.003229358,0.04475309,0.09968521,0.1219048,0.0625
+"1998-03-31",-0.007142857,-0.003481481,-0.06333826,0.03629771,-0.04074703,0.1458824
+"1998-04-30",0.07014389,-0.0315514,-0.03159558,0.01946246,0.02300885,-0.02053388
+"1998-05-29",-0.08006722,0.01576699,-0.01141925,-0.02545455,-0.1141869,0.01467505
+"1998-06-30",0.01838235,0.02523077,0.1192739,-0.06432836,-0.078125,0.08057851
+"1998-07-31",-0.03610108,0.006490566,-0.0915805,-0.08835341,0.1355932,0.123327
+"1998-08-31",-0.1603745,0.0154717,-0.1577236,-0.09140969,-0.266791,-0.1710638
+"1998-09-30",0.04269663,0.01502804,-0.1326641,-0.01328485,0.02798982,0.2412731
+"1998-10-30",0.1293103,0.005481482,0.2857143,0.1648079,0.3737624,0.03970223
+"1998-11-30",0.120916,-0.0222963,-0.03819444,-0.01382979,0.1171171,-0.04216388
+"1998-12-31",-0.006849315,0.005638095,-0.3189892,-0.2200216,0.1016129,0.3895349
+"1999-01-29",-0.2068966,-0.01340952,-0.03457447,-0.09217877,0.4802343,0.2223551
+"1999-02-26",-0.01878261,-0.003961165,0.1625344,0.1615385,-0.1196835,-0.02298288
+"1999-03-31",0.002232143,-0.004,-0.0514692,-0.09928477,0.1089888,0.1991992
+"1999-04-30",0.1135857,0.00570297,0.03759398,0.3239227,-0.1306991,-0.1794658
+"1999-05-28",0.03536,-0.004039604,0.02173913,-0.09090909,0.02564103,0.02950153
+"1999-06-30",0.01361868,0.00592,-0.008416075,0.03091358,0.3431818,-0.03754941
+"1999-07-30",-0.01631478,-0.0036,-0.09569378,-0.001207729,-0.02622673,0.2628337
+"1999-08-31",-0.06403902,-0.01389899,-0.0952381,-0.1015719,-0.01216334,0.08211382
+"1999-09-30",-0.2163866,0.01674227,-0.1069006,-0.1318439,0.09322779,-0.0202855
+"1999-10-29",0.06702413,-0.0242449,-0.2960526,-0.03291536,0.156074,-0.02147239
+"1999-11-30",0.1449246,-0.01431579,0.07009346,0.008103727,0.0848991,0.1426332
+"1999-12-31",-0.1150443,-0.01462366,-0.07668122,0.2380064,0.3001924,0.3182442
+"2000-01-31",-0.01,0.04,-0.2047619,-0.163827,0.08337445,0.0603538
+"2000-02-29",-0.0689899,0.01761702,-0.07784431,-0.09874608,0.332878,0.07065751
+"2000-03-31",0.1013699,0.01743158,0.1002597,0.2783304,0.03040656,-0.09990834
+"2000-04-28",-0.1218905,0.01725,0.172619,0.1497253,0.08023873,-0.08757637
+"2000-05-31",-0.07648725,-0.01352577,0.1015228,-0.1290323,-0.1798649,0.1361607
+"2000-06-30",0.3416149,0.03882105,-0.02101382,0.05766804,0.08532934,0.1041257
+"2000-07-31",0,0.006693878,-0.1611374,-0.01832461,-0.1627586,-0.07562277
+"2000-08-31",0.05092593,0.01689796,-0.1073446,-0.08,0.1375618,0.1674687
+"2000-09-29",0.001666667,-0.003636364,0.1420253,-0.1332754,-0.3128168,-0.07893652
+"2000-10-31",-0.06378259,0.01657143,0.1564246,0.1607445,-0.1043203,-0.1702842
+"2000-11-30",0.0450237,0.006303031,-0.02415459,0.00728863,-0.2388235,0.09816613
+"2000-12-29",-0.2402746,0.05680808,0.1437624,0.138987,-0.05564142,0.004911591
+"2001-01-31",0.2379518,0.01061542,0.02908588,-0.04184617,0.3175123,0.09970675
+"2001-02-28",0.04379562,0.009035219,0.1413189,0.1014772,-0.1602484,0.02488889
+"2001-03-30",-0.03058824,0.007328206,0.04599061,-0.03479105,0.0295858,-0.1647875
+"2001-04-30",0.08271842,-0.01874998,-0.08962797,0.08167412,0.2551724,0.01582553
+"2001-05-31",-0.0781922,0.01499999,0.1021672,-0.05071376,-0.08553111,0.08570491
+"2001-06-29",0.08369348,0.006811108,0.0629214,-0.04887218,-0.01662331,-0.08586919
+"2001-07-31",0.06381436,0.0191654,-0.05391123,-0.07873189,-0.06598774,0.03345416
+"2001-08-31",-0.01431493,0.03262192,0.005027941,-0.1159982,-0.06040123,0.02535487
+"2001-09-28",-0.1426578,-0.01290799,-0.1295164,-0.05284872,-0.3399861,-0.08600315
+"2001-10-31",-0.1558177,0.02311177,0.2088123,-0.05482088,0.1993671,-0.03318021
+"2001-11-30",0.04867471,-0.01750736,-0.02482834,0.1183328,0.1650543,0.1691306
+"2001-12-31",0.0846118,-0.01016698,-0.0657251,0.02840765,0.009058801,-0.1503839
Added: pkg/PerformanceAnalytics/sandbox/PAshiny/crsp.short.Rdata
===================================================================
(Binary files differ)
Property changes on: pkg/PerformanceAnalytics/sandbox/PAshiny/crsp.short.Rdata
___________________________________________________________________
Added: svn:mime-type
+ application/octet-stream
Added: pkg/PerformanceAnalytics/sandbox/PAshiny/run.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/PAshiny/run.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/PAshiny/run.R 2014-06-22 20:49:22 UTC (rev 3436)
@@ -0,0 +1,60 @@
+# TODO: Add comment
+#
+# Author: kirkli
+###############################################################################
+
+
+rm(list=ls())
+# install.packages('devtools')
+# install.packages("shiny")
+# devtools::install_github('shiny-incubator', 'rstudio')
+# install.packages("Rglpk")
+# setwd("C:/Dropbox/doug/MVO")
+if(!"devtools" %in% rownames(installed.packages())) {install.packages('devtools')}
+# In linux, if error occurs, check R-Curl.
+if(!"shiny" %in% rownames(installed.packages())) {install.packages('shiny')}
+if(!"shinyIncubator" %in% rownames(installed.packages())) {devtools::install_github("shiny-incubator", "rstudio")}
+if(!"Rglpk" %in% rownames(installed.packages())) {install.packages('Rglpk')}
+if(!"xts" %in% rownames(installed.packages())) {install.packages('xts')}
+if(!"corpcor" %in% rownames(installed.packages())) {install.packages('corpcor')}
+if(!"quadprog" %in% rownames(installed.packages())) {install.packages('quadprog')}
+
+library(shinyIncubator)
+library(shiny)
+library(quadprog)
+library(Rglpk)
+library(xts)
+
+# ##
+# load("crsp.short.Rdata")
+#
+# allcap.ts <- merge(merge(smallcap.ts,midcap.ts),largecap.ts)
+# stock.names.list <- c(names(smallcap.ts)[1:2],names(midcap.ts)[1:2],names(largecap.ts)[1:2])
+# files <- list(data=allcap.ts[,stock.names.list],group=rep(c(1,2,3),each=2))
+# save(files,file="crsp.short.6.Rdata")
+#
+# load("crsp.short.6.Rdata")
+# files$data
+# write.csv(as.data.frame(files$data),file="crsp.short.6.csv",row.names=TRUE)
+# write.csv(files$group,file="crsp.short.6.group.csv",row.names=FALSE)
+#test <- read.csv("crsp.short.6.csv")
+#test2 <- read.csv("crsp.short.6.group.csv")
+#
+# head(test)
+# head(test2)
+
+result.folder <<- getwd()
+code.folder <<- getwd()
+setwd(code.folder)
+runApp()
+
+
+
+
+
+
+
+
+
+
+
Property changes on: pkg/PerformanceAnalytics/sandbox/PAshiny/run.R
___________________________________________________________________
Added: svn:mime-type
+ text/plain
Added: pkg/PerformanceAnalytics/sandbox/PAshiny/server.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/PAshiny/server.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/PAshiny/server.R 2014-06-22 20:49:22 UTC (rev 3436)
@@ -0,0 +1,210 @@
+# TODO: Add comment
+#
+# Author: KirkLi
+###############################################################################
+
+
+library(shiny)
+
+source("table.Performance.R")
+source("chooser.R")
+count <- 0
+# Define server logic for random distribution application
+shinyServer(function(input, output) {
+
+
+ inputTextarea <- function(inputId, label="",value="", nrows=10, ncols=10) {
+ tagList(
+ singleton(tags$head(tags$script(src = "textarea.js"))),
+ tags$label(label, `for` = inputId),
+ tags$textarea(id = inputId,
+ class = "inputtextarea",
+ rows = nrows,
+ cols = ncols,
+ as.character(value))
+ )
+ }
+
+ output$text <- renderPrint({
+# if(input$goButton1==0) {
+ if(is.null(input$file1) & input$dataset)
+ cat("Please load data.\n")
+# if (input$dataset==F)
+# cat("Example csv file: \n")
+ else{
+ if(!is.null(input$file1))cat("first 10 rows of the return data: \n")}
+# }
+# else{
+
+# }
+ }
+ )
+
+# output$contents <- renderDataTable({
+## if(input$goButton1==0) {
+## test <- read.csv("crsp.short.6.csv")
+## head(test)
+## }
+## else{
+# if(input$dataset==F){
+# mydata <- mydata.raw <- read.csv("crsp.short.6.csv")
+# rownames(mydata) <- mydata[,1]
+# colnames(mydata.raw)[1] <- "date"
+# mydata <- mydata[,-1]
+# mydata <<- mydata
+# date <- mydata.raw[,1]
+# cbind(date,round(mydata,2))
+# }else{
+# if(!is.null(input$file1)){
+# inFile1 <- input$file1
+# mydata <- mydata.raw <- read.csv(
+# inFile1$datapath,
+# header=input$header1,
+# sep=input$sep1,
+# quote=input$quote1)
+# rownames(mydata) <- mydata[,1]
+# colnames(mydata.raw)[1] <- "date"
+# mydata <- mydata[,-1]
+# mydata <<- mydata
+# date <- mydata.raw[,1]
+# cbind(date,round(mydata,2))
+# }
+#
+# }
+## }
+# })
+
+ output$summary <- renderDataTable({
+# if(input$goButton1==0) {
+# test <- read.csv("crsp.short.6.csv")
+# head(test)
+# }
+# else{
+ if(input$dataset==F){
+ mydata <- mydata.raw <- read.csv("crsp.short.6.csv")
+ rownames(mydata) <- mydata[,1]
+ colnames(mydata.raw)[1] <- "date"
+ mydata <- mydata[,-1]
+ mydata <<- mydata
+ date <- mydata.raw[,1]
+ cbind(date,round(mydata,2))
+ }else{
+ if(!is.null(input$file1)){
+ inFile1 <- input$file1
+ mydata <- mydata.raw <- read.csv(
+ inFile1$datapath,
+ header=input$header1,
+ sep=input$sep1,
+ quote=input$quote1)
+ rownames(mydata) <- mydata[,1]
+ colnames(mydata.raw)[1] <- "date"
+ mydata <- mydata[,-1]
+ mydata <<- mydata
+ date <- mydata.raw[,1]
+ cbind(date,round(mydata,2))}
+
+ }
+# }
+ })
+
+ metric.list <- reactive({
+ if(length(input$mychooser$right)>=1)
+ table.Performance.input.shiny(metrics=input$mychooser$right)
+ else return()
+ })
+#
+ nmetric<- reactive({
+ length(metric.list())
+ })
+#
+
+# metric.list <-function()table.Performance.input.shiny(metrics="BernardoLedoitRatio")
+#
+# metric.list()
+#
+
+ output$selection <- renderPrint(
+# nrows <<- length(input$mychooser$right)
+ input$mychooser$right
+ )
+
+#
+ ## metric.list <- function() table.Performance.input.shiny(metrics="ES")
+ ## metric.list()
+
+
+ ct=1:50
+ eval(parse(text=paste0("output$para.",ct," <- renderUI({
+ if(length(input$mychooser$right)>= ",ct," ){
+ count <- ",ct,"
+ inputId = eval(parse(text=paste0('\"para.',count,'\"')))
+ label= eval(parse(text=paste0('paste0(names(metric.list())[',count,'],\":\")')))
+ value= eval(parse(text=paste0('paste0(names(metric.list()[[',count,']]),\"=\",metric.list()[[',count,']],collapse=\"\n\")')))
+ if(nchar(value)>=2 & length(value)>0) # colum sign
+ inputTextarea(inputId,label,value,nrow=5,ncol=10)
+ else return()
+
+ }
+ else return()
+ })")))
+
+
+ eval(parse(text=paste0("metric.list.m.",ct,"<- reactive({if(length(input$mychooser$right)>=",ct,"){if(length(input$para.",ct,")>0){
+ l1 <- unlist(strsplit(input$para.",ct,",'\n'))
+ l1 <- strsplit(l1,'=')
+ temp <- metric.list()[[",ct,"]]
+ temp[unlist(lapply(l1,'[[',1))] <- unlist(lapply(l1,'[[',2))} else return()
+ temp
+ }
+ else{return()}
+ })")))
+
+ ##
+
+ output$result <-renderDataTable({
+ metrics <- input$mychooser$right
+ if(length(input$mychooser$right)>0){
+ metricsOptArgVal <-list()
+ string.use <-
+ paste0("list(",paste0("metric.list.m.",1:50,"()",collapse=","),")")
+ metricsOptArgVal <- eval(parse(text=string.use
+ ))
+
+ names(metricsOptArgVal) <- metrics
+ res <<- table.Performance.output.shiny(R=mydata,metricsOptArgVal= metricsOptArgVal,metrics=metrics,metricsNames=NULL)
+ cbind(metrics,res) } else return()
+ })
+
+
+# output$diag2 <- renderPrint({
+# metrics <- input$mychooser$right
+# string.use <- paste0("list(",paste0("metric.list.m.",1:50,"()",collapse=","),")")
+# metricsOptArgVal <- eval(parse(text=string.use
+# ))
+#
+# names(metricsOptArgVal) <- metrics
+# metricsOptArgVal
+# }
+# )
+
+
+ output$downloadData <- downloadHandler(
+ # This function returns a string which tells the client
+ # browser what name to use when saving the file.
+ filename = function() {
+ paste0("PerformanceMetricTable_",Sys.Date(),".",input$filetype)
+ },
+
+ # This function should write data to a file given to it by
+ # the argument 'file'.
+ content = function(file) {
+ sep <- switch(input$filetype, "csv" = ",", "tsv" = "\t")
+ # Write to a file specified by the 'file' argument
+ write.table(res, file, sep = sep,
+ row.names = TRUE,col.names=NA)
+ })
+
+
+ })
+
+
Property changes on: pkg/PerformanceAnalytics/sandbox/PAshiny/server.R
___________________________________________________________________
Added: svn:mime-type
+ text/plain
Added: pkg/PerformanceAnalytics/sandbox/PAshiny/server_bk.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/PAshiny/server_bk.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/PAshiny/server_bk.R 2014-06-22 20:49:22 UTC (rev 3436)
@@ -0,0 +1,906 @@
+library(shiny)
+
+source("table.Performance.R")
+source("chooser.R")
+count <- 0
+# Define server logic for random distribution application
+shinyServer(function(input, output) {
+
+
+ inputTextarea <- function(inputId, label="",value="", nrows=10, ncols=10) {
+ tagList(
+ singleton(tags$head(tags$script(src = "textarea.js"))),
+ tags$label(label, `for` = inputId),
+ tags$textarea(id = inputId,
+ class = "inputtextarea",
+ rows = nrows,
+ cols = ncols,
+ as.character(value))
+ )
+ }
+
+ output$text <- renderPrint({
+# if(input$goButton1==0) {
+ if(is.null(input$file1))
+ cat("Please load data.\n")
+ if (input$dataset==F)
+ cat("Example csv file: \n")
+ else{
+ if(!is.null(input$file1))cat("first 10 rows of the return data: \n")}
+# }
+# else{
+
+# }
+ }
+ )
+
+ output$contents <- renderTable({
+# if(input$goButton1==0) {
+# test <- read.csv("crsp.short.6.csv")
+# head(test)
+# }
+# else{
+ if(input$dataset==F){
+ mydata1 <<- read.csv("crsp.short.6.csv")
+ rownames(mydata1) <- mydata1[,1]
+ mydata <<- mydata1[,-1]
+ head(mydata)
+ }else{
+ if(!is.null(input$file1)){
+ inFile1 <- input$file1
+ mydata <- read.csv(
+ inFile1$datapath,
+ header=input$header1,
+ sep=input$sep1,
+ quote=input$quote1)
+ rownames(mydata) <- mydata[,1]
+ mydata <<- mydata[,-1]
+ head(mydata)}
+
+ }
+# }
+ })
+
+ output$summary <- renderTable({mydata})
+ metric.list <- reactive({
+ if(length(input$mychooser$right)>=1)
+ table.Performance.input.shiny(metrics=input$mychooser$right)
+ else return()
+ })
+#
+ nmetric<- reactive({
+ length(metric.list())
+ })
+#
+
+# metric.list <-function()table.Performance.input.shiny(metrics="BernardoLedoitRatio")
+#
+# metric.list()
+#
+
+ output$selection <- renderPrint(
+# nrows <<- length(input$mychooser$right)
+ input$mychooser$right
+ )
+
+
+ output$para.1 <- renderUI({
+ if(length(input$mychooser$right)>=1){
+ count <- 1
+ inputId = eval(parse(text=paste0("'para.",count,"'")))
+ label= eval(parse(text=paste0("paste0(names(metric.list())[",count,"],':')")))
+ value= eval(parse(text=paste0("paste0(names(metric.list()[[",count,"]]),':',metric.list()[[",count,"]],collapse='\n')")))
+ if(nchar(value)>=2 & length(value)>0) # colum sign
+ inputTextarea(inputId,label,value,nrow=10,ncol=10)
+ else return()
+
+ }
+ else return()
+ })
+
+
+ output$para.2 <- renderUI({
+ if(length(input$mychooser$right)>=2){
+ count <- 2
+ inputId = eval(parse(text=paste0("'para.",count,"'")))
+ label= eval(parse(text=paste0("paste0(names(metric.list())[",count,"],':')")))
+ value= eval(parse(text=paste0("paste0(names(metric.list()[[",count,"]]),':',metric.list()[[",count,"]],collapse='\n')")))
+ if(nchar(value)>=2 & length(value)>0) # colum sign
+ inputTextarea(inputId,label,value,nrow=10,ncol=10)
+ else return()
+
+ }
+ else return()
+ })
+
+
+ output$para.3 <- renderUI({
+ if(length(input$mychooser$right)>=3){
+ count <- 3
+ inputId = eval(parse(text=paste0("'para.",count,"'")))
+ label= eval(parse(text=paste0("paste0(names(metric.list())[",count,"],':')")))
+ value= eval(parse(text=paste0("paste0(names(metric.list()[[",count,"]]),':',metric.list()[[",count,"]],collapse='\n')")))
+ if(nchar(value)>=2 & length(value)>0) # colum sign
+ inputTextarea(inputId,label,value,nrow=10,ncol=10)
+ else return()
+
+ }
+ else return()
+ })
+
+ output$para.4 <- renderUI({
+ if(length(input$mychooser$right)>=4){
+ count <- 4
+ inputId = eval(parse(text=paste0("'para.",count,"'")))
+ label= eval(parse(text=paste0("paste0(names(metric.list())[",count,"],':')")))
+ value= eval(parse(text=paste0("paste0(names(metric.list()[[",count,"]]),':',metric.list()[[",count,"]],collapse='\n')")))
+ if(nchar(value)>=2 & length(value)>0) # colum sign
+ inputTextarea(inputId,label,value,nrow=10,ncol=10)
+ else return()
+
+ }
+ else return()
+ })
+
+ output$para.5 <- renderUI({
+ if(length(input$mychooser$right)>= 5 ){
+ count <- 5
+ inputId = eval(parse(text=paste0("'para.",count,"'")))
+ label= eval(parse(text=paste0("paste0(names(metric.list())[",count,"],':')")))
+ value= eval(parse(text=paste0("paste0(names(metric.list()[[",count,"]]),':',metric.list()[[",count,"]],collapse='\n')")))
+ if(nchar(value)>=2 & length(value)>0) # colum sign
+ inputTextarea(inputId,label,value,nrow=10,ncol=10)
+ else return()
+
+ }
+ else return()
+ })
+
+
+ output$para.6 <- renderUI({
+ if(length(input$mychooser$right)>= 6 ){
+ count <- 6
+ inputId = eval(parse(text=paste0("'para.",count,"'")))
+ label= eval(parse(text=paste0("paste0(names(metric.list())[",count,"],':')")))
+ value= eval(parse(text=paste0("paste0(names(metric.list()[[",count,"]]),':',metric.list()[[",count,"]],collapse='\n')")))
+ if(nchar(value)>=2 & length(value)>0) # colum sign
+ inputTextarea(inputId,label,value,nrow=10,ncol=10)
+ else return()
+
+ }
+ else return()
+ })
+
+ output$para.7 <- renderUI({
+ if(length(input$mychooser$right)>= 7 ){
+ count <- 7
+ inputId = eval(parse(text=paste0("'para.",count,"'")))
+ label= eval(parse(text=paste0("paste0(names(metric.list())[",count,"],':')")))
+ value= eval(parse(text=paste0("paste0(names(metric.list()[[",count,"]]),':',metric.list()[[",count,"]],collapse='\n')")))
+ if(nchar(value)>=2 & length(value)>0) # colum sign
+ inputTextarea(inputId,label,value,nrow=10,ncol=10)
+ else return()
+
+ }
+ else return()
+ })
+
+ output$para.8 <- renderUI({
+ if(length(input$mychooser$right)>= 8 ){
+ count <- 8
+ inputId = eval(parse(text=paste0("'para.",count,"'")))
+ label= eval(parse(text=paste0("paste0(names(metric.list())[",count,"],':')")))
+ value= eval(parse(text=paste0("paste0(names(metric.list()[[",count,"]]),':',metric.list()[[",count,"]],collapse='\n')")))
+ if(nchar(value)>=2 & length(value)>0) # colum sign
+ inputTextarea(inputId,label,value,nrow=10,ncol=10)
+ else return()
+
+ }
+ else return()
+ })
+
+ output$para.9 <- renderUI({
+ if(length(input$mychooser$right)>= 9 ){
+ count <- 9
+ inputId = eval(parse(text=paste0("'para.",count,"'")))
+ label= eval(parse(text=paste0("paste0(names(metric.list())[",count,"],':')")))
+ value= eval(parse(text=paste0("paste0(names(metric.list()[[",count,"]]),':',metric.list()[[",count,"]],collapse='\n')")))
+ if(nchar(value)>=2 & length(value)>0) # colum sign
+ inputTextarea(inputId,label,value,nrow=10,ncol=10)
+ else return()
+
+ }
+ else return()
+ })
+
+ output$para.10 <- renderUI({
+ if(length(input$mychooser$right)>= 10 ){
+ count <- 10
+ inputId = eval(parse(text=paste0("'para.",count,"'")))
+ label= eval(parse(text=paste0("paste0(names(metric.list())[",count,"],':')")))
+ value= eval(parse(text=paste0("paste0(names(metric.list()[[",count,"]]),':',metric.list()[[",count,"]],collapse='\n')")))
+ if(nchar(value)>=2 & length(value)>0) # colum sign
+ inputTextarea(inputId,label,value,nrow=10,ncol=10)
+ else return()
+
+ }
+ else return()
+ })
+
+ output$para.11 <- renderUI({
+ if(length(input$mychooser$right)>= 11 ){
+ count <- 11
+ inputId = eval(parse(text=paste0("'para.",count,"'")))
+ label= eval(parse(text=paste0("paste0(names(metric.list())[",count,"],':')")))
+ value= eval(parse(text=paste0("paste0(names(metric.list()[[",count,"]]),':',metric.list()[[",count,"]],collapse='\n')")))
+ if(nchar(value)>=2 & length(value)>0) # colum sign
+ inputTextarea(inputId,label,value,nrow=10,ncol=10)
+ else return()
+
+ }
+ else return()
+ })
+
+ output$para.12 <- renderUI({
+ if(length(input$mychooser$right)>= 12 ){
+ count <- 12
+ inputId = eval(parse(text=paste0("'para.",count,"'")))
+ label= eval(parse(text=paste0("paste0(names(metric.list())[",count,"],':')")))
+ value= eval(parse(text=paste0("paste0(names(metric.list()[[",count,"]]),':',metric.list()[[",count,"]],collapse='\n')")))
+ if(nchar(value)>=2 & length(value)>0) # colum sign
+ inputTextarea(inputId,label,value,nrow=10,ncol=10)
+ else return()
+
+ }
+ else return()
+ })
+
+ output$para.13 <- renderUI({
+ if(length(input$mychooser$right)>= 13 ){
+ count <- 13
+ inputId = eval(parse(text=paste0("'para.",count,"'")))
+ label= eval(parse(text=paste0("paste0(names(metric.list())[",count,"],':')")))
+ value= eval(parse(text=paste0("paste0(names(metric.list()[[",count,"]]),':',metric.list()[[",count,"]],collapse='\n')")))
+ if(nchar(value)>=2 & length(value)>0) # colum sign
+ inputTextarea(inputId,label,value,nrow=10,ncol=10)
+ else return()
+
+ }
+ else return()
+ })
+
+ output$para.14 <- renderUI({
+ if(length(input$mychooser$right)>= 14 ){
+ count <- 14
+ inputId = eval(parse(text=paste0("'para.",count,"'")))
+ label= eval(parse(text=paste0("paste0(names(metric.list())[",count,"],':')")))
+ value= eval(parse(text=paste0("paste0(names(metric.list()[[",count,"]]),':',metric.list()[[",count,"]],collapse='\n')")))
+ if(nchar(value)>=2 & length(value)>0) # colum sign
+ inputTextarea(inputId,label,value,nrow=10,ncol=10)
+ else return()
+
+ }
+ else return()
+ })
+
+ output$para.15 <- renderUI({
+ if(length(input$mychooser$right)>= 15 ){
+ count <- 15
+ inputId = eval(parse(text=paste0("'para.",count,"'")))
+ label= eval(parse(text=paste0("paste0(names(metric.list())[",count,"],':')")))
+ value= eval(parse(text=paste0("paste0(names(metric.list()[[",count,"]]),':',metric.list()[[",count,"]],collapse='\n')")))
+ if(nchar(value)>=2 & length(value)>0) # colum sign
+ inputTextarea(inputId,label,value,nrow=10,ncol=10)
+ else return()
+
+ }
+ else return()
+ })
+
+ output$para.16 <- renderUI({
+ if(length(input$mychooser$right)>= 16 ){
+ count <- 16
+ inputId = eval(parse(text=paste0("'para.",count,"'")))
+ label= eval(parse(text=paste0("paste0(names(metric.list())[",count,"],':')")))
+ value= eval(parse(text=paste0("paste0(names(metric.list()[[",count,"]]),':',metric.list()[[",count,"]],collapse='\n')")))
+ if(nchar(value)>=2 & length(value)>0) # colum sign
+ inputTextarea(inputId,label,value,nrow=10,ncol=10)
+ else return()
+
+ }
+ else return()
+ })
+ output$para.17 <- renderUI({
+ if(length(input$mychooser$right)>= 17 ){
+ count <- 17
+ inputId = eval(parse(text=paste0("'para.",count,"'")))
+ label= eval(parse(text=paste0("paste0(names(metric.list())[",count,"],':')")))
+ value= eval(parse(text=paste0("paste0(names(metric.list()[[",count,"]]),':',metric.list()[[",count,"]],collapse='\n')")))
+ if(nchar(value)>=2 & length(value)>0) # colum sign
+ inputTextarea(inputId,label,value,nrow=10,ncol=10)
+ else return()
+
+ }
+ else return()
+ })
+ output$para.18 <- renderUI({
+ if(length(input$mychooser$right)>= 18){
+ count <- 18
+ inputId = eval(parse(text=paste0("'para.",count,"'")))
+ label= eval(parse(text=paste0("paste0(names(metric.list())[",count,"],':')")))
+ value= eval(parse(text=paste0("paste0(names(metric.list()[[",count,"]]),':',metric.list()[[",count,"]],collapse='\n')")))
+ if(nchar(value)>=2 & length(value)>0) # colum sign
+ inputTextarea(inputId,label,value,nrow=10,ncol=10)
+ else return()
+
+ }
+ else return()
+ })
+ output$para.19 <- renderUI({
+ if(length(input$mychooser$right)>= 19 ){
+ count <- 19
+ inputId = eval(parse(text=paste0("'para.",count,"'")))
+ label= eval(parse(text=paste0("paste0(names(metric.list())[",count,"],':')")))
+ value= eval(parse(text=paste0("paste0(names(metric.list()[[",count,"]]),':',metric.list()[[",count,"]],collapse='\n')")))
+ if(nchar(value)>=2 & length(value)>0) # colum sign
+ inputTextarea(inputId,label,value,nrow=10,ncol=10)
+ else return()
+
+ }
+ else return()
+ })
+ output$para.20 <- renderUI({
+ if(length(input$mychooser$right)>= 20 ){
+ count <- 20
+ inputId = eval(parse(text=paste0("'para.",count,"'")))
+ label= eval(parse(text=paste0("paste0(names(metric.list())[",count,"],':')")))
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/returnanalytics -r 3436
More information about the Returnanalytics-commits
mailing list