Szett

Zalán Péter

A szett játékot egy speciális, 81 lapos kártyával játsszák. A kártyákon síkidomok vannak, amiknek 4 alapvető tulajdonságuk van:
	1. a színük (pl. piros, kék, zöld),
	2. a síkidom fajtája (téglalap, ellipszis, rombusz),
	3. a síkidomok száma (egy, kettő, három),
	4. a síkidom belseje (üres, pöttyös, csíkos).
A játék menete: a pakliból 12 kártyát felcsapunk, ezek között kell szettet találni, azaz három olyan kártyát, amelyek páronként pontosan ugyanazokban a tulajdonságokban egyeznek meg. Szettet alkot például: 1. két darab, üres, kék ellipszis; 2. egy darab, üres, piros téglalap; 3. három darab, üres, zöld rombusz; mivel mind csak a belsőben egyeznek meg, a többi tulajdonságuk pedig különböző. Ha valaki felhúz egy szettet, akkor utána ki kell egészíteni az asztalon lévő kártyák számát 12-re. Az is előfordulhat, hogy az asztalon lévő kártyák között nincs szett, ekkor egyesével kell újabb lapokat felcsapni, amíg valaki nem talál szettet.

A feladat célja, hogy adjunk egy alsó becslést arra, hogy  hány kártyát kell mindenképp felcsapni, hogy az asztalon lévő kártyák között legyen szett, illetve felső becslést, hogy hány kártya lehet az asztalon, hogy közöttük még nincs szett. Ez a két szám a valóságban nyilván csak eggyel tér el, de ezt a határszámot nem biztos, hogy egyszerű meghatározni.

Először vizsgáljunk hasonló, de egyszerűbb dolgokat, kevesebb tulajdonsággal, és azon belüli fajtával. Ha egy tulajdonságon belül csak két fajtát vizsgálunk, akkor a szabályt is módosítani kell, mivel ekkor nincs három olyan kártya, amik pontosan ugyanazokban a tulajdonságokban egyeznek meg, mert ha két kártya bizonyos tulajdonságokban megegyezik, a többiben nem, akkor a harmadik kártya a többi tulajdonságban mindig az egyikkel meg kell hogy egyezzen, mivel nincs harmadik fajta, hogy mindkettőtől különbözzön.

A 81 kártyás paklit valahogy modellezni kéne, hogy a Mathematicaval tudjunk számolni. Jellemezzük a kártyákat 4 dimenziós (Subscript[Z, 3]) feletti vektorokkal. Ezekből szintén 81 darab van, mivel 4 koordinátájának mindegyike 0, 1 vagy 2 lehet ((3^4)= 81). Megfeleltetjük a koordinátákat a tulajdonságoknak, ezen belül a számok a különböző fajták. Vizsgáljuk meg, hogy három kártya (vektor) mikor alkot szettet: egy tulajdonságban mind megegyeznek,vagy mind különbözőek, ekkor a három vektor ugyanazon koordinátái: 0,0,0; 1,1,1; 2,2,2; vagy 0,1,2. Ezek összege mind a négy esetben 0 ((Subscript[Z, 3])-ban). Ha a három koordináta nem ezeket a hármasokat alkotja, akkor az összegük nem lehet 0, mivel két szám meghatározza a harmadikat, hogy az összegük 0 legyen, és ez éppen a fenti hármasokat adja. Tehát három vektor pontosan akkor alkot szettet, ha összegük a nullvektort adja. Olyan összefüggőséget kell tehát definiálni, hogy három vektor akkor összefüggő, ha összegük (és nem valamilyen lineáris kombinációjuk) a nullvektor. Ekkor a maximális független rendszer lenne azon kártyák összessége, amelyekben még nincs szett.

