Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Passing a list of inputs parametrically #5

Closed
DataStrategist opened this issue Jan 3, 2017 · 7 comments
Closed

Passing a list of inputs parametrically #5

DataStrategist opened this issue Jan 3, 2017 · 7 comments

Comments

@DataStrategist
Copy link

Hi, take a look here: http://stackoverflow.com/questions/41402379/how-can-i-pass-character-strings-as-independent-parameters-after-a

Perhaps the functions being exposed by Gregor and by myself (Amit Kohli) could be useful inclusions to this packet.

The only addition I could think of could be to extend the function to accept inputs for thresolds and colors. Something like:

I'm close with this:

color.picker <- function(z) {
      if (is.na(z)) {                return(0)
      } else if (z < 5) {            return(1)
      } else if (5 >= z & z < 10) {  return(2)
      } else {                       return(3)
      }
    }
    
    CondFormatForInput2 <- function(Table,VectorToColor,VectorFromColor) {
        cf <- condformat(Table)
        input = data.frame(Val=VectorToColor,Comp=VectorFromColor)
        fills2_ = purrr::map2(input$Val,.y = input$Comp,.f = function(x,y) rule_fill_discrete_(x, expression =
                                                                                        sapply(Table[[y]],color.picker),colours = c(`0` = "white", `1` = "red",`2` = "lightyellow", `3` = "lightgreen")))
        res_ = Reduce(f = "+", x = fills2_, init = cf)
        res_
      }
      
      CondFormatForInput2(iris,
                        c("Petal.Width","Petal.Length"),
                        c("Petal.Width","Petal.Width"))

But there's two problems with my approach: 1) the parameter that decides the color is somehow Column 1 (in the xample above it's the Sepal.Length) rather than whatever I'm passing as y 2) This is still messy... I'm passing the sapply portion w/ the colors in the call, not in the color.picker function... which is messy and weird.

I think this would be really cool if the color.picker function accepted a df as input, with column 1 being the thresholds, and column 2 the colors... and then passing that modified color.picker function to the map2 command in CondFormatForInput2.

What do you think?

@zeehio
Copy link
Owner

zeehio commented Jan 5, 2017

What about this?

devtools::install_github("zeehio/condformat")
# Custom discrete color values can be specified with a function. The function takes
# the whole column and returns a vector with the colours.

# Custom discrete color values can be specified with a function. The function takes
# the whole column and returns a vector with the colours.
color_pick <- function(column) {
  sapply(column,
    FUN = function(value) {
      if (value < 4.7) {
        return("red")
      } else if (value < 6.0) {
        return("yellow")
      } else {
        return("blue")
      }
    })
}
condformat(head(iris)) + rule_fill_discrete_("Sepal.Length", ~ color_pick(Sepal.Length), colours = identity)

imatge

zeehio added a commit that referenced this issue Jan 5, 2017
As requested #5. See the example in `?rule_fill_discrete_` (unreleased into CRAN)
@DataStrategist
Copy link
Author

Yea man.. that's excellent. But again we are specifying the column to color based on explicit names... even more complicated is the fact that within the same rule_fill_discrete there is both standard and non standard evaluation... it makes it really hard to work with this.

That's kind of the priority 1 I think, to create a function that allows for the rules to be applied to columns to be done so without hard-coding.

One of these latest commits broke our simple (but hacky) solution:

ir = iris[c(1:5,70:75, 120:125), ]
cf = condformat(ir) 
input = c("Species", "Petal.Width")
fills_ = lapply(input, function(x) rule_fill_discrete_(x, expression = ir[[x]]))
res_ = Reduce(f = "+", x = fills_, init = cf)
res_

And also the more complicated one that applies formatting on some columns based on some others:

CondFormatForInput <- function(Table,VectorToColor,VectorFromColor) {
        cf <- condformat(Table)
        input = data.frame(Val=VectorToColor,
                           Comp=VectorFromColor)
        fills2_ = map2(input$Val,.y = input$Comp,.f = function(x,y) rule_fill_discrete_(x, expression = 
                                                                                          Table[[y]]))
        res_ = Reduce(f = "+", x = fills2_, init = cf)
        res_
      }

      CondFormatForInput(iris,
                        c("Sepal.Length","Sepal.Width","Petal.Length","Petal.Width"),
                        c("Sepal.Width","Sepal.Width","Petal.Width","Petal.Width"))

Something about the way rule_fill_discrete evaluates changed... perhaps you can restore rule_fill_discrete to the old functionality and create a new functionname to experiemetn with?

