ubi44 , Battleship Olympics

new

« Prev
1
Next »

ubi44
Junior Member

Posts: 51

ubi44 , Battleship Olympics Aug 6, 2024 10:51:33 GMT

Quote

Post by ubi44 on Aug 6, 2024 10:51:33 GMT

My AI for the Battleship Olympiads, is based on probability and a bit of randomness at the start. Set the variable 'copa' to 1 (line 94) to always have the same result & entirely based on probabilities. Comment line 126 for insane speed!

_Title "Battleship Olympics  _ubi44"


setparties:
Data "hd9va2vg2ve6hi9","vj5vd2ha2hg8vb7"
Data "hc3hc4hd5hd6hd7","vc2he3ve5hg6vf7","vb2hc3he5hf6he8","vh3hc2ve4hb8vb4","hb0vj1vj7va4hd9","EOD"
Restore setparties
nbcs = 0
Do
    Read sd$
    nbcs = nbcs + 1
    If sd$ = "EOD" Then Exit Do
Loop

Dim nbc(nbcs)
Restore setparties
Type bateau
    tx As Integer
    ty As Integer
    str As String
    type As Integer
    coule As Integer
End Type
ReDim Shared B(4) As bateau
B(0).str = "carrier"
B(1).str = "battleship"
B(2).str = "cruiser"
B(3).str = "sub"
B(4).str = "destroyer"
B(0).tx = 1: B(0).ty = 5
B(1).tx = 1: B(1).ty = 4
B(2).tx = 1: B(2).ty = 3
B(3).tx = 1: B(3).ty = 3
B(4).tx = 1: B(4).ty = 2
B(0).coule = 5
B(1).coule = 4
B(2).coule = 3
B(3).coule = 3
B(4).coule = 2
ReDim Shared NBCELL, NBBATEAUX
NBCELL = 10
Randomize Timer
NBBATEAUX = 5 - 1
Screen _NewImage(800, 600, 32)

RECOM = 1
nombredecoup = 0
partie = 0
36
ReDim COT$(5)

ReDim Shared KNOWBOAT
KNOWBOAT = 1

If RECOM = 1 Then
    B(0).tx = 1: B(0).ty = 5
    B(1).tx = 1: B(1).ty = 4
    B(2).tx = 1: B(2).ty = 3
    B(3).tx = 1: B(3).ty = 3
    B(4).tx = 1: B(4).ty = 2

    ReDim Shared GrilleAI(NBCELL - 1, NBCELL - 1)
    ReDim Shared GrilleProb(NBCELL - 1, NBCELL - 1)
    ReDim Shared GrilleJoueur(NBCELL - 1, NBCELL - 1)
    ReDim Shared GrilleJouBAT(NBCELL - 1, NBCELL - 1)
    ReDim Shared Btestjoue(NBBATEAUX)
    ReDim Shared memX(NBCELL - 1), memY(NBCELL - 1)
    ReDim Shared AI, Boat, DIRECTION, CUR, passATAC, mxCUR, sauvX, sauvY
    ReDim Shared MemB(NBBATEAUX)
    Boat = 0
    NTO = 0
    For x = 0 To NBCELL - 1
        For y = 0 To NBCELL - 1
            GrilleJouBAT(x, y) = -1
    Next y, x
    Read set$
    If set$ = "EOD" Then
        Color _RGB(255, 255, 255), _RGB(12, 30, 26)
        Locate 1, 1: Print "                                                                                                 "
        Locate 25, 2

        Print "   We reached the End Of Data."; partie; "game played"
        Print: Print "   The Computer AI took"; nombredecoup; "shots to sink all the ships in the DATA set."
        For i = 0 To partie - 1
            Print "    game "; i + 1; ":"; nbc(i); "shots"
        Next i
        Print "   Press spacebar to restart, ESC to quit "
        _Display
                Do
            xke = _KeyHit
            If xke Then
                If xke = 32 Then: Print: Print "       restart ...": _Display: _Delay 1: Run
                If xke = 27 Then: End
            End If
            _Limit 5
            _Display
        Loop
    Else
        affi$ = set$
    End If
    k = 1
    For j = 0 To 4
        COT$(j) = Mid$(set$, k, 3)
        k = k + 3
    Next j

    placebateau
End If
AI = 0
Cls , _RGB(12, 30, 26)
copa = 0
45

choix x, y, copa

GrilleAI(x, y) = 1
nombredecoup = nombredecoup + 1
nbc(partie) = nbc(partie) + 1
rep = envoi(x, y) '                  0=water  1=touche  2=coule
If rep = 2 Then copa = 1
IA rep, x, y

trace x, y, rep
Locate 1, 1
Print "data set "; partie + 1; ":"; affi$
Circle (455 + x * 20 + 10, 150 + y * 20 + 10), 4, _RGB(255, 0, 0)
Color _RGB(255, 255, 255), _RGB(12, 30, 26)
For x = 0 To NBCELL - 1
    _PrintString (464 + x * 20, 150 - 20), Chr$(65 + x) 'Str$(x + 1)
    For y = 0 To NBCELL - 1
        _PrintString (430, 150 + y * 20), Str$(y) 'Chr$(65 + y)
        If GrilleJoueur(x, y) = 1 Then
            r = 255: g = 255: b = 0
            Line (456 + x * 20, 151 + y * 20)-(456 + x * 20 + 18, 151 + y * 20 + 18), _RGB(r, g, b), B
        Else
            r = 0: g = 0: b = 255
            Circle (455 + x * 20 + 10, 150 + y * 20 + 10), 2, _RGB(r, g, b)
            Line (455 + x * 20, 150 + y * 20)-(455 + x * 20 + 20, 150 + y * 20 + 20), _RGB(r, g, b), B
        End If
Next y, x

_Display
ktim = Timer + .02 'slowdown the show!
Do
Loop Until ktim < Timer

If Boat = NBBATEAUX + 1 Then
    partie = partie + 1
    GoTo 36
End If
If InKey$ = Chr$(27) Then End
GoTo 45

Sub trace (x, y, reponse)
    Select Case reponse
        Case 0 'water
            r = 0: g = 50: b = 128
        Case 1 'touche
            r = 255: g = 0: b = 0
        Case 2 'coule
            r = 255: g = 0: b = 0
    End Select
    If reponse > 0 Then
        Line (458 + x * 20, 153 + y * 20)-(458 + x * 20 + 16, 151 + y * 20 + 16), _RGB(r, g, b), B
    Else
        Circle (455 + x * 20 + 10, 150 + y * 20 + 10), 1, _RGB(r, g, b)
    End If
