Sudoku megoldása R-ben10 perc olvasás

A sudoku egy világszerte ismert logikai játék, amelynek számtalan variánsa létezik. Ebben a cikkben a legelterjedtebb változat egy megoldásalgoritmusát mutatom be, amelyet Bánóczi Annával és Reizinger Kristóffal csináltunk egy projekt keretében.

Ezen játék során az a cél, hogy egy 9×9-es táblázatot feltöltsünk 1-től 9-ig terjedő számokkal, azon feltétel mellett, hogy nem kerülhet azonos szám semelyik oszlopba, sorba vagy a 9 darab 3×3-as résztáblába.

Megoldásunk alapjául a backtracking algoritmus szolgál, amit minden lépésben kiegészítünk a biztosan tudható számok beírásával. A két megközelítés kombinálása lehetővé teszi, hogy hatékonyan tippeljük meg a számokat, és gyorsan kiszűrjük az esetleges rossz tippeket.

A kódban főleg globális változókat használtunk (<<-), ami azért bizonyult hasznosnak, mert így minden függvényen belül frissíteni tudtuk az adott változókat, amikre így később nem függvényeken keresztül kellett hivatkozni.

A kód

A megoldófüggvény („solvesudoku”) kódja a következő sorokban látható, melyeknek részeit egyenként ismertetem a következőkben.


#install.packages("abind")
library(abind) 

#install.packages("sudokuAlt")
library(sudokuAlt) # for visualization

solvesudoku<-function(name){
  convert(name)
  pos_values(msudoku)
  
  fewest_pos<<-min(rowSums(jps)[rowSums(jps)!=0])
  guess_loc<<-which(rowSums(jps)==fewest_pos)
  nummemory<<-matrix(c(guess_loc[1],which(jps[guess_loc[1],])[1],1,fewest_pos),1,4)
  colnames(nummemory)<<-c("guess location","guess","prev index","number of possible values")
  matrixmemory<<-array(msudoku,c(9,9,1))
  
  guessing()
    
  plot(as.sudoku(msudoku), col = "Black", par(bg="#f4c2c2"), colGame="#f9046f", lty= "solid")
  plot(as.sudoku(original), col = NA, par(bg="transparent",new=T), colGame="#842593")
  
 }
 

A kód elején található „convert” függvény egy mátrixot generál a megadott inputból, amely a megfelelő helyre betölti a megadott számokat, a többi helyre pedig nullákat ír. A játék megadásához soronként kell bevinni az adatokat, minden sort vesszővel elválasztva, és space-szel jelölve a nem megadott számokat.


sudoku = "   4 28  ,7    9  1,    8  73, 2   79  ,    2    ,  31   6 ,84  1    ,3  2    5,  79 8   "

convert<-function(sudoku){
  msudoku<<-matrix(0,9,9)
  colnames(msudoku)<<-paste("C",c(1:9),sep = "") 
  rownames(msudoku)<<-paste("R",c(1:9),sep = "") 
  for(i in 1:9){
    msudoku[i,]<<-rbind(as.numeric(unlist(strsplit(unlist(strsplit(sudoku, ","))[i],NULL))[1:9]))}                                                 
  msudoku[is.na(msudoku)]<<-0
  original<<-msudoku
  }

Miután beolvastuk a játékot, a program során az „msudoku” mátrixot vizsgáljuk, illetve változtatjuk. Először is azt kell megnézni, hogy a kitöltendő helyekre milyen számok kerülhetnek. Ezt az alábbi kód mondja meg, amely megnézi, hogy milyen számok kerülhetnek ezekre a helyekre sor, oszlop, és résztáblázat szerint, majd egy 81×9-es táblázatba gyűjti azokat az eseteket, amelyeknél mindhárom kritérium alapján beírható egy szám. Ez a „jps” táblázat, aminek a 81 sora reprezentálja a sudoku 81 celláját oszlopfolytonosan, és a 9 oszlopa jelzi TRUE és FALSE értékekkel, hogy milyen számok írhatóak be. Ha az első sorban csak egy darab TRUE található, akkor oda be lehet írni azt a számot, amelyik oszlopban volt a TRUE.

pos_values<-function(msudoku){
  psol<-array(0,c(3,9,81)) 
  for(i in 1:9){
    for (j in 1:9){
    psol[1,j,which(msudoku[i,]==0)*9-9+i]<-sum(!sum(msudoku[i,]==j)) 
    psol[2,j,which(msudoku[,i]==0)+(i-1)*9]<-sum(!sum(msudoku[,i]==j)) 
    if(msudoku[(j-1)*9+i]==0){
      for(k in 1:9){ 
      psol[3,k,(j-1)*9+i]<-sum(!sum(msudoku[(1+3*(ceiling(i/3)-1)):(3+3*(ceiling(i/3)-1)),(1+3*(ceiling(j/3)-1)):(3+3*(ceiling(j/3)-1))]==k))
    }}}}
  jps<<-t(colSums(psol)==3)
  }
 

