Related
I have a list of tables (in actual data) with different columns for which, after to combine, I get a table of 15 columns. In actual data, the list of tables is get from several previous steps and each step takes less than a second, but only Table.Combine() takes almost 2 minutes with an input of about 1200 rows. In order to show the example, I show below an output of 4 columns only,
Is there a faster alternative way to get the same output given by Table.Combine()? Thanks for any help.
This is the code of the query I has so far.
let
Tables = {
Table.FromRecords({[Name = "Bob", Phone = "123-4567"],
[Name = "",Phone = ""]
}),
Table.FromRecords({[Fax = "987-6543", Phone = "838-7171"],
[Fax = "", Phone = "233-687"],
[Fax = "", Phone = "544-778"]
}),
Table.FromRecords({[Cell = "543-7890"],
[Cell = ""],
[Cell = ""]
})
},
CombinedTable = Table.Combine(Tables)
in
CombinedTable
The current output is:
UPDATE
This is the entire query, with Table.Buffer() added in step group5
let
Source = Table.FromRows(Json.Document(Binary.Decompress(Binary.FromText("jVNdb4JAEPwvPFty3KHUR1C4Sg+0x5lqqSF+tGlqH5q0mv787hkal41FEsLNLjczu5NQlk6kpqP7yixnceU5Pad+Vr3SCQF4qI4A9FE9AiBQXcyj6qTWlBkDYKiOSd1C8wkNTyPpdK174DntHpzscUucB8R5iOqE6rU6B1ecOXEeEueOUXmE5nejBS1uCZHt6C5JnCge3mReiiMLJ/mNELidARgZreMCNTWAsQozPMgC0N2DFbHK8unUTTOr9XxgTGzzuVIn9AKtRZrDe7M5uod3xrj7uf8I2MD9Or7u1t9rxA2VmsJRGIPui//vX/CK8rOX7zHLFXBgbntM9L+T01koSUaRnvQNiciEanw1Ir37gSLZ7mx/Uw/qcbFvDKjjFD7Bijq1Eywf64uC87egWwzS/xP3hmfG6hc=", BinaryEncoding.Base64), Compression.Deflate)),
let
_t = ((type nullable text) meta [Serialized.Text = true])
in
type table [COL1 = _t, COL2 = _t, COL3 = _t, COL4 = _t]
),
fx = each not List.IsEmpty(List.RemoveItems(_,{"",null})),
group0 = Table.Group(Source, "COL2", {"n", each _}, 0, (x, y) => Byte.From(y = "" or y = null)),
group1 = Table.TransformColumns(
group0,
{
"n",
each
let
a = Table.Skip(_),
b = Table.FirstN(a, each [COL3] = "" or [COL3] = null),
c = Table.Skip(a, Table.RowCount(b))
in
[a = a, b = b, c = c]
}
),
group2 = Table.TransformColumns(
group1,
{"n", each Table.ToColumns(Table.Transpose([b])) & Table.ToColumns([c])}
),
group3 = Table.TransformColumns(group2, {"n", each List.Select(_, fx)}),
group4 = Table.TransformColumns(group3, {"n", each Table.FromColumns(_)}),
group5 = Table.Buffer( Table.TransformColumns(group4, {"n", each Table.PromoteHeaders(_)}) ) ,
combine = Table.Combine(group5[n]),
Custom1 = Table.SelectRows(combine, each fx(Record.ToList(_)))
in
Custom1
The purpose of this query is to tabulate data that appears in repeated blocks and subblock in the way I show below.
This is the output given by the query.
No, but try wrapping the initial table definitions as you go along in Table.Buffer()
let
a= Table.Buffer(Table.FromRecords({[Name = "Bob", Phone = "123-4567"],[Name = "",Phone = ""]})),
b= Table.Buffer(Table.FromRecords({[Fax = "987-6543", Phone = "838-7171"], [Fax = "", Phone = "233-687"],[Fax = "", Phone = "544-778"]})),
c= Table.Buffer(Table.FromRecords({[Cell = "543-7890"],[Cell = ""],[Cell = ""]})),
CombinedTable = Table.Combine({a,b,c})
in CombinedTable
I have the code below, but the options for the individual columns widths I want to control is not doing anything.
output$search_results <- DT::renderDataTable(filtered_df(),
server=TRUE,
extensions = c('Buttons', 'ColReorder', 'FixedColumns','FixedHeader', 'KeyTable'),
options = list(
#dom = 'Blfrtip',
dom = 'Blptilp',
colReorder = TRUE,
buttons = c('copy', 'csv', 'excel'),
autoWidth = TRUE,
scrollX = TRUE,
scrollY = "500px",
fixedColumns = list(leftColumns = 2),
fixedHeader = TRUE,
keys=TRUE,
lengthMenu = c(5,10,20,50,100),
columnDefs = list(list(width = '500px', targets = c(0,1)))
)
)
I am trying to reproduce the decomposed time series plot with highchart.
The result is perfect in the working directory of r but when I put it in r shiny no result comes out.
Here is my code
library(shinyjs)
library(shiny)
library(shinydashboard)
library(highcharter)
library(forecast)
shinyOptions(bslib = TRUE)
bs_global_theme()
bs_theme_base_colors(bg = "#002B36", fg = "#EEE8D5")
bs_theme_accent_colors(primary = "#2AA198")
thematic::thematic_shiny()
ui<-fluidPage(
theme=shinytheme("cerulean"),
themeSelector(),
useShinyjs(),
navbarPage(
title= "Stock exchange", position = "static-top",
id="nav",
tabPanel("Single stock analysis",value = "single_stock", icon = icon("chart-area"),
sidebarLayout(
div(id = "Sidebar",
sidebarPanel(width = 3, align = "center",
selectInput("ticker",
strong("Ticker"),
# quotes$Symbole,
choices = c("AirPassengers", "ttrc"),
selectize = TRUE
),
dateRangeInput("date", strong("Select data range"),
start = "2012-01-01", end = (Sys.Date()-1)
),
tags$br(),
fluidPage(column(width = 3, "Session")
)
)),
mainPanel(
fluidRow(align = "center",
selectInput("hideorshow", label = strong("Sidebar disposition"),
choices = c("Show", "Hide"), selected = "Show")),
tabsetPanel(
tabPanel("Data structure and summary",
icon = icon("table"),
h1(align = "center",
strong(" STRUCTURE OF THE DATAFRAME ")),
tags$br(),tags$b(),class="fa fa-table",
verbatimTextOutput("struc"),
tags$br(),tags$br(),
h1(align = "center",strong(" SUMMARY OF THE DATAFRAME ")),
br(),verbatimTextOutput("summary1")
),
tabPanel("Dataset",icon = icon("tablet-alt"), DTOutput('tbl1')),
tabPanel("Plot",icon = shiny::icon('chart-bar'), br(),br(), br(),
airDatepickerInput(inputId = "date.ts",
strong("Time of the first observation"),
value = "2017-01-01",
minDate = "1998-09-16",
maxDate = Sys.Date(),
view = "months",
minView = "months",
dateFormat = "yyyy-mm"),
highchartOutput("closing_pr.ts",width = "auto", height = "600px"),
),
)
)
)),
tabPanel("Multiple stocks analysis", tabName = "mult_stock", icon = icon("th"))
)
)
I think the problem is hide in the server; exactely the renderHighchart but i can't find it. Please any help will be appreciate.
cs <- new.env()
dt_new <- eventReactive(c(input$ticker,input$date[1],input$date[2]), {
if (input$ticker =="AirPassengers"){
data(AirPassengers)
mydata1 <- AirPassengers
}
else if (input$ticker =="ttrc"){
data(ttrc)
mydata1 <- ttrc
}
mydata1
})
output$closing_pr.ts<-renderHighchart({
year.ts <- as.numeric(year(input$date.ts))
month.ts <- as.numeric(month(input$date.ts))
dc <- decompose(AirPassengers)
df <- as.data.frame(dc[c("x","trend","seasonal","random")])
df2 <- data.frame(Date = index(dc$x),
apply(df, 2, as.numeric))
names(df2) <- c("Date", "Observed", "Trend", "Seasonal", "Random")
df2$Date <- as.Date(yearmon(df2$Date))
df2 <- as.xts(df2[,-c(1)],
order.by = df2$Date)
df2 <- round(df2, digits = 3)
highchart(type = "stock") %>%
hc_title(text = "TIME SERIE DECOMPOSITION") %>%
hc_add_series(df2[, "Observed"], yAxis = 0, name = "Observed", showInLegend = FALSE) %>%
hc_add_yAxis(nid = 1L, title = list(text = "Observed"), relative = 2) %>%
hc_add_series(df2[, "Trend"], yAxis = 1, type = "line",name = "Trend", showInLegend = FALSE) %>%
hc_add_yAxis(nid = 2L, title = list(text = "Trend"), relative = 1)%>%
hc_add_series(df2[, "Seasonal"], yAxis = 2, type = "line",name = "Seasonal", showInLegend = FALSE) %>%
hc_add_yAxis(nid = 1L, title = list(text = "Seasonal"), relative = 2) %>%
hc_add_series(df2[, "Random"], yAxis = 3, type = "line", name = "Random", showInLegend = FALSE) %>%
hc_add_yAxis(nid = 2L, title = list(text = "Random"), relative = 1)%>%
hc_exporting(
enabled = TRUE, # always enabled,
filename = paste0("Closing price decomposition line charts from ",
min(index(df2)),
" to ", max(index(df2))))%>%
hc_colors(colors = c("blue", "red", "cyan", "darkgreen"))
})
observeEvent(input$hideorshow, {
if ( input$hideorshow== "Show") {
shinyjs::show(id = "Sidebar")}
else {shinyjs::hide(id = "Sidebar")}
})
output$summary1 <- renderPrint({
summary(dt_new())
})
output$struc<- renderPrint({
str(dt_new())
})
}
shinyApp(ui=ui, server = server)
Try this
library(shinyjs)
library(shiny)
library(shinydashboard)
library(highcharter)
library(forecast)
library(lubridate)
library(zoo)
library(xts)
shinyOptions(bslib = TRUE)
# bs_global_theme()
# bs_theme_base_colors(bg = "#002B36", fg = "#EEE8D5")
# bs_theme_accent_colors(primary = "#2AA198")
# thematic::thematic_shiny()
ui<-fluidPage(
#theme=shinytheme("cerulean"),
#themeSelector(),
useShinyjs(),
navbarPage(
title= "Stock exchange", position = "static-top",
id="nav",
tabPanel("Single stock analysis",value = "single_stock", icon = icon("chart-area"),
sidebarLayout(
div(id = "Sidebar",
sidebarPanel(width = 3, align = "center",
selectInput("ticker",
strong("Ticker"),
# quotes$Symbole,
choices = c("AirPassengers", "ttrc"),
selectize = TRUE
),
dateRangeInput("date", strong("Select data range"),
start = "2012-01-01", end = (Sys.Date()-1)
),
tags$br(),
fluidPage(column(width = 3, "Session")
)
)),
mainPanel(
fluidRow(align = "center",
selectInput("hideorshow", label = strong("Sidebar disposition"),
choices = c("Show", "Hide"), selected = "Show")),
tabsetPanel(
tabPanel("Data structure and summary",
icon = icon("table"),
h1(align = "center",
strong(" STRUCTURE OF THE DATAFRAME ")),
tags$br(),tags$b(),class="fa fa-table",
verbatimTextOutput("struc"),
tags$br(),tags$br(),
h1(align = "center",strong(" SUMMARY OF THE DATAFRAME ")),
br(),verbatimTextOutput("summary1")
),
tabPanel("Dataset",icon = icon("tablet-alt"), DTOutput('tbl1')),
tabPanel("Plot",icon = shiny::icon('chart-bar'), br(),br(), br(),
airDatepickerInput(inputId = "date.ts",
strong("Time of the first observation"),
value = "2017-01-01",
minDate = "1998-09-16",
maxDate = Sys.Date(),
view = "months",
minView = "months",
dateFormat = "yyyy-mm"),
highchartOutput("closing_prts",width = "auto", height = "600px"),
),
)
)
)),
tabPanel("Multiple stocks analysis", tabName = "mult_stock", icon = icon("th"))
)
)
server <- function(input, output, session){
cs <- new.env()
# dt_new <- eventReactive(c(input$ticker,input$date[1],input$date[2]), {
dt_new <- reactive({
if (input$ticker =="AirPassengers"){
data(AirPassengers)
print("Hello")
mydata1 <- AirPassengers
} else if (input$ticker =="ttrc"){
data(ttrc)
mydata1 <- ttrc
}
as.data.frame(mydata1)
})
df1 <- reactive({
year.ts <- as.numeric(year(input$date.ts))
month.ts <- as.numeric(month(input$date.ts))
dc <- decompose(AirPassengers)
df <- as.data.frame(dc[c("x","trend","seasonal","random")])
df2 <- data.frame(Date = index(dc$x),
apply(df, 2, as.numeric))
names(df2) <- c("Date", "Observed", "Trend", "Seasonal", "Random")
df2$Date <- as.Date(yearmon(df2$Date))
df2 <- as.xts(df2[,-c(1)],
order.by = df2$Date)
df2 <- round(df2, digits = 3)
df2
})
output$closing_prts <- renderHighchart({
df2 <- df1()
highchart(type = "stock") %>%
hc_title(text = "TIME SERIE DECOMPOSITION") %>%
hc_add_series(df2[, "Observed"], yAxis = 0, name = "Observed", showInLegend = FALSE) %>%
hc_add_yAxis(nid = 1L, title = list(text = "Observed"), relative = 2) %>%
hc_add_series(df2[, "Trend"], yAxis = 1, type = "line",name = "Trend", showInLegend = FALSE) %>%
hc_add_yAxis(nid = 2L, title = list(text = "Trend"), relative = 1)%>%
hc_add_series(df2[, "Seasonal"], yAxis = 2, type = "line",name = "Seasonal", showInLegend = FALSE) %>%
hc_add_yAxis(nid = 1L, title = list(text = "Seasonal"), relative = 2) %>%
hc_add_series(df2[, "Random"], yAxis = 3, type = "line", name = "Random", showInLegend = FALSE) %>%
hc_add_yAxis(nid = 2L, title = list(text = "Random"), relative = 1)%>%
hc_exporting(
enabled = TRUE, # always enabled,
filename = paste0("Closing price decomposition line charts from ",
min(index(df2)),
" to ", max(index(df2))))%>%
hc_colors(colors = c("blue", "red", "cyan", "darkgreen"))
})
observeEvent(input$hideorshow, {
if ( input$hideorshow== "Show") {
shinyjs::show(id = "Sidebar")}
else {shinyjs::hide(id = "Sidebar")}
})
output$tbl1 <- renderDT({datatable(dt_new())})
output$summary1 <- renderPrint({
summary(dt_new())
})
output$struc<- renderPrint({
str(dt_new())
})
}
shinyApp(ui, server)
output$plot <- renderImage({
outfile <- tempfile(fileext = '.png')
png(outfile, width = 400, height = 300)
venn.diagram(
x = list(
T = T,
I = I
),
main = "Venn Diagram ",
filename =outfile, output=TRUE,
lwd = 2,na = "remove",
fill = c("orange", "blue"),
alpha = c(0.5,0.5),
label.col = "black",
cex=1.5,
fontface = "plain",
cat.col = c("cornflowerblue", "pink"),
cat.cex = 1.5,
cat.fontfamily = "serif",
cat.fontface = "plain",
cat.dist = c(0.05, 0.05),
cat.pos = c(-20, 14),
cat.default.pos = "text",
scaled = FALSE
)
dev.off()
list(src = outfile,
contentType = 'image/png',
width = 400,
height = 300,
alt = "This is alternate text")
}, deleteFile = TRUE)
I was trying plot a venn diagram using this code. But it only displays This is alternate text and not outputting any image on the app, Any Idea ?
Try to create a reactive graph as shown below
output$plot <- renderImage({
vennd <- reactive({venn.diagram(
x = list(
T = T,
I = I
),
main = "Venn Diagram ",
filename =outfile, output=TRUE,
lwd = 2,na = "remove",
fill = c("orange", "blue"),
alpha = c(0.5,0.5),
label.col = "black",
cex=1.5,
fontface = "plain",
cat.col = c("cornflowerblue", "pink"),
cat.cex = 1.5,
cat.fontfamily = "serif",
cat.fontface = "plain",
cat.dist = c(0.05, 0.05),
cat.pos = c(-20, 14),
cat.default.pos = "text",
scaled = FALSE
)
})
outfile <- tempfile(fileext = '.png')
png(outfile, width = 400, height = 300)
vennd()
dev.off()
list(src = outfile,
contentType = 'image/png',
width = 400,
height = 300,
alt = "This is alternate text")
}, deleteFile = TRUE)
output$plot <- renderImage({
vennd <- reactive({venn.diagram(
x = list(
T = T,
I = I
),
main = "",
filename =outfile, output=TRUE,
lwd = 2,na = "remove",imagetype="png",
fill = c("orange", "blue"),
alpha = c(0.5,0.5),
label.col = "black",
cex=1.5,
fontface = "plain",
cat.col = c("cornflowerblue", "pink"),
cat.cex = 1.5,
cat.fontfamily = "serif",
cat.fontface = "plain",
cat.dist = c(0.05, 0.05),
cat.pos = c(-20, 14),
cat.default.pos = "text",
scaled = FALSE
)
})
outfile <- tempfile(fileext = '.png')
png(outfile, width = 500, height = 500,type="cairo")
vennd()
dev.off()
list(src = outfile,
contentType = 'image/png',
width = 500,
height = 500,
alt = "This is alternate text")
}, deleteFile = TRUE)
Need to add imagetype="png" and type="cairo" thank you #YBS
There is something wrong when calling the input in my app 'x' must be numeric. Does anyone see what is wrong?
I think the error relates to input$MicroRNA
structure(list(hsa_miR_524_5p = c(-1.25502104562923, -1.27256722242831,
-1.33134902421063, -1.1390337316217, -1.14257242781803), hsa_miR_548aq_5p = c(-1.25502104562923,
-1.27256722242831, -1.33134902421063, -1.1390337316217, -1.14257242781803
), hsa_miR_6778_5p = c(-1.25502104562923, -1.27256722242831,
-1.33134902421063, -1.1390337316217, -1.14257242781803), hsa_miR_6812_5p = c(-1.25502104562923,
-1.27256722242831, -1.33134902421063, -1.1390337316217, -1.14257242781803
), hsa_miR_3122 = c(-1.25502104562923, -1.27256722242831, -1.33134902421063,
-1.1390337316217, -1.14257242781803), hsa_miR_3923 = c(-1.25502104562923,
-1.27256722242831, -1.33134902421063, -1.1390337316217, -1.14257242781803
), hsa_miR_4465 = c(-1.25502104562923, -1.27256722242831, -1.33134902421063,
-1.1390337316217, -1.14257242781803), hsa_miR_4641 = c(-1.25502104562923,
-1.27256722242831, -1.33134902421063, -1.1390337316217, -1.14257242781803
), TimeDiff = c(71.0416666666667, 601.958333333333, 1130, 1393,
117.041666666667), Status = c(1L, 1L, 0L, 0L, 1L)), row.names = c("86",
"175", "217", "394", "444"), class = "data.frame")
ui <- fluidPage(
selectInput("MicroRNA", "miRNA", choices = unique(colnames(df.miRNA.cpm.t))),
plotOutput("myplot"))
server <- function(input, output, session) {
output$myplot <- renderPlot({
fitSurv <- survfit(Surv(ss.survival.shiny.miRNA$TimeDiff, ss.survival.shiny.miRNA$Status) ~ paste(cut(input$MicroRNA , quantile(input$MicroRNA , probs = c(0, 0.8)), include.lowest=T)), data = as.data.frame((df.miRNA.cpm.t)))
ggsurvplot(fitSurv ,title="", xlab="Time (Yrs)", ylab="Survival prbability",
font.main = 8,
font.x = 8,
font.y = 8,
font.tickslab = 8,
font.legend=8,
pval.size = 3,
pval.coord = c(1000,1),
size=0.4,
legend = "right",
censor.size=2,
break.time.by = 365,
pval =T,#"p=0.003",#"p=0.41",
#xscale=365,
#palette = c("#E7B800", "#2E9FDF"),
#ggtheme = theme_bw(),
risk.table = F,
xscale=365.25,
xlim=c(0,7*365))
})
}
shinyApp(ui, server)
'x' must be numeric