You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
512 lines
12 KiB
512 lines
12 KiB
res <- res * ct
|
|
curr <- curr + 1
|
|
if (.x[curr] == "shiny gold") break
|
|
}
|
|
res
|
|
}) %>%
|
|
sum()
|
|
all_simple_paths(ig, 1) %>%
|
|
map(names) %>%
|
|
keep(~"no other" %in% .x)
|
|
all_simple_paths(ig, 1) %>%
|
|
map(names) %>%
|
|
keep(~"no other" %in% .x) -> paths
|
|
paths %>%
|
|
map_dbl(~{
|
|
.x <- rev(head(.x, -1))
|
|
curr <- 1
|
|
res <- 1
|
|
repeat {
|
|
cat(.x[curr+1], .x[curr], "\n")
|
|
ct <- filter(bag_rules, bag_color == .x[curr+1] & contains == .x[curr])$count
|
|
res <- res * ct
|
|
curr <- curr + 1
|
|
if (.x[curr] == "shiny gold") break
|
|
}
|
|
res
|
|
}) %>%
|
|
sum()
|
|
paths %>%
|
|
map_dbl(~{
|
|
.x <- rev(head(.x, -1))
|
|
curr <- 1
|
|
res <- 1
|
|
repeat {
|
|
cat(.x[curr+1], .x[curr], "\n")
|
|
ct <- filter(bag_rules, bag_color == .x[curr+1] & contains == .x[curr])$count
|
|
res <- res * ct
|
|
curr <- curr + 1
|
|
if (.x[curr] == "shiny gold") break
|
|
}
|
|
res
|
|
}) %>%
|
|
{ sum() + lengths(paths) - 1 }
|
|
paths %>%
|
|
map_dbl(~{
|
|
.x <- rev(head(.x, -1))
|
|
curr <- 1
|
|
res <- 1
|
|
repeat {
|
|
cat(.x[curr+1], .x[curr], "\n")
|
|
ct <- filter(bag_rules, bag_color == .x[curr+1] & contains == .x[curr])$count
|
|
res <- res * ct
|
|
curr <- curr + 1
|
|
if (.x[curr] == "shiny gold") break
|
|
}
|
|
res
|
|
}) %>%
|
|
{ sum(.) + lengths(paths) - 1 }
|
|
paths %>%
|
|
map_dbl(~{
|
|
.x <- rev(head(.x, -1))
|
|
curr <- 1
|
|
res <- 1
|
|
repeat {
|
|
cat(.x[curr+1], .x[curr], "\n")
|
|
ct <- filter(bag_rules, bag_color == .x[curr+1] & contains == .x[curr])$count
|
|
res <- res * ct
|
|
curr <- curr + 1
|
|
if (.x[curr] == "shiny gold") break
|
|
}
|
|
res
|
|
})
|
|
paths %>%
|
|
map_dbl(~{
|
|
.x <- rev(head(.x, -1))
|
|
curr <- 1
|
|
res <- 1
|
|
repeat {
|
|
cat(.x[curr+1], .x[curr], "\n")
|
|
ct <- filter(bag_rules, bag_color == .x[curr+1] & contains == .x[curr])$count
|
|
res <- res * ct
|
|
curr <- curr + 1
|
|
if (.x[curr] == "shiny gold") break
|
|
}
|
|
res
|
|
}) %>%
|
|
{ sum(.) + length(paths) - 1 }
|
|
input <- read_lines("/tmp/test.txt")
|
|
input %>%
|
|
stri_match_first_regex(
|
|
"^([[:alpha:][:space:]]+)[[:space:]]bags[[:space:]](.*)$",
|
|
) %>%
|
|
.[,2:3] %>%
|
|
as.data.frame() %>%
|
|
as_tibble() %>%
|
|
rename(
|
|
bag_color = 1,
|
|
rule = 2
|
|
) %>%
|
|
separate_rows(rule, sep=", ") %>%
|
|
mutate(
|
|
count = case_when(
|
|
stri_detect_regex(rule, "^[[:digit:]]") ~ stri_match_first_regex(rule, "^([[:digit:]]+)")[,2],
|
|
stri_detect_regex(rule, "contain [[:digit:]]") ~ stri_match_first_regex(rule, "^contain ([[:digit:]]+)")[,2],
|
|
stri_detect_fixed(rule, "no other") ~ "0"
|
|
) %>%
|
|
as.integer(),
|
|
contains = stri_match_first_regex(rule, "[[:space:]]([[:alpha:][:space:]]+)[[:space:]]ba")[,2]
|
|
) %>%
|
|
select(bag_color, contains, count) -> bag_rules
|
|
bag_rules %>%
|
|
select(
|
|
to = bag_color,
|
|
from = contains
|
|
) %>%
|
|
graph_from_data_frame(directed = TRUE) -> g
|
|
g %>%
|
|
subcomponent("shiny gold", "out") %>%
|
|
names() %>%
|
|
grep("shiny gold|no other", ., value = TRUE, invert = TRUE) %>%
|
|
length()
|
|
igraph::bfs(
|
|
graph = g,
|
|
root = "shiny gold",
|
|
neimode = "out",
|
|
unreachable = FALSE,
|
|
father = TRUE,
|
|
pred = TRUE,
|
|
) -> tmp
|
|
ig <- induced_subgraph(g, na.exclude(as.numeric(tmp$order)), impl = "create_from_scratch")
|
|
all_simple_paths(ig, 1) %>%
|
|
map(names) %>%
|
|
keep(~"no other" %in% .x) -> paths
|
|
paths %>%
|
|
map_dbl(~{
|
|
.x <- rev(head(.x, -1))
|
|
curr <- 1
|
|
res <- 1
|
|
repeat {
|
|
cat(.x[curr+1], .x[curr], "\n")
|
|
ct <- filter(bag_rules, bag_color == .x[curr+1] & contains == .x[curr])$count
|
|
res <- res * ct
|
|
curr <- curr + 1
|
|
if (.x[curr] == "shiny gold") break
|
|
}
|
|
res
|
|
}) %>%
|
|
{ sum(.) + length(paths) - 1 }
|
|
paths %>%
|
|
map_dbl(~{
|
|
.x <- rev(head(.x, -1))
|
|
curr <- 1
|
|
res <- 1
|
|
repeat {
|
|
ct <- filter(bag_rules, bag_color == .x[curr+1] & contains == .x[curr])$count
|
|
cat(.x[curr+1], .x[curr], ct, "\n")
|
|
res <- res * ct
|
|
curr <- curr + 1
|
|
if (.x[curr] == "shiny gold") break
|
|
}
|
|
res
|
|
}) %>%
|
|
{ sum(.) + length(paths) - 1 }
|
|
all_simple_paths(ig, 1) %>%
|
|
map(names) -> paths
|
|
paths %>%
|
|
map_dbl(~{
|
|
.x <- rev(head(.x, -1))
|
|
curr <- 1
|
|
res <- 1
|
|
repeat {
|
|
ct <- filter(bag_rules, bag_color == .x[curr+1] & contains == .x[curr])$count
|
|
cat(.x[curr+1], .x[curr], ct, "\n")
|
|
res <- res * ct
|
|
curr <- curr + 1
|
|
if (.x[curr] == "shiny gold") break
|
|
}
|
|
res
|
|
}) %>%
|
|
{ sum(.) + length(paths) - 1 }
|
|
paths
|
|
all_simple_paths(ig, 1) %>%
|
|
map(names) %>%
|
|
keep(~"no other" %in% .x) -> paths
|
|
paths %>%
|
|
map_dbl(~{
|
|
# .x <- rev(head(.x, -1))
|
|
.x <- rev(.x)
|
|
curr <- 1
|
|
res <- 1
|
|
repeat {
|
|
ct <- filter(bag_rules, bag_color == .x[curr+1] & contains == .x[curr])$count
|
|
cat(.x[curr+1], .x[curr], ct, "\n")
|
|
res <- res * ct
|
|
curr <- curr + 1
|
|
if (.x[curr] == "shiny gold") break
|
|
}
|
|
res
|
|
}) %>%
|
|
{ sum(.) + length(paths) - 1 }
|
|
paths %>%
|
|
map_dbl(~{
|
|
# .x <- rev(head(.x, -1))
|
|
.x <- rev(.x)
|
|
curr <- 1
|
|
res <- 0
|
|
repeat {
|
|
ct <- filter(bag_rules, bag_color == .x[curr+1] & contains == .x[curr])$count
|
|
cat(.x[curr+1], .x[curr], ct, "\n")
|
|
if (ct == 0) {
|
|
res <- res + 1
|
|
} else {
|
|
res <- res*ct
|
|
}
|
|
curr <- curr + 1
|
|
if (.x[curr] == "shiny gold") break
|
|
}
|
|
res
|
|
}) %>%
|
|
{ sum(.) + length(paths) - 1 }
|
|
paths %>%
|
|
map_dbl(~{
|
|
# .x <- rev(head(.x, -1))
|
|
.x <- rev(.x)
|
|
curr <- 1
|
|
res <- 0
|
|
repeat {
|
|
ct <- filter(bag_rules, bag_color == .x[curr+1] & contains == .x[curr])$count
|
|
cat(.x[curr+1], .x[curr], ct, "\n")
|
|
if (ct == 0) {
|
|
res <- res + 1
|
|
} else {
|
|
res <- res + res*ct
|
|
}
|
|
curr <- curr + 1
|
|
if (.x[curr] == "shiny gold") break
|
|
}
|
|
res
|
|
}) %>%
|
|
{ sum(.) + length(paths) - 1 }
|
|
paths %>%
|
|
map_dbl(~{
|
|
# .x <- rev(head(.x, -1))
|
|
.x <- rev(.x)
|
|
curr <- 1
|
|
res <- 0
|
|
repeat {
|
|
ct <- filter(bag_rules, bag_color == .x[curr+1] & contains == .x[curr])$count
|
|
cat(.x[curr+1], .x[curr], ct, "\n")
|
|
if (ct == 0) {
|
|
res <- res + 1
|
|
} else {
|
|
res <- res*ct
|
|
}
|
|
curr <- curr + 1
|
|
if (.x[curr] == "shiny gold") break
|
|
}
|
|
res
|
|
}) %>%
|
|
{ sum(.) + length(paths) - 1 }
|
|
paths %>%
|
|
map_dbl(~{
|
|
counter <- function(path, start) {
|
|
if (path[start] == "no other") return(1)
|
|
ct <- filter(bag_rules, bag_color == .x[curr] & contains == .x[curr+1])$count
|
|
return(ct * counter(path, start+1))
|
|
}
|
|
counter(.x, 1)
|
|
})
|
|
paths %>%
|
|
map_dbl(~{
|
|
counter <- function(path, start) {
|
|
if (path[start] == "no other") return(1)
|
|
ct <- filter(bag_rules, bag_color == .x[start] & contains == .x[start+1])$count
|
|
return(ct * counter(path, start+1))
|
|
}
|
|
counter(.x, 1)
|
|
})
|
|
paths %>%
|
|
map_dbl(~{
|
|
counter <- function(path, start) {
|
|
if (path[start] == "no other") return(1)
|
|
ct <- filter(bag_rules, bag_color == .x[start] & contains == .x[start+1])$count
|
|
cat(.x[curr+1], .x[curr], ct, "\n")
|
|
return(ct * counter(path, start+1))
|
|
}
|
|
counter(.x, 1)
|
|
})
|
|
paths %>%
|
|
map_dbl(~{
|
|
counter <- function(path, start) {
|
|
if (path[start] == "no other") return(1)
|
|
ct <- filter(bag_rules, bag_color == .x[start] & contains == .x[start+1])$count
|
|
cat(.x[start], .x[start+1], ct, "\n")
|
|
return(ct * counter(path, start+1))
|
|
}
|
|
counter(.x, 1)
|
|
})
|
|
paths %>%
|
|
map_dbl(~{
|
|
counter <- function(path, start) {
|
|
if (path[start] == "no other") return(1)
|
|
ct <- filter(bag_rules, bag_color == .x[start] & contains == .x[start+1])$count)
|
|
cat(.x[start], .x[start+1], ct, "\n")
|
|
if (ct == 0) ct <- 1
|
|
return(ct * counter(path, start+1))
|
|
}
|
|
counter(.x, 1)
|
|
})
|
|
paths %>%
|
|
map_dbl(~{
|
|
counter <- function(path, start) {
|
|
if (path[start] == "no other") return(1)
|
|
ct <- filter(bag_rules, bag_color == .x[start] & contains == .x[start+1])$count
|
|
cat(.x[start], .x[start+1], ct, "\n")
|
|
if (ct == 0) ct <- 1
|
|
return(ct * counter(path, start+1))
|
|
}
|
|
counter(.x, 1)
|
|
})
|
|
paths
|
|
ig
|
|
all_simple_paths
|
|
all_simple_paths(ig, 1) %>%
|
|
map(names) %>%
|
|
keep(~"no other" %in% .x) -> paths
|
|
paths
|
|
all_simple_paths(ig, 1) %>%
|
|
map(names)
|
|
paths %>%
|
|
map_dbl(~{
|
|
counter <- function(path, start) {
|
|
if (path[start] == "no other") return(1)
|
|
ct <- filter(bag_rules, bag_color == .x[start] & contains == .x[start+1])$count
|
|
cat(.x[start], .x[start+1], ct, "\n")
|
|
if (ct == 0) ct <- 1
|
|
return(ct * counter(path, start+1))
|
|
}
|
|
counter(.x, 1)
|
|
})
|
|
paths %>%
|
|
map_dbl(~{
|
|
counter <- function(path, start) {
|
|
if (path[start] == "no other") return(1)
|
|
ct <- filter(bag_rules, bag_color == .x[start] & contains == .x[start+1])$count
|
|
cat(.x[start], .x[start+1], ct, "\n")
|
|
if (ct == 0) ct <- 1
|
|
return(ct + ct * counter(path, start+1))
|
|
}
|
|
counter(.x, 1)
|
|
})
|
|
2 * ( 2 * (2 * ( 2 * ( 2 * (2)))))
|
|
# input <- read_lines("/tmp/test.txt")
|
|
input <- read_lines("/tmp/test-orig.txt")
|
|
input %>%
|
|
stri_match_first_regex(
|
|
"^([[:alpha:][:space:]]+)[[:space:]]bags[[:space:]](.*)$",
|
|
) %>%
|
|
.[,2:3] %>%
|
|
as.data.frame() %>%
|
|
as_tibble() %>%
|
|
rename(
|
|
bag_color = 1,
|
|
rule = 2
|
|
) %>%
|
|
separate_rows(rule, sep=", ") %>%
|
|
mutate(
|
|
count = case_when(
|
|
stri_detect_regex(rule, "^[[:digit:]]") ~ stri_match_first_regex(rule, "^([[:digit:]]+)")[,2],
|
|
stri_detect_regex(rule, "contain [[:digit:]]") ~ stri_match_first_regex(rule, "^contain ([[:digit:]]+)")[,2],
|
|
stri_detect_fixed(rule, "no other") ~ "0"
|
|
) %>%
|
|
as.integer(),
|
|
contains = stri_match_first_regex(rule, "[[:space:]]([[:alpha:][:space:]]+)[[:space:]]ba")[,2]
|
|
) %>%
|
|
select(bag_color, contains, count) -> bag_rules
|
|
bag_rules %>%
|
|
select(
|
|
to = bag_color,
|
|
from = contains
|
|
) %>%
|
|
graph_from_data_frame(directed = TRUE) -> g
|
|
g %>%
|
|
subcomponent("shiny gold", "out") %>%
|
|
names() %>%
|
|
grep("shiny gold|no other", ., value = TRUE, invert = TRUE) %>%
|
|
length()
|
|
igraph::bfs(
|
|
graph = g,
|
|
root = "shiny gold",
|
|
neimode = "out",
|
|
unreachable = FALSE,
|
|
father = TRUE,
|
|
pred = TRUE,
|
|
) -> tmp
|
|
ig <- induced_subgraph(g, na.exclude(as.numeric(tmp$order)), impl = "create_from_scratch")
|
|
all_simple_paths(ig, 1) %>%
|
|
map(names) %>%
|
|
keep(~"no other" %in% .x) -> paths
|
|
paths %>%
|
|
map_dbl(~{
|
|
counter <- function(path, start) {
|
|
if (path[start] == "no other") return(1)
|
|
ct <- filter(bag_rules, bag_color == .x[start] & contains == .x[start+1])$count
|
|
if (ct == 0) ct <- 1
|
|
cat(.x[start], .x[start+1], ct, "\n")
|
|
return(ct * counter(path, start+1))
|
|
}
|
|
counter(.x, 1)
|
|
})
|
|
paths %>%
|
|
map_dbl(~{
|
|
counter <- function(path, start) {
|
|
if (path[start] == "no other") return(1)
|
|
ct <- filter(bag_rules, bag_color == .x[start] & contains == .x[start+1])$count
|
|
if (ct == 0) ct <- 1
|
|
cat(.x[start], .x[start+1], ct, "\n")
|
|
return(ct * counter(path, start+1))
|
|
}
|
|
counter(.x, 1)
|
|
}) %>%
|
|
sum()
|
|
paths %>%
|
|
map_dbl(~{
|
|
counter <- function(path, start) {
|
|
if (path[start] == "no other") return(1)
|
|
ct <- filter(bag_rules, bag_color == .x[start] & contains == .x[start+1])$count
|
|
if (ct == 0) ct <- 1
|
|
cat(.x[start], .x[start+1], ct, "\n")
|
|
return(ct * counter(path, start+1) + 1)
|
|
}
|
|
counter(.x, 1)
|
|
}) %>%
|
|
sum()
|
|
paths %>%
|
|
map_dbl(~{
|
|
counter <- function(path, start) {
|
|
if (path[start] == "no other") return(1)
|
|
ct <- filter(bag_rules, bag_color == .x[start] & contains == .x[start+1])$count
|
|
bag <- if (ct == 0) 0 else 1
|
|
cat(.x[start], .x[start+1], ct, "\n")
|
|
return(ct * counter(path, start+1) + bag)
|
|
}
|
|
counter(.x, 1)
|
|
}) %>%
|
|
sum()
|
|
paths %>%
|
|
map_dbl(~{
|
|
counter <- function(path, start) {
|
|
if (path[start] == "no other") return(1)
|
|
ct <- filter(bag_rules, bag_color == .x[start] & contains == .x[start+1])$count
|
|
bag <- if (ct == 0) 0 else 1
|
|
cat(.x[start], .x[start+1], ct, "\n")
|
|
return(bag * counter(path, start+1) + bag)
|
|
}
|
|
counter(.x, 1)
|
|
}) %>%
|
|
sum()
|
|
paths %>%
|
|
map_dbl(~{
|
|
counter <- function(path, start) {
|
|
if (path[start] == "no other") return(1)
|
|
ct <- filter(bag_rules, bag_color == .x[start] & contains == .x[start+1])$count
|
|
bag <- if (ct == 0) 0 else 1
|
|
if (ct == 0) ct <- 1
|
|
cat(.x[start], .x[start+1], ct, "\n")
|
|
return(ct * counter(path, start+1) + bag)
|
|
}
|
|
counter(.x, 1)
|
|
}) %>%
|
|
sum()
|
|
paths %>%
|
|
map_dbl(~{
|
|
counter <- function(path, start) {
|
|
if (path[start] == "no other") return(1)
|
|
ct <- filter(bag_rules, bag_color == .x[start] & contains == .x[start+1])$count
|
|
bag <- if (ct == 0) 0 else 1
|
|
if (ct == 0) ct <- 1
|
|
cat(.x[start], .x[start+1], ct, "\n\n")
|
|
return(ct * counter(path, start+1) + bag)
|
|
}
|
|
counter(.x, 1)
|
|
}) %>%
|
|
sum()
|
|
(1 + 3 + 1 + 4 + 1 + 2 + 5 + 1 + 2 + 6 + 1)
|
|
length(paths)
|
|
27+4
|
|
paths %>%
|
|
map_dbl(~{
|
|
counter <- function(path, start) {
|
|
if (path[start] == "no other") return(0)
|
|
ct <- filter(bag_rules, bag_color == .x[start] & contains == .x[start+1])$count
|
|
if (ct == 0)
|
|
return(ct * counter(path, start+1) + bag)
|
|
}
|
|
1 + counter(.x, 1)
|
|
}) %>%
|
|
sum()
|
|
1 + (1*3) + (1*4) + 2 + (2*5) + (2*6)
|
|
all_simple_paths(ig, 1)
|
|
all_simple_paths(ig, 1) %>%
|
|
map(names)
|
|
all_simple_paths(ig, 1) %>%
|
|
map_chr(names)
|
|
all_simple_paths(ig, 1) %>%
|
|
map(names)
|
|
all_simple_paths(ig, 1) %>%
|
|
map(names) -> paths
|
|
for (path in paths) {
|
|
ct <- filter(bag_rules, bag_color == .x[start] & contains == .x[start+1])$count
|
|
cat(path, ct, "\n")
|
|
}
|
|
|