Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
I occasionally like to participate in an odd sport known as ‘code golf’ where the aim is to write some code to achieve a given task using the smallest number of characters.
The tradtional way to cheat at golf is to lower your score
R isn’t optimised for this in the slightest (why would it be?) and there are other languages which have expanded character sets which are, e.g. BQL, MATL, and 05AB1E.
These are typically short, contained problems which can be solved in a variety of ways, so they usually include some restrictions and test cases. Some are more amenable to using R, while others have better support in other languages.
This one caught my eye, partly because my kids are obsessed with Minecraft. The problem as stated:
Minecraft has a fairly unique lighting system. Each block’s light value is either one less than the brightest one surrounding it, or it is a light source itself. Your task is to write a method that takes in a 2D array of light source values, and then returns a 2D array with spread out lighting, where 0 is the minimum value.
Input1 = [
[0, 0, 4, 0],
[0, 0, 0, 0],
[0, 2, 0, 0],
[0, 0, 0, 0]
]
Output1 = [
[2, 3, 4, 3],
[1, 2, 3, 2],
[1, 2, 2, 1],
[0, 1, 1, 0]
]
Input2 = [
[2, 0, 0, 3],
[0, 0, 0, 0],
[0, 0, 0, 0],
[0, 0, 0, 0]
]
Output2 = [
[2, 1, 2, 3],
[1, 0, 1, 2],
[0, 0, 0, 1],
[0, 0, 0, 0]
]
Matrix operations? That sounds like something R can work with. I decided to have a go. There were already some answers using the golfing languages, and I can’t even read those, so those aren’t any help. There was at least one python answer, but I didn’t want to confuse myself trying to translate an existing answer when the tooling doesn’t quite work that way.
Defining the input matrices is straightforward enough
mtest1 <- matrix(c(0, 0, 4, 0,
0, 0, 0, 0,
0, 2, 0, 0,
0, 0, 0, 0), 4, 4, byrow = TRUE)
mtest1
## [,1] [,2] [,3] [,4]
## [1,] 0 0 4 0
## [2,] 0 0 0 0
## [3,] 0 2 0 0
## [4,] 0 0 0 0
mtest2 <- matrix(c(2, 0, 0, 3,
0, 0, 0, 0,
0, 0, 0, 0,
0, 0, 0, 0), 4, 4, byrow = TRUE)
mtest2
## [,1] [,2] [,3] [,4]
## [1,] 2 0 0 3
## [2,] 0 0 0 0
## [3,] 0 0 0 0
## [4,] 0 0 0 0
but do remember to set byrow = TRUE if you’re writing your matrix out … by rows.
I needed a way to identify the locations and values of these light sources. I know that which() can return array indices with arr.ind = TRUE so I tried that
which(mtest1 > 0, arr.ind = TRUE) ## row col ## [1,] 3 2 ## [2,] 1 3
I’ll also need the values at those sources
mtest1[mtest1 > 0] ## [1] 2 4
So far, so good. Now, I’ll need to spread ‘light’ out from each of those sources. That seems… trickier.
A few options came to mind, including a convolution operation, but I couldn’t get that to work. I eventually ended up writing a loop to set decreasing values along the row and column of each light source, forwards and backwards.
for (r in seq_along(y)) {
q <- p <- y[[r]]
q <- rbind(q, data.frame(l=p$l-seq_along(p$c:n)+1, r=p$r, c=p$c:n))
q <- rbind(q, data.frame(l=p$l-seq_along(p$c:1)+1, r=p$r, c=p$c:1))
q <- rbind(q, data.frame(l=p$l-seq_along(p$r:n)+1, r=p$r:n, c=p$c))
q <- rbind(q, data.frame(l=p$l-seq_along(p$r:1)+1, r=p$r:1, c=p$c))
}
This involved creating a data.frame of row and column values, plus the value of the light at that position. This isn’t efficient at all, and not just from the processing side – it uses a lot of characters.
One way to get around this in codegolf is to use a short alias to a longer named function, e.g. d = data.frame, b = rbind. This saves a lot of characters.
The idea of creating indices at which to set values comes from the fact that a matrix can be subset by another matrix that specifies the rows and columns. i.e.
## create a matrix m = matrix(1:9, 3, 3, byrow = TRUE) m ## [,1] [,2] [,3] ## [1,] 1 2 3 ## [2,] 4 5 6 ## [3,] 7 8 9 ## specify the extraction of the elements as (1, 2) and (3, 2) msub = matrix(c(1, 2, 3, 2), 2, 2, byrow = TRUE) msub ## [,1] [,2] ## [1,] 1 2 ## [2,] 3 2 m[msub] ## [1] 2 8
This can essentially ‘un-which()’ a matrix.
Once I had the reduced values in each direction away from a light source, for each light source, the last step was to combine these and take the maximum value at each element. Reduce() does this nicely with the function pmax() (parallel maximum which works across multiple vectors rather than the global maximum).
Lastly, a second pass using all these new points as light sources ensures that the ‘light’ is propagated in all directions.
The solution, as I had it, worked and produced the test case results, but it was not yet golfed.
To “golf” some R code there’s some optimisations we can make.
- Delete spaces where possible
- Use
=over<-to save a character each time - For R>=4.1, use the shorthand syntax for
function()
f=\(x)x^2 f(3) ## [1] 9
- use
TandFforTRUEandFALSE– generally inadvisable in regular code, but here they save some characters. - use partial argument matching where possible – it’s a dangerous feature of the language, but you only “need” to use as many letters of a function argument so that it’s uniquely specified, so
which(mtest1>0, arr.ind = TRUE) ## row col ## [1,] 3 2 ## [2,] 1 3
can be shortened to
which(mtest1>0,a=T) ## row col ## [1,] 3 2 ## [2,] 1 3
- Create aliases to functions – just remember to alias the name of the function, not the call (with parentheses)
d=determinant.matrix identical( d(mtest1), determinant.matrix(mtest1) ) ## [1] TRUE
- Use the prefix notation version of functions which require many characters, e.g.
if
if (3 > 2) {
"res1"
} else {
"res2"
}
vs
`if`(3>2,"res1","res2")
keeping in mind that ifelse() requires the same structure in both returned results (and it evaluates both), which tripped me up
ifelse(TRUE, 1:4, 2) ## [1] 1
With all those in place, I landed at 377 characters for my solution. Certainly not great, considering the python answer was ~200.
I really wanted a better way to “spread” the light out from a single point, but I wasn’t finding any nice solutions to that simpler sub-problem. A great way to get a solution is to ask other people, so I wrote a short post on my new mini blog asking the simpler question of how to achieve this. That cross-posts to Twitter, where June Choe provided a great outer() solution. I’d tried something like that but not so cleverly.
vx <- 4 vy <- 3 vv <- 5 n <- 8 outer(1:n, 1:n, function(x, y) pmax(vv - abs(x - vx) - abs(y - vy), 0)) ## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] ## [1,] 0 1 2 1 0 0 0 0 ## [2,] 1 2 3 2 1 0 0 0 ## [3,] 2 3 4 3 2 1 0 0 ## [4,] 3 4 5 4 3 2 1 0 ## [5,] 2 3 4 3 2 1 0 0 ## [6,] 1 2 3 2 1 0 0 0 ## [7,] 0 1 2 1 0 0 0 0 ## [8,] 0 0 1 0 0 0 0 0
This greatly improves R’s chances at solving this efficiently because now we can condense all the ‘spread light’ stuff into this one function, and because it’s not iterative, we can lapply() over the results.
The “final” version, after some more clean up, is an okay 182 characters
ls=\(m,w=T) {
n=ncol(m)
p=m>1
i=which(p,a=T)
y=lapply(1:nrow(i),\(j)outer(1:n,1:n,\(x,y)pmax(m[p][j]-abs(x-i[j,1])-abs(y-i[j,2]),0)))
z=Reduce(pmax,y)
`if`(w,ls(z,F),z)
}
ls(mtest1)
## [,1] [,2] [,3] [,4]
## [1,] 2 3 4 3
## [2,] 1 2 3 2
## [3,] 1 2 2 1
## [4,] 0 1 1 0
ls(mtest2)
## [,1] [,2] [,3] [,4]
## [1,] 2 1 2 3
## [2,] 1 0 1 2
## [3,] 0 0 0 1
## [4,] 0 0 0 0
I’m still of course interested if there are more optimisations to be made, so do let me know if you can spot any!
< details> < summary> devtools::session_info()
## ─ Session info ─────────────────────────────────────────────────────────────── ## setting value ## version R version 4.1.2 (2021-11-01) ## os Pop!_OS 21.04 ## system x86_64, linux-gnu ## ui X11 ## language en_AU:en ## collate en_AU.UTF-8 ## ctype en_AU.UTF-8 ## tz Australia/Adelaide ## date 2022-03-26 ## ## ─ Packages ─────────────────────────────────────────────────────────────────── ## package * version date lib source ## assertthat 0.2.1 2019-03-21 [3] CRAN (R 4.0.1) ## blogdown 1.8 2022-02-16 [1] CRAN (R 4.1.2) ## bookdown 0.24 2021-09-02 [1] CRAN (R 4.1.2) ## brio 1.1.1 2021-01-20 [3] CRAN (R 4.0.3) ## bslib 0.3.1 2021-10-06 [1] CRAN (R 4.1.2) ## cachem 1.0.3 2021-02-04 [3] CRAN (R 4.0.3) ## callr 3.7.0 2021-04-20 [1] CRAN (R 4.1.2) ## cli 3.2.0 2022-02-14 [1] CRAN (R 4.1.2) ## crayon 1.5.0 2022-02-14 [1] CRAN (R 4.1.2) ## DBI 1.1.1 2021-01-15 [3] CRAN (R 4.0.3) ## desc 1.4.1 2022-03-06 [1] CRAN (R 4.1.2) ## devtools 2.4.3 2021-11-30 [1] CRAN (R 4.1.2) ## digest 0.6.27 2020-10-24 [3] CRAN (R 4.0.3) ## dplyr * 1.0.8 2022-02-08 [1] CRAN (R 4.1.2) ## ellipsis 0.3.2 2021-04-29 [1] CRAN (R 4.1.2) ## evaluate 0.14 2019-05-28 [3] CRAN (R 4.0.1) ## fansi 0.4.2 2021-01-15 [3] CRAN (R 4.0.3) ## fastmap 1.1.0 2021-01-25 [3] CRAN (R 4.0.3) ## forcats * 0.5.1 2021-01-27 [3] CRAN (R 4.0.3) ## fs 1.5.0 2020-07-31 [3] CRAN (R 4.0.2) ## generics 0.1.0 2020-10-31 [3] CRAN (R 4.0.3) ## glue 1.6.1 2022-01-22 [1] CRAN (R 4.1.2) ## htmltools 0.5.2 2021-08-25 [1] CRAN (R 4.1.2) ## jquerylib 0.1.4 2021-04-26 [1] CRAN (R 4.1.2) ## jsonlite 1.7.2 2020-12-09 [3] CRAN (R 4.0.3) ## knitr 1.37 2021-12-16 [1] CRAN (R 4.1.2) ## lifecycle 1.0.1 2021-09-24 [1] CRAN (R 4.1.2) ## magrittr 2.0.1 2020-11-17 [3] CRAN (R 4.0.3) ## memoise 2.0.0 2021-01-26 [3] CRAN (R 4.0.3) ## pillar 1.7.0 2022-02-01 [1] CRAN (R 4.1.2) ## pkgbuild 1.2.0 2020-12-15 [3] CRAN (R 4.0.3) ## pkgconfig 2.0.3 2019-09-22 [3] CRAN (R 4.0.1) ## pkgload 1.2.4 2021-11-30 [1] CRAN (R 4.1.2) ## prettyunits 1.1.1 2020-01-24 [3] CRAN (R 4.0.1) ## processx 3.5.2 2021-04-30 [1] CRAN (R 4.1.2) ## ps 1.5.0 2020-12-05 [3] CRAN (R 4.0.3) ## purrr 0.3.4 2020-04-17 [3] CRAN (R 4.0.1) ## R6 2.5.0 2020-10-28 [3] CRAN (R 4.0.2) ## remotes 2.4.2 2021-11-30 [1] CRAN (R 4.1.2) ## rlang 1.0.1 2022-02-03 [1] CRAN (R 4.1.2) ## rmarkdown 2.13 2022-03-10 [1] CRAN (R 4.1.2) ## rprojroot 2.0.2 2020-11-15 [3] CRAN (R 4.0.3) ## rstudioapi 0.13 2020-11-12 [3] CRAN (R 4.0.3) ## sass 0.4.0 2021-05-12 [1] CRAN (R 4.1.2) ## sessioninfo 1.1.1 2018-11-05 [3] CRAN (R 4.0.1) ## stringi 1.5.3 2020-09-09 [3] CRAN (R 4.0.2) ## stringr 1.4.0 2019-02-10 [3] CRAN (R 4.0.1) ## testthat 3.1.2 2022-01-20 [1] CRAN (R 4.1.2) ## tibble 3.1.6 2021-11-07 [1] CRAN (R 4.1.2) ## tidyselect 1.1.2 2022-02-21 [1] CRAN (R 4.1.2) ## usethis 2.1.5 2021-12-09 [1] CRAN (R 4.1.2) ## utf8 1.1.4 2018-05-24 [3] CRAN (R 4.0.2) ## vctrs 0.3.8 2021-04-29 [1] CRAN (R 4.1.2) ## withr 2.5.0 2022-03-03 [1] CRAN (R 4.1.2) ## xfun 0.30 2022-03-02 [1] CRAN (R 4.1.2) ## yaml 2.2.1 2020-02-01 [3] CRAN (R 4.0.1) ## ## [1] /home/jono/R/x86_64-pc-linux-gnu-library/4.1 ## [2] /usr/local/lib/R/site-library ## [3] /usr/lib/R/site-library ## [4] /usr/lib/R/library
R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.