R Shiny Image without padding/ stretched across page using css - html

I'm building a shiny dashboard and I want an image to stretch across the top of the dashboard body with no padding. I'm new to customizing apps and CSS, and I'd prefer to keep my css inline if possible.
This is what I have right now:
I'd like to extend the image as indicated by blue arrows/ red outline below.
Here's code for what I have so far:
library('shiny')
library('shinyjs')
library('shinydashboard')
##########
header<-dashboardHeader(titleWidth = 325)
header$children[[2]]$children <-
#tags$a(tags$img(src='image.PNG',height='45',width='184'))
######
body<-dashboardBody( tags$style(".content {background-color: black;}"),
useShinyjs(),
tags$style(type='text/css', ".skin-blue .main-header .logo {background-color: #000000}" ),
tags$style(type='text/css', ".skin-blue .main-header .logo:hover {background-color: #000000}"),
tags$style(type='text/css', ".skin-blue .main-header .navbar {background-color: #000000}"),
tags$style(type="text/css",".shiny-output-error { visibility: hidden; }",".shiny-output-error:before { visibility: hidden; }"),
fluidPage(
img(src="img2.PNG",height="100%", width="100%"),
tabBox("Menu Surf Database", width = 12,
tabPanel("Menu Surf Database",
tabsetPanel(
tabPanel("LTO Survey results",
h2(strong(textOutput("t"))),
h4(textOutput("Description")),
h2(strong("LTO Results"),align='center'),
h4(strong(textOutput("Price"))),
br(),
plotOutput("Q4plot",height = 200),
br(),br(),
plotOutput("seasonPlot",height=200),
br(),br(),
plotOutput("Q1plot"),
br(),br()),
tabPanel("Demographics",
h2(strong(textOutput("t2"))),
h4(textOutput("Description2")),
h2(strong("Demographics of Top Two Box:"),align='center'),
h3(strong("By Purchase Intent"),align= "center"),
br(),
plotOutput("demoPlot1"),
plotOutput("demoPlot2")
))),
tabPanel("Exploratory Comparison",
tabsetPanel(
tabPanel("Visuals",
h2(strong("Proprietary Menu Surf Results:")),
selectInput("index",label = "Index by:",choices = c("Meal Part","Day Part"),selected = "Meal Part",multiple = FALSE),
checkboxInput("addItem", label="Include sidebar item for comparision?", value = FALSE, width = NULL),
h4(strong("Purchase Intent Indices:")),
plotOutput("prop1"),
h4(strong("Uniqueness Indices:")),
plotOutput("prop2"),
h4(strong("Draw Indices:")),
plotOutput("prop3"),
h4(strong("Cravebility Indices:")),
plotOutput("prop4"),
h4(strong("Brand Fit Indices")),
plotOutput("prop5")
),
tabPanel("Tables",
h2(strong("Menu Surf Results, tables:")),
h3("Purchase Intent"),
br(),
dataTableOutput("propTable1")
)))
)))
sidebar<-dashboardSidebar(width = 325,
conditionalPanel(
condition = "$('li.active a').first().html()==='Menu Surf Database'",
h4("Filters:"),
br(),
selectInput('month',label='Month:',choices= month.name,multiple = TRUE,selected = "March"),
selectInput("year",label= "Year:",choices= c("2017"),multiple = FALSE,selected = "2017"),
selectInput("daypart",label = "Day Part:",choices=c("Breakfast","Lunch/Dinner"),selected = c("Breakfast","Lunch/Dinner"),multiple = TRUE),
selectInput("mealpart",label="Meal Part:",choices =c("Adult Beverage","App/Starter","Dessert","Ent/Main Dish","Non-Alcohol Beverage","Side/Extra","Snack"),selected = c("Adult Beverage","App/Starter","Dessert","Ent/Main Dish","Non-Alcohol Beverage","Side/Extra","Snack"),multiple = TRUE),
selectInput("courseCategory",label = "Course Category:",choices = c('All','Asian Bowl','Baked Goods','Beef Dish','Beverage','Breaded Other',
'Breaded Protein','Breaded Vegetables','Breads','Breakfast Starch',
'Burgers','Chicken Dish','Combo Plates','Egg Dish','Fish Dish','Fried Dessert',
'Fries','Frozen Beverage','Ice Cream','Mexican','Mixed Grill','Nachos','Pasta/Noodles',
'Pizza','Pork Dish','Salad Main Dish','Sandwich','Shellfish Dish','Soup','Specialty Drinks'
),selected= 'All',multiple = FALSE),
#textOutput('test'),
uiOutput('restChoices'),
uiOutput('itemChoices'),
br(),
h5("Edit data by demographic features below:"),
selectInput('gender',label = "Gender:",choices = c("Female","Male"),multiple = TRUE,selected = c("Female","Male")),
selectInput('generation',label = "Generation:",choices = c("Generation Z","Millennials","Generation X","Baby Boomers","Matures"),selected = c("Generation Z","Millennials","Generation X","Baby Boomers","Matures"),multiple = TRUE),
selectInput('ethnicity',label ='Ethnicity:',choices = c("Asian","Black/African American (non-Hispanic)","Caucasian (non-Hispanic)","Hispanic","Mixed ethnic background","Other"),selected = c("Asian","Black/African American (non-Hispanic)","Caucasian (non-Hispanic)","Hispanic","Mixed ethnic background","Other"),multiple = TRUE),
selectInput('ea',label = 'Eater Archetype:', choices = c("Affluent Socializers","Bargain Hunters","Busy Balancers","FS Hobbyist","FS Hobbyists","Functional Eater","Functional Eaters","Habitual Matures","Health Enthusiast","Health Enthusiasts"),selected = c("Affluent Socializers","Bargain Hunters","Busy Balancers","FS Hobbyist","FS Hobbyists","Functional Eater","Functional Eaters","Habitual Matures","Health Enthusiast","Health Enthusiasts"),multiple = TRUE)
),
conditionalPanel(
condition = "$('li.active a').first().html()==='Exploratory Comparison'",
#h5("The Exploratory Comparison tab allows you to view results for many items. Please filter for your results below."),
h4("Filters:"),
br(),
selectInput('month2',label='Month:',choices= month.name,multiple = TRUE,selected = "March"),
selectInput("year2",label= "Year:",choices= c("2017"),multiple = FALSE,selected = "2017"),
selectInput("daypart2",label = "Day Part:",choices=c("Breakfast","Lunch/Dinner"),selected = c("Breakfast","Lunch/Dinner"),multiple = TRUE),
selectInput("mealpart2",label="Meal Part:",choices =c("Adult Beverage","App/Starter","Dessert","Ent/Main Dish","Non-Alcohol Beverage","Side/Extra","Snack"),selected = c("Adult Beverage","App/Starter","Dessert","Ent/Main Dish","Non-Alcohol Beverage","Side/Extra","Snack"),multiple = TRUE),
selectInput("courseCategory2",label = "Course Category:",choices = c('All','Asian Bowl','Baked Goods','Beef Dish','Beverage','Breaded Other',
'Breaded Protein','Breaded Vegetables','Breads','Breakfast Starch',
'Burgers','Chicken Dish','Combo Plates','Egg Dish','Fish Dish','Fried Dessert',
'Fries','Frozen Beverage','Ice Cream','Mexican','Mixed Grill','Nachos','Pasta/Noodles',
'Pizza','Pork Dish','Salad Main Dish','Sandwich','Shellfish Dish','Soup','Specialty Drinks'
),selected= 'All',multiple = FALSE),
uiOutput('restChoices2'),
br(),
h5("Edit data by demographic features below:"),
selectInput('gender2',label = "Gender:",choices = c("Female","Male"),multiple = TRUE,selected = c("Female","Male")),
selectInput('generation2',label = "Generation:",choices = c("Generation Z","Millennials","Generation X","Baby Boomers","Matures"),selected = c("Generation Z","Millennials","Generation X","Baby Boomers","Matures"),multiple = TRUE),
selectInput('ethnicity2',label ='Ethnicity:',choices = c("Asian","Black/African American (non-Hispanic)","Caucasian (non-Hispanic)","Hispanic","Mixed ethnic background","Other"),selected = c("Asian","Black/African American (non-Hispanic)","Caucasian (non-Hispanic)","Hispanic","Mixed ethnic background","Other"),multiple = TRUE),
selectInput('ea2',label = 'Eater Archetype:', choices = c("Affluent Socializers","Bargain Hunters","Busy Balancers","FS Hobbyist","FS Hobbyists","Functional Eater","Functional Eaters","Habitual Matures","Health Enthusiast","Health Enthusiasts"),selected = c("Affluent Socializers","Bargain Hunters","Busy Balancers","FS Hobbyist","FS Hobbyists","Functional Eater","Functional Eaters","Habitual Matures","Health Enthusiast","Health Enthusiasts"),multiple = TRUE)
))
########
ui <-
dashboardPage(
header,
sidebar,
body
)
###########
server<-function(input, output, session){
}
#####
shinyApp(ui = ui, server = server)
Thanks in advance ! :)