A biztos számok beírásának másik alapvető része a „certain_fill” és a „findallcertain” függvények, amelyek a megoldás során a „guessing” függvényen belül kerülnek csak meghívásra. A „certain_fill” függvény az előbb létrehozott „jps” táblázat alapján beír minden olyan számot, ami a játék jelenlegi állapotában biztosan tudható. Ehhez megnézi, hogy csak egy lehetséges értéket lehet-e beírni egy adott helyre, illetve azt is, hogy adott sorban, oszlopban és résztáblázatban nincs-e olyan üres cella, amelynél egyedüliként fordul elő egy lehetséges érték. A „findallcertain” pedig annyiszor hívja meg az előbbi függvényt, amennyiszer tudott beírni új, biztos számokat.

certain_fill<-function(){
  
  pos_values(msudoku)
  
  mstart<<-msudoku 
  
  location<<-which(rowSums(jps)==1) if(length(location)>0){
    value<<-row(t(jps[location,,drop=F]))[t(jps[location,,drop=F])]
    msudoku[location]<<-value
    }
  
  for(i in 1:9){
    Column<<-(9*(i-1)+1):(9*(i-1)+9)
    value1<<-which(colSums(jps[Column,])==1)
    location1<<-Column[row(jps[Column,value1,drop=F])[jps[Column,value1]]] 
    msudoku[location1]<<-value1
    }
  
  for(i in 1:9){
    Row<<-seq(i,72+i,9)
    value2<<-which(colSums(jps[Row,])==1)
    location2<<-Row[row(jps[Row,value2,drop=F])[jps[Row,value2]]] 
    msudoku[location2]<<-value2
    }
    
  for(i in 1:9){
    subregion<<-c(seq((3*((i-1)%%3)+1+(ceiling(i/3)-1)*27),(3*((i-1)%%3)+3+(ceiling(i/3)-1)*27),1),
            seq((9+3*((i-1)%%3)+1+(ceiling(i/3)-1)*27),(9+3*((i-1)%%3)+3+(ceiling(i/3)-1)*27),1),
            seq(18+3*((i-1)%%3)+1+(ceiling(i/3)-1)*27,18+3*((i-1)%%3)+3+(ceiling(i/3)-1)*27,1))
    value3<<-which(colSums(jps[subregion,])==1) 
    location3<<-subregion[row(jps[subregion,value3,drop=F])[jps[subregion,value3]]] 
    msudoku[location3]<<-value3
    }
  }

findallcertain<-function(game){
  msudoku<<-game
  mstart<<-matrix(0,9,9)
  while(sum(msudoku-mstart)){
    certain_fill()
    }
  }
 

Mivel az előző eljárás során adott körben az összes biztos érték bekerül a mátrixba, így előfordulhat, hogy helytelenül tölti fel a mátrixot a program, ha már eleve nem megoldható mátrixot vizsgálunk. Így szükséges a következő függvény, ami ellenőrzi, hogy minden sorban, oszlopban és résztáblázatban csak egyszer fordulnak elő az értékek.

check<-function(){
  msudoku[msudoku==0]<-NA 
  count<-c(apply(msudoku,1,table),apply(msudoku,2,table)) 
  for(i in 1:9){
    subregion<-c(seq((3*((i-1)%%3)+1+(ceiling(i/3)-1)*27),(3*((i-1)%%3)+3+(ceiling(i/3)-1)*27),1),
            seq((9+3*((i-1)%%3)+1+(ceiling(i/3)-1)*27),(9+3*((i-1)%%3)+3+(ceiling(i/3)-1)*27),1),
            seq(18+3*((i-1)%%3)+1+(ceiling(i/3)-1)*27,18+3*((i-1)%%3)+3+(ceiling(i/3)-1)*27,1))
    count<-c(count,list(table(msudoku[subregion])))}
  sum(unlist(count)!=1)==0 
  }
 

