Code Golf: проверка сетки судоку

Введение

Действительная сетка судоку заполнена числами от 1 до 9, причем число не встречается более одного раза в каждом подблоке из 9, строки или столбца. Прочтите эту статью для получения дополнительных сведений, если вы не знакомы с этой популярной головоломкой.

Вызов

Задача состоит в том, чтобы написать самую короткую программу, которая проверяет сетку судоку, которая может быть не заполнена.

На входе будет строка из 9 строк по 9 символов в каждой, представляющая сетку. Пустая ячейка будет представлена ​​.. Ваш вывод должен быть Valid, если сетка действительна, иначе выведите Invalid.

Пример

Вход

123...789
...456...
456...123
789...456
...123...
564...897
...231...
897...564
...564...

Вывод

Valid

Вход

123456789
987654321
123456789
123456789
987654321
123456789
123456789
987654321
123456789

Вывод

Invalid

Кодекс правил игры в гольф

Разместите кратчайший код на любом языке, который решает эту проблему. Ввод и вывод можно обрабатывать через stdin и stdout или другие файлы по вашему выбору.

Победителем будет кратчайшее решение (по количеству байтов) на языке, реализация которого существовала до публикации этого вопроса. Таким образом, хотя вы можете использовать только что придуманный вами язык, чтобы отправить 0-байтовое решение, оно не будет учитываться, и вы, вероятно, получите отрицательные голоса.


person Community    schedule 10.12.2010    source источник
comment
Что делает неполную головоломку недействительной? Имеете несколько решений? Нет решений?   -  person Gabe    schedule 10.12.2010
comment
@Gabe Действительная сетка определена во вступлении, например, сетка с двумя единицами в первой строке недействительна.   -  person moinudin    schedule 10.12.2010
comment
В вашем вступлении говорится, что действительная сетка судоку заполнена числами от 1 до 9, но затем вы говорите, что могут быть пустые ячейки. Поскольку пустые ячейки не имеют номеров от 1 до 9, это означает, что неполная головоломка недопустима. Это противоречит вашему примеру, поэтому я прошу пояснений.   -  person Gabe    schedule 10.12.2010
comment
@Gabe Нет необходимости проверять решения, валидность определяется только тем, есть ли какие-либо незаконные размещения чисел в предоставленной сетке.   -  person moinudin    schedule 10.12.2010
comment
@marcog: Вы понимаете, что сетка может удовлетворить эти требования, но по-прежнему не имеет решений? (Например, представьте, что верхняя левая ячейка пуста, а остальная часть верхней строки содержит 2–9, а оставшаяся часть крайнего левого столбца содержит 1–8. В левой верхней ячейке не может быть одновременно 1 и 9.)   -  person j_random_hacker    schedule 10.12.2010
comment
@j_random_hacker цель состоит в том, чтобы отклонить доску, если она недопустима на первый взгляд, а не если она неразрешима.   -  person hobbs    schedule 10.12.2010
comment
Бьюсь об заклад, для этого есть одно регулярное выражение Perl в стиле nqueens ...   -  person    schedule 11.12.2010
comment
Боже мой: 5 решений Perl. Напомните, нафига вопросы по гольфу CW?   -  person Nakilon    schedule 11.12.2010
comment
Примите участие в новом предложении по созданию собственной платформы обмена стеками для сложных и непонятных вопросов: area51.stackexchange.com/proposals/4570/   -  person fuz    schedule 13.12.2010


Ответы (14)


Гольфскрипт: 56

n%{zip''+9/.{'.'-..&=}%$0=\}:|2*{3/}%|;**"InvV"3/="alid"
person Community    schedule 10.12.2010

C: 165 162 161 160 159

int v[1566],x,y=9,c,b;main(){while(y--)for(x=9;x--+1;)if((c
=getchar()*27)>1242)b|=v[x+c]++|v[y+9+c]++|v[x-x%3+y/3+18+c]
++;puts(b?"Invalid":"Valid");return 0;}

Две новые строки не нужны. Один символ, спасенный josefx :-) ...

person Community    schedule 11.12.2010
comment
Я часто задаю вопрос: как мне научиться писать такой код? Впечатляющий. - person hol; 16.12.2010
comment
@josefx: нет ... это не было бы эквивалентом. Эквивалент будет --x>-2 или x-->=0, но они одинаковой длины. x должен считать от 8 до -1 (включительно; 10-й символ - это новая строка), чтобы можно было использовать x-x%3 или x/3*3 в формуле селектора блока 3x3. Подумывал поменять торцевую часть на return 0>puts(...);. Это сделало бы его лучшим гражданином (то есть возвращение ненулевого кода статуса, если установка не удалась), но все еще той же длины. - person 6502; 28.12.2010
comment
@ 6502 ты прав, не знаю, как мне удалось перепутать --x и x--. - person josefx; 30.12.2010
comment
моя последняя попытка: замена x - ›- 1; с x - + 1; - person josefx; 30.12.2010