I am by no means a CSS expert, but this is how I was able to achieve what you are looking for:
tags$style(".topimg {
margin-left:-30px;
margin-right:-30px;
margin-top:-15px;
}"),
div(class="topimg",img(src="https://dotunroy.files.wordpress.com/2015/05/happy-people.jpg",height="100%", width="100%")),
I had to choose another image, because I did not have the image you used. But luckily I found some volunteers. Look at all those happy people!

Related

Remove '¶' character from R saveWidget output

I'm generating a reactable object and saving it in a HTML widget with saveWidget function, my code is like this: (qmd document)
```{css, echo = FALSE}
.tag {
display: inline-block;
padding: 2px 12px;
border-radius: 15px;
font-weight: 600;
font-size: 12px;
overflow-y: scroll;
height:400px;
}
```
Generate and save table:
```{r}
library("reactable")
library("htmlwidgets")
reactable(data = data_table,
class = "tag",
filterable = TRUE,
rownames = FALSE,
selection = "multiple",
showPageSizeOptions = TRUE,
paginationType = "jump",
showSortable = TRUE,
highlight = TRUE,
resizable = TRUE,
rowStyle = list(cursor = "pointer"),
onClick = "select") %>%
saveWidget(.,
"table_name.html",
selfcontained = T,
libdir = "lib"
)
```
My problem is: when I open the output ("table_name.html") there's a string with "¶¶¶¶¶¶", I don't know how to remove it.
This is how it looks:
Judging from the link in the comments, this is fixed in the widget. However, if one should run into this in a different context, then on could also use a Lua filter.
local sep = pandoc.Inlines{pandoc.Space(), pandoc.Str '¶', pandoc.Space()}
function Inlines (inlines)
for i = #inlines - 2, 1, -1 do
if pandoc.Inlines{inlines[i], inlines[i+1], inlines[i+2]} == sep then
inlines:remove(i+2); inlines:remove(i+1); inlines:remove(i)
end
end
return inlines
end
Save the above to a file, say remove-pilcrow.lua, and use it with
---
output:
html_document:
pandoc_args: ['--lua-filter=remove-pilcrow.lua']
---
in R Markdown or
---
filters:
- remove-pilcrow.lua
---
in Quarto.

