-
R
I’m most familiar with R, so I like to start there. I created a swap
function that swaps a vector at some indices, along with some helpers
so that I could use pmap_int()
really cleanly.
swap <- function(x, y, v) {
xx <- v[x]
yy <- v[y]
v[x] <- yy
v[y] <- xx
v
}
chr_swap <- function(x, y, v) {
paste0(swap(x, y, v), collapse = "")
}
toInt_swap <- function(x, y, v) {
as.integer(chr_swap(x, y, v))
}
maxmin <- function(num) {
chars <- strsplit(as.character(num), "")[[1]]
n <- nchar(num)
s <- seq_len(n)
opts <- expand.grid(x = s, y = s)
opts$v <- list(chars)
vals <- purrr::pmap_int(opts, toInt_swap)
keeps <- vals[nchar(vals) == n]
c(max(keeps), min(keeps))
}
maxmin(213)
[1] 312 123
maxmin(12345)
[1] 52341 12345
maxmin(100)
[1] 100 100
maxmin(11321)
[1] 31121 11123
The expand.grid()
does create some redundant combinations, but these fall
out naturally so I didn’t bother filtering them out. Also, since this
includes no-op swaps (e.g. swapping index 2
and 2
) it already contains
the original vector. Rather than filtering to the vectors of integers not
starting with 0, I filtered to those which contain the right number of digits
after converting back to integer, which is equivalent.
Try pasting the code into the
{webr} online editor here; I’m not sure
if it’s possible to link to an existing state, but when it asks if you want
to install {purrr} to the interface, respond that you do.
-
APL
In Dyalog APL it’s easier to define a swap function; the @
operator takes a
function (reverse) so s
here performs a swap. The outer product is super
handy for finding all the combinations of x
and y
: x ∘., y
.
maxmin←{
⎕IO←1 ⍝ so that x[1] is subset not x[0]
n←⍎¨⍕⍵ ⍝ convert int to vec
s←{⌽@⍵⊢⍺} ⍝ swap two elements
swaps←{n s ⍵} ⍝ apply swaps to a vec n
opts←,(⍳≢n)∘.,⍳≢n ⍝ combinations of 1..n
new←swaps¨opts ⍝ perform the swaps
keep←(~0=⊃¨new)/new ⍝ filter out values starting with 0
(⌈/,⌊/)10⊥¨keep ⍝ max and min of ints
}
maxmin 213
312 123
maxmin 12345
52341 12345
maxmin 100
100 100
maxmin 11321
31121 11123
I’m quite pleased with this solution; performing a map
is as simple as
using each (¨
) and performing both max
and min
concatenated together
with a fork ((⌈/,⌊/)
) is just so aesthetic. Conversion from a vector of
numbers to a single number uses a base-10 decode (10⊥
) which is how one
might need to do that in other languages, but with a loop.
If I was to take some liberties with what one calls a ‘line’, I could say
that this is a 1-line solution
maxmin←{⎕IO←1 ⋄ n←⍎¨⍕⍵ ⋄ s←{⌽@⍵⊢⍺} ⋄ swaps←{n s ⍵} ⋄ opts←,(⍳≢n)∘.,⍳≢n ⋄ new←swaps¨opts ⋄ keep←(~0=⊃¨new)/new ⋄ (⌈/,⌊/)10⊥¨keep }
You can
try this out yourself at tryapl.org
-
Julia
In Julia the swap
function can use destructuring which is nice, but since
the language uses pass-by-reference semantics, I need to make a copy of the
vector being swapped, otherwise I’ll just keep swapping it over and over.
Note: this recent post of mine.
using Combinatorics
function swap(x, i, j)
y = copy(x)
y[i], y[j] = y[j], y[i]
y
end
function maxmin(x)
nvec = parse.(Int64, split(string(x), ""))
opts = collect(combinations(1:length(nvec), 2))
new = [[nvec]; map(x -> swap(nvec, x...), opts)]
keep = filter(x -> x[1] != 0, new)
vals = parse.(Int64, join.(keep))
(maximum(vals), minimum(vals))
end
maxmin(213)
(312, 123)
maxmin(12345)
(52341, 12345)
maxmin(100)
(100, 100)
maxmin(11321)
(31121, 11123)
The part I probably had the most trouble with here was concatenating together
the original vector with its swapped versions; it looks clean now, but
figuring out how to get those all into the same vector-of-vectors took me a
while.
The splatting of opts
variants in the map
was nice; no need to define the
swap in terms of a tuple. Overall, this is a very clean solution, in my
opinion – Julia really does make for a lovely language.
-
Haskell
Continuing my Haskell-learning journey, I figured it would be best to have a
go at this. As a heavily functional language, one doesn’t do a lot of
defining of variables, instead one writes a lot of functions which will pass
data around. This makes it a bit tricky for testing, but I got there
eventually. I did have to borrow the swapElts
function, and nub
was a new
one for me (essentially unique()
).
import Data.List
import Data.Digits
uniq_pairs l = nub [(x,y) | x <- l, y <- l, x < y]
opts n = uniq_pairs [0..n-1]
-- https://gist.github.com/ijt/2010183
swapElts i j ls = [get k x | (k, x) <- zip [0..length ls - 1] ls]
where get k x | k == i = ls !! j
| k == j = ls !! i
| otherwise = x
doswap t v = swapElts (fst t) (snd t) v
newlist v = v : map (\x -> doswap x v) (opts (length v))
keep v = filter (\x -> (head x /= 0)) (newlist v)
maxmin n = (maximum(x), minimum(x)) where
x = map (unDigits 10) (keep (digits 10 n))
maxmin 213
(312,123)
maxmin 12345
(52341,12345)
maxmin 100
(100,100)
maxmin 11321
(31121,11123)
The Data.Digits
package was very helpful here – having digits
and
unDigits
, though if I was going to use these more I would have curried
the required base 10 into something like digits10
and unDigits10
.
There are likely improvements to be made here, and I’m interested in any you
can spot!
-
Python
“Everyone” uses it, so I gotta learn it… is what I keep telling myself. I’m
no stranger to the quirks of different languages, but every time I try
to do something functional in python I end up angry that the print method for
generators shows the memory address instead of, say, the first few elements.
Printing a value and seeing <map at 0x7fb928d4a2c0>
gets me every. single.
time. Yes, yes, list(value)
“collects” it, but grrr…
Python has the destructuring syntax which is nice in the swap
function, but
again it’s pass-by-reference so I need to make a copy first.
import itertools
def swap(x, t):
y = x.copy()
i, j = t
y[i], y[j] = y[j], y[i]
return y
def minmax(num):
nums = [int(i) for i in str(num)]
opts = itertools.combinations(range(len(nums)), 2)
new = map(lambda x: swap(nums, x), list(opts))
keeps = list(filter(lambda x: x[0] != 0, new))
keeps.append(nums)
vals = list(map(lambda x: int(''.join(map(str, x))), keeps))
return (max(vals), min(vals))
minmax(213)
(312, 123)
minmax(12345)
(52341, 12345)
minmax(100)
(100, 100)
minmax(11321)
(31121, 11123)
Aside from my grumbles while writing it, the solution is still pretty clean.
The calls to list()
interspersed throughout might be avoidable, but the
need to do that while developing at least slowed me down.
-
Rust
I almost didn’t do a Rust solution because I thought I’d done enough. It
ended up being the most complicated, though – I’m not sure if that’s because
of me, or Rust.
use itertools::Itertools;
fn swap(v: Vec<u32>, t1: usize, t2: usize) -> Vec<u32> {
let mut vv = v;
let tmp1 = vv[t1];
let tmp2 = vv[t2];
vv[t1] = tmp2;
vv[t2] = tmp1;
return vv;
}
fn maxmin(num: u32) -> (u32, u32) {
let numc = num.to_string();
let n = numc.len();
let numv: Vec<u32> = numc
.to_string()
.chars()
.map(|c| c.to_digit(10).unwrap())
.collect();
let mut opts = Vec::new();
for (a, b) in (0..n).tuple_combinations() {
opts.push((a, b));
}
let mut new: Vec<Vec<u32>> = Vec::new();
new.push(numv.clone());
for o in opts {
new.push(swap(numv.clone(), o.0, o.1));
}
let keeps: Vec<Vec<u32>> = new.into_iter().filter(|x| x[0] != 0).collect();
let mut vals = Vec::new();
for v in keeps {
let tmp: u32 = v
.clone()
.into_iter()
.map(|x| x.to_string())
.collect::<String>()
.parse()
.unwrap();
vals.push(tmp);
}
let min = *vals.iter().min().unwrap();
let max = *vals.iter().max().unwrap();
(max, min)
}
fn main() {
println!("{:?}", maxmin(213));
println!("{:?}", maxmin(12345));
println!("{:?}", maxmin(100));
println!("{:?}", maxmin(11321))
}
(312, 123)
(52341, 12345)
(100, 100)
(31121, 11123)
This solution reminded me why I like working with array (or
at least vector-supporting) languages; not needing to explicitly loop over
every element of a vector to do something. I had to write a lot of push()
loops to move data around. max()
doesn’t work on a vector (in the sense of
finding the maximum of n elements); it works that way on an iterator, and may
fail, hence the longer min
and max
lines.
Having to clone()
various values explicitly because they can’t be re-used
was a bit annoying, but I understand why it complains about those.
This took longer than I would have liked, but of course I learned more by
doing it.
-
J
At the APL meetup we discussed one partial J solution which used a slightly
different approach to the ‘swap’ algorithm. I’m not sure that there is a
way in J that’s as elegant as the APL solution, but I’d be interested if
there is.
Justus Perlwitz offered
this
solution, the essence of which is
digits =: 10&#.^:_1
sd =: {{
amend =. (|.y)}
swap =. (y { ]) amend ]
swap &.: digits x
}}
cart =: {{
all =. ,/ (,"0)/~ y
uniq =. ~. /:~"1 all
l =. 0{"1 uniq
r =. 1{"1 uniq
(l ~: r) # uniq
}}
swapmaxmin =: {{
ndigits =. [: # digits
combs =. cart i. ndigits y
constr =. ((ndigits y) <: [: ndigits"0 ]) # ]
swaps =. constr y, y sd"1 combs
(>./ , <./) swaps
}}
swapmaxmin 213
312 123
swapmaxmin 12345
52341 12345
swapmaxmin 100
100 100
swapmaxmin 11321
31121 11123
and which you can run in
the J playground
There’s a lot I want to learn about J, so I’ll be digging through this
solution myself.
Summary
I was most pleased with the APL solution; it does what it says on the box
without ambiguity because it’s constructed entirely from primitives (or utility
functions defined in terms of those). The Julia solution also feels very clean,
while the Haskell solution, defined entirely from functions, nicely demonstrates
the functional principle.
I found it to be an interesting example of where pass-by-reference is not so
helpful. For packaged Julia functions that distinction is made clear with the
!
suffix to denote mutating functions, and it’s common to write both a
mutating and non-mutating version wherever possible.
Writing these taught me more and more about using each of these languages, and
I’m of the opinion that just reading solutions is no substitute for getting your
hands dirty in some actual code.
Comments, improvements, or your own solutions are most welcome. I can be found on
Mastodon or use the comments below.
devtools::session_info()
## ─ Session info ───────────────────────────────────────────────────────────────
## setting value
## version R version 4.4.1 (2024-06-14)
## os macOS Sonoma 14.6
## system aarch64, darwin20
## ui X11
## language (EN)
## collate en_US.UTF-8
## ctype en_US.UTF-8
## tz Australia/Adelaide
## date 2024-10-26
## pandoc 3.2 @ /Applications/RStudio.app/Contents/Resources/app/quarto/bin/tools/aarch64/ (via rmarkdown)
##
## ─ Packages ───────────────────────────────────────────────────────────────────
## package * version date (UTC) lib source
## blogdown 1.19 2024-02-01 [1] CRAN (R 4.4.0)
## bookdown 0.41 2024-10-16 [1] CRAN (R 4.4.1)
## bslib 0.8.0 2024-07-29 [1] CRAN (R 4.4.0)
## cachem 1.1.0 2024-05-16 [1] CRAN (R 4.4.0)
## cli 3.6.3 2024-06-21 [1] CRAN (R 4.4.0)
## devtools 2.4.5 2022-10-11 [1] CRAN (R 4.4.0)
## digest 0.6.37 2024-08-19 [1] CRAN (R 4.4.1)
## ellipsis 0.3.2 2021-04-29 [1] CRAN (R 4.4.0)
## evaluate 1.0.1 2024-10-10 [1] CRAN (R 4.4.1)
## fastmap 1.2.0 2024-05-15 [1] CRAN (R 4.4.0)
## fs 1.6.4 2024-04-25 [1] CRAN (R 4.4.0)
## glue 1.8.0 2024-09-30 [1] CRAN (R 4.4.1)
## htmltools 0.5.8.1 2024-04-04 [1] CRAN (R 4.4.0)
## htmlwidgets 1.6.4 2023-12-06 [1] CRAN (R 4.4.0)
## httpuv 1.6.15 2024-03-26 [1] CRAN (R 4.4.0)
## jquerylib 0.1.4 2021-04-26 [1] CRAN (R 4.4.0)
## jsonlite 1.8.9 2024-09-20 [1] CRAN (R 4.4.1)
## knitr 1.48 2024-07-07 [1] CRAN (R 4.4.0)
## later 1.3.2 2023-12-06 [1] CRAN (R 4.4.0)
## lifecycle 1.0.4 2023-11-07 [1] CRAN (R 4.4.0)
## magrittr 2.0.3 2022-03-30 [1] CRAN (R 4.4.0)
## memoise 2.0.1 2021-11-26 [1] CRAN (R 4.4.0)
## mime 0.12 2021-09-28 [1] CRAN (R 4.4.0)
## miniUI 0.1.1.1 2018-05-18 [1] CRAN (R 4.4.0)
## pkgbuild 1.4.4 2024-03-17 [1] CRAN (R 4.4.0)
## pkgload 1.4.0 2024-06-28 [1] CRAN (R 4.4.0)
## profvis 0.4.0 2024-09-20 [1] CRAN (R 4.4.1)
## promises 1.3.0 2024-04-05 [1] CRAN (R 4.4.0)
## purrr 1.0.2 2023-08-10 [1] CRAN (R 4.4.0)
## R6 2.5.1 2021-08-19 [1] CRAN (R 4.4.0)
## Rcpp 1.0.13 2024-07-17 [1] CRAN (R 4.4.0)
## remotes 2.5.0 2024-03-17 [1] CRAN (R 4.4.0)
## rlang 1.1.4 2024-06-04 [1] CRAN (R 4.4.0)
## rmarkdown 2.28 2024-08-17 [1] CRAN (R 4.4.0)
## rstudioapi 0.17.0 2024-10-16 [1] CRAN (R 4.4.1)
## sass 0.4.9 2024-03-15 [1] CRAN (R 4.4.0)
## sessioninfo 1.2.2 2021-12-06 [1] CRAN (R 4.4.0)
## shiny 1.9.1 2024-08-01 [1] CRAN (R 4.4.0)
## urlchecker 1.0.1 2021-11-30 [1] CRAN (R 4.4.0)
## usethis 3.0.0 2024-07-29 [1] CRAN (R 4.4.0)
## vctrs 0.6.5 2023-12-01 [1] CRAN (R 4.4.0)
## xfun 0.48 2024-10-03 [1] CRAN (R 4.4.1)
## xtable 1.8-4 2019-04-21 [1] CRAN (R 4.4.0)
## yaml 2.3.10 2024-07-26 [1] CRAN (R 4.4.0)
##
## [1] /Library/Frameworks/R.framework/Versions/4.4-arm64/Resources/library
##
## ──────────────────────────────────────────────────────────────────────────────