Control legend colors in tactile::bwplot2 - lattice

In this reproducible example below with the tactile package, the colors are automatically chosen for the boxplots and corresponding legend. However, I would like to customize the colors of the boxplots and legend.
tactile::bwplot2(runif(1000) ~ cut(runif(1000), c(0,0.3,0.6,1)) | as.factor(c(1,2,3)),
groups = sample(1:2, 1000, replace = TRUE), auto.key = TRUE)
However, when I tried to do this, the colors in the boxplots changed but the legend colors did not:
Here I create a new color scheme:
coolNewPars <- list(superpose.symbol = list(pch = 21, cex = 2, col = "gray20",
fill = continentColors$color))
And then plot the boxplots again, with auto.key instructed to place the legend contents into 2 columns and the par.settings set to coolNewPars:
tactile::bwplot2(runif(1000) ~ cut(runif(1000), c(0,0.3,0.6,1)) | as.factor(c(1,2,3)),
groups = sample(1:2, 1000, replace = TRUE), auto.key = list(columns = 2),par.settings = coolNewPars)
How do I force the legend colors to match the coolNewPars colors?

The problem is that lattice::panel.superpose() uses trellis.get.par("superpose.symbol") to differentiate between groups, whilst
the function that draws the key uses "superpose.polygon", or something like it.
In any case, here is a solution (although it is awkward):
coolNewPars <- list(superpose.polygon = list(col = 2:3),
superpose.symbol = list(fill = 2:3))
tactile::bwplot2(runif(1000) ~ cut(runif(1000), c(0,0.3,0.6,1)) | as.factor(c(1,2,3)),
groups = sample(1:2, 1000, replace = TRUE),
auto.key = TRUE,
par.settings = coolNewPars)

Related

How to create a crosstab with variable labels for PDF output in R markdown

I would like to make a table in R markdown that prints a crosstabulation of two variables and includes the variable name above it and on the left side. Also, I need to print this to a PDF so I require code that is compatible with kable("latex").
Reproducible example:
set.seed(143)
x <- sample(x = c("yes", "no"), size = 20, replace = TRUE)
y <- sample(x = c("yes", "no"), size = 20, replace = TRUE)
table(x,y) %>%
kable("latex") %>%
pack_rows("X", 1, 2) %>%
add_header_above(c(" ", "Y" = 2))
Which gives the following output:
However I would like it to look like this (created in Word for example):

Using axis ranges to place labels at arbitrary category

As you can see in the below image. I want to add custom label ranges for y axis.
I have followed this tutorial and tried below code but it was not working, Any idea how to use categoryAxis with custom labels?
let range0 = categoryAxis.axisRanges.create();
range0.value = "MCR.INV-1";
range0.text = "MCR.INV-1";
let range500 = categoryAxis.axisRanges.create();
range500.value = "MCR.INV-2";
range500.text = "MCR.INV-2";
let range1000 = categoryAxis.axisRanges.create();
range1000.value = "PEV1.INV-1";
range1000.text = "PEV1.INV-1";
CategoryAxis ranges use category/endCategory for placement. Replacing value with category in your ranges will fix the problem.

How to create a measure that can mark two columns conditionally?

I have a table that is something like this:
ID
A
B
1H4
6S8
True
1L7
True
6T8
True
7Y8
6S2
True
True
1H1
True
6S3
True
1H9
True
True
6S0
I want to create a measure that evaluates a table to be able to conditionally (to later make conditional rules for report i.e. place color values in such cells) evaluate the cells for the following 2 conditions:
when there are values in both Column A and Column B
when there are blanks/nulls in both columns
(If both can be done in a single measure this would be ideal)
You can use a measure like this:
Background Color =
var Count_A = COUNTBLANK('Table'[A])
var Count_B = COUNTBLANK('Table'[B])
RETURN
SWITCH(TRUE();
AND(Count_A = 0; Count_B = 0); "Red";
AND(Count_A > 0; Count_B > 0); "Green";
"")
First count the blank values in each of the columns, and then return a different color, depending on both counts. Then use this measure to conditionally format the background color for each of the columns:
to get something like this:
You'll need a custom column with the logic of
Column name =
SWITCH (
TRUE (),
A = 'True'
&& B = 'True', "True",
A = ''
&& B = '', "False",
"Else goes here"
)
You'll have to change the logic if the cells without anything in them are '' or true blanks. SWITCH acts like a multiple IF statement, and Switch with TRUE() evaluates the conditions in the later steps.
You can achieve the desired result by using both custom columns and measures.
Custom Column
Column =
IF (
Table[A] <> BLANK ()
&& Table[B] <> BLANK (),
"Green",
IF ( Table[A] = BLANK () && Table[B] = BLANK (), "Red" )
)
Measure
Measure X =
IF(COUNTBLANK(Table[A]) = 0
&& COUNTBLANK(Table[B]) = 0 , "#00FF00",
IF(COUNTBLANK(Table[A]) <> 0
&& COUNTBLANK(Table[B]) <> 0 , "#FF0000")
)
After creating a measure or custom column go to conditional formatting and select background colour, and you may select either measure or column as per your choice. this will give you the desired result.
Output

Changing pallete values based on input (Shiny & leaflet)

I'm using leaflet and shiny. I would like to color my markers based on a column that can be changed via input. It's almost the same as Modifying Existing Maps with leafletProxy. In this example, the user can change the color palette. In my example, I would like to change the column that the palette is applied on.
I'm trying to use something like:
fillColor = ~pal(!!sym(input$col_to_apply)) # input$col_to_apply is a column name (string) I want to use
However, this doesn't work. I'm also not sure if I have to use reactive() in this case.
Sure. My suggestion would be to do it before the palette is created. Palettes are tricky enough as it is. See the below minimal example:
library(leaflet)
library(maps)
library(shiny)
ui <- fluidPage(
leafletOutput("map_1"),
selectInput(inputId = "input_species", label = "Species Selection", choices = c("Species_1", "Species_2", "Species_3"))
)
server <- function(input, output, session) {
#Load a map of the US from the 'map' package (runs once when apps starts)
shp_map = map("state", fill = TRUE, plot = FALSE)
#Make up a dataframe with some data for three species for each state (runs once when apps starts)
df_data <- data.frame(state = unique(shp_map$names), Species_1 = sample(100:199, 63), Species_2 = sample(200:299, 63), Species_3 = sample(300:399, 63))
#Create map
output$map_1 <- renderLeaflet({
df_map <- df_data
#Create a column called species selected based on which is selected in the dropdown box
df_map$Species_Selected <- df_map[, paste(input$input_species)]
#Create a palette function
palette <- colorNumeric(palette = "Blues", domain = df_map$Species_Selected)
#Use the palette function created above to add the appropriate RGB value to our dataframe
df_map$color <- palette(df_map$Species_Selected)
#Create map
map_1 <- leaflet(data = shp_map) %>%
addPolygons(fillColor = df_map$color, fillOpacity = 1, weight = 1, color = "#000000", popup = paste(sep = "", "<b>", paste(shp_map$names), " ", "</b><br>", df_map$Species_Selected))
map_1
})
}
shinyApp(ui, server)

Shiny - dygraphs: Show all error-bar values in legend

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.