@zeehio
Copy link
Owner

zeehio commented Jan 8, 2017

I believe now we have the best of both worlds: Both of your functions are working and we have a future-proof way of programming based on formulas.

I believe you will find worth reading the examples in ?rule_fill_discrete_.

@DataStrategist
Copy link
Author

I think there's a problem with rule_fill_discrete_... I'm running your example:

# Use it programmatically:
color_column_larger_than_threshold <- function(x, column, threshold) {
  condformat(x) +
    rule_fill_discrete_(column,
                        expression=~ lazyeval::uq(column) > lazyeval::uq(threshold))
}
color_column_larger_than_threshold(iris[c(1,51,101),], "Sepal.Length", 6.3)

but I obtain the following:
image

It seems the threshold values aren't being applied?

@zeehio
Copy link
Owner

zeehio commented Jan 9, 2017

I fixed the examples in the stackoverflow answer but I missed that one in the package.

There are two corrections needed:

This is the corrected example:

# Use it programmatically:
color_column_larger_than_threshold <- function(x, column, threshold) {
  condformat(x) +
    rule_fill_discrete_(column,
                        expression=~ uq(as.name(column)) > uq(threshold))
}
color_column_larger_than_threshold(iris[c(1,51,101),], "Sepal.Length", 6.3)

Already fixed in master.

Sorry for all the bugs and recent confusions. I am writing my PhD thesis and I am doing my best to cope with these projects on the few spare moments I have left 😓

@zeehio zeehio changed the title Passing a list of inputs parametricaly Passing a list of inputs parametrically Jan 9, 2017
@DataStrategist
Copy link
Author

No worries man, thanks for your efforts! I'm very happy to say that I am now able to apply my use case! Here's what I ended up doing, feel free to put as an example... or I can PR if u prefer.

## Allow for columns to be colored based on another column, according to a custom color scheme, with no hardcoding.

## Define color limits and scheme:
color_pick <- function(col) {
  ifelse(col < 1.5,"red",
         ifelse(col < 4.9,"yellow",
                "lightgreen"))
}

## Helper function to match columns
v_func <- function(x,y){
  paste('+ rule_fill_discrete_(columns = "',x,'",expression = ~ color_pick(',y,'),colours = identity)',sep='')
}

## Variables to pass
vv = "iris"
x = c("Sepal.Length","Sepal.Width","Petal.Length","Petal.Width")
y = c("Sepal.Length","Sepal.Length","Petal.Length","Petal.Length")

## Do it!
eval(parse(text = paste("condformat(",vv,")",paste(v_func(x,y),collapse=""),sep="")))

Feel free to close issue! Y gracias loco... te pasaste. Suerte con tu tesis.

@zeehio
Copy link
Owner

zeehio commented Jan 10, 2017

I am not a friend of eval(parse()) because it makes code hard to debug. But if it works for you then I am happy.

This would be my solution:

helperfun <- function(data, cols_x, cols_y) {
  stopifnot(length(cols_x) == length(cols_y))
  rule_list <- lapply(seq_len(length(cols_x)), function(i) {
    rule_fill_discrete_(columns = cols_x[i],
                        expression = ~ color_pick(uq(as.name(cols_y[i]))),
                        colours = identity)
  })
  Reduce(`+`, rule_list, init = condformat(data))
}

data(iris)
x <- c("Sepal.Length","Sepal.Width","Petal.Length","Petal.Width")
y <- c("Sepal.Length","Sepal.Length","Petal.Length","Petal.Length")
helperfun(iris, x, y)

This example is one of those cases where for and lapply have differences:

library(lazyeval)

# Using a for loop:
# All the formulas in formulas_for will share the same environment, 
# and after the for loop the value of `i` will be 3.
formulas_for <- list()
for (i in 1:3) {
  formulas_for[[i]] <- ~ i + 1
}

# Using lapply:
formulas_lapply <- lapply(1:3, function(i) ~ i + 1)
# Each formula has its own environment because it belongs to a different function call

# This always returns i+1 because i evaluates to 3 in all the cases (shared i)
print(sapply(formulas_for, function(x) f_eval(x)))
# 4, 4, 4

# This works as I would like to because each formula is evaluated in its own environment:
print(sapply(formulas_lapply, function(x) f_eval(x)))
# 2, 3, 4

Gracias por las pruebas y por los ánimos con la tesis!

@zeehio zeehio closed this as completed Jan 10, 2017
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

No branches or pull requests

2 participants