End Sub
Sub choix (x, y, cc)
    145
    Select Case AI
        Case 0
            If cc = 0 Then stat2 x, y Else stat x, y
        Case 1
            HBGD x, y
            passATAC = 0
        Case 2
            attac0 x, y
            If AI = 3 Then
                passATAC = 0
                Select Case DIRECTION
                    Case 0
                        If Rnd < .5 Then DIRECTION = 2 Else DIRECTION = 3
                    Case 1
                        If Rnd < .5 Then DIRECTION = 3 Else DIRECTION = 2
                    Case 2
                        If Rnd < .5 Then DIRECTION = 0 Else DIRECTION = 1
                    Case 3
                        If Rnd < .5 Then DIRECTION = 1 Else DIRECTION = 0
                End Select
                sauvX = memX(mxCUR)
                sauvY = memY(mxCUR)
                GoTo 145
            End If
        Case 3
            attac1 sauvX, sauvY, x, y
    End Select
End Sub
Sub IA (rep, x, y)
    Select Case rep
        Case 0
            Select Case AI
                Case 0
                    AI = 0
                Case 1
                    AI = 1
                Case 2
                    If passATAC = 0 Then
                        Select Case DIRECTION
                            Case 0
                                DIRECTION = 1
                                CUR = 0
                            Case 1
                                DIRECTION = 0
                                CUR = 0
                            Case 2
                                DIRECTION = 3
                                CUR = 0
                            Case 3
                                DIRECTION = 2
                                CUR = 0
                        End Select
                        passATAC = 1
                    Else
                        AI = 3
                        Select Case DIRECTION
                            Case 0
                                DIRECTION = 2
                            Case 1
                                DIRECTION = 3
                            Case 2
                                DIRECTION = 0
                            Case 3
                                DIRECTION = 1
                        End Select
                        passATAC = 0
                        sauvX = memX(mxCUR) 'CUR = 0
                        sauvY = memY(mxCUR)
                    End If
                Case 3
                    If passATAC = 0 Then
                        Select Case DIRECTION
                            Case 0
                                DIRECTION = 1
                            Case 1
                                DIRECTION = 0
                            Case 2
                                DIRECTION = 3
                            Case 3
                                DIRECTION = 2
                        End Select
                        passATAC = 1
                        sauvX = memX(mxCUR)
                        sauvY = memY(mxCUR)

                    End If
            End Select
        Case 1
            GrilleAI(x, y) = 2
            Select Case AI
                Case 0
                    ReDim memX(NBCELL - 1), memY(NBCELL - 1)
                    CUR = 0
                    memX(CUR) = x: memY(CUR) = y
                    AI = 1
                Case 1
                    CUR = CUR + 1
                    mxCUR = CUR
                    memX(CUR) = x: memY(CUR) = y
                    AI = 2
                Case 2
                    CUR = CUR + 1
                    mxCUR = CUR
                    memX(CUR) = x: memY(CUR) = y
                    AI = 2
                Case 3
                    sauvX = x
                    sauvY = y
                    AI = 3
            End Select
        Case 2
            GrilleAI(x, y) = 2
            Select Case AI
                Case 0, 1, 2
                    CUR = 0
                    AI = 0
                Case 3
                    mxCUR = mxCUR - 1
                    If mxCUR < 0 Then
                        AI = 0
                        mxCUR = 0
                        CUR = 0
                    Else
                        Select Case DIRECTION
                            Case 0
                                If Rnd < .5 Then DIRECTION = 1
                            Case 1
                                If Rnd < .5 Then DIRECTION = 0
                            Case 2
                                If Rnd < .5 Then DIRECTION = 3
                            Case 3
                                If Rnd < .5 Then DIRECTION = 2
                        End Select
                        sauvX = memX(mxCUR)
                        sauvY = memY(mxCUR)
                        passATAC = 0
                    End If
            End Select
            If KNOWBOAT = 1 Then
                ox = x: oy = y
                MemB(GrilleJouBAT(ox, oy)) = 0
                x = ox: y = oy
            End If
    End Select
End Sub
Sub stat (pox, poy)
    For x = 0 To NBCELL - 1
        For y = 0 To NBCELL - 1
            If GrilleAI(x, y) = 0 Then GrilleProb(x, y) = .1 Else GrilleProb(x, y) = 0
    Next y, x
    For i = 0 To NBBATEAUX
        If plusorb < MemB(i) And MemB(i) < 7 Then plusorb = MemB(i)
    Next i
    If KNOWBOAT = 1 Then
        For g = 0 To NBBATEAUX
            If MemB(g) > 0 And MemB(g) < 7 Then
                xa = MemB(g)
                ya = 1
                For x = 0 To NBCELL - 1
                    For y = 0 To NBCELL - 1
                        TESTbateau x, y, xa, ya, plusorb
                        TESTbateau x, y, ya, xa, plusorb
                Next y, x
            End If
        Next g
    Else
        For g = 0 To NBBATEAUX
            If MemB(g) < 7 Then
                xa = MemB(g)
                ya = 1
                For x = 0 To NBCELL - 1
                    For y = 0 To NBCELL - 1
                        TESTbateau x, y, xa, ya, plusorb
                        TESTbateau x, y, ya, xa, plusorb
                Next y, x
            End If
        Next g
    End If
    bob = 0
    ReDim cvX((NBCELL * NBCELL * .5) + .5), cvY((NBCELL * NBCELL * .5) + .5)
    For x = 0 To NBCELL - 1
        If sty = 0 Then sty = 1 Else sty = 0
        For y = sty To NBCELL - 1 Step 2
            cvX(bob) = x
            cvY(bob) = y
            bob = bob + 1
    Next y, x
    Randomize Timer(.00001)
    444
    lim = Int((NBCELL - 1) / 5)

    kop = 0
    For x = 0 To NBCELL - 1
        For y = 0 To NBCELL - 1
            cl = GrilleProb(x, y) * (2)
            'Line (258 + x * 20, 153 + y * 20)-(258 + x * 20 + 16, 151 + y * 20 + 16), _RGBA(cl, cl, cl, 25), BF
            If cl > kop And GrilleAI(x, y) = 0 Then
                For i = 0 To bob - 1
                    If x = cvX(i) And y = cvY(i) Then
                        pox = x
                        poy = y
                        kop = cl
                        doit = 1
                    End If
                Next i
            End If
    Next y, x
    If boot > 10 And doit = 0 Then
        sty = 1: bob = 0
        ReDim cvX(NBCELL * NBCELL * .5 + .5), cvY(NBCELL * NBCELL * .5 + .5)
        For x = 0 To NBCELL - 1
            If sty = 0 Then sty = 1 Else sty = 0
            For y = sty To NBCELL - 1 Step 2
                cvX(bob) = x
                cvY(bob) = y
                bob = bob + 1
        Next y, x
        GoTo 444
    End If
    If doit = 0 Then boot = boot + 1: GoTo 444
