-
Notifications
You must be signed in to change notification settings - Fork 255
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
accumulate_while #253
Comments
For example of the usefulness of library(purrr)
library(dplyr)
em_cluster <- function(data, expectation, log_likelihood, clusters = 2) {
expectation_lifted <- lift(expectation)
iterate <- function(last) {
# expectation: find the mean/sd of current clusters
estimates <- last %>%
group_by(assignment) %>%
do(expectation_lifted(.)) %>%
tidyr::crossing(data)
# maximization: pick best for each
estimates$likelihood <- do.call(log_likelihood, estimates)
estimates %>%
group_by(observation) %>%
top_n(1, likelihood) %>%
ungroup()
}
not_converged <- ~ !all(.x$assignment == .y$assignment)
data %>%
mutate(assignment = factor(sample(clusters, nrow(data), replace = TRUE))) %>%
accumulate_while(iterate, not_converged, .compare = TRUE) %>%
map2_df(seq_along(.), ~ mutate(.x, iteration = .y))
} For example, Gaussian clustering would be done with: set.seed(2016)
# setup: simulate data
observations <- data_frame(observation = seq_len(1000)) %>%
mutate(oracle = sample(c("A", "B"), n(), TRUE)) %>%
mutate(mu = ifelse(oracle == "A", 0, 4),
x = rnorm(n(), mu, sd = 1))
estimate_normal <- function(x, ...) {
data_frame(mu_hat = mean(x), sd_hat = sd(x))
}
likelihood_normal <- function(x, mu_hat, sd_hat, ...) {
dnorm(x, mu_hat, sd_hat)
}
result <- em_cluster(observations, estimate_normal, likelihood_normal)
result
#> # A tibble: 8,000 × 9
#> observation oracle mu x assignment iteration mu_hat sd_hat
#> <int> <chr> <dbl> <dbl> <fctr> <int> <dbl> <dbl>
#> 1 1 A 0 0.9005550 2 1 NA NA
#> 2 2 A 0 -0.4388189 2 1 NA NA
#> 3 3 B 4 4.1400180 1 1 NA NA
#> 4 4 A 0 0.1586751 1 1 NA NA
#> 5 5 A 0 0.9073702 1 1 NA NA
#> 6 6 A 0 1.6201261 2 1 NA NA
#> 7 7 B 4 4.0466888 1 1 NA NA
#> 8 8 B 4 4.7145865 1 1 NA NA
#> 9 9 A 0 1.0421298 2 1 NA NA
#> 10 10 A 0 0.1820228 2 1 NA NA
#> # ... with 7,990 more rows, and 1 more variables: likelihood <dbl>
library(ggplot2)
ggplot(result, aes(x, fill = assignment)) +
geom_histogram() +
facet_wrap(~ iteration)
|
I think this seems reasonable, so I'd be happy to review a PR. (purrr development will kick off seriously in about a month, so there's no rush) |
This would be useful in conjunction with a way of saving temporary results. This is a case where the user might also want to interrupt, check, and resume computations. I thought at first that mapping environments would be useful for this but @hadley feels this is out of scope for purrr (cf #135). But how about this: saving the current computations in a list, à la ggplot2? Then if interrupted you could check This is starting to feel like base R muckery, and it would feel a bit icky to program with this. Indeed this kind of stuff is for interactive data analysis and one-time scripts. Should it be an adverb? Using the condition system we could check if the user requested saving of computations earlier on the call stack. Maybe we could have something even more general, i.e., you'd supply |
I thing that the naming of this function is a bit misleading. Functions I suggest renaming this function to something else, for example
|
I'm happy to add reduce_while <- function(.x, .f, .p, ..., .init){
out <- reduce_init(.x, .init, left = TRUE)
idx <- reduce_index(.x, .init, left = TRUE)
.f <- as_mapper(.f, ...)
.p <- as_mapper(.p)
for (i in idx) {
if(is_false(.p(out))) break
out <- .f(out, .x[[i]], ...)
}
out
} I implemented this with tail recursive functions using the trampoline pattern but it was very very slow. |
The solution above is a bit incomplete, there is some ambiguity on whether to return the result after the first fail, or from before. I defaulted to before, but implemented this as an argument, issuing PR now. |
In partial resolution of tidyverse#253
This sort of streaming problems might be more relevant for the flowery package. |
Didn't realize this problem was already solved in flowery, perhaps close the issue so others don't spend time on this? |
We are not sure yet what direction we are going to take regarding flowery. This is still experimental. |
Ahh I see, I misunderstood to message on the PR. I'll reopen and try to implement trapping. |
I think it's better to leave the PR in its current state so that your work is saved in the git refs of the tidyverse/purrr repo. You could implement the sentinel in another PR. But it's not clear yet whether we want to do this at all, and whether we'd do it with a sentinel or a signalled condition as you suggested in the PR. At this point it may be more helpful to experiment outside purrr, this could help us take the right design decisions. About sentinel vs condition, I think I'd prefer a sentinel value here, which is the approach taken by Clojure and flowery for this particular problem. I'm not sure I can articulate why though. Another case where we might want to use conditions is to continue mapping on error and throw an aggregated error at the end. This would be an optional behaviour, e.g. |
There's a functional pattern that I think would be useful in purrr: repeat a function until some predicate is met, where the output would then be of an unpredictable size. This would be very useful in iterative algorithms like this EM that run until convergence.
For example, consider this implementation of
accumulate_while
, which (likeaccumulate
) iteratively changes a value while keeping intermediate states, then stops when a predicate is not met:As one minimal example:
There's also a
.compare
option where the predicate takes the last two values, which is very useful for "run until convergence"I can think of other variations as well:
reduce_while
: same, but drop the intermediate statesrerun_while
: performs each trial independently until the result satisfies a condition (like a geometric process), keeps the intermediate result. (Technically a special case ofaccumulate_while
).If you support this I can turn it into a pull request with docs and tests.
(Also note that the final version could easily support an option of
.max
being infinite, and successively doubling the size ofret
when it is reached- I left it out for simplicity here).The text was updated successfully, but these errors were encountered: