Code: Select all
'' bluatigro 28 sept 2018
'' binary puzle solver try
'' there are only 0's and 1's
'' every row / colom has equal number of 0's and 1's
'' there are no more then 2 0's or 1's in a set
const as integer max_x = 7
const as integer max_y = 7
dim shared as integer p( max_x + 1 , max_y + 1 ) , x , y
function save_x( q as integer ) as integer
return 0 <= q and q <= max_x
end function
function save_y( q as integer ) as integer
return 0 <= q and q <= max_y
end function
sub horizontal_lines
dim as integer tel_0 , tel_1 , a , q
for y = 0 to max_y
tel_0 = 0
tel_1 = 0
for x = 0 to max_x
if p( x , y ) = -1 then
if save_x( x + 2 ) then
if p( x + 1 , y ) = p( x + 2 , y ) then
if p( x + 1 , y ) <> -1 then
print "horizontal " ; x ; " " ; y ; " before fount _"
p( x , y ) = 1 - p( x + 1 , y )
end if
end if
end if
if save_x( x - 2 ) then
if p( x - 1 , y ) = p( x - 2 , y ) then
if p( x - 1 , y ) <> -1 then
print "horizontal " ; x ; " " ; y ; " after fount _"
p( x , y ) = 1 - p( x - 1 , y )
end if
end if
end if
if save_x( x - 1 ) and save_x( x + 1 ) then
if p( x - 1 , y ) = p( x + 1 , y ) then
if p( x - 1 , y ) <> -1 then
print "horizontal " ; x ; " " ; y ; " between fount _"
p( x , y ) = 1 - p( x - 1 , y )
end if
end if
end if
end if
if p( x , y ) = 0 then
tel_0 = tel_0 + 1
a = x
q = 0
end if
if p( x , y ) = 1 then
tel_1 = tel_1 + 1
a = x
q = 1
end if
next x
if tel_0 + tel_1 = max_y - 1 then
print "horizontal " ; x ; " " ; a ; " last spot fount _"
p( a , y ) = 1 - q
end if
next y
end sub
sub vertical_lines
dim as integer tel_0 , tel_1 , a , q
for x = 0 to max_x
tel_0 = 0
tel_1 = 0
for y = 0 to max_y
if p( x , y ) = -1 then
if save_y( y + 2 ) then
if p( x , y + 1 ) = p( x , y + 2 ) then
if p( x , y + 1 ) <> -1 then
print "vertical " ; x ; " " ; y ; " above fount _"
p( x , y ) = 1 - p( x , y + 1 )
end if
end if
end if
if save_y( y - 2 ) then
if p( x , y - 1 ) = p( x , y - 2 ) then
if p( x , y - 1 ) <> -1 then
print "vertical " ; x ; " " ; y ; " below fount _"
p( x , y ) = 1 - p( x , y - 1 )
end if
end if
end if
if save_y( y - 1 ) and save_y( y + 1 ) then
if p( x , y - 1 ) = p( x , y + 1) then
if p( x , y - 1 ) <> -1 then
print "vertical " ; x ; " " ; y ; " between fount _"
p( x , y ) = 1 - p( x , y - 1 )
end if
end if
end if
end if
if p( x , y ) = 0 then
tel_0 = tel_0 + 1
a = y
q = 0
end if
if p( x , y ) = 1 then
tel_1 = tel_1 + 1
a = y
q = 1
end if
next y
if tel_0 + tel_1 = max_y - 1 then
print "vertical " ; x ; " " ; a ; " last spot fount _"
p( x , a ) = 1 - q
end if
next x
end sub
sub drawpuzle
dim as integer tel
tel = 0
for y = 0 to max_y
for x = 0 to max_x
print " " ;
select case p( x , y )
case 0
print "0" ;
case 1
print "1" ;
case else
print "_" ;
tel = tel + 1
end select
next x
print
next y
if tel = 0 then
print "[ solved ]"
end
end if
end sub
y = 0
dim as string q
while q <> "="
read q
for x = 1 to len( q )
select case mid( q , x , 1 )
case "0"
p( x - 1 , y ) = 0
case "1"
p( x - 1 , y ) = 1
case else
p( x - 1 , y ) = -1
end select
next x
y = y + 1
wend
data "1_0_____"
data "_____0__"
data "____1__1"
data "_11_____"
data "0_______"
data "____0__1"
data "__00___1"
data "_1____1_"
data "="
dim as string in
verder:
cls
drawpuzle
horizontal_lines
vertical_lines
input "solved ? [ y / n ] : " ; in
if in = "n" then goto verder
print "[ GAME OVER ]"
sleep