How to increase my container width to accomodate more items

I am building a dashboard using Plotly Dash. I am using bootstrap.min.css , I would like to increase the width of my container so that I can accommodate two graphs , in a single row.
My second graphs(Line graph) , has more width hence unable to align them in a single row.
I have attached the snapshot below,
DASH UI CODE :
# the style arguments for the sidebar. We use position:fixed and a fixed width
SIDEBAR_STYLE = {
"top": 0,
"left": 0,
"bottom": 0,
"width": "16rem",
"padding": "2rem 1rem",
"background-color": "#f8f9fa",
"position": "fixed",
"color":"#000",
}
# the styles for the main content position it to the right of the sidebar and
# add some padding.
CONTENT_STYLE = {
"margin-left": "18rem",
"margin-right": "2rem",
"padding": "2rem 1rem",
}
sidebar = html.Div(
[
html.H2("Plate", className="display-4"),
html.Hr(),
html.P(
"A simple dashboard", className="lead"
),
dbc.Nav(
[
dbc.NavLink("Dashboard", href="/dashboard", id="page-1-link"),
dbc.NavLink("Analytics", href="/page-2", id="page-2-link"),
dbc.NavLink("Page 3", href="/page-3", id="page-3-link"),
html.Hr(),
dbc.NavLink("Logout", href="/logout", id="page-4-link"),
],
vertical=True,
pills=True,
),
],
style=SIDEBAR_STYLE,
)
content = html.Div(id='page-content' , className ='container' ,style=CONTENT_STYLE)
app.layout = html.Div([dcc.Location(id="url"), sidebar, content])
app.config.suppress_callback_exceptions = True
# this callback uses the current pathname to set the active state of the
# corresponding nav link to true, allowing users to tell see page they are on
#app.callback(
[Output(f"page-{i}-link", "active") for i in range(1, 4)],
[Input("url", "pathname")],
)
def toggle_active_links(pathname):
if pathname == "/" or pathname == "/dashboard":
# Treat page 1 as the homepage / index
return True, False, False
return [pathname == f"/page-{i}" for i in range(1, 4)]
#app.callback(Output("page-content", "children"), [Input("url", "pathname")])
def render_page_content(pathname):
if pathname in ["/", "/page-1", "/dashboard"]:
dashBoard = html.Div([
html.Div([dcc.DatePickerRange(
id='my-date-picker-range',
min_date_allowed=dt(minDate[0],minDate[1],minDate[2]),
max_date_allowed=dt(maxDate[0],maxDate[1],maxDate[2]),
initial_visible_month=dt(maxDate[0],maxDate[1],maxDate[2]),
start_date=dt(minDate[0],minDate[1],minDate[2]).date(),
end_date=dt(maxDate[0],maxDate[1],maxDate[2]).date()
),
html.Button(id="date-button" , children ="Analyze" , n_clicks = 0, className = 'btn btn-outline-success')
], className = 'row'),
html.Div([
html.Br(),
html.Div([
html.H4(['Category Overview'] , className = 'display-4'),
html.Br(),
html.Br(),
], className = 'row'),
html.Div([
html.Div([dcc.Graph(id='categoryPerformance',figure = dict(data=ge.returnCategoryOverviewBarGraph(df)[0],
layout=ge.returnCategoryOverviewBarGraph(df)[1]))
], className = 'col'),
html.Div([dcc.Graph(id='categoryPerformanceTrend')
], className = 'col')
], className = 'row'),
html.Hr(),
html.Div([
html.Div([
dcc.Dropdown(id = 'category-dd', options = category_items, value = 'Food')
], className = 'col-6 col-md-4'),
html.Div([
dcc.Slider(id = 'headCount' , min = 5, max=20 , step = 5 , value = 5, marks = {i: 'Count {}'.format(i) for i in range(5,21,5)})
], className = 'col-12 col-sm-6 col-md-8')
], className = 'row'),
html.Div([
html.Br(),
html.Br(),
html.Div([
dcc.Graph(id ='idvlCategoryPerformanceBest')
], className ='col'),
html.Div([
dcc.Graph(id ='idvlCategoryPerformanceLeast')
], className = 'col')
], className = 'row')
])
] , className='container')
return dashBoard
I have zero knowledge in frontend / css , any help is much appreciated. Thanks !