End Sub
Sub HBGD (pox, poy)
    x = memX(CUR): y = memY(CUR)
    esp = 1
    i = -1
    pxl = x: pyl = y
    stat pxl, pyl
    tente0 = -1: tente1 = -1: tente2 = -1: tente3 = -1
    340
    fait = 0
    For i = 0 To 3
        Select Case i
            Case 0 'n
                If y - esp >= 0 Then
                    If GrilleAI(x, y - esp) = 0 Then
                        px = x: py = y - esp
                        mix0 = GrilleProb(x, y - esp)

                        fait = 1
                    Else
                        tente0 = GrilleAI(x, y - esp)

                    End If
                Else
                    tente0 = 1
                End If
            Case 1 's
                If y + esp <= NBCELL - 1 Then
                    If GrilleAI(x, y + esp) = 0 Then
                        px = x: py = y + esp
                        mix1 = GrilleProb(x, y + esp)
                        fait = 1
                    Else
                        tente1 = GrilleAI(x, y + esp)
                    End If
                Else
                    tente1 = 1
                End If
            Case 2 'e
                If x - esp >= 0 Then
                    If GrilleAI(x - esp, y) = 0 Then
                        px = x - esp: py = y
                        mix2 = GrilleProb(x - esp, y)
                        fait = 1
                    Else
                        tente2 = GrilleAI(x - esp, y)
                    End If
                Else
                    tente2 = 1
                End If
            Case 3 'o
                If x + esp <= NBCELL - 1 Then
                    If GrilleAI(x + esp, y) = 0 Then
                        px = x + esp: py = y
                        mix3 = GrilleProb(x + esp, y)
                        fait = 1
                    Else
                        tente3 = GrilleAI(x + esp, y)
                    End If
                Else
                    tente3 = 1
                End If
        End Select
    Next i
    If tente1 >= 1 And tente0 >= 1 And tente2 >= 1 And tente3 >= 1 Then
        ttt = 0
        af = 0
        If tente0 = 2 Then i = 0
        If tente1 = 2 Then i = 1
        If tente2 = 2 Then i = 2
        If tente3 = 2 Then i = 3
        tente1 = -1: tente0 = -1: tente2 = -1: tente3 = -1
        mix0 = 0: mix1 = 0: mix2 = 0: mix3 = 0:
        esp = esp + 1
        '  i = ttt
        GoTo 340
    End If
    If tente0 = -1 Then af = mix0: ttt = 0
    If tente1 = -1 Then If mix1 > af Then af = mix1: ttt = 1
    If tente2 = -1 Then If mix2 > af Then af = mix2: ttt = 2
    If tente3 = -1 Then If mix3 > af Then af = mix3: ttt = 3
    Select Case ttt
        Case 0
            pox = x: poy = y - esp
        Case 1
            pox = x: poy = y + esp
        Case 2
            pox = x - esp: poy = y
        Case 3
            pox = x + esp: poy = y
    End Select
    DIRECTION = ttt
End Sub

Sub attac0 (pox, poy)
    memDIRECTION = DIRECTION
    x = memX(CUR)
    y = memY(CUR)
    1012
    fait = 0
    Select Case DIRECTION
        Case 0
            If y - 1 >= 0 Then
                Select Case GrilleAI(x, y - 1)
                    Case 0
                        px = x: py = y - 1
                        fait = 1
                    Case 1
                        DIRECTION = 1
                    Case 2
                        y = y - 1: GoTo 1012
                End Select
            Else
                DIRECTION = 1
            End If
        Case 1 's
            If y + 1 <= NBCELL - 1 Then
                Select Case GrilleAI(x, y + 1)
                    Case 0
                        px = x: py = y + 1
                        fait = 1
                    Case 1
                        DIRECTION = 0
                    Case 2
                        y = y + 1: GoTo 1012
                End Select
            Else
                DIRECTION = 0
            End If
        Case 2 'e
            If x - 1 >= 0 Then
                Select Case GrilleAI(x - 1, y)
                    Case 0
                        px = x - 1: py = y
                        fait = 1
                    Case 1
                        DIRECTION = 3
                    Case 2
                        x = x - 1: GoTo 1012
                End Select
            Else
                DIRECTION = 3
            End If
        Case 3 'o
            If x + 1 <= NBCELL - 1 Then
                Select Case GrilleAI(x + 1, y)
                    Case 0
                        px = x + 1: py = y
                        fait = 1
                    Case 1
                        DIRECTION = 2
                    Case 2
                        x = x + 1: GoTo 1012
                End Select
            Else
                DIRECTION = 2
            End If
    End Select
    If memDIRECTION <> DIRECTION And passATAC = 0 Then
        x = memX(0)
        y = memY(0)
        passATAC = 1
        GoTo 1012
    End If
    If passATAC = 1 And fait = 0 Then AI = 3
    If fait = 1 Then
        pox = px
        poy = py
    End If
End Sub
Sub attac1 (svx, svy, pox, poy)
    memDIRECTION = DIRECTION
    1011
    x = svx
    y = svy
    1012
    fait = 0
    Select Case DIRECTION
        Case 0
            If y - 1 >= 0 Then
                Select Case GrilleAI(x, y - 1)
                    Case 0
                        px = x: py = y - 1
                        fait = 1
                    Case 1
                        DIRECTION = 1
                    Case 2
                        y = y - 1: GoTo 1012
                End Select
            Else
                DIRECTION = 1
            End If
        Case 1 's
            If y + 1 <= NBCELL - 1 Then
                Select Case GrilleAI(x, y + 1)
                    Case 0
                        px = x: py = y + 1
                        fait = 1
                    Case 1
                        DIRECTION = 0
                    Case 2
                        y = y + 1: GoTo 1012
                End Select
            Else
                DIRECTION = 0
            End If
        Case 2 'e
            If x - 1 >= 0 Then
                Select Case GrilleAI(x - 1, y)
                    Case 0
                        px = x - 1: py = y
                        fait = 1
                    Case 1
                        DIRECTION = 3
                    Case 2
                        x = x - 1: GoTo 1012
                End Select
            Else
                DIRECTION = 3
            End If
        Case 3 'o
            If x + 1 <= NBCELL - 1 Then
                Select Case GrilleAI(x + 1, y)
                    Case 0
                        px = x + 1: py = y
                        fait = 1
                    Case 1
                        DIRECTION = 2
                    Case 2
                        x = x + 1: GoTo 1012
                End Select
            Else
                DIRECTION = 2
            End If
    End Select
    If memDIRECTION <> DIRECTION And passATAC = 0 Then
        x = svx
        y = svy
        passATAC = 1
        memDIRECTION = DIRECTION
        GoTo 1012
    End If
    If fait = 1 Then
        pox = px
        poy = py
    End If
