Le Monde puzzle [#1154]
The weekly puzzle from Le Monde is another Sudoku challenge:
An n by n grid contains all numbers from 1 till n². Is it possible for fill the grid so that every row and every column has an integer average, for n=5, 7 9?
By sheer random search
`?`=rowSums; `+`=sample
o=function(n){
x=matrix(+(n^2),n)
while(any(c(?x,?t(x))%%n))x=x/x*+x
x}
I found solutions for n=3,4,5, quite easily,
[,1] [,2] [,3] [,4] [,5] [1,] 20 15 14 13 3 [2,] 21 4 25 6 9 [3,] 2 1 23 18 11 [4,] 17 12 22 24 5 [5,] 10 8 16 19 7
correction, for n=6 as well
[,1] [,2] [,3] [,4] [,5] [,6] [1,] 4 12 11 23 8 32 [2,] 17 15 14 33 5 30 [3,] 35 28 27 7 13 22 [4,] 31 1 6 2 21 29 [5,] 25 36 20 34 16 19 [6,] 26 10 24 3 9 18
but larger values of n require a less frontal attack… Simulated annealing maybe.
Xi'an's Og 
August 27, 2020 at 6:35 pm
an image of my code https://ibb.co/NVMJ6G2
August 26, 2020 at 10:32 am
This is much easier, as there is a simple algorithm by Euler to generate a magic square for any odd n, and the mean of each row and each column, as well as the main diagonals is (n²+1)/2. Regarding even n, this is less simple, but Euler’s general algorithm may provide some hints.
August 25, 2020 at 1:19 pm
An initial idea (not yet converted to an algorithm).
For n odd, it is enough to create the corresponding magic square (https://www.dcode.fr/magic-square). For n even, greater than 2, start from the corresponding magic square and select pairs of columns so that they include numbers (in different rows) with a difference of n / 2. For each column pair, change the positions of those numbers and ignore the corresponding rows and columns for the rest of the procedure.
August 27, 2020 at 6:14 pm
My code for even numbered tables (not optimized! – I could’t avoid random sampling).
Start by getting the corresponding magic square from : https://www.dcode.fr/magic-square
library(dplyr)
df con,header=FALSE);close(con)
df2 <- df # number of possible replacements
df3 <- df # the results
init.df <- df
n <- nrow(df)/2
for (k in 1:n){
# table with the number of possible replacements for each value
for (i in 1:nrow(df)){
for (j in 1:ncol(df)){
temp <- df[-i,-j]
x <- df[i,j]+n*c(seq(1,4*n-1,by=2),-seq(1,4*n-1,by=2))
df2[i,j] <- sum(x %in% unname(unlist(temp)))
}
}
# starting column
var <- names(sort(colSums(df2)))[1]
# select min or max number of possible replacements (??)
min.val 0,var]),min(df2[df2[,var]>0,var]))
# the corresponding value
val <- df[df2[,var]==min.val,var][1]
row.num <- which(df==val,arr.ind = T)[1]
row.num.init <- which(init.df==val,arr.ind = T)[1]
temp % filter(!row_number() %in% c(row.num)) %>%
select(-all_of(var))
v <- c(seq(1,4*n-1,by=2),-seq(1,4*n-1,by=2))
x <- val+n*v[sample.int(length(v))]
res 0)
# the replacement value
repl <- x[res][1]
# where is it?
pos <- which(df==repl,arr.ind = T)
pos.init <- which(init.df==repl,arr.ind = T)
df3[row.num.init,var] <- repl
df3[pos.init] <- val
vars <- c(var, names(df)[pos[2]])
df % filter(!row_number() %in% c(row.num,pos[1])) %>%
dplyr::select(-all_of(vars))
df2 <- df
}
# select all of the above and run it until you get no error
rowMeans(df3)
colMeans(df3)
August 28, 2020 at 8:31 am
Thank you!