I have a folder of xx .csv timeseries that I want to graph and knit into a clean HTML document. I have a ggplot code that produces the plot that I want using a single timeseries.csv. However, when I try to put the bones of that ggplot code in a function inside of a for loop to run each of the timeseries.csv files through the function I get a some plots with pretty different formatting.
Plot generated with my test ggplot code:
Plot generated with function and for loop:
Changes I'm trying to make to the ugly Rmd plot:
Nicely space the x-axis tick marks to whole mins (i.e. "11:14:00", "11:15:00")
Connect the data points (solved with subbing geom_line() with geom_path())
Example Rmd Code Below. Please Note that the graphs produced still have nice formatting, I'm not sure how to reproduce this problem sort of posting a 500 row dataframe. I also don't know how to post my rmd code without SO using the formatting commands in this post, so I threw in at 3 of " around my header formatting and at the end of the code to disable it.
Edits and Updates
I am getting a persistent error geom_path: Each group consists of only one observation. Do you need to adjust the group
aesthetic?.
As suggested by the commenters I tried removing plot() and using the the createChlDiffPlot() directly and replacing plot() with print(). Both produce the same ugly plots as before.
Replaced geom_line() with geom_path(). The points are now connected! x-axis cluttering is still there.
Time variable is reading as hms num
Many thanks for any help on this!
```
---
title: "Chl Filtration"
output:
flexdashboard::flex_dashboard:
theme: yeti
orientation: rows
editor_options:
chunk_output_type: console
---
```{r setup}
library(flexdashboard)
library(dplyr)
library(ggplot2)
library(hms)
library(ggthemes)
library(readr)
library(data.table)
#### Example Data
df1 <- data.frame(Time = as_hms(c("11:22:33","11:22:34","11:22:35","11:22:38","11:23:00","11:23:01","11:23:02")),
Chl_ug_L_Up = c(0.2,0.1,0.25,-0.2,-0.3,-0.15,0.1),
Chl_ug_L_Down = c(0.5,0.4,0.3,0.2,0.1,0,-0.1))
df2 <- data.frame(Time = as_hms(c("08:02:33","08:02:34","08:02:35","08:02:40","08:02:42","08:02:43","08:02:49")),
Chl_ug_L_Up = c(-0.2,-0.1,-0.25,0.2,0.3,0.15,-0.1),
Chl_ug_L_Down = c(-0.1,0,0.1,0.2,0.3,0.4,0.1))
data_directory = "./" # data folder in R project folder in the real deal
output_directory = "./" # output graph directory in R project folder
write_csv(df1, file.path(data_directory, "SO_example_df1.csv"))
write_csv(df2, file.path(data_directory, "SO_example_df2.csv"))
#### Function to create graphs
createChlDiffPlot = function(aTimeSeriesFile, aFileName, aGraphOutputDirectory, aType)
{
aFile_Mod = aTimeSeriesFile %<>%
select(Time, Chl_ug_L_Up, Chl_ug_L_Down) %>%
mutate(Chl_diff = Chl_ug_L_Up - Chl_ug_L_Down)
one_plot = ggplot(data = aFile_Mod, aes(x = Time, y = Chl_diff)) + # tried adding 'group = 1' in aes to connect points
geom_path(size = 1, color = "green") +
geom_point(color = "green") +
theme_gdocs() +
theme(axis.text.x = element_text(angle = 45, hjust = 1),
legend.title = element_blank()) +
labs(x = "", y = "Chl Difference", title = paste0(aFileName, " - ", "Filtration"))
one_graph_name = paste0(gsub(".csv", "", aFileName), "_", aType, ".pdf")
ggsave(one_graph_name, one_plot, dpi = 600, width = 7, height = 5, units = "in", device = "pdf", aGraphOutputDirectory)
return(one_plot)
}
"``` ### remove the quotes when running example
Plots - After Velocity Adjustment
=====================================" ### remove quotes when running example
```{r, fig.width=13.5, fig.height=5}
all_files_Filtration = list.files(data_directory, pattern = ".csv")
# Loop to plot function
for(file in 1 : length(all_files_Filtration))
{
file_name = all_files_Filtration[file]
one_file = fread(file.path(data_directory, file_name))
# plot the time series agains
plot(createChlDiffPlot(one_file, file_name, output_directory, "Velocity_Paired"))
}
"``` #remove quotes when running example
```
I finally figured it out.
1) Replacing geom_line() with geom_path() connected the data points when rendered in Rmd.
2) df1$Time was formatted as a difftime object. When I looked at the dataframe in the global environment, Time :hmsnum 11:11:09 .... This made me think my format was ok, but when I ran class(df1$Time) I got [1] "hms" "difftime". With a quick google I found out difftime objects are not quite the same as hms, and my original time was generated by subtracting times. I added a conversion into my mutate function:
select(Time, Chl_ug_L_Up, Chl_ug_L_Down) %>%
mutate(Chl_diff = Chl_ug_L_Up - Chl_ug_L_Down,
Time = as_hms(Time)) # convert difftime objecct to hms
ggplot I think has some auto-formatting for hms variables, which is why difftime variable was producing ugly crowded x- axes.
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!
I found package sparkline:https://github.com/htmlwidgets/sparkline
but I have no idea how to create in markdown/html data.frame with sparkcharts.
I know there is an example in link above, but I don't know how to create that data frame in html automatically.
I'm not really sure what your problem is or which data frame you refer to. The example on the link you provide is working perfectly. Try the following steps
Start R Studio
Install the sparkline package if you haven't
library(devtools)
install_github('htmlwidgets/sparkline')
Use File -> New File -> R markdown
Copy in the example from the htmlwidgets in the editor and hit the knitr button.
and you will get an html file with several examples.
I think this is what you are looking for: https://leonawicz.github.io/HtmlWidgetExamples/ex_dt_sparkline.html
you can also find a dummy example here:
R combining data tables DT package and sparkline package box plot with target value
As an example:
Boiled down dummy example as follows (disregard the last column in the data/table)
library(data.table)
library(DT)
library(sparkline)
hist.A<-rnorm(100)
hist.B<-rnorm(100)
hist.C<-rnorm(100)
current.A<-rnorm(1)
current.B<-rnorm(1)
current.C<-rnorm(1)
#whisker should show full range of data
boxval.A<-paste(quantile(hist.A,probs=c(0,0.25,0.5,0.75,1)),collapse = ",")
boxval.B<-paste(quantile(hist.B,probs=c(0,0.25,0.5,0.75,1)),collapse = ",")
boxval.C<-paste(quantile(hist.C,probs=c(0,0.25,0.5,0.75,1)),collapse = ",")
data<-data.frame(Variable=c("A","B","C"),Current=c(current.A,current.B,current.C),boxplot=c(boxval.A,boxval.B,boxval.C))
data$boxWithTarget<-paste(data$boxplot,data$Current,Sep=",")
cd <- list(list(targets = 2, render = JS("function(data, type, full){ return '<span class=sparkSamples>' + data + '</span>' }")))
line_string <- "type: 'line', lineColor: 'black', fillColor: '#ccc', highlightLineColor: 'orange', highlightSpotColor: 'orange'"
box_string <- "type: 'box', raw:true, showOutliers:false,lineColor: 'black', whiskerColor: 'black', outlierFillColor: 'black', outlierLineColor: 'black', medianColor: 'black', boxFillColor: 'orange', boxLineColor: 'black'"
cb = JS("function (oSettings, json) {\n $('.sparkSeries:not(:has(canvas))').sparkline('html', { ",
line_string, " });\n $('.sparkSamples:not(:has(canvas))').sparkline('html', { ",
box_string, " });\n}")
d <- datatable(data.table(data), rownames = FALSE, options = list(columnDefs = cd,
fnDrawCallback = cb))
d$dependencies <- append(d$dependencies, htmlwidgets:::getDependency("sparkline"))
d