End Sub
Function envoi (x, y)
    If GrilleJoueur(x, y) = 1 Then
        Btestjoue(GrilleJouBAT(x, y)) = Btestjoue(GrilleJouBAT(x, y)) - 1
        envoi = 1
        nto = 0
        For dfi = 0 To NBBATEAUX
            If Btestjoue(dfi) = 0 Then nto = nto + 1
        Next dfi
        If nto <> Boat Then Boat = nto: envoi = 2
    Else
        envoi = 0
    End If
End Function

Sub placebateau
    Shared COT$()
    For encour = 0 To 4
        o$ = Left$(COT$(encour), 1)
        l$ = Mid$(COT$(encour), 2, 1)
        ty = Val(Right$(COT$(encour), 1))
        tx = Asc(l$)
        x = tx - 65 - 32: y = ty
        If o$ = "h" Then Swap B(encour).tx, B(encour).ty
        If poss(x, y, B(encour).tx, B(encour).ty) Then
            If B(encour).tx < B(encour).ty Then
                For by = y To y + B(encour).ty - 1
                    GrilleJoueur(x, by) = 1
                    GrilleJouBAT(x, by) = encour
                Next by
                Btestjoue(encour) = B(encour).ty
            Else
                For bx = x To x + B(encour).tx - 1
                    GrilleJoueur(bx, y) = 1
                    GrilleJouBAT(bx, y) = encour
                Next bx
                Btestjoue(encour) = B(encour).tx
            End If
        Else
            Print "Problem with data set"; v
            _Delay 5
        End If
        MemB(encour) = B(encour).coule
    Next encour
End Sub
Sub stat2 (pox, poy)
    top = 0
    haz:
    x = Int(Rnd * (NBCELL))
    y = Int(Rnd * (NBCELL))
    If x > NBCELL - 1 Or y > NBCELL - 1 Or x < 0 Or y < 0 Then GoTo haz
    For encour = 0 To 4
        If possAI(x, y, 1, MemB(encour)) Or possAI(x, y, MemB(encour), 1) Then
            top = 1
        End If
    Next encour
    If top Then pox = x: poy = y Else GoTo haz
End Sub
Function poss (x, y, tx, ty)
    If tx < ty Then
        For uy = y To y + ty - 1
            If uy < NBCELL Then
                If GrilleJoueur(x, uy) = 1 Then poss = 0: Exit Function
            Else
                poss = 0
                Exit Function
            End If
        Next uy
    Else
        For ux = x To x + tx - 1
            If ux < NBCELL Then
                If GrilleJoueur(ux, y) = 1 Then poss = 0: Exit Function
            Else
                poss = 0
                Exit Function
            End If
        Next ux
    End If
    poss = 1
End Function
Sub TESTbateau (x, y, xa, ya, u)
    tp = (Int((Abs((NBCELL - 1) * .5 - x) + Abs((NBCELL - 1) * .5 - y)) * .5) / NBCELL) * 10
    If possAI(x, y, xa, ya) Then
        If xa < ya Then
            If ya = u Then plus = 1 + u
            For by = y To y + ya - 1
                If GrilleAI(x, by) = 0 Then GrilleProb(x, by) = GrilleProb(x, by) + (ya + plus + tp)
            Next by
        Else
            If xa = u Then plus = 1 + u
            For bx = x To x + xa - 1
                If GrilleAI(bx, y) = 0 Then GrilleProb(bx, y) = GrilleProb(bx, y) + (xa + plus + tp)
            Next bx
        End If
    End If
End Sub
Function testAI (x, y, tx, ty)
    If tx < ty Then
        For uy = y To y + ty - 1

            If GrilleAI(x, uy) = 2 Then testAIk = testAIk + 2

        Next uy
    Else
        For ux = x To x + tx - 1

            If GrilleAI(ux, y) = 2 Then testAIk = testAIk + 2

        Next ux
    End If
    testAI = testAIk
End Function
Function possAI (x, y, tx, ty)
    If tx < ty Then
        For uy = y To y + ty - 1
            If uy < NBCELL Then
                If GrilleAI(x, uy) = 1 Then possAI = 0: Exit Function
            Else
                possAI = 0
                Exit Function
            End If
        Next uy
    Else
        For ux = x To x + tx - 1
            If ux < NBCELL Then
                If GrilleAI(ux, y) = 1 Then possAI = 0: Exit Function
            Else
                possAI = 0
                Exit Function
            End If
        Next ux
    End If
    possAI = 1
End Function

a link to play against the AI in a full game!
battleship 3d

Last Edit: Aug 8, 2024 19:02:44 GMT by ubi44

bplus
Global Moderator

b = b + ...

Posts: 998

ubi44 , Battleship Olympics Aug 6, 2024 13:01:33 GMT ubi44 likes this

Quote

Post by bplus on Aug 6, 2024 13:01:33 GMT

Congrats ubi44 you got the Data part working and the ship set looks positioned correctly.

Glad you found the revised set of ship placements for the Data line(s).

Oh one thing, use _KeyClear after the question about running the program again. Without it, the spacebar never gets cleared and your program just jumps right into another run time after time thinking that spacebar you hit the one time is answering the same again and again. So _KeyClear will fix that just before you ask the question or just after it's answered with keypress.

Your bombing pattern looks allot like mine, great minds think alike!

Cheers! to the stars of Basic where ever they shine!

ubi44 Junior Member Posts: 51	ubi44 , Battleship Olympics Aug 6, 2024 13:15:02 GMT Quote Select Post Deselect Post Link to Post Member Give Gift Back to Top Post by ubi44 on Aug 6, 2024 13:15:02 GMT I used _keyclear before and after for sure !! I almost asked about this problem because I didn't have the solution... but you anticipated my request! Thanks, I learned another new function..

bplus Global Moderator b = b + ... Posts: 998	ubi44 , Battleship Olympics Aug 6, 2024 13:22:11 GMT Quote Select Post Deselect Post Link to Post Member Give Gift Back to Top Post by bplus on Aug 6, 2024 13:22:11 GMT good!
	Cheers! to the stars of Basic where ever they shine!

ubi44
Junior Member

Posts: 51

ubi44 , Battleship Olympics Aug 6, 2024 13:48:58 GMT

Quote

Post by ubi44 on Aug 6, 2024 13:48:58 GMT

i have question ? is there a function that returns the number of existing data ? (I need to know before starting how many sets there are in the data to size the 'nbc' variable which counts the number of shots per game) any ubound of data ?

I have a solution using restore working but if there is a function ....

Finally i used inkey$ insteed _keydown because problem persist..

Last Edit: Aug 6, 2024 14:10:11 GMT by ubi44: _keydown change to inkey$