Generating html from tabular chat conversation data

I have this table of chat conversation mydf
mydf = structure(list(User = c("Ana", "Ana", "Brian", "Ana", "Brian"), Message = c("Hi",
"How are you?", "Good. You?", "Ok", "What's up?"), Time = structure(c(1512156236.17704,
1512156238.67704, 1512156241.17704, 1512156243.67704, 1512156246.17704
), class = c("POSIXct", "POSIXt"))), .Names = c("User", "Message",
"Time"), row.names = c(NA, -5L), class = "data.frame")
#> mydf
# User Message Time
#1 Ana Hi 2017-12-01 13:23:56
#2 Ana How are you? 2017-12-01 13:23:58
#3 Brian Good. You? 2017-12-01 13:24:01
#4 Ana Ok 2017-12-01 13:24:03
#5 Brian What's up? 2017-12-01 13:24:06
My goal is to convert this data into conversation format in HTML. I am currently doing it by adding tags to the data and saving it. Then I have to work some more with CSS to make it better. Is there an easier way in R?
#REMOVE REPEATING NAMES
mydf$User = with(rle(mydf$User), unlist(sapply(seq_along(values),
function(i) c(rep(values[i], 1), rep("", lengths[i] - 1)))))
#ADD TAGS
mydf$User = ifelse(mydf$User == "", "", paste0("<h2 class=\"user\">", mydf$User, "</h2>"))
mydf$Message = paste0("<h3 class=\"msg\">", mydf$Message, "</h3>")
mydf$Time = paste0("<span class=\"tm\">", mydf$Time, "</span>")
#SAVE HTML
writeLines(paste(paste(mydf$User, mydf$Message, mydf$Time), collapse = "\n"),"~/test.html")
I am not sure if this satisfies you, but I would go with an approach that extends the data.frame and writes it directly in the file
#REMOVE REPEATING NAMES
mydf$User = with(rle(mydf$User), unlist(sapply(seq_along(values),
function(i) c(rep(values[i], 1), rep("", lengths[i] - 1)))))
#SAVE HTML
write.table(
data.frame(
ifelse(mydf$User!="", "<h2 class=\"user\">",""), mydf$User, ifelse(mydf$User!="","</h2>",""),
"<h3 class=\"msg\">", mydf$Message, "</h3>",
"<span class=\"tm\">", mydf$Time, "</span>"),
file = "~/test.html", quote = F, col.names = F, row.names = F )