Mivel a biztos számokkal már fel tudjuk tölteni az „msudoku” mátrixot, így a következő lépés, hogy a bizonytalan cellákra is meghatározzuk az értékeket. Ehhez tippelni kell. Mivel a „jps” mátrixot mindig frissítjük, így mindig az aktuálisan feltöltött mátrixnak láthatjuk a lehetséges értékeit. Ezt felhasználva sokat segít az algoritmus hatékonyságán, ha arra a helyre kezdünk el tippelni, ahova a legkevesebb lehetséges értéket lehet beírni, vagyis abba a cellába, ahol a „jps” szerint a legkevesebb TRUE található az adott sorban. Ennek meghatározására még az elsőként belinkelt kódrészleten belül kerül sor. Ugyanis a program mindig előre meghatározza, hogy mi lesz a következő tipp, amit be fogunk írni, így minden lehetséges kimenetel esetén frissítjük „nummemory” táblázatot, amely azt gyűjti, hogy hova írtuk be a tippet, mit tippeltünk, hányadikként tippeltük és hány lehetséges érték közül írtuk be a tippet. Ennek megfelelően a „guessing” függvénynek a következő elágazásai lehetnek miután tippelt egy értéket, és ennek függvényében feltöltötte az újonnan beírható biztos számokkal:

  • Megoldást találtunk.
  • Rosszul lett feltöltve a mátrix, vagyis rossz volt az előző tipp.
  • A mátrixban egyelőre nem található ellentmondás, de további tippelés szükséges.

guessing<-function(){
  
  guess_location<<-tail(nummemory,1)[1] 
  
  guess<<-tail(nummemory,1)[2] 
  
  msudoku[guess_location]<<-guess
  
  findallcertain(msudoku)
  
  if(sum(jps)==0 && sum(msudoku==0)==0 && check()){
    # solution found
    } else if((sum(jps)==0 && sum(msudoku==0)!=0) || !check()){
        msudoku<<-matrixmemory[,,dim(matrixmemory)[3]]
        
        actual<<-dim(matrixmemory)[3]
        index<<-nummemory[actual,3]
      
        pos_values(msudoku)
        
        if(tail(which(jps[guess_loc[1],]),1)!=nummemory[actual,2]){
          index<<-index+1
          nummemory[actual,2]<<-which(jps[guess_loc[1],])[index]
          nummemory[actual,3]<<-index
          nummemory[actual,4]<<-fewest_pos
          
          guessing()

     } else{ 
      checkpreviousmatrix()
      
      guessing()
      }
    
  } else {
    fewest_pos<<-min(rowSums(jps)[rowSums(jps)!=0])
    guess_loc<<-which(rowSums(jps)==fewest_pos)
    nummemory<<-rbind(nummemory,c(guess_loc[1],which(jps[guess_loc[1],])[1],1,fewest_pos))
    matrixmemory<<-abind(matrixmemory,msudoku,along=3)
    guessing()
  }
}


 

Az előbb felsorolt három kimenetel közül a második esetben szükségünk van egy további függvényre, ami megvizsgálja, hogy eggyel korábbi tippünknél, nem-e az utolsó lehetséges értéket írtuk be az adott helyre. Ugyanis ekkor kettővel korábbi állapotra kell visszatérnünk, feltéve hogy abban az állapotban nem az utolsó lehetséges tippet írtuk be…


checkpreviousmatrix<-function(){
  nummemory<<-nummemory[-length(nummemory[,1]),,drop=F]
  matrixmemory<<-matrixmemory[,,-dim(matrixmemory)[3],drop=F]
  msudoku<<-matrixmemory[,,dim(matrixmemory)[3]]
  
  pos_values(msudoku)
  fewest_pos<<-min(rowSums(jps)[rowSums(jps)!=0])
  guess_loc<<-which(rowSums(jps)==fewest_pos)
  
  actual<<-dim(matrixmemory)[3]
  index<<-nummemory[actual,3]
  
  if(tail(which(jps[guess_loc[1],]),1)==nummemory[actual,2]){
    checkpreviousmatrix()
    } else {
    index<<-index+1
    nummemory[actual,2]<<-which(jps[guess_loc[1],])[index]
    nummemory[actual,3]<<-index
    nummemory[actual,4]<<-fewest_pos
    }
  }

 

Vizualizáció

Mivel a „guessing” függvény addig hívja meg magát, amíg nem talál megoldást, így már csak az eredmény kiírása maradt hátra. Ezt a „sudokuAlt” package segítségével oldottuk meg, amiben egyébként található megoldóprogram is.

Hogy egy kicsit szemléletesebben is bemutassam a kód algoritmusát, itt láthatóak a fentebb megadott játékba bevitt tippek, illetve az egyes lépések, amik a megoldáshoz vezetnek.

Vagyis először a harmincadik helyre 5-t tippel, majd a hatodik helyre 5-t, de ez csak a második tipp volt a hatodik helyre (az alábbi ábrán látható, hogy elsőre 4-et tippelt oda), és így tovább. Piros számokkal látható a kezdeti játék, lilával pedig a beírt számok.

 

Leave a Reply

Your email address will not be published. Required fields are marked *