RosettaCodeData/Task/N-queens-problem/QBasic/n-queens-problem.basic

46 lines
1.6 KiB
Plaintext

DIM SHARED queens AS INTEGER
CLS
COLOR 15
INPUT "Numero de reinas"; queens
IF queens <= 0 THEN END
CLS
PRINT "queens: Calcula el problema de las"; queens; " reinas."
DIM SHARED arrayqcol(queens) AS LONG ' columnas de reinas
DIM SHARED nsoluciones AS LONG
dofila (1)' comenzar en la fila 1
COLOR 14: LOCATE 6 + (2 * queens), 1: PRINT "Hay " + STR$(nsoluciones) + " soluciones"
END
SUB dofila (ifila) ' comienza con la fila de abajo
FOR icol = 1 TO queens
FOR iqueen = 1 TO ifila - 1 ' Comprueba conflictos con las reinas anteriores
IF arrayqcol(iqueen) = icol THEN GOTO continue1 ' misma columna?
' iqueen también es fila de la reina
IF iqueen + arrayqcol(iqueen) = ifila + icol THEN GOTO continue1 ' diagonal derecha?
IF iqueen - arrayqcol(iqueen) = ifila - icol THEN GOTO continue1 ' diagonal izquierda?
NEXT iqueen
' En este punto podemos añadir una reina
arrayqcol(ifila) = icol ' añadir al array
COLOR 8
LOCATE ifila + 2, icol: PRINT "x"; ' mostrar progreso
COLOR 15
IF ifila = queens THEN ' solucion?
nsoluciones = nsoluciones + 1
LOCATE 4 + queens, 1: PRINT "Solucion #" + STR$(nsoluciones)
FOR i1 = 1 TO queens ' filas
s1$ = STRING$(queens, ".") ' columnas
MID$(s1$, arrayqcol(i1), 1) = "Q" ' Q en la columna reina
PRINT s1$
NEXT i1
PRINT ""
ELSE
dofila (ifila + 1)' llamada recursiva a la siguiente fila
END IF
COLOR 7: LOCATE ifila + 2, icol: PRINT "."; ' quitar reina
continue1:
NEXT icol
END SUB