I am using dygraphs for R and I opened the following issue on GitHub the other day, however, I have not yet received an answer. Therefore, I am hoping someone in here will be able to answer my question.
I want to know if it is possible to show all the values of the prediction interval in the legend, i.e. , lower, actual, upper, without having them as three separate plain dySeries? I like the look of the shading that the upper/lower bars bring, but I would also like to be able to hover over a point and see all the values for that particular point, not just the middle one. If such a function does not exists, is there an easy workaround, maybe with fillGraph = TRUE or something?
library(dygraphs)
hw <- HoltWinters(ldeaths)
p <- predict(hw, n.ahead = 72, prediction.interval = TRUE)
dygraph(p, main = "Predicted Lung Deaths (UK)") %>%
dySeries(c("lwr", "fit", "upr"), label = "Deaths")
The preceding code is the example from the web page, which is similar to my problem. I simply want to see the lwr and upr values in the legend when hovering.
So I found a workaround for anybody looking for something similar.
library(dygraphs)
hw <- HoltWinters(ldeaths)
p <- predict(hw, n.ahead = 72, prediction.interval = TRUE)
max <- p[,2]
min <- p[,3]
p <- ts.union(p, max, min)
dygraph(p, main = "Predicted Lung Deaths (UK)") %>%
dySeries(c("p.lwr", "p.fit", "p.upr"), label = "Deaths") %>%
dySeries("max", label = "Max", pointSize = 0.01, strokeWidth = 0.001) %>%
dySeries("min", label = "Max", pointSize = 0.01, strokeWidth = 0.001)
Obviously, this can be modified to suit your needs (e.g. color of the points etc.) The main idea in this method is simply to create two new columns containing the same information that is used in the bands, and then to make the lines to these too small to see.
Related
I am a basic-level learner of R. I am having a problem knitting out tables with a code my professor designed for the students. The code for table designs is set as below. I put this in my R markdown as below.
```{r, results="hide", message=FALSE, warning = FALSE, error = FALSE}
## my style latex summary of regression
jhp_report <- function(...){
output <- capture.output(stargazer(..., omit.stat=c("f", "ser")))
# The first three lines are the ones we want to remove...
output <- output[4:length(output)]
# cat out the results - this is essentially just what stargazer does too
cat(paste(output, collapse = "\n"), "\n")
}
```
After this, I tried printing this out with knitr.
```{r, message=FALSE, warning = FALSE, error = FALSE}
set.seed(1973)
N <- 100
x <- runif(N, 6, 20)
D <- rbinom(N, 1, .5)
t <- 1 + 0.5*x - .4*D + rnorm(N)
df.lm <- data.frame(y = y, x =x, D =D)
df.lm$D <- factor(df.lm$D, labels = c('Male', 'Female'))
##REGRESSION
reg.parallel <- lm(y ~ x + D, data = df.lm)
jhp_report(reg.parallel, title = "Result", label = "tab:D", dep.var.labels = "$y$")
```
As a result, instead of a table, it keeps on showing only the pure codes. I would like to know how I have to set up R markdown for it to print out the table instead of the codes. This is how the result looks like when I knit it.
I expected that there must be some setup options to print the table out. But I couldn't find the right one. Also, my assignment for class requires students to use this code. I did find other options like knitr::kable but I would like to use the given code for this assignment.
Thank you in advance!
I am trying to remove two columns from the below table however when knitted as a pdf from markdown I get the below error. I am unsure if this just isn't possible or if there is a work around.
ERROR:
Error in remove_column(., 4:5) :
Removing columns was not implemented for latex kables yet
Calls: ... kable_classic -> kable_light -> kable_styling -> remove_column
Execution halted
OverCortTab <- bind_rows(AlexOverCortTab$table_body,OptOverCortTab$table_body)%>%
mutate(Predictor=str_replace(Predictor,"TAS_Tot","Alexithymia"),
Predictor=str_replace(Predictor,"OPT_Tot","Optimism"))%>%
mutate(Fit=str_replace(Fit,"95%","95\\\\%"),
Fit=str_replace(Fit,"R2","R$2$"),
Fit=lead(Fit,n=2))%>%
filter(Predictor !=""|Fit !="")%>%
kable(caption = "Table 1: Hair Cortisol and Personality",
booktabs=TRUE,
col.names = c("Predictor","$\\beta$","$\\beta$ 95\\% CI","$\\beta$","$\\beta$ 95\\% CI","sr2","sr2 95\\% CI","r","Fit"),
escape=FALSE) %>%
remove_column(4:5)%>%
kable_classic(font_size=12)%>%
footnote(general=c("A Significant $\\beta$-weight indicates the semi-partial correlation is also significant.","$\\beta$ represents unstandardised regression weights.","sr2 represents the semi-partial correlation squared.","Square brackets are used to enclose the lower and upper limits of the confidence interval.","* indicates p < .05", "** indicates p < .01"),escape=FALSE) %>%
group_rows("Alexithymia",1,2,hline_before=TRUE,hline_after=TRUE,underline=TRUE)%>%
group_rows("Optimism",3,4,hline_before=TRUE,hline_after=TRUE,underline=TRUE) ```
Instead of removing the column inside the kbl function, you could try removing it before.
This could work, by piping select:
OverCortTab <- bind_rows(AlexOverCortTab$table_body,OptOverCortTab$table_body)%>%
mutate(Predictor=str_replace(Predictor,"TAS_Tot","Alexithymia"),
Predictor=str_replace(Predictor,"OPT_Tot","Optimism"))%>%
mutate(Fit=str_replace(Fit,"95%","95\\\\%"),
Fit=str_replace(Fit,"R2","R$2$"),
Fit=lead(Fit,n=2))%>%
filter(Predictor !=""|Fit !="")%>%
select(-c(4:5))%>%
kable(caption = "Table 1: Hair Cortisol and Personality",
booktabs=TRUE,
col.names = c("Predictor","$\\beta$","$\\beta$ 95\\% CI","$\\beta$","$\\beta$ 95\\% CI","sr2","sr2 95\\% CI","r","Fit"),
escape=FALSE) %>%
kable_classic(font_size=12)%>%
footnote(general=c("A Significant $\\beta$-weight indicates the semi-partial correlation is also significant.","$\\beta$ represents unstandardised regression weights.","sr2 represents the semi-partial correlation squared.","Square brackets are used to enclose the lower and upper limits of the confidence interval.","* indicates p < .05", "** indicates p < .01"),escape=FALSE) %>%
group_rows("Alexithymia",1,2,hline_before=TRUE,hline_after=TRUE,underline=TRUE)%>%
group_rows("Optimism",3,4,hline_before=TRUE,hline_after=TRUE,underline=TRUE)
Is there any reason this wouldn't work? I simply want to see which terms are found in the two selected columns. I figured intersect would do the job, but I'm not seeing results. If this looks alright, perhaps I have some other syntax error along the way? Do the inputs need to be in different sidebar panels?
selectInput("data1", "Choose you Input:", choices = colnames(data), selected = "PD.Risk.Factor"),
selectInput("data2", "Choose you Input:", choices = colnames(data), selected = "AD.Risk.Factor")),
Output:
p2 = intersect(x = input$data1, y = input$data2)
print(p2)
Welcome to SO! Please provide a reprex the next time - this will help to get help.
For our problem. What your snippet does is to compare not the columns of your data frame but the the strings as returned by selectInput. What you want to do is to use these strings to retrieve the corresponding columns in the data.
library(shiny)
sample_dat <- data.frame(x = 1:10, y = 5:14, z = 9:18)
ui <- fluidPage(selectInput("col1", "Column 1:", names(sample_dat), "x"),
selectInput("col2", "Column 1:", names(sample_dat), "y"),
verbatimTextOutput("result"))
server <- function(input, output, session) {
output$result <- renderPrint({
list(on_strings = list(col1 = input$col1,
col2 = input$col2,
intersect = intersect(input$col1, input$col2)),
on_cols = list(col1 = input$col1,
col2 = input$col2,
intersect = intersect(sample_dat[[input$col1]],
sample_dat[[input$col2]])))
})
}
shinyApp(ui, server)
I have a dataset in which I am graphing means from 4 treatments over time, along with their standard errors, at 2 sites. The standard error bars are not being assigned properly to their respective means --they are going to both panels - can you please advise? See example:
d <- data.frame(site=rep(1:2,each=12),time=rep(1:3,8),trt=rep(rep(1:4,each=3),2))
d$mn <- rnorm(24,4,1)
d$se <- rnorm(24,2,1)
d$ul <- d$mn+d$se # create y value for standard error upper limit
my.panel <- function(x,y, ...){
panel.xyplot(x, y, ...)
panel.arrows(x, y, x, d$ul, length = 0.1,
angle = 90)
}
xyplot(mn ~ time|site,data=d,
group = trt,
type=c('p','l'),
panel = my.panel
)
I am trying to create a leaflet map as part of an R-Shiny project which displays circle markers at locations I previously geocoded from address information using the Google API. Putting the lon/lat values back into Google gives me the exact location of the address.
When I create the map from those lon/lat values in my shiny project using the code below, the marker positions are off in random directions by a few 100 meters (at maximum zoom level).
Based on google searches my guess is that it is something to do with markers changing position due to zoom level or with incompatible map projections.
output$mymap <- renderLeaflet({
alldata_sel = alldata
if(input$dachverbandCheck != T){alldata_sel = filter(alldata_sel, Dachverband==input$dachverband)}
if(input$landkreisCheck != T){alldata_sel = filter(alldata_sel, Landkreis==input$landkreis)}
if(input$leistungstypCheck != T){alldata_sel = filter(alldata_sel,
LeistungstypBezeichnung==input$leistungstyp)}
if(input$traegerCheck != T){alldata_sel = filter(alldata_sel, Traegername==input$traeger)}
#initialize map and setView
leaflet(options = leafletOptions(minZoom = 5, maxZoom = 18)) %>%
addProviderTiles(providers$CartoDB.Positron) %>%
addCircleMarkers(
data = alldata_sel,
lng=~longitude, # Longitude coordinates
lat=~latitude, # Latitude coordinates
radius=~KapRadius,
stroke=FALSE, # Circle stroke
fillOpacity=0.5, # Circle Fill Opacity
color = rgb(alldata_sel$colour_r, alldata_sel$colour_g, alldata_sel$colour_b,
maxColorValue = 255)
)
})