could not find function "eventReactive"

When I run the app in Ubuntu it works perfectly but when I run in on Mac OSX, things (like buttons) are not aligned and after a while I get the following error:
> shiny::runApp()
Loading required package: shiny
Listening on http://127.0.0.1:7240
Loading required package: lattice
Loading required package: ggplot2
data.table 1.8.10 For help type: help("data.table")
Error in (structure(function (input, output) :
could not find function "eventReactive"
ERROR: [on_request_read] connection reset by peer
Here's some part of code:
trainres <- eventReactive(input$buttontrain, {
thisfds = list(); singtrain = NULL; singtest = NULL
thiskfkds = list(); multtrain = NULL; multtest = NULL
yvectr = NULL; yvects = NULL; predvectr = NULL; predvects = NULL
tim = 0.0
if(input$dbterm == "Multi table") {
thiskfkds = append(thiskfkds, KFKD(EntCol=input$fk1, AttCol=input$pk1, UseFK=input$usefk1))
if(!is.null(input$fk2)) {
thiskfkds = append(thiskfkds, KFKD(EntCol=input$fk2, AttCol=input$pk2, UseFK=input$usefk2))
}
if(!is.null(input$fk3)) {
thiskfkds = append(thiskfkds, KFKD(EntCol=input$fk3, AttCol=input$pk3, UseFK=input$usefk3))
}
cat("KFKDs:\n")
print(thiskfkds)
multtrain = switch(input$dataset,
"Walmart" = MultData(Target=as.data.frame(WStr[,1]), EntTable=WStr[,-1], AttTables=list(WR1, WR2), KFKDs=thiskfkds),
"Walmart (R)" = MultData(Target=as.data.frame(DWStr[,1]), EntTable=DWStr[,-1], AttTables=list(DWR1, DWR2), KFKDs=thiskfkds),
"Yelp" = MultData(Target=as.data.frame(YStr[,1]), EntTable=YStr[,-1], AttTables=list(YR1, YR2), KFKDs=thiskfkds),
"Yelp (R)" = MultData(Target=as.data.frame(DYStr[,1]), EntTable=DYStr[,-1], AttTables=list(DYR1, DYR2), KFKDs=thiskfkds),
"Expedia" = MultData(Target=as.data.frame(EStr[,1]), EntTable=EStr[,-1], AttTables=list(ER1, ER2), KFKDs=thiskfkds),
"Expedia (R)" = MultData(Target=as.data.frame(DEStr[,1]), EntTable=DEStr[,-1], AttTables=list(DER1, DER2), KFKDs=thiskfkds),
"Flights" = MultData(Target=as.data.frame(FStr[,1]), EntTable=FStr[,-1], AttTables=list(FR1, FR2, FR3), KFKDs=thiskfkds),
"Flights (R)" = MultData(Target=as.data.frame(DFStr[,1]), EntTable=DFStr[,-1], AttTables=list(DFR1, DFR2, DFR3), KFKDs=thiskfkds)
)
Here's how apps looks like after running:
Here's the code in ui.R:
library(shiny)
library(caret)
shinyUI(fluidPage(
list(tags$head(HTML('<h4><table><tr><td rowspan="2"><img src="http://umark.wisc.edu/brand/templates-and-downloads/downloads/print/UWCrest_4c.jpg"
border="0" style="padding-right:10px" width="34" height="40" alt="UW-Madison Database Group"/>
</td><td><b>Santoku</b></td></tr><tr><td>University of Wisconsin-Madison Database Group</td></tr></table></h4>'))),
sidebarLayout(
sidebarPanel(width = 6,
wellPanel(fluidRow(column(6, radioButtons("dbterm", "Database Type", c("Multi table", "Single table"))),
column(6, selectInput("dataset", "Load Dataset", c("Walmart", "Walmart (R)", "Yelp", "Yelp (R)", "Expedia",
"Expedia (R)", "Flights", "Flights (R)")))),
uiOutput("uideps")),
wellPanel(fluidRow(column(6, radioButtons("mlalgo", "ML Model:", c("Logistic Regression" = "lr", "Naive Bayes" = "nb",
"TAN" = "tan", "Decision Tree" = "dt"))),
column(6, uiOutput("uimlpt"))),
fluidRow(div(class="padding2", column(3, checkboxInput("checkcv", "Validate", TRUE))),
div(class="padding3", column(2, actionButton("buttontrain", "Learning"))),
div(class="padding4", column(3, actionButton("buttonfe", "Feature Exploration")))))
),
mainPanel(width = 6,
tabsetPanel(
tabPanel("Single Learning", verbatimTextOutput("trainreso")),
tabPanel("Feature Exploration", plotOutput("feplotso"))
#tabPanel("Wiki", verbatimTextOutput("Wiki")),
#tabPanel("Analysis", tableOutput("plots"))
)
)
)#end sidebarLayout
))#end main
The current version is shiny 0.12.2 in this version there is a function called eventReactive. To quickly update you can use the code;
install.packages(shiny)

quantmod R getsymbols.MySQL modification

I have already studied the case
Quantmod: Error loading symbols from MySQL DB
and already try to fix the getSymbols.MySQL function in R
However, I found that my database just contain
date, open, high, low, close, volume (without the close.adj column).
So, if I want to further modify the getSymbols.MySQL function, what can I do?
I have tried to use 'fix(getSymbols.MySQL)' to fix the function. However, it returns
Error in colnames<-(*tmp*, value = c("H0001.Open", "H0001.High", "H0001.Low", : length of 'dimnames' [2] not equal to array extent
when I connect to my database.
function (Symbols, env, return.class = "xts", db.fields = c("date",
"o", "h", "l", "c", "v", "a"), field.names = NULL, user = NULL,
password = NULL, dbname = NULL, host = "localhost", port = 3306,
...)
{
importDefaults("getSymbols.MySQL")
this.env <- environment()
for (var in names(list(...))) {
assign(var, list(...)[[var]], this.env)
}
if (!hasArg(verbose))
verbose <- FALSE
if (!hasArg(auto.assign))
auto.assign <- TRUE
if (!requireNamespace("DBI", quietly = TRUE))
stop("package:", dQuote("DBI"), "cannot be loaded.")
if (!requireNamespace("RMySQL", quietly = TRUE))
stop("package:", dQuote("RMySQL"), "cannot be loaded.")
if (is.null(user) || is.null(password) || is.null(dbname)) {
stop(paste("At least one connection argument (", sQuote("user"),
sQuote("password"), sQuote("dbname"), ") is not set"))
}
con <- DBI::dbConnect("MySQL", user = user, password = password,
dbname = dbname, host = host, port = port)
db.Symbols <- DBI::dbListTables(con)
if (length(Symbols) != sum(Symbols %in% db.Symbols)) {
missing.db.symbol <- Symbols[!Symbols %in% db.Symbols]
warning(paste("could not load symbol(s): ", paste(missing.db.symbol,
collapse = ", ")))
Symbols <- Symbols[Symbols %in% db.Symbols]
}
for (i in 1:length(Symbols)) {
if (verbose) {
cat(paste("Loading ", Symbols[[i]], paste(rep(".",
10 - nchar(Symbols[[i]])), collapse = ""), sep = ""))
}
query <- paste("SELECT ", paste(db.fields, collapse = ","),
" FROM ", Symbols[[i]], " ORDER BY date")
rs <- DBI::dbSendQuery(con, query)
fr <- DBI::fetch(rs, n = -1)
fr <- xts(as.matrix(fr[, -1]), order.by = as.Date(fr[,
1], origin = "1970-01-01"), src = dbname, updated = Sys.time())
colnames(fr) <- paste(Symbols[[i]], c("Open", "High",
"Low", "Close", "Volume", "Adjusted"), sep = ".")
fr <- convert.time.series(fr = fr, return.class = return.class)
if (auto.assign)
assign(Symbols[[i]], fr, env)
if (verbose)
cat("done\n")
}
DBI::dbDisconnect(con)
if (auto.assign)
return(Symbols)
return(fr)
}
I think the problem is the function was designed to read 7 column of data rather than 6 column of data. Hope someone can help.
Here's a patch that should allow you to do what you want. I'm unable to test because I don't have a MySQL installation to test against. Please let me know whether or not it works.
diff --git a/R/getSymbols.R b/R/getSymbols.R
index 0a2e814..7a9be66 100644
--- a/R/getSymbols.R
+++ b/R/getSymbols.R
## -634,9 +634,9 ## function(Symbols,env,return.class='xts',
fr <- xts(as.matrix(fr[,-1]),
order.by=as.Date(fr[,1],origin='1970-01-01'),
src=dbname,updated=Sys.time())
- colnames(fr) <- paste(Symbols[[i]],
- c('Open','High','Low','Close','Volume','Adjusted'),
- sep='.')
+ if(is.null(field.names))
+ field.names <- c('Open','High','Low','Close','Volume','Adjusted')
+ colnames(fr) <- paste(Symbols[[i]], field.names, sep='.')
fr <- convert.time.series(fr=fr,return.class=return.class)
if(auto.assign)
assign(Symbols[[i]],fr,env)
Then your function call should be:
getSymbols.MySQL("H0001", env, return.class = 'xts',
db.fields = c("date", "open", "high", "low", "close", "volume"),
field.names = c("date", "open", "high", "low", "close", "volume"),
user = 'xxxx', password = 'xxxx', host='xxxx', dbname = 'xxxx')