Tahta oyunu

Masa oyunda " Carcassonne " oyuncuları, kenarlarını eşleştirerek fayansları yerleştirir ve arazilerin geniş bitişik alanlarını oluşturarak en yüksek puanları kazanır. Aşağıdakiler (kabaca) oyunda yer alan çini türleri ve miktarlarıdır:

#01 x4 #02 x5 #03 x8 #04 x2

#05 x9 #06 x4 #07 x1 #08 x3

#09 x3 #10 x3 #11 x4 #12 x5

#13 x3 #14 x3 #15 x2 #16 x5

#17 x5 #18 x2 #19 x3 #20 x1

#21 x5 #22 x2 #23 x1 #24 x1

#25 x1

Görev

Mümkün olan en geniş bitişik arazi alanlarını korumaya çalışırken, kenarları eşleştirerek döşemeyi yerleştirmelisiniz.

Yerleştirme

• Döşemeler, yalnızca oyun alanındaki mevcut döşemelere (veya döşemelere) bitişik (en fazla 4) boşluktan birine yerleştirilebilir.
• Fayans 90, 180 veya 270 derece döndürülebilir.

Kenar eşleştirme

• Yerleştirilen bir döşemenin kenarları (en fazla 4) komşu döşemenin dokunma kenarlarına uymalıdır, yani dokunma pikselleri aynı renktedir.

Bitişik arazi

• "Arazi alanının kapatılması", bir kiremitin bitişik herhangi bir renk alanının daha sonra başka kiremit yerleşimlerine devam edemeyeceği şekilde döşenmesi anlamına gelir.
• Alternatif bir yerleşim mümkünse, bir arazi alanını kapatacak herhangi bir karo yerleşimi arasından seçilmelidir.
• Bir dizi kapanış yerleşimi arasında seçim yapmak durumundaysanız, herhangi birini seçin. Bir dizi kapanmayan yerleşim arasında seçim yapmanız gerekiyorsa, herhangi birini seçin.
• Bitişik alanları hesaplarken # ff00ff (köşe pikselleri) değerini dikkate almayın. Ayrıca binaları, yani zaten bir döşemenin içine tamamen alınmış renk alanlarını göz ardı edin.

Giriş

• Giriş iki görüntüdür:

  1. Oyun alanı.

     • İlk oyun alanı kiremitten #11(tek bir kiremit) oluşur.
     • Çıktı olarak oluşturulan artırılmış oyun alanı da girdi olarak desteklenmelidir.

  2. Yerleştirilecek kiremit.

     • Örnek döşemelerin tümü giriş olarak desteklenmelidir.

• Yalnızca bu görüntü verilerini kullanarak eşleşen kenarları / bitişik alanları belirleyin. Kodlama yok.

Çıktı

• Çıktı, döşemeyi yerleştirdikten sonra ortaya çıkan oyun alanını gösteren bir görüntüdür.
• Görüntü, kendi programınızla uyumlu olmalıdır, yani oyun alanı girişi olarak kullanılabilir.
• Döşeme yapmak imkansızsa, bir hata gönderin.

Bunu varsayabilirsin

• Fayanslar her zaman 55 piksele 55 piksele kadardır
• Döşemeler yalnızca örnek döşemelerde şu anda kullanılan renkleri içerir.

notlar

• Cevabınız en az 2 kez geçtikten sonra örnek çıktı içermelidir (daha fazla teşvik edilir).
• Bu, orijinal tahta oyununun kısmi ve yanlış bir gösterimidir, burada belirtilmeyen kuralların veya taktiklerin hiçbirini uygulamanıza gerek yoktur.

Gol

• Puanınız gönderinizin bayt sayımıdır.
• Resim verileri puanınıza dahil değildir.
• En düşük puan kazanır.

Aşağıdakilerden oluşan tam bir oyun oynamak için başvurunuzu kullanan bir senaryo yazmak isteyebilirsiniz:

• Seçilmiş bir döşemeyi 85'in tam setinden sözde sırayla yerleştirmek.
• Karo yerleştirilemiyorsa sete geri getirilir.
• Her karo yerleştirilene kadar - veya arka arkaya iki karo yerleştirilinceye kadar tekrarlama.

Bu, bayt sayınıza dahil edilmeyecek veya puanınızı yükseltmeyecektir, ancak büyük olasılıkla bu tür bir cevap için bir teklif sunacağım.

PerlMagick ile Perl 5: 875 789 763

sub wMerkeze olan mesafeleri sıralamak için kullanılan ve kompakt çözümleri tercih etmek için kullanılan çizgiyi saymadım (şimdi düzgün çalışıyor). Bu sürümde istenildiği gibi kapanmaktan kaçınıldı, ancak oyunun tam tersini daha ilginç ve doğru buluyorum. Bunu başarmak için çizgiyi $s=$t if!grep...değiştirin $s=$t if grep....

use Image::Magick;
sub p{/x/;@o=$r->GetPixel(y=>$'+pop,x,$`+pop);"@o"}
sub o{$w=&p;"0 0 0"eq$w?3:&p eq$w}
sub f{$r->FloodfillPaint(y=>$J+$',x,$I+$&,channel,All,fill,@_)}
($i=Image::Magick->new)->Read(@ARGV);$r=$b=$i->[0];
$h=$b->Get(rows)+112;$:=$b->Get(width)+112;
$b->Extent(geometry,"$:x$h-56-56",background,none);
@v=grep p()eq"0 0 0",map{map-54+55*$_.x.($'*55-54),//..$:/55}1..$h/55;
sub w{$_=pop;/x/;abs($:-2*$`)+abs($h-2*$')}@v=sort{w($b)<=>w($a)}@v;
map{map{/x/;$I=$`;$J=$';$r=$b->Clone();
($t=$r)->Composite(image,$i->[1],x,$I,y=>$J);
if((o(27,0,27,-1)&o(0,27,-1,27)&o(27,54,27,55)&o(54,27,55,27))==1){
$s=$t if!grep{/../;$r=$t->Clone();f(none);f(red);
!grep{p()eq"1 0 0"}@v}
map{/..$/;($_,$&.$`)}map{($_.-1,$_.55)}10,27,45;
$o=$r=$t;}$i->[1]->Rotate(degrees,90)}($_)x4}@v;
$s||=$o or exit 1;$s->Trim();$s->Write("car.png")

Kullanımı: perl car.pl board.png tile.png. Sonuç saklandı car.png. Döşeme yerleştirilemediğinde Çıkış durumu 1'dir.

Komple bir oyun çalıştırmak için komut dosyası. Yukarıda kodu varsayar dosyasında olduğunu car.plve fayans saklanır tilesadlı dizin 01.pngiçin 25.png.

use List::Util shuffle;$x='00';
@t=shuffle map{($x++)x$_}split'',a4582941333353325523152111;
`cp tiles/11.png car.png`;
$i++,`perl car.pl car.png tiles/$_.png`,print"placed $i\n"for@t

Bu şimdi oldukça yavaş çalışıyor. Makineme 8-12 dakika. Tercih edilen kapanışla: Kapatmanın engellenmesi ile (hiçbir şeyin kapalı olmadığını unutmayın).

Common Lisp, 2650 2221 1992 1186 1111 bayt

Güncelleme: Şimdi "Kolay" golf oynamak, daha fazla kazanç daha büyük değişiklikler gerektirecektir.

Güncelleme 2: Rekabet arttıkça, yeni sürüm artık mevcut oyun alanı dikdörtgeni içerisindeki konumları desteklememektedir (bu, fazladan 57 bayt olacaktır). Bu seçenek, basit bir hız optimizasyonunun yanı sıra, simülatör ile indirilebilir sürümde varsayılan olarak etkindir, ancak aşağıdaki resmi cevapta değildir.

Güncelleme 3: Küçük arayüz büyük bayt sayısı kazanımları için değişir.

Ben de basit bir Web UI oluşturdum. Paketin tamamını (tek bir LISP dosyası ve döşeme görüntüleri) buradan indirebilirsiniz . , Deneyin yüklemek için hunchentoot, zpngve png-readquiclisp, yük ile carcassonne.lispve bağlanın localhost:8080. Kod CCL / Windows ve SBCL / Linux üzerinde test edilmiştir. Yukarıda belirtilen kütüphanelere sadece UI / simülatör bölümü için ihtiyaç duyulur; çözümün kendisi ANSI Ortak Lisp'tir.

(defun c(f p &aux b a s z(c 55))
  (macrolet((d(v l &body b)`(dotimes(,v,l),@b))
            (b(b c)`(d i c(d j c(setf,b,c))))
            (r(&rest p)`(aref,@p))
            (n(u v i j)`(and(setf l(*(f,u,v)l))
                            (find(r f(+,u,i)(+,v,j))`(0,(r f,u,v))))))
    (labels((p(p w)(d y(ceiling w 2)(d x(- w y y)(rotatef(r p y #6=(+ x y))(r p #6##7=(- w y))(r p #7##8=(- w x y))(r p #8#y)))))
            (a(y x)(or(if(= 0(r f y x))1 #4=(and(= 1(incf(r s y x)))(=(r f y x)z)(push`(,y,x)a)0))0))
            (f(y x)(setf z(r f y x))(if #4#(loop for((y x))= a while(pop a)maximize(+(a(1- y)x)(a y(1- x))(a(1+ y)x)(a y(1+ x))))1)))
      (d i 8(when(d x #1=(array-dimension f 0)(or(= 0(r f(- #1#52 i)x))(return t)))(setf f(adjust-array f`(#2=,(+ #1#c)#2#))))(p f(1- #1#)))
      (d i 4(d u #9=(/ #1#c)(d v #9#
        (let((y(* u c))(x(* v c))(l 9e9))
          (when(= 0(r f y x))
            (b #10=(r f(+ y i)(+ x j))(r p i j))
            (setf s(make-array`(,#1#,#1#))a())
            (ignore-errors(if(> #11=(*(loop for d from 1 to 53
                                            sum(+(n y #3=(+ x d)-1 0)(n #5=(+ y d)(+ 54 x)0 1)(n(+ 54 y)#3#1 0)(n #5#x 0 -1)))
                                      (1+ l))
                                (or(car b)0))
                             (setf b`(,#11#,i,y,x))))
            (b #10#0)))))
         (p p 54))
      (when b(d j(cadr b)(p p 54))(b(r f(+(third b)i)(+(nth 3 b)j))(r p i j)))
      `(,f,b))))

Tüm satır beslemeleri ve satır başlangıç ​​aralığı yalnızca okunabilirliği sağlamak için ve kozmetiklerin toplamı için sayılmaz.

İşlevi ciki argümanla çağırmalısınız : Geçerli oyun alanı ve yerleştirilecek döşeme. Her ikisi de 2B diziler olmalıdır; karo 55x55 ve alan bunun bir katıdır. Ek olarak, alan dizisi ayarlanabilir olmalıdır. İşlev, ilk argüman olarak yeni alanla birlikte iki elemanlı bir liste döndürür. İkinci öğe, NILdöşemenin yerleştirilememesi veya başka bir şekilde, sol üst koordinatları ve bu dizideki en son döşemenin dönüşünü ve bu döşemenin puanını içeren bir listedir. Bu bilgi görselleştirme amacıyla kullanılabilir.

Diğer aramalarda, cikinci liste elemanı olsa bile geri gönderilen yeni alanı kullanmanız gerektiğini unutmayın NIL(orijinal dizi değiştirilmiş adjust-arrayve bu nedenle geçersiz olabilir).

Kod artık yavaş tarafta biraz, bayt sayısı optimizasyonu ile gereksiz hesaplamalara neden oluyor. Aşağıdaki örnek sistemimde yaklaşık üç dakika içinde tamamlandı.

85 döşemenin tamamı için örnek çalıştırma:

Web UI ekran görüntüsü:

DarkBASIC Pro: 2078 1932 1744 bayt

GÜNCELLEME: Sadece daha fazla golf çabası

GÜNCELLEME: Şimdi kapanmayan seçimleri tercih etmek de dahil olmak üzere şartnameyi tamamen karşılamaktadır.

DarkBASIC'i seçtim çünkü oldukça ayrıntılı olsa da, görüntüleri değiştirmek için oldukça basit ve basit bir komut seti sağlıyor.

DarkBASIC derleyicisine sahip olmayan insanlar için bir EXE yükledim ( Windows ).

#constant m memblock
#constant f function
#constant k endfunction
#constant z exitfunction
#constant i image
#constant e endif
#constant t then
#constant o or
#constant s paste image
#constant n next
#constant r for
set i colorkey 0,20,0:load i "map.png",1:f$="next.png"
if file exist(f$)=0 t f$=str$(rnd(24)+1)+".png"
load i f$,2:make m from i 1,1:make m from i 2,2
global ts,h,j,u,v,td
ts=i width(2):h=i width(1):j=i height(1):u=h/ts:v=j/ts:td=ts*2
create bitmap 2,h+td+1,j+td+1:r b=1 to 4:r xx=0 to u+1:r yy=0 to v+1:x=xx*ts-1:y=yy*ts-1
cls 5120:s 1,ts,ts,1:if (a(x+1,y) o a(x,y+1) o a(x-ts,y) o a(x,y-ts)) and a(x,y)=0
x1=ts*xx:y1=ts*yy:make i from m 2,2:s 2,x1,y1,1
cl=0:r fd=0 to 1:r x2=1 to ts-2:r yt=0 to 1:y2=yt*ts-yt:y3=yt*ts+yt-1
aa=x2:ab=x2:ba=y2:bb=y3:t2=y1:r t3=0 to 1:p=point(x1+aa,y1+ba):q=point(x1+ab,y1+bb)
if p<>q and rgbg(q)<>20 and t2+b>0 t goto fa
if fd and p<>0xFF0000
if l(x1+aa,y1+ba,p)=0 t cl=1
e
aa=y2:ba=x2:bb=x2:ab=y3:t2=x1:n t3:n yt:n x2:n fd:dn=1:c=xx-1:g=yy-1:make i from m 3,2:if cl=0 t goto dm
e
fa:
n y:n x
d=ts/2:r x=0 to d:r y=0 to d-1:vx=ts-1-x:vy=ts-1-y:t1=rd(x,y):t2=rd(vy,x):wr(vy,x,t1):t1=rd(vx,vy):wr(vx,vy,t2):t2=rd(y,vx):wr(y,vx,t1):wr(x,y,t2):n x:n y:n b
dm:
if dn=0 t report error "Not placed"
p=c<0:q=g<0:t1=h+ts*(p o c>=u):t2=j+ts*(q o g>=v):cls 5120:p=ts*p:q=ts*q:s 1,p,q,1:s 3,c*ts+p,g*ts+q,1:get i 1,0,0,t1,t2,1:save i "map.png",1
end
f l(x,y,w)
if x<0 o y<0 o x>=h+td o y>=j+td t z 1
p=point(x,y)
if rgbg(p)=20 t z 1
if p<>w t z 0
dot x,y,0xFF0000:rt=l(x+1,y,p) o l(x-1,y,p) o l(x,y+1,p) o l(x,y-1,p)
k rt
f rd(x,y)
w=m dword(2,0):b=m dword(2,12+(y*w+x)*4)
k b
f wr(x,y,d)
w=m dword(2,0):write m dword 2,12+(y*w+x)*4,d
k
f a(x,y)
if x<0 o y<0 o x>=h o y>=j t z 0
b=m byte(1,15+(y*h+x)*4)
k b