Nothing
#' @importFrom TTR volatility
#' @import gt
#' @import gtExtras
#' @import data.table
#' @importFrom dygraphs dygraphOutput renderDygraph
#' @import shiny
#' @import shinyFeedback
#' @import FinanceGraphs
source("./R/utilities.R")
tver<-"0.7.81"
# 1.8: News, ability to keep output from one run to the next
# 1.6: Bug checks and check()
# 1.45: APpearance changes: Plumbed list management out of options, but still need to code
# 1.4: Passed Check, add new data
# 1.3: Most of list done; check opts for invalid tickers
av_make_ui <- function() {
order1=order2=aesnm=NULL
curr_assetgroups <- sort(unique(the_av$assetgroups$listnm))
runlist1 <- avsd$deflist[!is.na(order1)]$runcode
runlist2 <- avsd$deflist[!is.na(order2)]$runcode
av_ui<- fluidPage(
shinyFeedback::useShinyFeedback(),
shinyjs::useShinyjs(),
tags$head(
tags$style(type='text/css',avsd$inputcss_side),
tags$style(type='text/css',avsd$inputcss_top),
tags$style(type='text/css',"#msg {font-size:10px; background-color: #ddfcd9; width:330px}"),
tags$style(type='text/css',"#gropts {font-size:10px; background-color: #ddfcd9}"),
lapply(avsd$table_aes[aesnm=="HTML"]$val_str, \(x) tags$style(HTML(x))),
),
fluidRow(
column(1,
actionButton("RUN","RUN",width='100%',class = "btn btn-primary"),
selectizeInput("gropts","TSGraphopts",
c("last","lastlabel","hilightfirst","splitts","hilow"),
selected=s(the_av$gropts),
multiple=TRUE,options(list(maxOptions=5,maxItems=1,avsd$selectizeoptions))),
textInput(inputId="ts_events", label="Events", value = the_av$ts_events),
textInput(inputId="datestring", label="dts", value=the_av$datestring),
textInput(inputId="ts_volparams", label="Histvolparams", value=the_av$ts_volparams),
sliderInput(inputId="dtstartfrac","FocusPct",min=0,max=100,value=0),
radioButtons(inputId="ts_rebase","Rebase",choices=c("none","start","focus"),selected=the_av$ts_rebase),
checkboxInput(inputId="totrtn","TotalRtn",value=TRUE),
checkboxInput(inputId="useLive","useLive",value=FALSE),
checkboxInput(inputId="verbose","Status Msgs",value=the_av$verbose),
checkboxInput(inputId="autocopy","copyTable",value=the_av$autocopy)
),
column(10, # Was 11
fluidRow(
column(width=2,selectInput("anopt1","",runlist1,multiple=FALSE,width='100%')),
column(width=6,textInput("istr1", "", the_av$inpline1,width='100%')),
column(width=2,selectizeInput("list1","",c("List"="", c("",sort(unique(the_av$assetgroups$listnm)))),
size="80%",options=list(create=TRUE))),
column(width=2,radioButtons("managelist1","",choices=c("get","save","delete"),selected =character(0),width="60%",inline=TRUE))
),
fluidRow(
column(width=2,selectInput("anopt2","",runlist2,multiple=FALSE,width='100%')),
column(width=6,textInput("istr2", "", the_av$inpline2,width='100%')),
column(width=2,selectizeInput("list2","",c("List"="", c("",sort(unique(the_av$assetgroups$listnm)))),
size="80%",options=list(create=TRUE))),
column(width=2,radioButtons("managelist2","",choices=c("get","save","delete"),selected =character(0),width="60%",inline=TRUE))
),
fluidRow(
tabsetPanel(id="inTabset",selected=the_av$starttab,
# Main: t1gt | t3l_gt + t3r_gt | t2gt | (dy)view1 | (dy)view2
tabPanel("MAIN", value="main",
gt_output(outputId = "t1gt"),
#splitLayout(gt_output(outputId = "t3l_gt"), gt_output(outputId = "t3r_gt"),cellWidths=c("60%","40%")),
fillPage(div(class = "no-gap-row",
div(class = "table-pane", gt_output("t3l_gt")),
div(class = "table-pane", gt_output("t3r_gt")) )),
gt_output(outputId = "t2gt"),
dygraphOutput("view"),
dygraphOutput("view2")
),
# Detail: det1gt | det2gt | plot1 | plot2
tabPanel("DETAIL", value="detail",
gt_output(outputId = "det1gt"), gt_output(outputId = "det2gt"), imageOutput("plot1"), imageOutput("plot2")),
tabPanel("OPTIONS",value="options",
fluidRow(
column(width=2,span(textInput(inputId="ochains", label="Chains",value=the_av$ochains),style=avsd$labelcss)),
column(width=2,numericInput(inputId="mindelta", label="mindelta", value=5,min=0,max=100)),
column(width=2,selectInput(inputId="otodisplay", label="Output",
c("reduced","trading","all"),selected=the_av$otodisplay,multiple=FALSE)),
column(width=2,selectInput(inputId="oscaling", label="Scaling",
c("None","10contracts","10kMV"),selected=the_av$oscaling,multiple=FALSE))
),
fluidRow(
gt_output(outputId="opt1gt"),
imageOutput(outputId="optplot1")
)
),
tabPanel("NEWS",value="news",
fluidRow(
column(width=2,
numericInput(inputId="nArticles", label="nArticles", value=the_av$nArticles,min=20,max=300),
selectInput(inputId="newssort",label="SortOn",c("time","sentiment","time,symbol","symbol,time"),selected=the_av$newssort,
multiple=FALSE),
selectInput(inputId="newsfilter",label="Filter on:",c("none","tickerOnly","useMinSentiment","maxDays"),
selected="none",multiple=TRUE),
span(textInput(inputId="newsgrep", label="Terms to filter out", value=the_av$newsgrep),style=avsd$labelcss),
numericInput(inputId="minabssent", label="MinSentiment", value=the_av$minabssent,min=0,max=1),
numericInput(inputId="maxagedays", label="Maximum Age (Days)", value=the_av$maxagedays,min=0),
),
column(width=8,
gt_output(outputId = "newsgt")
)
)
),
tabPanel("AVOPTS",value="avopts",
column(width=3,
actionButton("SetOpts","Set Opts",width='50%',class = "btn btn-primary"),
span(passwordInput(inputId="avapikey", label="av api key", value=the_av$avapikey),style=avsd$labelcss),
span(textInput(inputId="avapientitlement", label="av entitlement", value=the_av$avapientitlement),style=avsd$labelcss),
span(textInput(inputId="cachedir", label="Cache Data Directory", value=the_av$cachedir),style=avsd$labelcss),
#span(textInput(inputId="extracalc_file", label="extracalc csv", value=the_av$extracalc_file),style=avsd$labelcss), ## <<--- TODO
span(textInput(inputId="ts_colorset", label="fgts colorset", value=the_av$ts_colorset),style=avsd$labelcss),
selectInput(inputId="sigpct","Regr Significance", c("0.05","0.025","0.1"),selected=c("0.025"),multiple=FALSE),
span(textInput(inputId="av_dump_dir", label="AV dump Directory", value=the_av$av_dump_dir),style=avsd$labelcss),
selectInput(inputId="capture_av_what",label="Capture AV Data",c("none","pricesonly","noprices","all"),
selected=s(the_av$capture_av_what), multiple=FALSE),
selectInput(inputId="capture_av_update",label="Update or Cumulative",c("update","cum"),
selected=s(the_av$capture_av_update), multiple=FALSE),
selectInput(inputId="capture_av_save",label="Data Saving Options",c("none","CleanOnStart","SaveEveryAVCall","SaveNowOnOptUpdate"),
selected=the_av$capture_av_save, multiple=TRUE)
),
column(width=7,gt_output(outputId = "dumpthe"))
)
)
)
)
)
)
return(av_ui)
}
#' @importFrom stats cor
#' @importFrom shinyjs runjs
av_make_server <- function() {
ts_rebase=ts_events=ts_volparams=imp=NULL
out <- list()
av_server<-function(input, output,session) {
inlist=list_ts=NULL
curr_assetgroups <- sort(unique(the_av$assetgroups$listnm))
quick_message("ochains","[F(ront)|B(ack)],[M(onth)|Q(tr)],[C(all)|P(ut)],[itm|otm|all]")
# On Startup download current index list if not there
update_tickerlists( is.null(the_av$tickerlist) || nrow(the_av$tickerlist)<=0 ||
(min(the_av$tickerlist$list_ts)<=Sys.Date()-7) )
FinanceGraphs::fg_sync_group("avshiny")
if("CleanOnStart" %in% the_av$capture_av_save) { save_av_data(data.table(),"KILL") }
# ----
reset_opts <- reactive({
tmp1 <- paste0(input$anopt1,",",input$anopt2,",",input$list1,",",input$list2)
updateSelectInput(session,"anopt1",selected="SelectOption")
updateSelectInput(session,"anopt2",selected="SelectOption")
return("reset opts at ",Sys.time())
})
# height_from_obs <- reactive({ the_av$out1h })
need_index_asset <- reactive({
is_in_list <- s(input$istr2)[1] %in% the_av$pxinv$symbol
shinyFeedback::feedbackWarning("is_in_list", !is_in_list, "(1) Need an asset in inventory to compare against")
})
set_list <- function(todo,tlist,instr,no) {
rtnmsg <- ""
if(todo=="save") {
if(nchar(instr)<=0 | nchar(tlist)<=0) {
rtnmsg <- "Cannot Save blank assetgroups Name"
}
else {
newassets <- data.table(ticker=s(instr))[,listnm:=tlist][]
the_av$assetgroups <- DTUpsert(the_av$assetgroups,newassets,c("listnm"),replaceifbempty=the_av$assetgroups[!(listnm==tlist),])
save_avs_state("all",msg="saveassets")
updateSelectizeInput(session,"list1", choices=sort(unique(the_av$assetgroups$listnm)))
updateSelectizeInput(session,"list2", choices=sort(unique(the_av$assetgroups$listnm)))
rtnmsg <-paste0("Asset set saved as ",tlist)
}
}
if(todo=="get") {
av_set_defaults(paste0("inpline",no),paste0( the_av$assetgroups[listnm==tlist,]$ticker,collapse=";") )
save_avs_state("all",msg="getassets")
updateTextInput(session,paste0("istr",no), value= the_av[[paste0("inpline",no)]])
}
if(todo=="delete") {
the_av$assetgroups <- the_av$assetgroups[!listnm==tlist,]
updateSelectizeInput(session,"list1", choices=sort(unique(the_av$assetgroups$listnm)))
updateSelectizeInput(session,"list2", choices=sort(unique(the_av$assetgroups$listnm)))
rtnmsg <-paste0("Deleted Asset List: ",tlist)
save_avs_state("all",msg="deleteassets")
}
Sys.sleep(0.2)
updateRadioButtons(session,paste0("managelist",no),selected=character(0))
return(rtnmsg)
}
observeEvent(input$gropts, {
req(input$gropts)
av_set_defaults("gropts",paste0(input$gropts,sep=";"))
})
observeEvent(input$managelist1, {
req(input$managelist1)
quick_message("istr1",set_list(input$managelist1,input$list1,input$istr1,1))
})
observeEvent(input$managelist2, {
req(input$managelist2)
quick_message("istr2",set_list(input$managelist2,input$list2,input$istr2,2))
})
observeEvent(input$anopt1, {
req(input$anopt1)
shinyFeedback::hideFeedback(inputId="anopt1")
if(nchar(thishelp <- avsd$deflist[runcode==input$anopt1,]$help)>0) {
thishelp <- paste0("<small>",thishelp,"</small>")
shinyFeedback::showFeedback(inputId="anopt1", text=thishelp,color="#2ca35f") }
})
observeEvent(input$anopt2, {
req(input$anopt2)
shinyFeedback::hideFeedback(inputId="anopt2")
if(nchar(thishelp <- avsd$deflist[runcode==input$anopt2,]$help)>0) {
thishelp <- paste0("<small>",thishelp,"</small>")
shinyFeedback::showFeedback(inputId="anopt2", text=thishelp,color="#2ca35f") }
})
observeEvent(input$SetOpts, {
old=toget=NULL
rv <- isolate(reactiveValuesToList(input))
th1<- dump_the()
oldcache <- th1[nm=="cachedir",]$toget
av_api_key(rv$avapikey,rv$avapientitlement)
av_set_default_set("setopts",rv)
if( nchar(newcache<-av_validate_directory(rv$cachedir,"cachedir"))>0 ) {
if(!(newcache==oldcache)) {
message_if_red(TRUE,"Cache directory moved; cleaning up old price/inventory data from ",oldcache)
unlink(paste0(oldcache,"/avpf_px.fst"),force = TRUE)
unlink(paste0(oldcache,"/avpf_inv.RD"),force = TRUE)
av_set_defaults("cachedir",newcache)
}
oldcache <- newcache
}
av_set_defaults("cachedir",oldcache)
av_set_caching_directories() # constants_fn always has to be in tmp directory:
if( nchar(newcache<- av_validate_directory(rv$av_dump_dir,"av_dump_dir"))>0 ) {
av_set_defaults("av_dump_dir",newcache)
}
av_set_defaults("starttab","main")
save_avs_state("all",msg="sEToPTS")
th1 <- th1[,.(nm,old=toget)][dump_the(),on=.(nm)][,format:=fifelse(old==toget,"","yellow")][]
th1 <- th1[,.SD,.SDcols=s("classtype;nm;toget;format")]
output$dumpthe <- render_gt(expr=th1 |> gt() |> gt.basetheme() |> decorate_table())
})
observeEvent(input$capture_av_what, {
req(input$capture_av_what)
feedtxt<- fcase(input$capture_av_what=="none","No Data Capture",
input$capture_av_what=="pricesonly","Only prices captured",
input$capture_av_what=="noprices","Only non price data captured",
input$capture_av_what=="all","All Data captured",
default="Denmark call home")
if("capture" %chin% feedtxt) {
feedtxt <- paste0(feedtxt," to ",input$av_dump_dir,"/av_download.RD")
}
shinyFeedback::showFeedback(inputId="av_dump_dir", text=feedtxt,color="#2ca35f")
})
observeEvent(!(input$capture_av_save==the_av$capture_av_save), {
if("SaveNowOnOptUpdate" %in% input$capture_av_save) {
save_av_data(data.table(),"SaveNowOnOptUpdate")
updateSelectInput(session,"capture_av_save",selected=the_av$capture_av_save)
}
})
observeEvent(!(input$verbose==the_av$verbose), {
av_set_defaults("verbose",input$verbose)
save_avs_state("the",msg="verbose")
})
observeEvent(!(input$autocopy==the_av$autocopy), {
av_set_defaults("autocopy",input$autocopy)
save_avs_state("the",msg="autocopy")
})
observeEvent(input$RUN, {
rv <- isolate(reactiveValuesToList(input))
thisenv <- environment()
if(the_av$avapikey=="NOT_SET") {
quick_message("anopt1","SET Alphavantage API key")
quick_message("anopt2","SET Alphavantage API key")
return()
}
# Make variables out of captured input values
lapply(names(rv),\(x) { assign(x,rv[[x]],envir=thisenv)})
av_set_defaults("starttab",tolower(avsd$deflist[runcode==anopt1,]$focus) )
av_set_default_set("onrun",rv,save="the")
# Out gets destroyed on end of routine. Need to keep it in the the environment.
message_if(the_av$verbose,"avrs(",tver,") >>>> input(",anopt1,"/",anopt2,") sid1:", istr1, " sid2:", istr2, " szout:",length(out))
# Recreate old tabs
if( nrow(savedgtnames <- dump_the()[classtype=="gt_tbl",])>0) {
for(x in savedgtnames$nm) out[[x]]<- get(x,envir=the_av)
}
lapply(s("istr1;istr2"),\(x) quick_message(x,""))
eqlist1 <- s(istr1)
eqlist2 <- s(istr2)
avsh_set_tabtitle()
av_set_defaults("seriesnm", fifelse(rv$totrtn,"adjusted_close","close"))
av_set_defaults("uselive",rv$useLive)
if(anopt1=="Gen:Inventory") {
if(nrow(the_av$pxinv)<=0) { quick_message("istr1","Create Data by running a Time Series Graph") }
else {
out[["TABLE3GT"]]<- the_av$pxinv[,age:=Sys.Date()-end_dt] |> gt.avtheme(themeset="pxinv")
out[["DET1GT"]]<- dump_assetgroups(returngt=TRUE) |> gt.avtheme(themeset="assetgroups")
out[["DET2GT"]]<- av_get_pf("","MARKET_STATUS") |> av_extract_df() |> gt.avtheme(themeset="mktstatus")
avsh_set_tabtitle("AssetList")
}
}
if(anopt1=="Gen:LivePx") {
toplot <- symbol_grep_by_type(NULL,"Equity|ETF")
if(toplot[[1]]=="NOPXINV") {
quick_message("istr1","Run some Price History first..")
}
else {
toplot <- av_get_pf(toplot,"REALTIME_BULK_QUOTES",melted=FALSE)
if( length( fxsymbols <-symbol_grep_by_type(NULL,"FX") )>0 ) {
toplot_fx <- lapply(fxsymbols, \(x) av_get_pf(x,"CURRENCY_EXCHANGE_RATE",melted=FALSE) |> av_extract_fx(cols="symbol;timestamp;close") )
toplot <- rbindlist(list(toplot,rbindlist(toplot_fx)),use.names=TRUE,fill=TRUE)
}
toplot <- data.table(symbol=eqlist1)[,inlist:=TRUE][toplot,on=.(symbol)][order(change_percent)]
avsh_clipboard(toplot,"liveprice")
out[["TABLE1GT"]]<- toplot |> gt.avtheme(themeset="live")
}
# Save latest to history, but how to ensure no gaps?
}
if(anopt1=="TS:PriceTS") {
toplot<-data_from_list(eqlist1,datestring,ts_rebase,dtstartfrac,msg_inputID="istr1")
out[["MSG"]]<-""
if( nrow(toplot[[1]])>0) {
out[["TS1"]] <- one_px_ts(toplot,rv,events=ts_events,dtstartfrac=dtstartfrac)
save_avs_state("px",msg="px1")
}
}
if(anopt2=="TS:PriceTS") {
out[["MSG"]]<-""
toplot<-data_from_list(eqlist2,datestring,ts_rebase,dtstartfrac,msg_inputID="istr2")
if( nrow(toplot[[1]])>0) {
out[["TS2"]] <- one_px_ts(toplot,rv,events=ts_events,dtstartfrac=dtstartfrac)
save_avs_state("px",msg="px2")
}
}
if(anopt1=="TS:ActiveTS") {
out[["MSG"]]<-""
is_in_list <- s(istr2)[1] %in% the_av$pxinv$symbol
shinyFeedback::feedbackDanger("istr2", !is_in_list, "2. Need a previously downloaded hedge/index")
req(is_in_list, cancelOutput = TRUE)
toplot<-data_from_list(c(eqlist1,eqlist2),datestring,ts_rebase,dtstartfrac,msg_inputID="istr1")
if( nrow(toplot[[1]])>0) {
t_toget <- data.table(symbol=c(eqlist2[1],eqlist1),catg=c("idx",rep("act",length(eqlist1))))
t_toget <- t_toget[,.SD[1],by=.(symbol)] # Weed out duplicates
toplot <- the_av$pxd[t_toget,on=.(symbol)] |> narrowbydtstr(datestring)
toplot <- toplot[,.(timestamp,adjusted_close,cumrtn=log(adjusted_close)-log(first(adjusted_close))),by=.(catg,symbol)]
toplot <- toplot[,let(rtn=c(NA_real_,diff(cumrtn,1))), by=.(catg,symbol)]
toplot_idx <- toplot[catg=="idx",.(timestamp,idxpx=adjusted_close,mktrtn=rtn,cummktrtn=cumrtn)]
toplot_idx <- toplot_idx[toplot[catg=="act",],on=.(timestamp)]
toplot_tridx <- toplot_idx[,.(timestamp,variable=symbol,value=100*exp(cumrtn-cummktrtn))]
avsh_clipboard(toplot_tridx,anopt1)
out[["TS1"]] <- one_px_ts(toplot_tridx,rv,title=paste0("Excess Returns over ",eqlist2[1]),extra_anno="hline,100",
events=ts_events,dtstartfrac=dtstartfrac)
toplot_idx <- toplot_idx[,let(rtn=100*rtn,mktrtn=100*mktrtn)]
volp_n <- as.integer(s(ts_volparams)[[2]])
toplot_corr <- toplot_idx[,rcor:=frollapply(.SD,volp_n,\(x) 100*cor(x$mktrtn,x$rtn,method="kendall",
use="complete.obs"),by.column=FALSE), by=.(symbol)]
out[["TS2"]] <- one_px_ts(toplot_corr[,.(timestamp,variable=symbol,value=rcor)],rv,
title=paste0("Rolling ",volp_n," day kendall correlation"),extra_anno="hline,100",
events=ts_events,dtstartfrac=dtstartfrac)
rtnscatall <- fg_scatplot(toplot_idx,"rtn ~ mktrtn + color:symbol + point:label", "lm",datecuts=c(7),
title=paste0("Asset Daily returns vs ",eqlist2[1], "Daily rtn"),
axislabels=paste0("Asset TR;",eqlist2[1]," TR"),returnregresults=TRUE)
out[["SCAT1"]] <- rtnscatall[[1]]
out[["TABLE1GT"]]<- rtnscatall[[2]] |> gt.avtheme(themeset="activeregression", s(istr2)[1], sigpct)
toplot_idx <- toplot_idx[,let(rtnidx=100*exp(cumrtn), mktrtnidx=100*exp(cummktrtn))]
out[["SCAT2"]] <- fg_scatplot(toplot_idx,"rtnidx ~ mktrtnidx + color:symbol + point:label", "lm",datecuts=c(7),
title=paste0("TR Level vs Level ",datestring),axislabels="Asset TR Index;Index TR Index")
}
# TO do, other statistics (PCA?)
}
if(anopt1=="TS:HistVolTS") {
out[["MSG"]]<-""
toplot<-data_from_list(eqlist1,datestring,ts_rebase,dtstartfrac,msg_inputID="istr1")
if( nrow(toplot[[1]])>0) {
toplot2 <- ts_vol(toplot,ts_volparams);
avsh_clipboard(toplot2,"HistVol")
out[["TS1"]] <- one_px_ts(toplot2,rv,title=paste("Volatility (pct) using ",ts_volparams),events=ts_events,dtstartfrac=dtstartfrac)
out[["TS2"]] <- one_px_ts(toplot,rv,events=ts_events,dtstartfrac=dtstartfrac)
}
}
if(anopt1=="EQ:DES") {
out[["MSG"]]<-""
toplot<-data_from_list(eqlist1,datestring,ts_rebase,dtstartfrac,msg_inputID="istr1") # Just to get the asset type.
tickerset = the_av$pxinv[data.table(symbol=eqlist1),on=.(symbol)][,.(symbol,type,currency)]
if( length(eqset <- symbol_grep_by_type(eqlist1,"Equity"))>0 ) {
eqdt <- rbindlist(lapply(eqset, \(x) av_get_pf(x,"OVERVIEW")))
eqdt <- eqdt |> save_av_data("OVERVIEW")
olist <- avsd$overviewlist[,variable:=EquityName][]
eqdta <- olist[eqdt,on=.(variable)][source=="av",]
eqdta <- eqdta[order(catprio,prio)][,.(category,symbol,catprio,prio,variable,ltype,value_str,format ,value_num)]
toplot <- dcast(eqdta[order(catprio,prio)], catprio+prio+category + variable+format ~ symbol, value.var="value_str")
toplot <- toplot[,imp:=fifelse(grepl("green|yellow|bold",format),"imp","")]
setcolorder(toplot,"imp",after="category")
out[["TABLE1GT"]] <- toplot |> gt.avtheme(themeset="eqdesc1")
}
# tab_style(eval(parse(text=fm31)),eval(parse(text=fm32)))
if( length(eqset <- symbol_grep_by_type(eqlist1,"ETF"))>0 ) {
eqdt <- rbindlist(lapply(eqset, \(x) av_get_pf(x,"ETF_PROFILE")))
eqdt <- eqdt |> save_av_data("ETF_PROFILE")
olist <- avsd$overviewlist[,variable:=ETFName][]
eqdta <- olist[eqdt,on=.(variable)][source=="av",]
toplot <- dcast(eqdta[order(catprio,prio)], catprio+prio+category + variable+format ~ symbol, value.var="value_str")
sectorset <- eqdt |> av_extract_df("sectors")
if("weight" %in% colnames(sectorset)) {
sectorset <- dcast(sectorset[!is.na(sector),][,let(weight=100*weight)], sector ~ symbol,value.var="weight")
sectorset <- sectorset[,let(category="sects",catprio=max(toplot$catprio)+1,prio=.I,format="")]
setnames(sectorset,"sector","variable")
toplot <- rbindlist(list(toplot, sectorset),use.names=TRUE,fill=TRUE)
}
out[["DET1GT"]] <- toplot |> gt.avtheme(themeset="eqdescsec")
avsh_set_tabtitle("ETF")
holdset <- eqdt |> av_extract_df("holdings")
if("weight" %in% colnames(holdset)) {
holdset <- holdset[,.SD[order(-weight)][,let(n=.I-min(.I)+1, weight=100*weight)], by=.(symbol)]
holdset <- dcast(holdset[n<=50,],n ~ symbol,value.var=c("description","weight"))
holdsetcn <- data.table(nm=colnames(holdset)[-1])[,let(i=.I+1,symbol=s(nm,"_")[2]),by=.I][order(symbol,nm)]
setcolorder(holdset, c(1,holdsetcn$i))
out[["DET2GT"]] <- holdset |> gt.avtheme(themeset="etfholdings")
}
}
}
if(anopt1=="EQ:DivEarn") {
out[["MSG"]]<-""
fwddts <- extenddtstr(datestring,rtn="list",endchg=2*360)
alleqs <- symbol_grep_by_type(eqlist1,"Equity")
if(length(alleqs)>0) {
allearn <- rbindlist(lapply(alleqs,\(x) oneticker_earns(x,fwddts,datestring)))
lastqtr <- max(allearn[symbol==alleqs[[1]] & !is.na(reportedDate)]$fiscalDateEnding)
lastqtr <- paste0(lubridate::year(lastqtr),"Q",lubridate::quarter(lastqtr))
avsh_clipboard(allearn,"earnings")
out[["TABLE1GT"]]<- allearn |> gt.avtheme(themeset="earnings")
xout <- av_get_pf(alleqs[[1]],"EARNINGS_CALL_TRANSCRIPT",quarter=lastqtr) |>
av_extract_df("transcript")
xout <- xout[,title:=fcase(grepl("Chief Executive|CEO",title),"CEO",grepl("Chief Financial|CFO",title),"CFO",grepl("Investor Relations",title),"InvRel",default=title)]
xout <- xout |> gt.avtheme(themeset="earningstranscript",paste0(alleqs[[1]]," ",lastqtr))
out[["DET1GT"]]<- xout
avsh_set_tabtitle("Transcript")
}
alldivs <- rbindlist(lapply(eqlist1, \(x) oneticker_divs(x,datestring)),fill=TRUE,use.names=TRUE)
out[["TABLE2GT"]]<- alldivs |> gt.avtheme(themeset="dividends")
}
if(anopt1=="Gen:Movers") {
tdta <- av_get_pf("","TOP_GAINERS_LOSERS") |> save_av_data("TOP_GAINERS_LOSERS")
tab1 <- rbindlist(list(
av_extract_df(tdta,"top_losers")[,.(ticker,price,pctchg=as.numeric(gsub("%","",change_percentage)),item="losers",n=.I)],
av_extract_df(tdta,"top_gainers")[,.(ticker,price,pctchg=as.numeric(gsub("%","",change_percentage)),item="winners",n=.I)],
av_extract_df(tdta,"most_actively_traded")[,.(ticker,price,pctchg=as.numeric(gsub("%","",change_percentage)),item="traded",n=.I)]
))
toplot = tab1 |> tidyr::pivot_wider(names_from="item",id_cols="n",values_from=c(ticker,price,pctchg),names_vary="slowest")
avsh_clipboard(toplot,"Movers")
out[["TABLE1GT"]]<- toplot |> gt.avtheme(themeset="Gen:Movers",tdta[variable=="last_updated",]$value_str)
}
if(anopt1=="Gen:NameSearch") {
eqdta <- av_get_pf("","SYMBOL_SEARCH",keywords=istr1) |> save_av_data("SYMBOL_SEARCH")
eqdta[,let(format=fcase(type=="Equity" & region=="United States","bold",default=""))]
setcolorder(eqdta,neworder="matchScore")
idxsearch <- the_av$tickerlist[grepl(istr1,name,ignore.case=TRUE) | grepl(istr1,symbol,ignore.case=TRUE),][,.(symbol,name,type="Index")]
eqdta <- rbindlist(list(idxsearch[,format:="green"],eqdta),fill=TRUE,use.names=TRUE)
avsh_clipboard(eqdta,"eq search")
out[["TABLE1GT"]] <- eqdta |> gt.avtheme(themeset="namesearch",istr1)
}
if(anopt1=="EQ:OptSearch") {
allmsg <- ""
indta <- data.table()
for (x in eqlist1) {
theseopts <- av_get_pf(x,"HISTORICAL_OPTIONS")
if("variable" %in% names(theseopts)) {
allmsg <- paste(allmsg, x) }
else {
indta <- rbindlist(list(indta,theseopts), fill=TRUE)
}
}
indta <- indta |> save_av_data("HISTORICAL_OPTIONS")
quick_message("istr1",paste(nrow(indta),"rows ", fifelse(nchar(allmsg)>0, paste0(allmsg, " missing"),"")))
if(nrow(indta)>0) {
inspots <- rbindlist(lapply(eqlist1,\(x) av_get_pf(x,"GLOBAL_QUOTE",melted=TRUE)))
inspots <- inspots[variable=="price",.(symbol,spot=value_num)]
indta <- inspots[indta,on=.(symbol)][,ncak:=1]
filteredopts <- indta |> av_grep_opts(grepstring=ochains,mindelta=as.numeric(mindelta)/100)
filteredopts <- filteredopts |> av_opt_helper_cols(scaling=oscaling)
colstoshow <- data.table(showset=c("reduced","trading","all"),
colstring=c("symbol;ncak;strike;type;daysExp;moneyn;mat_be;mat_be_pct;IV;mark;last;bo_pct;delta;vega;theta;contractID",
"symbol;ncak;strike;daysExp;volume;open_interest;IV;delta;last;mark;bo_pct;bid;ask;bid_size_poi;ask_size_poi;contractID",
paste0(names(filteredopts),collapse=";")))
atmopts = indta[type=="call" & expiration<=Sys.Date()+60,][,.SD[which.min(abs(delta-0.5))],by=.(symbol,expiration)] |>
av_opt_helper_cols(scaling="none")
out[["SCAT1"]] <- fg_scatplot(atmopts,"IV ~ daysExp + color:symbol",type="loessnofill",psize=3,title="ATM Term Structure")
filteredopts[,type:=fifelse(type=="call","C","P")]
filteredopts<- filteredopts[,.SD,.SDcols=s(colstoshow[showset==otodisplay,]$colstring)]
avsh_clipboard(filteredopts,"opts")
out[["OPT1GT"]] <- filteredopts |> gt.avtheme(themeset="filteredopts", istr1, otodisplay)
}
}
if(anopt1=="EQ:News") {
av_set_default_set("news",rv)
eqset <- symbol_grep_by_type(eqlist1,"Equity|ETF",check_vs_inv=FALSE)
allnews <- rbindlist(lapply(eqset,\(x)
getNews(x,nArticles=input$nArticles,minabssent=input$minabssent,newsfilter=input$newsfilter,
newsagrep=input$newsgrep,maxage=input$maxagedays)))
if(newssort=="sentiment") { allnews<- allnews[order(symbol,-sntmt)] }
if(newssort=="time,symbol") { allnews<- allnews[order(-time_published,symbol)] }
if(newssort=="symbol,time") { allnews<- allnews[order(symbol, -time_published)] }
out[["NEWSGT"]] <- allnews |> gt.avtheme(themeset="news",istr1)
av_set_defaults("NEWSGT",out[["NEWSGT"]])
}
if(length(out)<=1) {
quick_message("anopt1","Select an Action",eval=(anopt1=="SelectOption" || anopt2=="SelectOption"))
quick_message("anopt1",paste0("NOT IMPLEMENTED YET:", anopt1, " or ",anopt2),eval=!(anopt1=="SelectOption" || anopt2=="SelectOption"))
}
# =============================================================================================================================================
the_av$dyg1h <- fifelse( "dygraphs" %in% class(out[["TS1"]]), "600px","auto")
the_av$dyg2h <- fifelse( "dygraphs" %in% class(out[["TS2"]]), "600px","auto")
output$t1gt <- render_gt(expr=out[["TABLE1GT"]])
output$t2gt <- render_gt(expr=out[["TABLE2GT"]])
output$t3l_gt <- render_gt(expr=out[["TABLE3GT"]])
output$t3r_gt <- render_gt(expr=out[["TABLE4GT"]])
output$det1gt <- render_gt(expr=out[["DET1GT"]])
output$det2gt <- render_gt(expr=out[["DET2GT"]])
output$opt1gt <- render_gt(expr=out[["OPT1GT"]])
output$newsgt <- render_gt({ out[["NEWSGT"]] })
output$view <- renderDygraph({ out[["TS1"]] })
output$view2 <- renderDygraph({ out[["TS2"]] })
output$plot1 <- renderPlot({ out[["SCAT1"]] })
output$plot2 <- renderPlot({ out[["SCAT2"]] })
output$optplot1<- renderPlot({ out[["SCAT1"]] })
output$msg <- renderPrint({ print(out[["MSG"]]) })
updateTabsetPanel(session,"inTabset",selected=the_av$starttab)
}) # obsARUnn
} # Server
return(av_server)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.