Haskell: 207 230 218 195 172

import List
t=take 3
h=[t,t.drop 3,drop 6]
v[]="V"
v _="Inv"
f s=v[1|v<-[s,transpose s,[g=<<f s|f<-h,g<-h]],g<-map(filter(/='.'))v,g/=nub g]++"alid\n"
main=interact$f.lines
person Community    schedule 10.12.2010
comment
К сожалению, 207-символьное решение было неверным: оно сравнивало группы, а не отдельные строки / столбцы / блоки, и не фильтровало точки. - person Joey Adams; 10.12.2010
comment
И снова: замените Data.List на List и Control.Monad на Monad. Удалите let и поместите h как объявление верхнего уровня. Измените do-notation на явные монады. Но действительно очень мило. - person fuz; 10.12.2010
comment
@FUZxxl: Спасибо, готово. Обратите внимание, что я все еще должен сказать Control.Monad, потому что replicateM недоступен в Monad, только в Control.Monad. - person Joey Adams; 10.12.2010
comment
Как насчет replicate 9`liftM`getLine вместо replicateM? И продвигайте эту лямбду к правильной функции, заменяя if-than-else на pattern-guards. Обычно короче. - person fuz; 11.12.2010
comment
PS: Вы знаете, вы можете разместить все защитные ограждения на линии, например: f x|a=0|b=1 - person fuz; 11.12.2010
comment
@Joey Adams: Вы даже можете удалить этот импорт с помощью replicate 9fmapgetLine! - person fuz; 14.12.2010
comment
@FUZxxl: replicate 9 `liftM` getLine - это не то же самое, что replicateM 9 getLine. Хотя они оба имеют один и тот же тип IO [String], первый выполняет действие только один раз, повторяя его результат 9 раз. - person Joey Adams; 14.12.2010
comment
@FUZxxl: Однако я заменил replicateM 9 getLine на getContents >>= … . lines, сохранив 22 символа. Я также заменил if / then функцией v и сопоставлением с образцом, сохранив 1 символ. - person Joey Adams; 14.12.2010
comment
@ Джои Адамс: Извини. Слишком устал для этого. Как насчет interact? - person fuz; 14.12.2010
comment
Я думаю, также стоит сделать take 3 собственную функцию и по возможности использовать transpose. - person fuz; 14.12.2010
comment
@FUZxxl: Спасибо, они, безусловно, помогли! Когда я писал это, я думал о функции transpose, но понятия не имел, что она есть в стандартных библиотеках. - person Joey Adams; 14.12.2010

Perl: 168 128

$_=join'',<>;@a=/.../g;print+(/(\d)([^\n]{0,8}|(.{10})*.{9})\1/s
+map"@a[$_,$_+3,$_+6]"=~/(\d).*\1/,0..2,9..11,18..20)?Inv:V,alid

Первое регулярное выражение проверяет наличие дубликатов в той же строке и столбце; второе регулярное выражение обрабатывает дубликаты в «том же поле».

Дальнейшее улучшение возможно, если заменить \n в первом регулярном выражении буквальным переводом строки (1 символ) или> = Perl 5.12, заменив [^\n] на \N (3 символа).

Раньше решение с 168 символами: ввод осуществляется через стандартный ввод, вывод - на stderr, потому что это упрощает задачу. Переносы строк не обязательны и не учитываются.

$_=join'',<>;$m=alid.$/;$n=Inv.$m;/(\d)(\N{0,8}|(.{10})*.{9})\1/s&&
die$n;@a=/.../g;for$i(0,8,17){for$j($i..$i+2){
$_=$a[$j].$a[$j+3].$a[$j+6];/(\d).*\1/&&die$n}}die"V$m"
person Community    schedule 10.12.2010
comment
Я получаю сообщение об ошибке Константа (\ N {0,8}) unknown: (возможно, отсутствует использование charnames ...) на моем Perl v5.10.0. Глядя на определение \N, похоже, что оно предназначено для именованных символов Юникода - как вы пытаетесь использовать его здесь? - person j_random_hacker; 10.12.2010
comment
Как оказалось, @j_random_hacker работает только на 5.12.0+ :) Это означает что угодно, кроме новой строки, это то же самое, что . означает, когда /s отключен, за исключением того, что он работает независимо от /s. - person hobbs; 10.12.2010

Python: 230 221 200 185

Сначала читаемую версию с len = 199:

import sys
r=range(9)
g=[raw_input()for _ in r]
s=[[]for _ in r*3]
for i in r:
 for j in r:
  n=g[i][j]
  for x in i,9+j,18+i/3*3+j/3:
<T>if n in s[x]:sys.exit('Invalid')
<T>if n>'.':s[x]+=n
print'Valid'

Поскольку SO не отображает символы табуляции, я использовал <T> для представления одного символа табуляции.

PS. тот же подход уменьшен до 185 символов:

r=range(9)
g=[raw_input()for _ in r]
s=['']*27
for i in r:
 for j in r:
    for x in i,9+j,18+i/3*3+j/3:n=g[i][j];s[x]+=n[:n>'.']
print['V','Inv'][any(len(e)>len(set(e))for e in s)]+'alid'
person Community    schedule 10.12.2010
comment
заменен список цифр со строкой цифр (так как они 1..9), что позволило несколько сократить код. читабельность пострадала, хотя - person Nas Banov; 10.12.2010

Perl, 153 символа

@B содержит 81 элемент платы.

&E проверяет, содержит ли подмножество @B повторяющиеся цифры

основной цикл проверяет каждый столбец, «блок» и строку головоломки.

sub E{$V+="@B[@_]"=~/(\d).*\1/}
@B=map/\S/g,<>;
for$d(@b=0..80){
E grep$d==$_%9,@b;
E grep$d==int(($_%9)/3)+3*int$_/27,@b;
E$d*9..$d*9+8}
print$V?Inv:V,alid,$/
person Community    schedule 10.12.2010
comment
Я также могу уменьшить алгоритм Хоббса до 136 символов. - person mob; 11.12.2010
comment
Мне нравится фрагмент массива @B в E. - person j_random_hacker; 11.12.2010

Python: 159 158

v=[0]*244
for y in range(9):
 for x,c in enumerate(raw_input()):
  if c>".":
<T>for k in x,y+9,x-x%3+y//3+18:v[k*9+int(c)]+=1
print["Inv","V"][max(v)<2]+"alid"

‹T› - это символ табуляции

person Community    schedule 10.12.2010

Common Lisp: 266 252

(princ(let((v(make-hash-table))(r "Valid"))(dotimes(y 9)(dotimes(x
10)(let((c(read-char)))(when(>(char-code c)46)(dolist(k(list x(+ 9
y)(+ 18(floor(/ y 3))(- x(mod x 3)))))(when(>(incf(gethash(+(* k
9)(char-code c)-49)v 0))1)(setf r "Invalid")))))))r))
person Community    schedule 11.12.2010

Perl: 186

Ввод осуществляется со стандартного ввода, вывод - со стандартного вывода, разрывы строк во вводе необязательны.

@y=map/\S/g,<>;
sub c{(join'',map$y[$_],@$h)=~/(\d).*\1/|c(@_)if$h=pop}
print(('V','Inv')[c map{$x=$_;[$_*9..$_*9+8],[grep$_%9==$x,0..80],[map$_+3*$b[$x],@b=grep$_%9<3,0..20]}0..8],'alid')

(Разрывы строк добавлены для «ясности».)

c() - это функция, которая проверяет ввод в @y на соответствие списку списков номеров позиций, переданных в качестве аргумента. Он возвращает 0, если все списки позиций действительны (не содержат числа более одного раза), и 1 в противном случае, используя рекурсию для проверки каждого списка. Нижняя строка составляет этот список списков, передает его c() и использует результат для выбора правильного префикса для вывода.

Одна вещь, которая мне очень нравится, это то, что это решение использует преимущество «самоподобия» в списке «блочных» позиций в @b (который многократно перестраивается избыточно, чтобы не было @b=... в отдельном операторе): верхняя левая позиция i-й блок во всей головоломке можно найти, умножив i-й элемент в @b на 3.

Больше разложено:

# Grab input into an array of individual characters, discarding whitespace
@y = map /\S/g, <>;

# Takes a list of position lists.
# Returns 0 if all position lists are valid, 1 otherwise.
sub c {
    # Pop the last list into $h, extract the characters at these positions with
    # map, and check the result for multiple occurences of
    # any digit using a regex.  Note | behaves like || here but is shorter ;)
    # If the match fails, try again with the remaining list of position lists.
    # Because Perl returns the last expression evaluated, if we are at the
    # end of the list, the pop will return undef, and this will be passed back
    # which is what we want as it evaluates to false.
    (join '', map $y[$_], @$h) =~ /(\d).*\1/ | c(@_) if $h = pop
}

# Make a list of position lists with map and pass it to c().
print(('V','Inv')[c map {
        $x=$_;                  # Save the outer "loop" variable
        [$_*9..$_*9+8],         # Columns
        [grep$_%9==$x,0..80],   # Rows
        [map$_+3*$b[$x],@b=grep$_%9<3,0..20]   # Blocks
    } 0..8],                    # Generates 1 column, row and block each time
'alid')
person Community    schedule 10.12.2010