Vizsgáljunk először 3 tulajdonságot két fajtával. Ez 8 darab 3 dimenziós vektor. Most másként kell definiálni a szett fogalmát. Nem megfelelő definíció, ha azt mondjuk, hogy két kártya akkor alkot szettet, ha valahány tulajdonságban megegyezik. mivel két kártya mindenképp 0, 1 vagy 2 tulajdonságban megegyezik (3-ban nem egyezhetnek, mert akkor ugyanazok lennének. Ezért külön kell vizsgálni, hogy a kártyák 0, 1 vagy 2 tulajdonságban egyeznek:
	0 tulajdonság (koordináta):
Ekkor minden kártyának van egy "komplementere", amely párok szettet alkotnak: (0,0,0) - (1,1,1), (0,0,1) - (1,1,0), (0,1,0) - (1,0,1), (1,0,0) - (0,1,1). Mindegyik párból egyet kiválasztva olyan halmazt kapunk, amiben még nincs szett, de 5 kártyát már nem tudunk kiválasztani, mivel ekkor kéne egy párból kettőt is választani. Tehát ekkor legfeljebb 4 kártya között nincs szett.
	1 tulajdonság (koordináta):
Ekkor 2 darab négyes csoport keletkezik, amin belül bármely kettő szettet alkot: (0,0,0) - (0,1,1) - (1,0,1) - (1,1,0), (0,0,1) - (0,1,0) - (1,0,0) - (1,1,1). Ekkor legfeljebb két kártya nem alkot szettet.
	2 tulajdonság (koordináta):
Ekkor minden kártya 3 másikkal alkot szettet (ennyiféleképp választhatjuk ki, hogy melyik koordináta egyezik meg), de nem alkotnak csoportokat, hanem a következő ábra mutatja az "összefüggőségi gráfot":

<< DiscreteMath`Combinatorica`

ShowGraph[
      Fold[DeleteEdge[#1, #2] &, 
        CompleteGraph[4, 4], {{1, 5}, {2, 6}, {3, 7}, {4, 8}}]]

Az egymás melett lévő vektorok különböznek mind a három koordinátában, az egy oszlopban lévők pedig 1 koordinátában egyeznek. A maximális független élhalmaz tagjai nem alkotnak szettet, tehát 4 darab.

Vizsgáljuk meg azt az esetet, amikor 2 tulajdonság van 3 fajtával.
Ekkor 9 darab vektorunk van: (0,0), (0,1), (0,2), (1,0), (1,1), (1,2), (2,0), (2,1), (2,2). Itt a szett ugyanúgy értelmezhető, mint az alapesetben.

w = {{0, 0}, {0, 1}, {0, 2}, {1, 0}, {1, 1}, {1, 2}, {2, 0}, {2, 
            1}, {2, 2}};

Ezek a vektorok, így könnyebben tudunk majd hivatkozni rájuk. Kevés próbálgatással látható, hogy van 4 darab, ami nem alkot szettet. Ellenőrizzük, hogy hány ilyen négyes van, majd megnézzük, hogy van-e 5 olyan kártya, amiben nincsen szett.

Module[{i, j, k, l, s = 0}, 
      For[i = 1, i < 7,  ++i, 
        For[j = i + 1, j < 8, ++j, 
          For[k = j + 1, k < 9,  ++k, 
            For[l = k + 1, l < 10, ++l, 
              If[Mod[w[[i]] + w[[j]] + w[[k]], 3] ≠ {0, 
                      0}  &&  Mod[w[[i]] + w[[j]] + w[[l]], 
                      3] ≠ {0, 0}  &&  
                  Mod[w[[i]] + w[[k]] + w[[l]], 
                      3] ≠ {0, 0}  && 
                  Mod[w[[j]] + w[[k]] + w[[l]], 
                      3] ≠ {0, 0}, s = s + 1]]]]]; 
      s]

54/Binomial[9, 4]

Length[
      Select[Map[w[[#]] &, KSubsets[Range[9], 4]], 
        Mod[Plus @@ # - #[[1]], 3] ≠ {0, 0} && 
            Mod[Plus @@ # - #[[2]], 3] ≠ {0, 0} && 
            Mod[Plus @@ # - #[[3]], 3] ≠ {0, 0} && 
            Mod[Plus @@ # - #[[4]], 3] ≠ {0, 0} &]]

Tehát az  összes négyes (3/7)-ében nincs szett.

Module[{i, j, k, l, m, s = 0}, 
      For[i = 1, i < 6,  ++i, 
        For[j = i + 1, j < 7, ++j, 
          For[k = j + 1, k < 6,  ++k, 
            For[l = k + 1, l < 9, ++l, 
              For[m = l + 1, 
                m < 10, ++m, 
If[
                  Mod[w[[i]] + w[[j]] + w[[k]], 
                        3] ≠ {0, 0}  &&  
                    Mod[w[[i]] + w[[j]] + w[[l]], 
                        3] ≠ {0, 0}  &&  
                    Mod[w[[i]] + w[[k]] + w[[l]], 
                        3] ≠ {0, 0}  && 
                    Mod[w[[i]] + w[[j]] + w[[m]], 
                        3] ≠ {0, 0} &&  
                    Mod[w[[i]] + w[[k]] + w[[m]], 
                        3] ≠ {0, 0}  &&  
                    Mod[w[[i]] + w[[l]] + w[[m]], 
                        3] ≠ {0, 0}  && 
                    Mod[w[[j]] + w[[k]] + w[[l]], 
                        3] ≠ {0, 0} &&  
                    Mod[w[[j]] + w[[k]] + w[[m]], 
                        3] ≠ {0, 0}  &&  
                    Mod[w[[j]] + w[[l]] + w[[m]], 
                        3] ≠ {0, 0}  && 
                    Mod[w[[k]] + w[[l]] + w[[m]], 
                        3] ≠ {0, 0}
, 
                  s = s + 1]]]]]]; s]

Az ötösökben már mind van szett.

Tehát (3^2)darab kártyában van (2^2)darab független, azaz amelyikben semelyik 3 nem alkot szettet. Innen jöhet az ötlet, hogy (3^4)kártyában lesz (2^4)darab független. Ez éppen annyi, hogy a koordináták három lehetséges értéke közül csak kettő szerepel (pl. a 2 nem). Ezek tényleg független vektorok, mivel összefüggőek csak úgy lehetnének, hogy a megfelelő koordinátájuk mind azonos (0 vagy 1), mivel nem lehet mind különböző, mert a 2 nem szerepelhet. Ekkor viszont a három vektornak meg kéne egyeznie, hogy összegük 0 legyen, de ez nem lehet. Ez a rendszer nem bővíthető tovább, mivel ha egy kettest tartalmazó vektort veszünk, akkor van két kettest nem tartalmazó vektor, amikkel összefüggő: ahol az új vektorban kettes van, ott vegyünk a másik kettőben egy egyest és nullást, ahol nem kettes van, ott marad ugyanez a koordináta. Ebben a két vektorban nem szerepel a kettes, és összefüggőek az adott vektorral.

Most próbáljunk felső becslést találni. Kiindulási adatunk a két tulajdonságnál kijött eredmény lesz, azaz kettő hosszú vektoroknál 5 darab biztosan összefüggő. Tehát kell lennie 5 olyan vektornak, aminek pl. az utolsó két koordinátája megegyezik. Ha van 13 darab 3 hosszú vektor, akkor ezek között lesz 5 olyan, hogy utolsó koordinátájuk azonos, mivel, ha nem lenne, akkor legfeljebb 3×4=12 vektor lehetne. Hasonlóan 4 hosszú vektorokra visszavezetve, ha van 3×12+1=37 darab vektor, akkor ezek között lesz biztosan 13 darab, amiknek utolsó koordinátájuk megegyezik, ezek között van 5 olyan, amiknek a 3. koordinátájuk is azonos, és az 5 kettő hosszú vektor között biztos van 3 összefüggő. Az ezeknek megfelelő 4 hosszú vektorok is összefüggőek. Tehát 37 vektor között biztos van 3 összefüggő.

Ha 3 dimenziós vektorokra élesebb felső határt tudnánk adni, akkor ez a becslés valamelyest javítható. 3 dimenziós vektorok között már 11 is biztosan összefüggő. Ha valamelyik végződésből van 5 darab, akkor ezek összefüggőek, mivel az első két koordinátában lévő 2 dimenziós vektorok összefüggőek. Ha ilyen nincs, akkor az utolsó koordináták 4,4,3 eloszlást adnak, feltehetjük, hogy 0 és 2 végű vektorból van 4 darab. Azonos végű koordináták között nem lehet 3 olyan, hogy második koordinátájuk megegyezzen, mert ekkor az elsőnek csupa különbözőnek kell lennie, de ekkor összefüggőek lennének. A 0 végű vektorok között kell lennie kettőnek, amik a második koordinátájukban is megegyeznek.  Mellette még két azonos, vagy különböző második koordináta lehet a 0 végű vektoroknál. Az 1 végződésű vektoroknál legalább két szám előfordul második koordinátaként. Ha a 0 végűeknél 2 pár van, akkor ezek a 2 végűektől minden második koordináta mellett kizárnak két lehetséges első koordinátát, mivel az egyik 1 végű kizár 2×2 darab vektort, és egy más második koordinátájú, 1 végű pedig 2 újabb vektort is, ezért ekkor 6 darab 2 végű vektort kizártunk a 9-ből, pedig kéne lennie 4 darabnak, tehát így biztosan összefüggőek. Tehát a 0 végűeknél a második koordináta eloszlásának 2+1+1-nek kell lennie. Ha az 1 végűeknél van két azonos második koordináta, akkor ezek 3+2+2 darab 2 végűt kizárnak, ami nem lehet. Ha mind a három különböző, akkor pedig ezek a két azonossal zárnak ki 2+2+2 darabot, így sem lehetnek függetlenek. Tehát 11 darab 3 dimenziós vektor már biztosan összefüggő. Ekkor viszont 31 darab 4 dimenziós is, mivel ezek között van 11 darab, amiknek az utolsó koordinátájuk megegyezik.

Elkészítjük a vektorok listáját:

vektor = 
      Flatten[Table[{i, j, k, l}, {i, 0, 2}, {j, 0, 2}, {k, 0, 2}, {l, 0, 
            2}], 3]

A következő program véletlenszerűen kiválaszt 17 különböző vektort, és ezek összefüggőségét vizsgálja. Ezzel nem tudjuk biztosan megmondani, hogy van-e független rendszer, mivel (({{81}, {17}})) (10^17) nagyságrendű, ezeket mind nem lehet ellenőrizni. A végére beraktam egy "számlálót", hogy lássuk, hol tart a számolás.

\(Timing[
      Module[{a, b, i, j, k, l, m, n}, a := Table[0, {17}]; 
        For[k = 1, k ≤ \ \ 50, \(++k\), 
          v := vektor; 
	
          For[i = 1, i ≤ 17, \(++i\), 
            b = Random[Integer, {1, 82 - i}]; 
		a = 
              ReplacePart[a, v[\([b]\)], i]; v = Drop[v, {b}]]; 
          j = 0; 
		For[l = 1, 
            l < 16, \(++l\), 
		For[m = l + 1, 
              m < 17, \(++m\), 
		For[n = m + 1, 
                n < 18, \(++n\), 
		If[
                  Mod[a[\([l]\)] + a[\([m]\)] + a[\([n]\)], 
                      3] ≠ {0, 0, 0, 
                      0}, \(++j\)]
]]]; 
			If[j == 680, 
            Print[Sort[a]]]
	
; 
          If[Mod[k, 10] == 0, Print[k]]]]]\)

Ez még aránylag gyorsan lefut, de az összes eset nagyon kis hányadát ellenőrzi le. Sejtésünk adódhat, hogy 17 vektor között mindig lesz 3 összefüggő, de ezt nehéz belátni.

Az alábbi program megadja a beadott 4 dimenziós vektorokról, hogy függetlenek-e. Amennyiben függetlenek, akkor a visszatérési érték igaz, különben hamis.

dim[] := 
      Module[{i, j, k, l, sz}, 
        sz = Input["A vektorok száma (legalább 3)"]; 
        l = Table[0, {sz}]; 
        For[i = 1, i ≤ sz, ++i, 
          k = Input["vektor (4 dimenziós)"]; 
          l = ReplacePart[l, k, i]]; 
For[i = 1, 
          i ≤ sz - 2, ++i, 
For[j = i + 1, 
            j ≤ sz - 1, ++j, 
For[k = j + 1, 
              k ≤ sz, ++k, 
              If[Mod[l[[i]] + l[[j]] + l[[k]], 3] == {0, 0, 
                    0, 0}, Goto[be]]]]]; Label[be]; Print[Sort[l]]; 
        If[i == sz - 1  && j == sz  && k == sz + 1, True, 
          False]]

dim[]

Az alábbi programban elég a vektornak a "vektor" listában lévő sorszámát megadni.

fuggetlen[] := 
      Module[{i, j, k, l, sz}, 
        sz = Input["A vektorok száma (legalább 3)"]; 
        l = Table[0, {sz}]; 
        For[i = 1, i ≤ sz, ++i, 
          k = Input["A vektor sorszáma (1 és 81 k\
özött)"]; 
          l = ReplacePart[l, vektor[[k]], i]]; 
For[
          i = 1, i ≤ sz - 2, ++i, 
For[
            j = i + 1, 
            j ≤ sz - 1, ++j, 
For[k = j + 1, 
              k ≤ sz, ++k, 
              If[Mod[l[[i]] + l[[j]] + l[[k]], 3] == {0, 0, 
                    0, 0}, Goto[be]]]]]; Label[be]; Print[{sz, Sort[l]}]; 
        If[i == sz - 1  && j == sz  && k == sz + 1, True, 
          False]]

fuggetlen[]

fuggetlen[]

A következő programban megadhatjuk a vektorok hosszát, ami tetszőleges lehet.

valt[] := 
      Module[{d, i, j, k, l, m, sz}, 
d = 
          Input["A vektorok dimenziója"]; 
sz = 
          Input["A vektorok száma (legalább 3)"]; 
        l = Table[0, {sz}]; 
        For[i = 1, i ≤ sz, ++i, k = Input["Vektor"]; 
          l = ReplacePart[l, k, i]]; 
For[i = 1, 
          i ≤ sz - 2, ++i, 
For[j = i + 1, 
            j ≤ sz - 1, ++j, 
For[k = j + 1, 
              k ≤ sz, ++k, 
              If[Mod[l[[i]] + l[[j]] + l[[k]], 3] == 
                  Table[0, {d}], Goto[be]]]]]; Label[be]; 
        Print[{sz, Sort[l]}]; 
        If[i == sz - 1  && j == sz  && k == sz + 1, True, 
          False]]

valt[]

A következő program mindig bővíti a független halmazok rendszerét. Külön tároljuk a még szóba jöhető vektorok listáját, amiből önkényesen kiválasztunk egyet, majd megnézzük, hogy az eddig kiválasztott vektorokkal hogyan alkothat szettet. A lehetséges harmadik tagokat töröljük a szóbajöhető vektorok listájából. Az első vektort még teljesen szabadon megválaszthatjuk, utána viszont már befolyásolja a végeredményt, hogy hogyan választjuk ki a többi vektort. Egyszerű választás, ha a "szabad" vektorok közül mindig az elsőt, vagy utolsót választjuk, mivel ekkor az általa rosszá lett vektorok kiselejtezése után is első, ill. utolsó lesz a listában.

Module[{a, i, l}, l = Drop[vektor, {1}]; 
      a = {{0, 0, 0, 0}}; 
While[
        Length[l] ≠ 0, 
a = 
          Join[a, {l[[1]]}]; 
        For[i = 1, 
          i < Length[a], ++i, 
If[
            MemberQ[l, Mod[-a[[i]] - l[[1]], 3]], 
            l = Delete[
                l, Position[l, 
                      Mod[-a[[i]] - l[[1]], 
                        3]][[1]][[1]]]]]; l = Drop[l, {1}]]; 
      a]

Module[{a, i, l}, l = Drop[vektor, {1}]; 
      a = {{0, 0, 0, 0}}; 
While[
        Length[l] ≠ 0, 
a = 
          Join[a, {l[[-1]]}]; 
        For[i = 1, 
          i < Length[a], ++i, 
If[
            MemberQ[l, Mod[-a[[i]] - l[[-1]], 3]], 
            l = Delete[
                l, Position[l, 
                      Mod[-a[[i]] - l[[-1]], 
                        3]][[1]][[1]]]]]; l = Drop[l, {-1}]]; 
      Sort[a]]

Tehát láthatjuk, hogy van 18 független vektor is. Most kipróbáljuk, hogy a második vektort is mi adjuk meg, akkor esetleg lehet még több is. Az összes lehetsége módon kiválasztjuk a második vektort.

Module[{a, b = {}, c, i, j, l}, 
For[j = 1, 
        j ≤ 80, ++j, l = Drop[vektor, {1}]; c = l[[j]]; 
        a = Join[{{0, 0, 0, 0}}, {c}]; l = Drop[l, {j}]; 
        l = Delete[
            l, Position[l, 
                  Mod[-c, 
                    3]][[1]][[1]]]; 
While[
          Length[l] ≠ 0, 
a = 
            Join[a, {l[[1]]}]; 
          For[i = 1, 
            i < Length[a], ++i, 
If[
              MemberQ[l, Mod[-a[[i]] - l[[1]], 3]], 
              l = Delete[
                  l, Position[l, 
                        Mod[-a[[i]] - l[[1]], 
                          3]][[1]][[1]]]]]; l = Drop[l, {1}]]; 
        b = Join[b, {Length[a]}]]; b]

Module[{a, b = {}, c, i, j, l}, 
For[j = 1, 
        j ≤ 80, ++j, l = Drop[vektor, {1}]; c = l[[j]]; 
        a = Join[{{0, 0, 0, 0}}, {c}]; l = Drop[l, {j}]; 
        l = Delete[
            l, Position[l, 
                  Mod[-c, 
                    3]][[1]][[1]]]; 
While[
          Length[l] ≠ 0, 
a = 
            Join[a, {l[[-1]]}]; 
          For[i = 1, 
            i < Length[a], ++i, 
If[
              MemberQ[l, Mod[-a[[i]] - l[[-1]], 3]], 
              l = Delete[
                  l, Position[l, 
                        Mod[-a[[i]] - l[[-1]], 
                          3]][[1]][[1]]]]]; 
          l = Drop[l, {-1}]]; b = Join[b, {Length[a]}]]; b]

Tehát így sem találtunk nagyobb független rendszert. Nézzük meg, hogy hány különböző rendszert találtunk:

Module[{a, b = {}, c, i, j, l}, 
For[j = 1, 
        j ≤ 80, ++j, l = Drop[vektor, {1}]; c = l[[j]]; 
        a = Join[{{0, 0, 0, 0}}, {c}]; l = Drop[l, {j}]; 
        l = Delete[
            l, Position[l, 
                  Mod[-c, 
                    3]][[1]][[1]]]; 
While[
          Length[l] ≠ 0, 
a = 
            Join[a, {l[[1]]}]; 
          For[i = 1, 
            i < Length[a], ++i, 
If[
              MemberQ[l, Mod[-a[[i]] - l[[1]], 3]], 
              l = Delete[
                  l, Position[l, 
                        Mod[-a[[i]] - l[[1]], 
                          3]][[1]][[1]]]]]; l = Drop[l, {1}]]; 
        If[Length[a] == 18, b = Join[b, {Sort[a]}]]]; d = Union[b]]; 
    Length[d]

Module[{a, b = {}, c, i, j, l}, 
For[j = 1, 
        j ≤ 80, ++j, l = Drop[vektor, {1}]; c = l[[j]]; 
        a = Join[{{0, 0, 0, 0}}, {c}]; l = Drop[l, {j}]; 
        l = Delete[
            l, Position[l, 
                  Mod[-c, 
                    3]][[1]][[1]]]; 
While[
          Length[l] ≠ 0, 
a = 
            Join[a, {l[[-1]]}]; 
          For[i = 1, 
            i < Length[a], ++i, 
If[
              MemberQ[l, Mod[-a[[i]] - l[[-1]], 3]], 
              l = Delete[
                  l, Position[l, 
                        Mod[-a[[i]] - l[[-1]], 
                          3]][[1]][[1]]]]]; 
          l = Drop[l, {-1}]]; 
        If[Length[a] == 18, b = Join[b, {Sort[a]}]]]; e = Union[b]]; 
    Length[e]

Length[Union[d,e]]

Egyébként, ha már találunk egy független rendszert, akkor többet is találunk, mivel a koordináták sorrendjét, és egymástól függetlenül a koordinátaértékeket is megpermutálhatjuk.

Tehát találtunk 18 vektorból álló független rendszert, de csak 31 vektorra tudjuk, hogy biztosan lesz közöttük 3 összefüggő vektor.