I have the following nasty, nested list
Edit: updated to include value_I_dont_want
mylist <- list(
list(
nested_1 = list(
nested_2 = list(
list( value_I_want = "a", value_I_dont_want = "f"),
list( value_I_want = "b", value_I_dont_want = "g")
)
)
),
list(
nested_1 = list(
nested_2 = list(
list( value_I_want = "c", value_I_dont_want = "h"),
list( value_I_want = "d", value_I_dont_want = "i"),
list( value_I_want = "e", value_I_dont_want = "j")
)
)
)
)
And I want to get all the value_I_wants
I know I can use the following code within a for loop
mylist[[x]]$nested_1$nested_2[[y]]$value_I_want
But I want to improve my map skills. I understand how to use map_chr when the list is a single level but I haven't found many resources on plucking from very nested lists. I also know I can use [[ but haven't found good documentation for when this is appropriate?
Any help appreciated!
If we need the 'yay's
library(purrr)
library(dplyr)
map(mylist, ~ .x$nested_1$nested_2 %>% unlist%>% grep("^yay", ., value = TRUE))
Or use pluck to extract the elements based on the key 'value_I_want' after looping over the list with map
map(mylist, ~ .x$nested_1$nested_2 %>%
map(pluck, "value_I_want") )
A more general solution that requires we only know how deeply the desired values are nested:
map(mylist, ~pluck(.,1,1) %>% map(pluck, "value_I_want"))
The second pluck operates on the nesting level set by the first pluck.
This can also work on nested lists that are missing intermediate names, as often found in JSON data pulled from the internet.
Related
The whole function which i need to convert the for loop in to apply for optimization
plans_achievements <- function(pa_m,pa_q){
if(nrow(pa_m)==0 & nrow(pa_q==0)){
df = data.frame(a = c(""), b = c("No Data Available"))
colnames(df)=""
}else{
pa_m= pa_m%>% select(inc,month_year,Plans,Achievements,quarter_year)
colnames(pa_mon)[2] = "Period"
pa_q= pa_q%>% select(inc,quarter_year,Plans,Achievements)
colnames(pa_qtr)[2] = "Period"
df = data.frame(inc=c(""),Period=c(""),Plans=c(""),Achievements=c(""))
for (q in unique(pa_q$Period)){
df1 = pa_q[pa_q$Period==q,]
df1$Period = paste0("<span style=\"color:#288D55\">",df1$Period,"</span>")
df1$Plans = paste0("<span style=\"color:#288D55\">",df1$Plans,"</span>")
df1$Achievements = paste0("<span style=\"color:#288D55\">",df1$Achievements,"</span>")
df = rbind(df,df1)
for (m in unique(pa_m$quarter_year)){
if(m==q){
df2 = pa_m[pa_m$quarter_year==q,][-5]
df = rbind(df,df2)
}
}
}
df = df[-1,]
}
return(df)
}
The apply which i tried
my_fun <- function(q){
df1 = pa_qtr[pa_qtr$Period==q,]
df1$Period = paste0("<span style=\"color:#288D55\">",df1$Period,"</span>")
df1$Plans = paste0("<span style=\"color:#288D55\">",df1$Plans,"</span>")
df1$Achievements = paste0("<span style=\"color:#288D55\">",df1$Achievements,"</span>")
df = rbind(df,df1)
}
df = do.call(rbind,lapply(unique(pa_qtr$Period), my_fun))
my_fun2 <- function(m,my_fun){
if (m == q) {
df2 = pa_mon[pa_mon$qtr_yr == q, ][-5]
df = rbind(df,df2)
}
}
df = do.call(cbind,lapply(unique(pa_mon$qtr_yr), my_fun2))
DT::datatable(plans_achievements(pa_m[pa_m$inc=="vate",],pa_q[pa_q$inc=="vate",]), rownames = F,escape = FALSE,selection=list(mode="single",target="row"),options = list(pageLength = 50,scrollX = TRUE,dom = 'tp',ordering=F,columnDefs = list(list(visible=FALSE, targets=c(0)),list(className = 'dt-left', targets = '_all'))))
Why you get the error comparison is possible only for atomic and list types
I will answer your original question first:
You get the error because you haven't defined q as a variable inside the function my_fun2. Since you haven't defined this variable, R will look for it in the global environment. There R will find the function q() (used to quit R). So you get the error message comparison (1) is possible only for atomic and list types because R thinks you are trying to compare a number m with the function q.
Here is a small example to make it easy to see:
# Run this in a clean environment
m <- 1
m == b # Understandable error message - "b" is not found
m == q # Your error - because R thinks you are comparing m to a function
You fix this error by making sure that q is defined inside your function. Either by creating it inside the function, or by supplying it as an input argument.
A possible solution for your problem
As I understand your code, you want to format, merge and sort the values in pa_q and pa_m, to display them in a html table.
Under is a possible solution, using tidyverse and vectorized operations, rather than a loop or apply functions. Vectorized functions are typically your fastest option in R, as I know you want to optimize your code.
library(dplyr)
plans_achievements <- function(pa_m, pa_q) {
# I've modified the logic a bit: there is no need to wrap the full function in
# an else statement, since we can return early if the data has no rows
if (nrow(pa_m) == 0 && nrow(pa_q == 0)) {
df = data.frame(a = c(""), b = c("No Data Available"))
colnames(df) = ""
return(df)
}
pa_q <-
pa_q %>%
# Select and rename the columns vi need
select(inc, Period = quarter_year, Plans, Achievements, date) %>%
# Format the values
mutate(
Period = paste0("<span style=\"color:#288D55\">", Period,"</span>"),
Plans = paste0("<span style=\"color:#288D55\">", Plans,"</span>"),
Achievements = paste0("<span style=\"color:#288D55\">", Achievements,"</span>")
)
pa_m <-
pa_m %>%
# Select and rename the columns we need
select(inc, Period = month_year, Plans, Achievements, date) #%>%
# Combine the datasets
bind_rows(
pa_q,
pa_m
) %>%
# Make sure that R understand date as a date value
mutate(
date = lubridate::dmy(date)
) %>%
# Sort by date
arrange(desc(date)) %>%
# Remove columns we do not need
select(-date, -inc)
}
DT::datatable(
plans_achievements(
pa_m[pa_m$inc=="vate",],
pa_q[pa_q$inc=="vate",]
),
rownames = FALSE,
escape = FALSE,
selection = list(mode = "single", target = "row"),
options = list(
pageLength = 50,
scrollX = TRUE,
dom = 'tp',
ordering = FALSE,
columnDefs = list(
list(className = 'dt-left', targets = '_all')
)
)
)
Hopefully this solves your problem.
I'm making a table using formattable and I'd like to hide the column titles for the descriptive columns.
So for example, for dataframe "df" I'd like the resulting table to only show the column titles for msmt1, 2, and 3 and then have blank title names for the "site" and "variable" columns.
library(formattable)
df<-data.frame("site" = rep(c("1", "2"), 3),
"variable" = c("C", "C", "O", "O", "N", "N"),
"msmt1" = runif(6),
"msmt2" = runif(6),
"msmt3" = runif(6))
formattable(df)
Replacing the df column names with " " makes them show up as "X." in the table.
Is this possible in formattable?
How about this:
formattable(df, col.names = c("","","msmt1", "msmt2", "msmt3"))
In case you have more columns and don't want to specify them all literally, you could make it more dynamic like this:
formattable(df, col.names = c(rep("", 2), colnames(df)[3:ncol(df)]))
I'd like to create the radial network above utilizing the R package networkD3. I read the guide here which utilizes lists to create radial networks. Unfortunately my R skills with lists are lacking. They're actually non-existent. Fortunately there's the R4DS guide here.
After reading everything I come up with this code below, to create the diagram above.
library(networkD3)
nd3 <- list(Start = list(A = list(1, 2, 3), B = "B"))
diagonalNetwork(List = nd3, fontSize = 10, opacity = 0.9)
Alas, my attempt fails. And subsequent attempts fail to generate anything that's close to the diagram above. I'm pretty sure it's my list that's wrong. Maybe you can show me the right list and things will start to make sense.
Jason!
The issue here is that the parameter nd3 has a very specific grammar of node name and children. So your code should look like this:
library(networkD3)
nd3 <- list(name = "Start", children = list(list(name = "A",
children = list(list(name = "1"),
list(name = "2"),
list(name = "3")
)),
list(name = "B")))
diagonalNetwork(List = nd3, fontSize = 10, opacity = 0.9)
If you're like me and the data frame/spreadsheet format is easier to wrap your head around, you could build an easy data frame with your data and then use data.tree functions to convert it to the list/json format...
library(data.tree)
library(networkD3)
source <- c("Start", "Start", "A", "A", "A")
target <- c("A", "B", "1", "2", "3")
df <- data.frame(source, target)
nd3 <- ToListExplicit(FromDataFrameNetwork(df), unname = T)
diagonalNetwork(List = nd3, fontSize = 10, opacity = 0.9)
I am using Officer to create a Word document, which is a large table. Into this table I want to insert some images. To do this I am using flextable. The following code inserts an image into the flextable.
pupil.tbl <- tribble(
~col1, ~col2,
paste("Name:", pupil$name), paste("Class:", pupil.class),
"attendance_graph", "boxall_graph"
)
# add attendance plot
pupil.ft <- flextable(as.data.frame(pupil.tbl))
pupil.ft <- display(
pupil.ft, i=2, col_key = "col1", pattern = "{{att_tbl}}",
formatters = list(
att_tbl ~ as_image(
col1,
src = "attendance.png",
width = 3.3,
height = 1.65)
)
)
)
This works fine, but I have quite a few images to add so I thought I would abstract it into a function. However when I try to do this I get :
Error in data.frame(image_src = src, width = width, height = height, stringsAsFactors = FALSE) :
object 'image_file' not found
Here is the function and a call to the function(at the moment it is using the global variables for everything except the path to the image)
pupil.ft <- add_img_to_flextable("attendance.png")
add_img_to_flextable <- function(image_file){
return(
display(
pupil.ft, i=2, col_key = "col2", pattern = "{{att_tbl}}",
formatters = list(
att_tbl ~ as_image(
col1,
src = image_file,
width = 3.3,
height = 1.65)
)
)
)
}
If you add the src in a column of the input data.frame, it should work as expected. I can't reproduce everything as I don't have your data and your images.
library(flextable)
library(tibble)
download.file("https://www.r-project.org/logo/Rlogo.png", destfile = "Rlogo.png")
pupil.tbl <- tribble(
~col1, ~col2, ~col3,
"A", "B", "Rlogo.png",
"C", "D", "Rlogo.png"
)
pupil.tbl <- as.data.frame(pupil.tbl)
# display only col1 and col2
pupil.ft <- flextable(pupil.tbl, col_keys = c("col1", "col2") )
add_img_to_flextable <- function(ft, i, j){
display(
ft, i=i, col_key = j, pattern = "{{att_tbl}}",
formatters = list(# use col3 even if not displayed
att_tbl ~ as_image(col3, src = col3, width = 1.29, height = 1)
)
)
}
pupil.ft <- add_img_to_flextable(pupil.ft, i = 2, j = "col2")
pupil.ft
Note that I am not satisfied with the display function, I can see its usage is too complex, I might improve that point later.
Is it anyhow possible to use list as a key for a list? I'd like something as below to work:
lst <- list()
lst[[ list("a", 1:2) ]] <- list(name = "first item", id = 1)
## Error in lst[[list("a", 1:2)]] <- list(name = "first item", id = 1) :
## invalid subscript type 'list'
The idea is to create a lookup table with list keys. The simple solution is to use hashes as keys (e.g. fastdigest), but I am wondering if there is no any direct solution for this?
Example:
lst <- list()
lst[[ list(V1 = "a", V2 = 1:2, V3 = NULL) ]] <- list(name = "first item", id = 1)
lst[[ list(V1 = "a", V2 = 1:2, V3 = "lorem ipsum") ]] <- list(name = "second item", id = 2)
lst[[ list(V1 = "b", V2 = 3, V3 = "") ]] <- list(name = "third item", id = 3)
# calling it:
lst[[ list(V1 = "b", V2 = 3, V3 = "") ]]
## list(name = "third item", id = 3)
The basic problem with using hashes is that I would like also to be able to back-transform this data structure to "flat" list, e.g.
list(V1 = "a", V2 = 1:2, V3 = NULL, name = "first item", id = 1)
and with hashes, for doing this I would need to store the key-hash dictionary separately to be able to re-create them etc. It would also need defining my own, pretty complicated, classes and methods for accessing them. So I'm asking if there is no direct solution, i.e. using lists as keys?