Perl: 202

Я читаю Modern Perl и чувствую, что что-то кодирую ... (кстати, довольно классная книга :)

while(<>){$i++;$j=0;for$s(split//){$j++;$l{$i}{$s}++;$c{$j}{$s}++;
$q{(int(($i+2)/3)-1)*3+int(($j+2)/3)}{$s}++}}
$e=V;for$i(1..9){for(1..9){$e=Inv if$l{$i}{$_}>1or$c{$i}{$_}>1or$q{$i}{$_}>1}}
print $e.alid

Счетчик исключает ненужные символы новой строки. Для этого может потребоваться Perl 5.12.2.

Немного читабельнее:

#use feature qw(say);
#use JSON;

#$json = JSON->new->allow_nonref;

while(<>)
{
    $i++;
    $j=0;
    for $s (split //)
    {
        $j++;
        $l{$i}{$s}++;
        $c{$j}{$s}++;
        $q{(int(($i+2)/3)-1)*3+int(($j+2)/3)}{$s}++;
    }
}

#say "lines: ", $json->pretty->encode( \%l );
#say "columns: ", $json->pretty->encode( \%c );
#say "squares: ", $json->pretty->encode( \%q );

$e = V;
for $i (1..9)
{
    for (1..9)
    {
        #say "checking {$i}{$_}: " . $l{$i}{$_} . " / " . $c{$i}{$_} . " / " . $q{$i}{$_};
        $e = Inv if $l{$i}{$_} > 1 or $c{$i}{$_} > 1 or $q{$i}{$_} > 1;
    }
}

print $e.alid;
person Community    schedule 10.12.2010

Рубин - 176

f=->x{x.any?{|i|(i-[?.]).uniq!}}
a=[*$<].map{|i|i.scan /./}
puts f[a]||f[a.transpose]||f[a.each_slice(3).flat_map{|b|b.transpose.each_slice(3).map &:flatten}]?'Invalid':'Valid'
person Community    schedule 10.12.2010

Lua, 341 байт

Хотя я знаю, что Lua - не лучший язык для игры в гольф, однако, учитывая его размер, я думаю, что стоит опубликовать его;). Версия без гольфа, с комментариями и с печатью ошибок, для дополнительного удовольствия :)

i=io.read("*a"):gsub("\n","")   -- Get input, and strip newlines
a={{},{},{}} -- checking array, 1=row, 2=columns, 3=squares
for k=1,3 do for l=1,9 do a[k][l]={0,0,0,0,0,0,0,0,0}end end -- fillup array with 0's (just to have non-nils)

for k=1,81 do -- loop over all numbers
    n=tonumber(i:sub(k,k):match'%d') -- get current character, check if it's a digit, and convert to a number
    if n then
        r={math.floor((k-1)/9)+1,(k-1)%9+1} -- Get row and column number
        r[3]=math.floor((r[1]-1)/3)+3*math.floor((r[2]-1)/3)+1 -- Get square number
        for l=1,3 do v=a[l][r[l]] -- 1 = row, 2 = column, 3 = square
            if v[n] then -- not yet eliminated in this row/column/square
                v[n]=nil    
            else
                print("Double "..n.." in "..({"row","column","square"}) [l].." "..r[l]) --error reporting, just for the extra credit :)
                q=1 -- Flag indicating invalidity
            end
        end
    end
end
io.write(q and"In"or"","Valid\n")

Версия для гольфа, 341 байт

f=math.floor p=io.write i=io.read("*a"):gsub("\n","")a={{},{},{}}for k=1,3 do for l=1,9 do a[k][l]={0,0,0,0,0,0,0,0,0}end end for k=1,81 do n=tonumber(i:sub(k,k):match'%d')if n then r={f((k-1)/9)+1,(k-1)%9+1}r[3]=f((r[1]-1)/3)+1+3*f((r[2]-1)/3)for l=1,3 do v=a[l][r[l]]if v[n]then v[n]=nil else q=1 end end end end p(q and"In"or"","Valid\n")
person Community    schedule 10.12.2010

Python: 140

v=[(k,c) for y in range(9) for x,c in enumerate(raw_input()) for k in x,y+9,(x/3,y/3) if c>'.']
print["V","Inv"][len(v)>len(set(v))]+"alid"
person Community    schedule 02.01.2011

ASL: 108

args1["\n"x2I3*x;{;{:=T(T'{:i~{^0}?})}}
{;{;{{,0:e}:;{0:^},u eq}}/`/=}:-C
dc C@;{:|}C&{"Valid"}{"Invalid"}?P

ASL - это созданный мной язык сценариев на основе Golfscript.

person Community    schedule 05.02.2011