bplus
Global Moderator

b = b + ...

Posts: 998

ubi44 , Battleship Olympics Aug 6, 2024 15:41:01 GMT

Quote

Post by bplus on Aug 6, 2024 15:41:01 GMT

Aug 6, 2024 13:48:58 GMT ubi44 said:

There is no function that returns count of Data, but you can do this with Restore:
Just Read and count through the Data until you hit "EOD" (BTW it doesn't have to be "EOD" just some string your code will ID as the end of the Data.)
Child's play, no?

With your count for Data you just Restore (BTW you can also Restore to a line label if you have many kinds of Data.)
You can Dim | ReDim arrays to match number of Data.
Good idea, I will do that too.

Shot counts on each Ship set is good to know!

So if you have a sol'n with Restore then you may already know my suggestion above.

Don't use _KeyDown thats a different kind of Function, use _KeyClear Sub that clears the keyboard buffer of last things in it.

Last Edit: Aug 6, 2024 15:43:18 GMT by bplus

Cheers! to the stars of Basic where ever they shine!

ubi44
Junior Member

Posts: 51

ubi44 , Battleship Olympics Aug 9, 2024 9:54:25 GMT

Quote

Post by ubi44 on Aug 9, 2024 9:54:25 GMT

I spotted a flaw in my AI when several boats are hit before sinking. Sometimes only one key is missing and the AI takes all its time...

I also post a version which retries each grid until obtaining an interesting score lower than 40 or 30 depending on the set.(it takes some times) The final report displays the number of attempts to obtain these scores..

(a path to progress ...)

this is not official release only for test... the official release is in first post !

_Title "Battleship Olympics  _ubi44"


setparties:
Data "hd9va2vg2ve6hi9","vj5vd2ha2hg8vb7"
Data "hc3hc4hd5hd6hd7","vc2he3ve5hg6vf7","vb2hc3he5hf6he8","vh3hc2ve4hb8vb4","hb0vj1vj7va4hd9","EOD"
Restore setparties
nbcs = 0
Do
    Read sd$
    nbcs = nbcs + 1
    If sd$ = "EOD" Then Exit Do
Loop

Dim nbc(nbcs), nbp(nbcs)
Restore setparties
Type bateau
    tx As Integer
    ty As Integer
    str As String
    type As Integer
    coule As Integer
End Type
ReDim Shared B(4) As bateau
B(0).str = "carrier"
B(1).str = "battleship"
B(2).str = "cruiser"
B(3).str = "sub"
B(4).str = "destroyer"
B(0).tx = 1: B(0).ty = 5
B(1).tx = 1: B(1).ty = 4
B(2).tx = 1: B(2).ty = 3
B(3).tx = 1: B(3).ty = 3
B(4).tx = 1: B(4).ty = 2
B(0).coule = 5
B(1).coule = 4
B(2).coule = 3
B(3).coule = 3
B(4).coule = 2
ReDim Shared NBCELL, NBBATEAUX
NBCELL = 10
Randomize Timer
NBBATEAUX = 5 - 1
Screen _NewImage(800, 600, 32)

pfini = 0
RECOM = 1

partie = 0
retente = 0
TotC = 0
36
nombredecoup = 0
ReDim COT$(5)

ReDim Shared KNOWBOAT
KNOWBOAT = 1

If RECOM = 1 Then
    B(0).tx = 1: B(0).ty = 5
    B(1).tx = 1: B(1).ty = 4
    B(2).tx = 1: B(2).ty = 3
    B(3).tx = 1: B(3).ty = 3
    B(4).tx = 1: B(4).ty = 2

    ReDim Shared GrilleAI(NBCELL - 1, NBCELL - 1)
    ReDim Shared GrilleProb(NBCELL - 1, NBCELL - 1)
    ReDim Shared GrilleJoueur(NBCELL - 1, NBCELL - 1)
    ReDim Shared GrilleJouBAT(NBCELL - 1, NBCELL - 1)
    ReDim Shared Btestjoue(NBBATEAUX)
    ReDim Shared memX(NBCELL - 1), memY(NBCELL - 1)
    ReDim Shared AI, Boat, DIRECTION, CUR, passATAC, mxCUR, sauvX, sauvY
    ReDim Shared MemB(NBBATEAUX)
    Boat = 0
    NTO = 0
    For x = 0 To NBCELL - 1
        For y = 0 To NBCELL - 1
            GrilleJouBAT(x, y) = -1
    Next y, x
    If retente = 0 Then Read set$
    retente = 1

    If set$ = "EOD" Then
        Color _RGB(255, 255, 255), _RGB(12, 30, 26)
        Locate 1, 1: Print "                                                                                                 "
        Locate 25, 2
        hpp = 0
        For i = 0 To partie - 1: hpp = hpp + nbp(i): Next i
        Print "   We reached the End Of Data."; partie; "game played  _____("; hpp
        Print: Print "   The Computer AI took"; TotC; "shots to sink all the ships in the DATA set."
        For i = 0 To partie - 1
            Print "    game "; i + 1; ":"; nbc(i); "shots ___ "; nbp(i); "try"
        Next i
        Print "   Press spacebar to restart, ESC to quit "
        _Display
        Do
            xke = _KeyHit
            If xke Then
                If xke = 32 Then: Print: Print "       restart ...": _Display: _Delay 1: Run
                If xke = 27 Then: End

            End If
            _Limit 5
            _Display
        Loop
    Else
        affi$ = set$
    End If
    k = 1
    For j = 0 To 4
        COT$(j) = Mid$(set$, k, 3)
        k = k + 3
    Next j

    placebateau
End If
AI = 0

copa = 0
45

choix x, y, copa

GrilleAI(x, y) = 1
nombredecoup = nombredecoup + 1

rep = envoi(x, y) '                  0=water  1=touche  2=coule
If rep = 2 Then copa = 1
IA rep, x, y
If nombredecoup > 1 Then
    trace x, y, rep
    Circle (455 + x * 20 + 10, 150 + y * 20 + 10), 4, _RGB(255, 0, 0)
    _Display
Else
    Cls , _RGB(12, 30, 26)
    Locate 1, 1
    Print "data set "; partie + 1; ":"; affi$

    Color _RGB(255, 255, 255), _RGB(12, 30, 26)
    For x = 0 To NBCELL - 1
        _PrintString (464 + x * 20, 150 - 20), Chr$(65 + x) 'Str$(x + 1)
        For y = 0 To NBCELL - 1
            _PrintString (430, 150 + y * 20), Str$(y) 'Chr$(65 + y)
            If GrilleJoueur(x, y) = 1 Then
                r = 255: g = 255: b = 0
                Line (456 + x * 20, 151 + y * 20)-(456 + x * 20 + 18, 151 + y * 20 + 18), _RGB(r, g, b), B
            Else
                r = 0: g = 0: b = 255
                Circle (455 + x * 20 + 10, 150 + y * 20 + 10), 2, _RGB(r, g, b)
                Line (455 + x * 20, 150 + y * 20)-(455 + x * 20 + 20, 150 + y * 20 + 20), _RGB(r, g, b), B
            End If
    Next y, x
End If

If Boat = NBBATEAUX + 1 Then
    pfini = pfini + 1
    nbc(partie) = nombredecoup
    Select Case partie
        Case 0, 5, 6
            If nombredecoup < 38 Then retente = 0
        Case 1, 2, 3, 4
            If nombredecoup < 28 Then retente = 0
    End Select
    If retente = 0 Then partie = partie + 1: nbp(partie - 1) = pfini: pfini = 0 Else nombredecoup = 0
    TotC = TotC + nombredecoup
    '_Display
    GoTo 36
End If
If InKey$ = Chr$(27) Then End
GoTo 45

Sub trace (x, y, reponse)
    Select Case reponse
        Case 0 'water
            r = 0: g = 50: b = 128
        Case 1 'touche
            r = 255: g = 0: b = 0
        Case 2 'coule
            r = 255: g = 0: b = 0
    End Select
    If reponse > 0 Then
        Line (458 + x * 20, 153 + y * 20)-(458 + x * 20 + 16, 151 + y * 20 + 16), _RGB(r, g, b), B
    Else
        Circle (455 + x * 20 + 10, 150 + y * 20 + 10), 1, _RGB(r, g, b)
    End If
End Sub
Sub choix (x, y, cc)
    145
    Select Case AI
        Case 0
            If cc = 0 Then stat2 x, y Else stat x, y
        Case 1
            HBGD x, y
            passATAC = 0
        Case 2
            attac0 x, y
            If AI = 3 Then
                passATAC = 0
                Select Case DIRECTION
                    Case 0
                        If Rnd < .5 Then DIRECTION = 2 Else DIRECTION = 3
                    Case 1
                        If Rnd < .5 Then DIRECTION = 3 Else DIRECTION = 2
                    Case 2
                        If Rnd < .5 Then DIRECTION = 0 Else DIRECTION = 1
                    Case 3
                        If Rnd < .5 Then DIRECTION = 1 Else DIRECTION = 0
                End Select
                sauvX = memX(mxCUR)
                sauvY = memY(mxCUR)
                GoTo 145
            End If
        Case 3
            attac1 sauvX, sauvY, x, y
    End Select
End Sub
Sub IA (rep, x, y)
    Select Case rep
        Case 0
            Select Case AI
                Case 0
                    AI = 0
                Case 1
                    AI = 1
                Case 2
                    If passATAC = 0 Then
                        Select Case DIRECTION
                            Case 0
                                DIRECTION = 1
                                CUR = 0
                            Case 1
                                DIRECTION = 0
                                CUR = 0
                            Case 2
                                DIRECTION = 3
                                CUR = 0
                            Case 3
                                DIRECTION = 2
                                CUR = 0
                        End Select
                        passATAC = 1
                    Else
                        AI = 3
                        Select Case DIRECTION
                            Case 0
                                DIRECTION = 2
                            Case 1
                                DIRECTION = 3
                            Case 2
                                DIRECTION = 0
                            Case 3
                                DIRECTION = 1
                        End Select
                        passATAC = 0
                        sauvX = memX(mxCUR) 'CUR = 0
                        sauvY = memY(mxCUR)
                    End If
                Case 3
                    If passATAC = 0 Then
                        Select Case DIRECTION
                            Case 0
                                DIRECTION = 1
                            Case 1
                                DIRECTION = 0
                            Case 2
                                DIRECTION = 3
                            Case 3
                                DIRECTION = 2
                        End Select
                        passATAC = 1
                        sauvX = memX(mxCUR)
                        sauvY = memY(mxCUR)

                    End If
            End Select
        Case 1
            GrilleAI(x, y) = 2
            Select Case AI
                Case 0
                    ReDim memX(NBCELL - 1), memY(NBCELL - 1)
                    CUR = 0
                    memX(CUR) = x: memY(CUR) = y
                    AI = 1
                Case 1
                    CUR = CUR + 1
                    mxCUR = CUR
                    memX(CUR) = x: memY(CUR) = y
                    AI = 2
                Case 2
                    CUR = CUR + 1
                    mxCUR = CUR
                    memX(CUR) = x: memY(CUR) = y
                    AI = 2
                Case 3
                    sauvX = x
                    sauvY = y
                    AI = 3
            End Select
        Case 2
            GrilleAI(x, y) = 2
            Select Case AI
                Case 0, 1, 2
                    CUR = 0
                    AI = 0
                Case 3
                    mxCUR = mxCUR - 1
                    If mxCUR < 0 Then
                        AI = 0
                        mxCUR = 0
                        CUR = 0
                    Else
                        Select Case DIRECTION
                            Case 0
                                If Rnd < .5 Then DIRECTION = 1
                            Case 1
                                If Rnd < .5 Then DIRECTION = 0
                            Case 2
                                If Rnd < .5 Then DIRECTION = 3
                            Case 3
                                If Rnd < .5 Then DIRECTION = 2
                        End Select
                        sauvX = memX(mxCUR)
                        sauvY = memY(mxCUR)
                        passATAC = 0
                    End If
            End Select
            If KNOWBOAT = 1 Then
                ox = x: oy = y
                MemB(GrilleJouBAT(ox, oy)) = 0
                x = ox: y = oy
            End If
    End Select
End Sub
Sub stat (pox, poy)
    For x = 0 To NBCELL - 1
        For y = 0 To NBCELL - 1
            If GrilleAI(x, y) = 0 Then GrilleProb(x, y) = .1 Else GrilleProb(x, y) = 0
    Next y, x
    For i = 0 To NBBATEAUX
        If plusorb < MemB(i) And MemB(i) < 7 Then plusorb = MemB(i)
    Next i
    If KNOWBOAT = 1 Then
        For g = 0 To NBBATEAUX
            If MemB(g) > 0 And MemB(g) < 7 Then
                xa = MemB(g)
                ya = 1
                For x = 0 To NBCELL - 1
                    For y = 0 To NBCELL - 1
                        TESTbateau x, y, xa, ya, plusorb
                        TESTbateau x, y, ya, xa, plusorb
                Next y, x
            End If
        Next g
    Else
        For g = 0 To NBBATEAUX
            If MemB(g) < 7 Then
                xa = MemB(g)
                ya = 1
                For x = 0 To NBCELL - 1
                    For y = 0 To NBCELL - 1
                        TESTbateau x, y, xa, ya, plusorb
                        TESTbateau x, y, ya, xa, plusorb
                Next y, x
            End If
        Next g
    End If
    bob = 0
    ReDim cvX((NBCELL * NBCELL * .5) + .5), cvY((NBCELL * NBCELL * .5) + .5)
    For x = 0 To NBCELL - 1
        If sty = 0 Then sty = 1 Else sty = 0
        For y = sty To NBCELL - 1 Step 2
            cvX(bob) = x
            cvY(bob) = y
            bob = bob + 1
    Next y, x
    Randomize Timer(.00001)
    444
    lim = Int((NBCELL - 1) / 5)

    kop = 0
    For x = 0 To NBCELL - 1
        For y = 0 To NBCELL - 1
            cl = GrilleProb(x, y) * (2)
            'Line (258 + x * 20, 153 + y * 20)-(258 + x * 20 + 16, 151 + y * 20 + 16), _RGBA(cl, cl, cl, 25), BF
            If cl > kop And GrilleAI(x, y) = 0 Then
                For i = 0 To bob - 1
                    If x = cvX(i) And y = cvY(i) Then
                        pox = x
                        poy = y
                        kop = cl
                        doit = 1
                    End If
                Next i
            End If
    Next y, x
    If boot > 10 And doit = 0 Then
        sty = 1: bob = 0
        ReDim cvX(NBCELL * NBCELL * .5 + .5), cvY(NBCELL * NBCELL * .5 + .5)
        For x = 0 To NBCELL - 1
            If sty = 0 Then sty = 1 Else sty = 0
            For y = sty To NBCELL - 1 Step 2
                cvX(bob) = x
                cvY(bob) = y
                bob = bob + 1
        Next y, x
        GoTo 444
    End If
    If doit = 0 Then boot = boot + 1: GoTo 444
End Sub
Sub HBGD (pox, poy)
    x = memX(CUR): y = memY(CUR)
    esp = 1
    i = -1
    pxl = x: pyl = y
    stat pxl, pyl
    tente0 = -1: tente1 = -1: tente2 = -1: tente3 = -1
    340
    fait = 0
    For i = 0 To 3
        Select Case i
            Case 0 'n
                If y - esp >= 0 Then
                    If GrilleAI(x, y - esp) = 0 Then
                        px = x: py = y - esp
                        mix0 = GrilleProb(x, y - esp)

                        fait = 1
                    Else
                        tente0 = GrilleAI(x, y - esp)

                    End If
                Else
                    tente0 = 1
                End If
            Case 1 's
                If y + esp <= NBCELL - 1 Then
                    If GrilleAI(x, y + esp) = 0 Then
                        px = x: py = y + esp
                        mix1 = GrilleProb(x, y + esp)
                        fait = 1
                    Else
                        tente1 = GrilleAI(x, y + esp)
                    End If
                Else
                    tente1 = 1
                End If
            Case 2 'e
                If x - esp >= 0 Then
                    If GrilleAI(x - esp, y) = 0 Then
                        px = x - esp: py = y
                        mix2 = GrilleProb(x - esp, y)
                        fait = 1
                    Else
                        tente2 = GrilleAI(x - esp, y)
                    End If
                Else
                    tente2 = 1
                End If
            Case 3 'o
                If x + esp <= NBCELL - 1 Then
                    If GrilleAI(x + esp, y) = 0 Then
                        px = x + esp: py = y
                        mix3 = GrilleProb(x + esp, y)
                        fait = 1
                    Else
                        tente3 = GrilleAI(x + esp, y)
                    End If
                Else
                    tente3 = 1
                End If
        End Select
    Next i
    If tente1 >= 1 And tente0 >= 1 And tente2 >= 1 And tente3 >= 1 Then
        ttt = 0
        af = 0
        If tente0 = 2 Then i = 0
        If tente1 = 2 Then i = 1
        If tente2 = 2 Then i = 2
        If tente3 = 2 Then i = 3
        tente1 = -1: tente0 = -1: tente2 = -1: tente3 = -1
        mix0 = 0: mix1 = 0: mix2 = 0: mix3 = 0:
        esp = esp + 1
        '  i = ttt
        GoTo 340
    End If
    If tente0 = -1 Then af = mix0: ttt = 0
    If tente1 = -1 Then If mix1 > af Then af = mix1: ttt = 1
    If tente2 = -1 Then If mix2 > af Then af = mix2: ttt = 2
    If tente3 = -1 Then If mix3 > af Then af = mix3: ttt = 3
    Select Case ttt
        Case 0
            pox = x: poy = y - esp
        Case 1
            pox = x: poy = y + esp
        Case 2
            pox = x - esp: poy = y
        Case 3
            pox = x + esp: poy = y
    End Select
    DIRECTION = ttt
End Sub

Sub attac0 (pox, poy)
    memDIRECTION = DIRECTION
    x = memX(CUR)
    y = memY(CUR)
    1012
    fait = 0
    Select Case DIRECTION
        Case 0
            If y - 1 >= 0 Then
                Select Case GrilleAI(x, y - 1)
                    Case 0
                        px = x: py = y - 1
                        fait = 1
                    Case 1
                        DIRECTION = 1
                    Case 2
                        y = y - 1: GoTo 1012
                End Select
            Else
                DIRECTION = 1
            End If
        Case 1 's
            If y + 1 <= NBCELL - 1 Then
                Select Case GrilleAI(x, y + 1)
                    Case 0
                        px = x: py = y + 1
                        fait = 1
                    Case 1
                        DIRECTION = 0
                    Case 2
                        y = y + 1: GoTo 1012
                End Select
            Else
                DIRECTION = 0
            End If
        Case 2 'e
            If x - 1 >= 0 Then
                Select Case GrilleAI(x - 1, y)
                    Case 0
                        px = x - 1: py = y
                        fait = 1
                    Case 1
                        DIRECTION = 3
                    Case 2
                        x = x - 1: GoTo 1012
                End Select
            Else
                DIRECTION = 3
            End If
        Case 3 'o
            If x + 1 <= NBCELL - 1 Then
                Select Case GrilleAI(x + 1, y)
                    Case 0
                        px = x + 1: py = y
                        fait = 1
                    Case 1
                        DIRECTION = 2
                    Case 2
                        x = x + 1: GoTo 1012
                End Select
            Else
                DIRECTION = 2
            End If
    End Select
    If memDIRECTION <> DIRECTION And passATAC = 0 Then
        x = memX(0)
        y = memY(0)
        passATAC = 1
        GoTo 1012
    End If
    If passATAC = 1 And fait = 0 Then AI = 3
    If fait = 1 Then
        pox = px
        poy = py
    End If
End Sub
Sub attac1 (svx, svy, pox, poy)
    memDIRECTION = DIRECTION
    1011
    x = svx
    y = svy
    1012
    fait = 0
    Select Case DIRECTION
        Case 0
            If y - 1 >= 0 Then
                Select Case GrilleAI(x, y - 1)
                    Case 0
                        px = x: py = y - 1
                        fait = 1
                    Case 1
                        DIRECTION = 1
                    Case 2
                        y = y - 1: GoTo 1012
                End Select
            Else
                DIRECTION = 1
            End If
        Case 1 's
            If y + 1 <= NBCELL - 1 Then
                Select Case GrilleAI(x, y + 1)
                    Case 0
                        px = x: py = y + 1
                        fait = 1
                    Case 1
                        DIRECTION = 0
                    Case 2
                        y = y + 1: GoTo 1012
                End Select
            Else
                DIRECTION = 0
            End If
        Case 2 'e
            If x - 1 >= 0 Then
                Select Case GrilleAI(x - 1, y)
                    Case 0
                        px = x - 1: py = y
                        fait = 1
                    Case 1
                        DIRECTION = 3
                    Case 2
                        x = x - 1: GoTo 1012
                End Select
            Else
                DIRECTION = 3
            End If
        Case 3 'o
            If x + 1 <= NBCELL - 1 Then
                Select Case GrilleAI(x + 1, y)
                    Case 0
                        px = x + 1: py = y
                        fait = 1
                    Case 1
                        DIRECTION = 2
                    Case 2
                        x = x + 1: GoTo 1012
                End Select
            Else
                DIRECTION = 2
            End If
    End Select
    If memDIRECTION <> DIRECTION And passATAC = 0 Then
        x = svx
        y = svy
        passATAC = 1
        memDIRECTION = DIRECTION
        GoTo 1012
    End If
    If fait = 1 Then
        pox = px
        poy = py
    End If
End Sub
Function envoi (x, y)
    If GrilleJoueur(x, y) = 1 Then
        Btestjoue(GrilleJouBAT(x, y)) = Btestjoue(GrilleJouBAT(x, y)) - 1
        envoi = 1
        nto = 0
        For dfi = 0 To NBBATEAUX
            If Btestjoue(dfi) = 0 Then nto = nto + 1
        Next dfi
        If nto <> Boat Then Boat = nto: envoi = 2
    Else
        envoi = 0
    End If
End Function

Sub placebateau
    Shared COT$()
    For encour = 0 To 4
        o$ = Left$(COT$(encour), 1)
        l$ = Mid$(COT$(encour), 2, 1)
        ty = Val(Right$(COT$(encour), 1))
        tx = Asc(l$)
        x = tx - 65 - 32: y = ty
        If o$ = "h" Then Swap B(encour).tx, B(encour).ty
        If poss(x, y, B(encour).tx, B(encour).ty) Then
            If B(encour).tx < B(encour).ty Then
                For by = y To y + B(encour).ty - 1
                    GrilleJoueur(x, by) = 1
                    GrilleJouBAT(x, by) = encour
                Next by
                Btestjoue(encour) = B(encour).ty
            Else
                For bx = x To x + B(encour).tx - 1
                    GrilleJoueur(bx, y) = 1
                    GrilleJouBAT(bx, y) = encour
                Next bx
                Btestjoue(encour) = B(encour).tx
            End If
        Else
            Print "Problem with data set"; v
            _Delay 5
        End If
        MemB(encour) = B(encour).coule
    Next encour
End Sub
Sub stat2 (pox, poy)
    top = 0
    haz:
    x = Int(Rnd * (NBCELL))
    y = Int(Rnd * (NBCELL))
    If x > NBCELL - 1 Or y > NBCELL - 1 Or x < 0 Or y < 0 Then GoTo haz
    For encour = 0 To 4
        If possAI(x, y, 1, MemB(encour)) Or possAI(x, y, MemB(encour), 1) Then
            top = 1
        End If
    Next encour
    If top Then pox = x: poy = y Else GoTo haz
End Sub
Function poss (x, y, tx, ty)
    If tx < ty Then
        For uy = y To y + ty - 1
            If uy < NBCELL Then
                If GrilleJoueur(x, uy) = 1 Then poss = 0: Exit Function
            Else
                poss = 0
                Exit Function
            End If
        Next uy
    Else
        For ux = x To x + tx - 1
            If ux < NBCELL Then
                If GrilleJoueur(ux, y) = 1 Then poss = 0: Exit Function
            Else
                poss = 0
                Exit Function
            End If
        Next ux
    End If
    poss = 1
End Function
Sub TESTbateau (x, y, xa, ya, u)
    tp = (Int((Abs((NBCELL - 1) * .5 - x) + Abs((NBCELL - 1) * .5 - y)) * .5) / NBCELL) * 10
    If possAI(x, y, xa, ya) Then
        If xa < ya Then
            If ya = u Then plus = 1 + u
            For by = y To y + ya - 1
                If GrilleAI(x, by) = 0 Then GrilleProb(x, by) = GrilleProb(x, by) + (ya + plus + tp)
            Next by
        Else
            If xa = u Then plus = 1 + u
            For bx = x To x + xa - 1
                If GrilleAI(bx, y) = 0 Then GrilleProb(bx, y) = GrilleProb(bx, y) + (xa + plus + tp)
            Next bx
        End If
    End If
End Sub
Function testAI (x, y, tx, ty)
    If tx < ty Then
        For uy = y To y + ty - 1

            If GrilleAI(x, uy) = 2 Then testAIk = testAIk + 2

        Next uy
    Else
        For ux = x To x + tx - 1

            If GrilleAI(ux, y) = 2 Then testAIk = testAIk + 2

        Next ux
    End If
    testAI = testAIk
End Function
Function possAI (x, y, tx, ty)
    If tx < ty Then
        For uy = y To y + ty - 1
            If uy < NBCELL Then
                If GrilleAI(x, uy) = 1 Then possAI = 0: Exit Function
            Else
                possAI = 0
                Exit Function
            End If
        Next uy
    Else
        For ux = x To x + tx - 1
            If ux < NBCELL Then
                If GrilleAI(ux, y) = 1 Then possAI = 0: Exit Function
            Else
                possAI = 0
                Exit Function
            End If
        Next ux
    End If
    possAI = 1
End Function

ubi44 , Battleship Olympics

Post by ubi44 on Aug 6, 2024 10:51:33 GMT

Post by bplus on Aug 6, 2024 13:01:33 GMT

Post by ubi44 on Aug 6, 2024 13:15:02 GMT

Post by bplus on Aug 6, 2024 13:22:11 GMT

Post by ubi44 on Aug 6, 2024 13:48:58 GMT

Post by bplus on Aug 6, 2024 15:41:01 GMT

Post by ubi44 on Aug 9, 2024 9:54:25 GMT