When writing a table to an Excel workbook:
wb <- createWorkbook()
addWorksheet(wb, "Data")
data <- tibble(x = seq(1,10), y = c("A","B","C","D", NA, NA, NA, NA, NA, NA))
writeDataTable(wb, sheet = "Data", x = data, colNames = FALSE, withFilter = FALSE, tableStyle = "none")
saveWorkbook(wb, file = "Temp.xlsx", overwrite = TRUE)
Even when colNames = FALSE, names are written - it's just that the actual column names are replaced by "Column1", "Column2" etc.
Is there a way to get writeDataTable to write the table and completely omit the column names - so that the first data value in the data.frame is written at A1 (or wherever specified), not "Column1"?
Turns out the solution is a bit trivial - use writeData not writeDataTable.
wb <- createWorkbook()
addWorksheet(wb, "Data")
data <- tibble(x = seq(1,10), y = c("A","B","C","D", NA, NA, NA, NA, NA, NA))
writeData(wb, sheet = "Data", x = data, colNames = FALSE, withFilter = FALSE, tableStyle = "none")
saveWorkbook(wb, file = "Temp.xlsx", overwrite = TRUE)
I didn't realise the writeDataTable function is specifically for writing Excel tables - as opposed to what I thought (just generally writing tables of data).
Related
I am having a hard time understanding how the container argument from function VisNetwork::VisConfigure works. It seems as though one can move the configuration list in another HTML container but my understanding is too limited (and I found no examples online).
My goal would be to place the configuration list in a shinydashboardPlus::dropdownBlock (i.e., in the dashboardHeader leftUI argument), see reproducible example below:
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(visNetwork)
# Define the function to retrieve the parameters from VisConfigure
# See: https://github.com/datastorm-open/visNetwork/issues/333
visShinyGetOptionsFromConfigurator <- function (graph, input = paste0(graph$id, "_configurator")) {
if (!any(class(graph) %in% "visNetwork_Proxy")) {
stop("Can't use visGetPositions with visNetwork object. Only within shiny & using visNetworkProxy")
}
data <- list(id = graph$id, input = input)
graph$session$sendCustomMessage("visShinyGetOptionsFromConfigurator", data)
graph
}
ui <- dashboardPage(
dashboardHeader(title = "Test visConfigure container argument",
leftUi = tagList(
shinydashboardPlus::dropdownBlock(
id = "graphparams",
title = "Graph parameters",
icon = shiny::icon("gears"),
shinyWidgets::prettyRadioButtons(
inputId = "physics",
label = "Parameters should appear here",
choices = c("Yes","No"))))),
dashboardSidebar(width = 220),
dashboardBody(
fluidRow(box(id = "network",
title = "Network",
status = "primary",
width = 12,
solidHeader = TRUE,
collapsible = TRUE,
visNetworkOutput('network'))),
fluidRow(actionButton("ops", "Options"))))
server <- function(input, output, session) {
getDiagramPlot <- function(nodes, edges){
v <- visNetwork(
nodes,
edges) %>%
visIgraphLayout(layout = "layout_on_sphere", physics = TRUE, randomSeed = 1234) %>%
visPhysics(solver = "hierarchicalRepulsion",
hierarchicalRepulsion = list(springLength = 850, nodeDistance = 90),
stabilization = "onlyDynamicEdges") %>%
visOptions(highlightNearest = list(enabled = T, degree = 1, hover = F), autoResize = TRUE, collapse = FALSE) %>%
visEdges(color = list(highlight = "red")) %>%
visEdges(arrows = edges$arrows) %>%
visConfigure(enabled = TRUE, filter = "physics", container = NULL) %>%
visInteraction(multiselect = F)
return(v)
}
nodes <- data.frame(id = 0:20, label = LETTERS[1:21])
edges <- data.frame(from = 0, to = 1:20, value = seq(0.35, 0.5, length.out = 20))
output$network <- renderVisNetwork(
getDiagramPlot(nodes, edges)
)
# Send to console the settings from VisConfigure
# See: https://github.com/datastorm-open/visNetwork/issues/333
observeEvent(input$ops, { visNetworkProxy("network") %>% visShinyGetOptionsFromConfigurator() })
observe({ if(!is.null(input$network_configurator)) print(input$network_configurator)
})
session$onSessionEnded(stopApp)
}
shinyApp(ui, server)
Any idea?
Best,
C.
I tried to set container = input$graphparams but it didn't work.
[SOLVED]
I am trying to do a ShinyApp using some examples from the internet.
As part of my app I want to plot a Sankey Diagram, however, I have been finding a problem.
My app has a navbarPage structure and uses the example from https://github.com/jienagu/D3_folded_charts as one of the primary tabs. After some tests, I figured out that the sankeyNetwork was in conflict with the code part of the bar graph in the example above (specifically with this part: lines 147-149):
output$airbar = renderD3({ bar_graphD3() })
This is the code I am using to render the Sankey diagram:
output$diagram <- networkD3::renderSankeyNetwork({
networkD3::sankeyNetwork(Links = dispersores_df,
Nodes = nodes,
Source = "IDsource",
Target = "IDtarget",
Value = "value",
fontSize = 20,
NodeID = "name",
sinksRight=FALSE)
})
Since this bar graph function is very important for my app, I can't remove it.
Also, due to the fact that the console doesn't pop up any error message, I realized the sankeyNetwork was been rendered. So, I changed my app structure to the fluidPage() and I found the Sankey graph was there (but it was not interactive) as you can see in the figure below.
Sankey visualized in the fluidPage() structure
After changing back to navbarPage() I inspected the tab the Sankey was, and it looks like it is there but invisible.
Sankey invisible in the navbarPage() structure
I found a similar report here sankeyNetwork through renderUI disappears when applying JScode to remove viewbox with htmlwidgets::onRender() but its solution didn't work for me.
Does anyone have any idea or clues that could help me?
Thanks
Full code here:
# library ------------------------------------------------------------------
if(!require("devtools")) install.packages("devtools", dependencies = TRUE)
if(!require("shiny")) install.packages("shiny", dependencies = TRUE)
if(!require("janitor")) install.packages("janitor", dependencies = TRUE)
if(!require("tidyverse")) install.packages("tidyverse", dependencies = TRUE)
if(!require("purrr")) install.packages("purrr", dependencies = TRUE)
if(!require("rlang")) install.packages("rlang", dependencies = TRUE)
#if(!require("stringr")) install.packages("stringr", dependencies = TRUE)
if(!require("noteMD")) devtools::install_github("jienagu/noteMD")
#if(!require("DT")) install.packages("DT", dependencies = TRUE)
if(!require("r2d3")) install.packages("r2d3", dependencies = TRUE)
if(!require("webshot")) install.packages("webshot", dependencies = TRUE)
if(!require("htmlwidgets")) install.packages("htmlwidgets", dependencies = TRUE)
#if(!require("memor")) install.packages("memor", dependencies = TRUE)
if(!require("shinyjs")) install.packages("shinyjs", dependencies = TRUE)
if(!require("nivopie")) devtools::install_github("jienagu/nivopie")
#if(!require("shinythemes")) install.packages("shinythemes", dependencies = TRUE)
#webshot::install_phantomjs()
#tinytex::install_tinytex()
if(!require("leaflet")) install.packages("leaflet", dependencies = TRUE)
#if(!require("performance")) install.packages("performance", dependencies = TRUE)
if(!require("shinyWidgets")) install.packages("shinyWidgets", dependencies = TRUE)
#if(!require("rmarkdown")) install.packages("rmarkdown", dependencies = TRUE)
if(!require("networkD3")) devtools::install_github("christophergandrud/networkD3")
#if(!require("stats")) install.packages("stats", dependencies = TRUE)
#if(!require("stargazer")) install.packages("stargazer", dependencies = TRUE)
#if(!require("caret")) install.packages("caret", dependencies = TRUE)
#if(!require("sjPlot")) install.packages("sjPlot", dependencies = TRUE)
#if(!require("sjlabelled")) install.packages("sjlabelled", dependencies = TRUE)
#if(!require("sjmisc")) install.packages("sjmisc", dependencies = TRUE)
# ui ----------------------------------------------------------------------
col.list <- c("white")
colors <- paste0("background:",col.list,";")
ui <- bootstrapPage(
div(style="display:inline-block", img(src="gif_trees_birds_grid_reseed.gif",
style="position: header; width: 100%; margin-left:0%; margin-top: 0%")),
shinythemes::themeSelector(),
navbarPage(
theme = shinytheme("sandstone"),
title = "Atlantic forest plant traits",
setBackgroundColor(color = c("#FFF5EE")),
#header = tagList(
# useShinydashboard()
#),
# Pie graph ---------------------------------------------------------------
tabPanel(title = "Traits Summary",
sidebarLayout(
sidebarPanel(
selectInput(
inputId = "species",
label = "Species:",
selected = "Acnistus arborescens",
choices = c(unique(plant_traits$species)),
size = 25, selectize = FALSE
)
),
# Show a plot of the generated distribution
mainPanel(
tabsetPanel(
id = "tabs",
tabPanel(
title = "Analytics Dashboard",
value = "page1",
useShinyjs(),
checkboxInput("OneMore", label = h5("Show and Report donut Chart?"), T),
fluidRow(
column(
width = 6,
d3Output("traitbar")
),
div(id='Hide',
column(
width = 6,
nivopieOutput("traitpie")
)
)
)
)
)
)
)
),
# dispersers --------------------------------------------------------------
tabPanel(title = "Dispersers",
mainPanel(
tabsetPanel(type = "hidden",
tabPanel("Animal dispersers",
networkD3::sankeyNetworkOutput("diagram",
height = "700px",
width = "100%")))
))
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
# Trait summary -----------------------------------------------------------
shinyjs::useShinyjs()
observe({
shinyjs::toggle(id = "Hide", condition = input$OneMore, anim = TRUE, animType = "fade")
})
plant_traits_filtered <- reactive({
if (input$species != "ALL") plant_traits <- dplyr::filter(plant_traits, species == input$species)
plant_traits
})
bar_graphD3 <- reactive({
grouped <- ifelse(input$species != "ALL", expr(plant_traits), expr(species))
spptraitdata <- plant_traits_filtered() %>%
dplyr::group_by(!!grouped) %>%
dplyr::tally() %>%
dplyr::collect() %>%
dplyr::mutate(
y = n,
x = !!grouped) %>%
dplyr::select(x, y)
spptraitdata <- spptraitdata %>%
dplyr::mutate(label = x)
r2d3::r2d3(spptraitdata, "bar_plot.js")
})
pie_graph <- reactive({
grouped2 <- ifelse(input$species != "ALL", expr(plant_traits), expr(species))
spptraitdata2 <- plant_traits_filtered() %>%
dplyr::group_by(!!grouped2) %>%
dplyr::tally() %>%
dplyr::collect() %>%
dplyr::mutate(
value = n,
id = !!grouped2) %>%
dplyr::select(id, value)
spptraitdata3 <- data.frame(spptraitdata2)
spptraitdata3$id <- as.factor(spptraitdata3$id)
nivopie::nivopie(spptraitdata3, innerRadius=0.5, cornerRadius=5, fit=T, sortByValue=T,
colors='paired', enableRadialLabels=F, radialLabelsLinkDiagonalLength=1,
radialLabelsLinkHorizontalLength=8,
enableSlicesLabels=T, sliceLabel='id',isInteractive=T)
})
output$traitbar = r2d3::renderD3({
bar_graphD3()
})
output$traitpie=nivopie::renderNivopie({
pie_graph()
})
# plant/trait bar click (server) ---------------------------------
observeEvent(input$bar_clicked != "", {
if (input$species == "ALL") {
updateSelectInput(session, "species", selected = input$bar_clicked)
}
}, ignoreInit = TRUE)
# sankeyNetwork diagram plot ------------------------------------------------------
output$diagram <- networkD3::renderSankeyNetwork({
networkD3::sankeyNetwork(Links = dispersores_df,
Nodes = nodes,
Source = "IDsource",
Target = "IDtarget",
Value = "value",
fontSize = 20,
NodeID = "name",
sinksRight=FALSE) #%>%
# htmlwidgets::onRender('function(el) { el.querySelector("svg").removeAttribute("viewBox") }')
})
}
# Run the application
shinyApp(ui = ui, server = server)
I am wondering if there is a way to remove the index column (1st column) from the data table in Shiny.
For example, column of (1, 2, 3) before Name column as shown in the screenshot below:
Below is my code:
header <- dashboardHeader(
title = "Test"
)
sidebar <- dashboardSidebar(
)
body <- dashboardBody(
box(title = "Test", width = 7, status = "warning", DT::dataTableOutput("df"))
)
# UI
ui <- dashboardPage(header, sidebar, body)
# Server
server <- function(input, output, session) {
output$df = DT::renderDataTable(df, options = list(
autoWidth = TRUE,
columnDefs = list(list(width = '10px', targets = c(1,3)))))
}
# Shiny dashboard
shiny::shinyApp(ui, server)
Thanks in advance.
There is some excellent documentation of the package available at https://rstudio.github.io/DT/ I would highly recommend reading through.
At any rate, use the rownames = FALSE argument provided by the DT package as follows:
library(shinydashboard)
library(DT)
df <- mtcars
header <- dashboardHeader(
title = "Test"
)
sidebar <- dashboardSidebar(
)
body <- dashboardBody(
box(title = "Test", width = 7, status = "warning", DT::dataTableOutput("df"))
)
# UI
ui <- dashboardPage(header, sidebar, body)
# Server
server <- function(input, output, session) {
output$df = DT::renderDataTable(df, rownames = FALSE,
options = list(
autoWidth = TRUE,
columnDefs = list(list(width = '10px', targets = c(1,3)))))
}
# Shiny dashboard
shiny::shinyApp(ui, server)
I want to position a dropdown menu under the legend. However depending on how big the plot in terms of resolution is, plotly changes the position of this dropdown (cf. uploaded pictures).
The first plot shows the output like it appears in the little Rstudio
plot tab. The second shows how far the dropdown goes to the right if I switch to fullscreen.
How can I fix the position of the dropdown menu? Any solution is appreciated whether it is html, R or anything else
Below you can find the code which I used to create the plots:
library(plotly)
x <- seq(-2 * pi, 2 * pi, length.out = 1000)
df <- data.frame(x, y1 = sin(x), y2 = cos(x),tan_h=tanh(x))
p <- plot_ly(df, x = ~x) %>%
add_lines(y = ~y1, name = "sin") %>%
add_lines(y = ~y2, name = "cos") %>%
add_lines(y = ~tan_h, name='tanh',visible=FALSE) %>%
layout(
title = "Drop down menus - Styling",
xaxis = list(domain = c(0.1, 1)),
yaxis = list(title = "y"),
updatemenus = list(
list(
y = 0.7,
x = 1.1,
buttons = list(
list(method = "restyle",
args = list("visible", list(TRUE, TRUE, FALSE)),
label = "Cos"),
list(method = "restyle",
args = list("visible", list(TRUE, FALSE, TRUE)),
label = "Tanh"),
list(method = "restyle",
args = list("visible", list(TRUE, TRUE, TRUE)),
label = "All")
))
)
)
This question is old now, but for Python you now at least can position this via the plotly API, as per: https://plotly.com/python/v3/dropdowns/#style-dropdown
You can pass the arguments x, y, xanchor and yanchor to the updatemenus argument of the plotly graphobjects Figure's update_layout method:
import plotly.graph_objects as go
fig = go.Figure()
fig.update_layout(
title="Demo",
updatemenus=[go.layout.Updatemenu(
active=0,
buttons=[{"label": "Demo button...", "args": [{"showlegend": False}]}],
x = 0.3,
xanchor = 'left',
y = 1.2,
yanchor = 'top',
)
]
)
fig.show()
I am trying to set up an R script that will continuously collect JSON data(every 15secs throughout the day) from OpenSky's REST API.
I am trying to adapt this script meant to collect Car2Go data.
I think I have the basics for the loop, however, I am confusing myself in combining all the data into on dataframe that will can write to a csv at the end up the day.
library(tidyverse)
library(jsonlite)
for (day in 1:100){
flight.df.time <- data.frame()
for (i in seq(1,5760)){
rm(flight.df)
flight.df <- data.frame()
all_flights <- fromJSON('https://opensky-network.org/api/states/all')
# Creates df from JSON and filters lat/long to DC Metro Area
dc_flights <- as.data.frame(all_flights$states) %>%
mutate(V6 = as.numeric(levels(V6))[V6],
V7 = as.numeric(levels(V7))[V7]) %>%
filter(between(V6, -78.361647, -75.872761),
between(V7, 38.197760, 39.646129))
flight.df.time <- rbind(dc_flights, flight.df)
print(Sys.time())
Sys.sleep(15)
}
write.csv(flight.df.time, file = paste(day, '_flight.csv', sep = ''))
}
Would anyone be able to help me get the loop to continuously add data to the data frame and not overwrite it like I am doing now? Thanks!
library(tidyverse)
library(jsonlite)
flight.df.time <- data.frame(icao24 = character(),
callsign = character(),
origin_country = character(),
time_position = double(),
time_velocity = double(),
longitude = double(),
latitude = double(),
altitude = double(),
on_ground = character(),
velocity = double(),
heading = double(),
vertical_rate = double(),
sensors = character(),
Time = character(),
stringsAsFactors = FALSE)
write.table(flight.df.time,'G:/DCIST/OpenSky/Data/flight_week.csv', sep = ",", row.names = FALSE)
for (day in 1:100){
for (i in seq(1, 8640)){
rm(flight.df)
flight.df <- data.frame()
flight_url <- 'https://opensky-network.org/api/states/all'
tryCatch({
all_flights <- fromJSON(txt = flight_url)
}, error=function(e){cat("ERROR :",conditionMessage(e), "\n")})
dc_flights <- as.data.frame(all_flights$states) %>%
select(-(V14:V18)) %>%
mutate(V6 = as.numeric(levels(V6))[V6],
V7 = as.numeric(levels(V7))[V7],
Time = Sys.time()) %>%
filter(between(V6, -78.361647, -75.872761),
between(V7, 38.197760, 39.646129))
flight.df.time <- rbind(dc_flights, flight.df)
write.table(flight.df.time,'G:/DCIST/OpenSky/Data/flight_week.csv', append = TRUE, sep = ",", col.names = FALSE, row.names = FALSE)
print(Sys.time())
Sys.sleep(10)
}
}