:: Игры Разума
• Войти
Страницы:  1 2 3
Re: Алгоритмы и программы
leonid

Сообщений: 3204
Откуда: Рига
Дата регистрации: 03.02.2006
leonid
18.07.07 18:33:07
Вот еще один вариант, усовершенствованный. Позволяет брать ходы назад при помощи BackSpace 
close all

clear all

set talk off

set deleted on



#DEFINE XCNT 6

#DEFINE YCNT 6



#DEFINE SHAG 40



declare Sleep in Win32API Integer





create cursor cher_hody (hod C(2))



m.xdim=XCNT    

m.ydim=YCNT    

create cursor xcoor (x I)    

create cursor ycoor (y I)    

for i=1 to m.xdim    

    insert into xcoor values (i)    

next    

for i=1 to m.ydim    

    insert into ycoor values (i)    

next    

    

select x,y from xcoor, ycoor into cursor xycoor    

    

select xy1.x as x1, xy1.y as y1, xy2.x as x2, xy2.y as y2 ;    

    from xycoor xy1 join xycoor xy2 on xy1.x<xy2.x and xy1.y<=xy2.y ;    

    into cursor ver12    

    

select x1, y1, x2, y2, x2+y1-y2 as x3, y2+x2-x1 as y3, ;    

        x1+y1-y2 as x4, y1+x2-x1 as y4 ;    

    from ver12 where x1+y1-y2>0 and y2+x2-x1<=m.ydim ;    

    into cursor ver1234    



select str(x1,1,0)+str(y1,1,0) as v1, str(x2,1,0)+str(y2,1,0) as v2, ;    

    str(x3,1,0)+str(y3,1,0) as v3, str(x4,1,0)+str(y4,1,0) as v4 ;    

    from ver1234 order by 1 into cursor kvadr





oForm=NEWOBJECT("form1")



for m.i=1 to YCNT



    oForm.ADDOBJECT("linex"+allt(str(i)),"line")

    with eval("oForm.linex"+allt(str(i)))

        .Height = 0

        .Left = SHAG

        .Top = SHAG*m.i

        .Width = SHAG*(XCNT-1)

        .visible=.t.

    endwith



next





for m.i=1 to XCNT



    oForm.ADDOBJECT("liney"+allt(str(i)),"line")

    with eval("oForm.liney"+allt(str(i)))

        .Height = SHAG*(YCNT-1)

        .Left = SHAG*m.i

        .Top = SHAG

        .Width = 0

        .visible=.t.

    endwith



next





for m.i=1 to XCNT

    for m.j=1 to YCNT



    oForm.ADDOBJECT("fishka"+allt(str(m.i))+allt(str(m.j)),"fishka")

    with eval("oForm.fishka"+allt(str(m.i))+allt(str(m.j)))

        .Top = SHAG*m.j-SHAG/4

        .Left = SHAG*m.i-SHAG/4

        .visible=.t.

    endwith



    next

next





oform.Show

RETURN





DEFINE CLASS form1 AS form





    Autocenter=.t.

    Height = SHAG*(YCNT+1)

    Width = SHAG*(XCNT+1)

    DoCreate = .T.

    Caption = "Kvadratobojaznj"

    WindowType = 1

    MinButton=.f.

    MaxButton=.f.

    Name = "Form1"

    finished = .f.

    kbd=.t.

    

    Procedure otv_hod

    lparameters m.xcoor, m.ycoor



    m.xy=allt(str(m.xcoor))+allt(str(m.ycoor))

    insert into cher_hody values(m.xy)





    select * from kvadr where ;  

          v1 in (select * from cher_hody) and ;  

          v2 in (select * from cher_hody) and ;  

          v3 in (select * from cher_hody) and ;  

          v4 in (select * from cher_hody);  

          into cursor kv  



    if _tally>0



        Thisform.setall("enabled", .f.)



        Thisform.kbd=.f.

        for m.j=1 to 3

            for m.i=1 to 4

                with eval("Thisform.fishka"+eval("kv.v"+allt(str(m.i))))

                    .backcolor=RGB(255,0,0)

                endwith

            next

            doevents()

            sleep(250)

            for m.i=1 to 4

                with eval("Thisform.fishka"+eval("kv.v"+allt(str(m.i))))

                    .backcolor=0

                endwith

            next

            doevents()

            sleep(250)

        next

        for m.i=1 to 4

            with eval("Thisform.fishka"+eval("kv.v"+allt(str(m.i))))

                .backcolor=RGB(255,0,0)

            endwith

        next

        Thisform.finished=.t.

        Thisform.kbd=.t.

        return

    endif



    with eval("Thisform.fishka"+allt(str(XCNT+1-m.xcoor))+allt(str(YCNT+1-m.ycoor)))

        .backstyle=1

        .backcolor=0xFFFFFF

    endwith

    



    procedure keypress

    LPARAMETERS nKeyCode, nShiftAltCtrl

    do case

        case nShiftAltCtrl=0 and nKeyCode=127 and Thisform.kbd

            select count(*) from cher_hody into array ar1

            if ar1=0

                return

            endif

            select cher_hody

            go bottom

            Thisform.rem_hod(cher_hody.hod)

    endcase





    procedure rem_hod

    lparameter m.xy



    if !Thisform.finished

        with eval("Thisform.fishka"+m.xy)

            .backstyle=0

        endwith

        with eval("Thisform.fishka"+allt(str(XCNT+1-val(left(m.xy,1))))+ ;

                allt(str(YCNT+1-val(right(m.xy,1)))))

            .backstyle=0

        endwith

    else



        for m.i=1 to XCNT

            for m.j=1 to YCNT

                with eval("Thisform.fishka"+allt(str(m.i))+allt(str(m.j)))

                    if .backcolor=RGB(255,0,0)

                        .backcolor=0

                    endif

                endwith

            next

        next



        with eval("Thisform.fishka"+m.xy)

            .backstyle=0

        endwith

        with eval("Thisform.fishka"+allt(str(XCNT+1-val(left(m.xy,1))))+ ;

                allt(str(YCNT+1-val(right(m.xy,1)))))

            .backstyle=0

        endwith

        

        Thisform.finished=.f.



        Thisform.setall("enabled", .t.)

    endif

    select cher_hody

    delete

                

ENDDEFINE





DEFINE CLASS fishka AS shape



        Height = SHAG/2

        Width = SHAG/2

        BackStyle = 0

        BorderStyle = 0

        Curvature = 90

        

        Procedure DblClick

        

        if This.backstyle=1

            return

        endif

        This.BackColor = 0

        This.backstyle=1

        Thisform.otv_hod((This.left+SHAG/4)/SHAG,(This.top+SHAG/4)/SHAG)

        



ENDDEFINE
Ratings: 0 negative/0 positive
Re: Алгоритмы и программы
Igor Korolyov

Сообщений: 34580
Дата регистрации: 28.05.2002
Igor Korolyov
19.07.07 16:14:00
Hi All!

Пока вышло нечто вроде этого - на квадратных полях до 5*5 дело обычно завершается ничьёй (в т.ч. и при "симметричной" стратегии) - на полях большего размера найти ничью увы не удаётся - причем с ростом размера растёт и число пустых полей (т.е. проигрыш наступает раньше). На поле 6*6 не хватает всего 2-х точек - т.е. одного хода до ничьи
P.S. Код под VFP9. И естественно не оптимизирован никак и является избыточным - по сути наброски для одной из возможных стратегий... 



CLEAR

LOCAL lnX, lnY, o1

lnX = 0

lnY = 0

DO WHILE INKEY()#27

o1 = .null.

o1 = CREATEOBJECT("AvoidSquares")

*o1.DoMove(5, 5)

FOR ln1 = 1 TO o1.nSize^2+1

  IF o1.OfferMove(o1.nPlayerTurn, @m.lnX, @m.lnY)

    *? "Found move for: " + TRANSFORM(o1.nPlayerTurn) + " (" + ;

      TRANSFORM(m.lnX) + ", " + TRANSFORM(m.lnY) + ")"

    o1.DoMove(m.lnX, m.lnY)

    o1.DoMove(o1.nSize-m.lnX+1, o1.nSize-m.lnY+1)

    *o1.PrintMoves()

  ELSE

    o1.PrintMoves()

    EXIT

  ENDIF

ENDFOR

IF INKEY(20) = 27

  SUSPEND

ENDIF

ENDDO

RETURN



DEFINE CLASS AvoidSquares AS Session

nSize = 6

nPlayerTurn = 0



PROCEDURE OfferMove(tnPlayer, tnX, tnY)

* First we rank all free points

This.GetPointsForMove(m.tnPlayer)

* Try to use one of the points from the most safe range

DO CASE

*!*   CASE RECCOUNT("BPoints") # 0 OR RECCOUNT("NPoints") # 0 OR ;

*!*       RECCOUNT("My1DPoints") # 0 OR RECCOUNT("My2DPoints") # 0

*!*     SELECT x, y ;

*!*       FROM BPoints ;

*!*     UNION ;

*!*     SELECT x, y ;

*!*       FROM NPoints;

*!*     UNION ;

*!*     SELECT x, y ;

*!*       FROM My1DPoints ;

*!*     UNION ;

*!*     SELECT x, y ;

*!*       FROM My2DPoints ;

*!*     INTO CURSOR p1

*!*     SELECT x, y, ;

*!*         CAST(0 AS Integer) n, ;

*!*         CAST(0 AS Integer) b, ;

*!*         CAST(0 AS Integer) s2, ;

*!*         CAST(0 AS Integer) s1, ;

*!*         CAST(0 AS Integer) o3, ;

*!*         CAST(0 AS Integer) o2, ;

*!*         CAST(0 AS Integer) o1, ;

*!*         CAST(0 AS Integer) cnt, ;

*!*         CAST(0 AS Integer) rnd ;

*!*       FROM p1 ;

*!*       INTO CURSOR MoveEstimate READWRITE

*!*     USE IN SELECT("p1")

CASE RECCOUNT("BPoints") # 0

  * there are blocked points

  SELECT x, y, ;

      CAST(0 AS Integer) n, ;

      CAST(0 AS Integer) b, ;

      CAST(0 AS Integer) s2, ;

      CAST(0 AS Integer) s1, ;

      CAST(0 AS Integer) o3, ;

      CAST(0 AS Integer) o2, ;

      CAST(0 AS Integer) o1, ;

      CAST(0 AS Integer) cnt, ;

      CAST(0 AS Integer) rnd ;

    FROM BPoints ;

    INTO CURSOR MoveEstimate READWRITE

CASE RECCOUNT("NPoints") # 0

  * there are 0D points

  SELECT x, y, ;

      CAST(0 AS Integer) n, ;

      CAST(0 AS Integer) b, ;

      CAST(0 AS Integer) s2, ;

      CAST(0 AS Integer) s1, ;

      CAST(0 AS Integer) o3, ;

      CAST(0 AS Integer) o2, ;

      CAST(0 AS Integer) o1, ;

      CAST(0 AS Integer) cnt, ;

      CAST(0 AS Integer) rnd ;

    FROM NPoints ;

    INTO CURSOR MoveEstimate READWRITE

CASE RECCOUNT("My1DPoints") # 0

  * there are 1D points

  SELECT x, y, ;

      CAST(0 AS Integer) n, ;

      CAST(0 AS Integer) b, ;

      CAST(0 AS Integer) s2, ;

      CAST(0 AS Integer) s1, ;

      CAST(0 AS Integer) o3, ;

      CAST(0 AS Integer) o2, ;

      CAST(0 AS Integer) o1, ;

      CAST(0 AS Integer) cnt, ;

      CAST(0 AS Integer) rnd ;

    FROM My1DPoints ;

    INTO CURSOR MoveEstimate READWRITE

CASE RECCOUNT("My2DPoints") # 0

  * there are 2D points

  SELECT x, y, ;

      CAST(0 AS Integer) n, ;

      CAST(0 AS Integer) b, ;

      CAST(0 AS Integer) s2, ;

      CAST(0 AS Integer) s1, ;

      CAST(0 AS Integer) o3, ;

      CAST(0 AS Integer) o2, ;

      CAST(0 AS Integer) o1, ;

      CAST(0 AS Integer) cnt, ;

      CAST(0 AS Integer) rnd ;

    FROM My2DPoints ;

    INTO CURSOR MoveEstimate READWRITE

CASE RECCOUNT("My3DPoints") # 0

  * there are only 3D points, player lose

  ? "Player " + TRANSFORM(m.tnPlayer) + " lose, rest points:" + TRANSFORM(This.nSize^2 - RECCOUNT("Moves"))

  RETURN .F.

  GO CEILING(RAND() * RECCOUNT("My3DPoints")) IN My3DPoints

  tnX = My3DPoints.x

  tnY = My3DPoints.y

  RETURN .T.

OTHERWISE

  * there are no free points

  ? "Draw!"

  MESSAGEBOX("Draw")

  SUSPEND

  RETURN .F.

ENDCASE

SELECT MoveEstimate

SCAN ALL

  This.GetAllSquaresForPoint(MoveEstimate.x, MoveEstimate.y)

  IF m.tnPlayer = 0

    SELECT SUM(IIF(v1 = 0 AND v0 = 0, 1, 0)) n, ;

        SUM(IIF(v1 # 0 AND v0 # 0, 1, 0)) b, ;

        SUM(IIF(v1 = 0 AND v0 = 2, 1, 0)) s2, ;

        SUM(IIF(v1 = 0 AND v0 = 1, 1, 0)) s1, ;

        SUM(IIF(v1 = 3 AND v0 = 0, 1, 0)) o3, ;

        SUM(IIF(v1 = 2 AND v0 = 0, 1, 0)) o2, ;

        SUM(IIF(v1 = 1 AND v0 = 0, 1, 0)) o1, ;

        COUNT(*) cnt ;

      FROM AllSquaresForPoint ;

      INTO CURSOR est

  ELSE

    SELECT SUM(IIF(v1 = 0 AND v0 = 0, 1, 0)) n, ;

        SUM(IIF(v1 # 0 AND v0 # 0, 1, 0)) b, ;

        SUM(IIF(v0 = 0 AND v1 = 2, 1, 0)) s2, ;

        SUM(IIF(v0 = 0 AND v1 = 1, 1, 0)) s1, ;

        SUM(IIF(v0 = 3 AND v1 = 0, 1, 0)) o3, ;

        SUM(IIF(v0 = 2 AND v1 = 0, 1, 0)) o2, ;

        SUM(IIF(v0 = 1 AND v1 = 0, 1, 0)) o1, ;

        COUNT(*) cnt ;

      FROM AllSquaresForPoint ;

      INTO CURSOR est

  ENDIF

  SELECT MoveEstimate

  REPLACE n WITH est.n, ;

      b WITH est.b, ;

      s2 WITH est.s2, ;

      s1 WITH est.s1, ;

      o3 WITH est.o3, ;

      o2 WITH est.o2, ;

      o1 WITH est.o1, ;

      cnt WITH est.cnt, ;

      rnd WITH RAND() * 1000000

ENDSCAN

SELECT TOP 1 x, y ;

  FROM MoveEstimate ;

  ORDER BY s2, s1, b DESC, n, o3, o2, o1, cnt, rnd ;

  INTO CURSOR BestMove

tnX = BestMove.x

tnY = BestMove.y

USE IN SELECT("est")

USE IN SELECT("BestMove")

USE IN SELECT("MoveEstimate")

RETURN .T.

ENDPROC



PROCEDURE GetSquareState(tnPlayer, tnX1, tnY1, tnX2, tnY2)

* Square state can be one of the following:

* (4) 4D - player has 4 points in vertices, the game is lost

* (3) 3D - player has 3 points in vertices, 4th vertex is clear

* (2) 2D - player has 2 points in vertices, 2 other vertices are clear

* (1) 1D - player has 1 point in vertexes, 3 other vertices are clear

* (0) 0D (neutral) - all 4 vertices are clear

* (7) B Blocked - both players have points (at least one) in vertices

* (-1) -1D - opponent has 3 points in vertices, 4th vertex is clear

* (-2) -2D - opponent has 2 points in vertices, 2 other vertices are clear

* (-3) -3D - opponent has 1 point in vertexes, 3 other vertices are clear

* (-4) -4D - opponent has 4 points in vertices, the game is won

* (5) Error - there is no such square

* (6) Serious error in AllSquares table - duplicate squares



* We calculate state from the player 0 point of view

* If we need state for player 1 - just apply simple conversion

IF m.tnPlayer = 1

  LOCAL lnState

  lnState = This.GetSquareState(0, m.tnX1, m.tnY1, m.tnX2, m.tnY2)

  IF INLIST(m.lnState, 5, 7)

    RETURN m.lnState

  ELSE

    RETURN -m.lnState

  ENDIF

ELSE

  * Main routine is here

  LOCAL lnState

  SELECT v0, v1 ;

    FROM AllSquares ;

    WHERE x1 = m.tnX1 AND y1 = m.tnY1 AND ;

      x2 = m.tnX2 AND y2 = m.tnY2 ;

    INTO CURSOR cnts

  DO CASE

  CASE _TALLY = 0

    lnState = 5

  CASE _TALLY > 1

    lnState = 6

  OTHERWISE

    DO CASE

    CASE cnts.v1 = 0

      * Player 1 has no points in vertices

      lnState = cnts.v0

    CASE cnts.v0 = 0

      lnState = -cnts.v1

    OTHERWISE

      lnState = 7

    ENDCASE

  ENDCASE

  USE IN SELECT("cnts")

  RETURN m.lnState

ENDIF

ENDPROC



PROCEDURE GetPointsForMove(tnPlayer)

* Get all clear points that belong to players 3D squares

* If player will make move into this square, he will lose

LOCAL lnCnt0

lnCnt0 = IIF(m.tnPlayer = 0, 3, 0)

SELECT x1 x, y1 y ;

  FROM AllSquares ;

  WHERE v0 = m.lnCnt0 AND v1 = 3 - m.lnCnt0 ;

UNION ;

SELECT x2 x, y2 y ;

  FROM AllSquares ;

  WHERE v0 = m.lnCnt0 AND v1 = 3 - m.lnCnt0 ;

UNION ;

SELECT x3 x, y3 y ;

  FROM AllSquares ;

  WHERE v0 = m.lnCnt0 AND v1 = 3 - m.lnCnt0 ;

UNION ;

SELECT x4 x, y4 y ;

  FROM AllSquares ;

  WHERE v0 = m.lnCnt0 AND v1 = 3 - m.lnCnt0 ;

INTO CURSOR ddp

SELECT x, y ;

  FROM ddp ;

  WHERE BINTOC(x) + BINTOC(y) NOT IN ;

      (SELECT BINTOC(x) + BINTOC(y) ;

        FROM Moves) ;

  INTO CURSOR My3DPoints



* Get all clear points that belong to players 2D squares

lnCnt0 = IIF(m.tnPlayer = 0, 2, 0)

SELECT x1 x, y1 y ;

  FROM AllSquares ;

  WHERE v0 = m.lnCnt0 AND v1 = 2 - m.lnCnt0 ;

UNION ;

SELECT x2 x, y2 y ;

  FROM AllSquares ;

  WHERE v0 = m.lnCnt0 AND v1 = 2 - m.lnCnt0 ;

UNION ;

SELECT x3 x, y3 y ;

  FROM AllSquares ;

  WHERE v0 = m.lnCnt0 AND v1 = 2 - m.lnCnt0 ;

UNION ;

SELECT x4 x, y4 y ;

  FROM AllSquares ;

  WHERE v0 = m.lnCnt0 AND v1 = 2 - m.lnCnt0 ;

INTO CURSOR ddp

SELECT x, y ;

  FROM ddp ;

  WHERE BINTOC(x) + BINTOC(y) NOT IN ;

      (SELECT BINTOC(x) + BINTOC(y) ;

        FROM Moves) AND ;

    BINTOC(x) + BINTOC(y) NOT IN ;

      (SELECT BINTOC(x) + BINTOC(y) ;

        FROM My3DPoints) ;

  INTO CURSOR My2DPoints



* Get all clear points that belong to players 1D squares

lnCnt0 = IIF(m.tnPlayer = 0, 1, 0)

SELECT x1 x, y1 y ;

  FROM AllSquares ;

  WHERE v0 = m.lnCnt0 AND v1 = 1 - m.lnCnt0 ;

UNION ;

SELECT x2 x, y2 y ;

  FROM AllSquares ;

  WHERE v0 = m.lnCnt0 AND v1 = 1 - m.lnCnt0 ;

UNION ;

SELECT x3 x, y3 y ;

  FROM AllSquares ;

  WHERE v0 = m.lnCnt0 AND v1 = 1 - m.lnCnt0 ;

UNION ;

SELECT x4 x, y4 y ;

  FROM AllSquares ;

  WHERE v0 = m.lnCnt0 AND v1 = 1 - m.lnCnt0 ;

INTO CURSOR ddp

SELECT x, y ;

  FROM ddp ;

  WHERE BINTOC(x) + BINTOC(y) NOT IN ;

      (SELECT BINTOC(x) + BINTOC(y) ;

        FROM Moves) AND ;

    BINTOC(x) + BINTOC(y) NOT IN ;

      (SELECT BINTOC(x) + BINTOC(y) ;

        FROM My3DPoints) AND ;

    BINTOC(x) + BINTOC(y) NOT IN ;

      (SELECT BINTOC(x) + BINTOC(y) ;

        FROM My2DPoints) ;

  INTO CURSOR My1DPoints



* Get all clear points that belong to 0D (neutral) squares

SELECT x1 x, y1 y ;

  FROM AllSquares ;

  WHERE v0 = 0 AND v1 = 0 ;

UNION ;

SELECT x2 x, y2 y ;

  FROM AllSquares ;

  WHERE v0 = 0 AND v1 = 0 ;

UNION ;

SELECT x3 x, y3 y ;

  FROM AllSquares ;

  WHERE v0 = 0 AND v1 = 0 ;

UNION ;

SELECT x4 x, y4 y ;

  FROM AllSquares ;

  WHERE v0 = 0 AND v1 = 0 ;

INTO CURSOR ddp

SELECT x, y ;

  FROM ddp ;

  WHERE BINTOC(x) + BINTOC(y) NOT IN ;

      (SELECT BINTOC(x) + BINTOC(y) ;

        FROM Moves) AND ;

    BINTOC(x) + BINTOC(y) NOT IN ;

      (SELECT BINTOC(x) + BINTOC(y) ;

        FROM My3DPoints) AND ;

    BINTOC(x) + BINTOC(y) NOT IN ;

      (SELECT BINTOC(x) + BINTOC(y) ;

        FROM My2DPoints) AND ;

    BINTOC(x) + BINTOC(y) NOT IN ;

      (SELECT BINTOC(x) + BINTOC(y) ;

        FROM My1DPoints) ;

  INTO CURSOR NPoints



* Get all clear points that belong only to blocked squares

SELECT x1 x, y1 y ;

  FROM AllSquares ;

  WHERE v0 # 0 AND v1 # 0 ;

UNION ;

SELECT x2 x, y2 y ;

  FROM AllSquares ;

  WHERE v0 # 0 AND v1 # 0 ;

UNION ;

SELECT x3 x, y3 y ;

  FROM AllSquares ;

  WHERE v0 # 0 AND v1 # 0 ;

UNION ;

SELECT x4 x, y4 y ;

  FROM AllSquares ;

  WHERE v0 # 0 AND v1 # 0 ;

INTO CURSOR ddp

SELECT x, y ;

  FROM ddp ;

  WHERE BINTOC(x) + BINTOC(y) NOT IN ;

      (SELECT BINTOC(x) + BINTOC(y) ;

        FROM Moves) AND ;

    BINTOC(x) + BINTOC(y) NOT IN ;

      (SELECT BINTOC(x) + BINTOC(y) ;

        FROM My3DPoints) AND ;

    BINTOC(x) + BINTOC(y) NOT IN ;

      (SELECT BINTOC(x) + BINTOC(y) ;

        FROM My2DPoints) AND ;

    BINTOC(x) + BINTOC(y) NOT IN ;

      (SELECT BINTOC(x) + BINTOC(y) ;

        FROM My1DPoints) AND ;

    BINTOC(x) + BINTOC(y) NOT IN ;

      (SELECT BINTOC(x) + BINTOC(y) ;

        FROM NPoints) ;

  INTO CURSOR BPoints



* Get all clear points that belong to opponents 3D squares

LOCAL lnCnt0

lnCnt0 = IIF(m.tnPlayer = 0, 0, 3)

SELECT x1 x, y1 y ;

  FROM AllSquares ;

  WHERE v0 = m.lnCnt0 AND v1 = 3 - m.lnCnt0 ;

UNION ;

SELECT x2 x, y2 y ;

  FROM AllSquares ;

  WHERE v0 = m.lnCnt0 AND v1 = 3 - m.lnCnt0 ;

UNION ;

SELECT x3 x, y3 y ;

  FROM AllSquares ;

  WHERE v0 = m.lnCnt0 AND v1 = 3 - m.lnCnt0 ;

UNION ;

SELECT x4 x, y4 y ;

  FROM AllSquares ;

  WHERE v0 = m.lnCnt0 AND v1 = 3 - m.lnCnt0 ;

INTO CURSOR ddp

SELECT x, y ;

  FROM ddp ;

  WHERE BINTOC(x) + BINTOC(y) NOT IN ;

      (SELECT BINTOC(x) + BINTOC(y) ;

        FROM Moves) ;

  INTO CURSOR Opponents3DPoints



* Get all clear points that belong to opponents 2D squares

lnCnt0 = IIF(m.tnPlayer = 0, 0, 2)

SELECT x1 x, y1 y ;

  FROM AllSquares ;

  WHERE v0 = m.lnCnt0 AND v1 = 2 - m.lnCnt0 ;

UNION ;

SELECT x2 x, y2 y ;

  FROM AllSquares ;

  WHERE v0 = m.lnCnt0 AND v1 = 2 - m.lnCnt0 ;

UNION ;

SELECT x3 x, y3 y ;

  FROM AllSquares ;

  WHERE v0 = m.lnCnt0 AND v1 = 2 - m.lnCnt0 ;

UNION ;

SELECT x4 x, y4 y ;

  FROM AllSquares ;

  WHERE v0 = m.lnCnt0 AND v1 = 2 - m.lnCnt0 ;

INTO CURSOR ddp

SELECT x, y ;

  FROM ddp ;

  WHERE BINTOC(x) + BINTOC(y) NOT IN ;

      (SELECT BINTOC(x) + BINTOC(y) ;

        FROM Moves) AND ;

    BINTOC(x) + BINTOC(y) NOT IN ;

      (SELECT BINTOC(x) + BINTOC(y) ;

        FROM Opponents3DPoints) ;

  INTO CURSOR Opponents2DPoints



* Get all clear points that belong to opponents 1D squares

lnCnt0 = IIF(m.tnPlayer = 0, 0, 1)

SELECT x1 x, y1 y ;

  FROM AllSquares ;

  WHERE v0 = m.lnCnt0 AND v1 = 1 - m.lnCnt0 ;

UNION ;

SELECT x2 x, y2 y ;

  FROM AllSquares ;

  WHERE v0 = m.lnCnt0 AND v1 = 1 - m.lnCnt0 ;

UNION ;

SELECT x3 x, y3 y ;

  FROM AllSquares ;

  WHERE v0 = m.lnCnt0 AND v1 = 1 - m.lnCnt0 ;

UNION ;

SELECT x4 x, y4 y ;

  FROM AllSquares ;

  WHERE v0 = m.lnCnt0 AND v1 = 1 - m.lnCnt0 ;

INTO CURSOR ddp

SELECT x, y ;

  FROM ddp ;

  WHERE BINTOC(x) + BINTOC(y) NOT IN ;

      (SELECT BINTOC(x) + BINTOC(y) ;

        FROM Moves) AND ;

    BINTOC(x) + BINTOC(y) NOT IN ;

      (SELECT BINTOC(x) + BINTOC(y) ;

        FROM Opponents3DPoints) AND ;

    BINTOC(x) + BINTOC(y) NOT IN ;

      (SELECT BINTOC(x) + BINTOC(y) ;

        FROM Opponents2DPoints) ;

  INTO CURSOR Opponents1DPoints



USE IN SELECT("ddp")

ENDPROC



PROCEDURE GetAllSquaresForPoint(tnX, tnY)

* Create cursor AllSquaresForPoint with all squares having vertex in passed point

SELECT * ;

  FROM AllSquares ;

  WHERE (x1 = m.tnX AND y1 = m.tnY) OR ;

    (x2 = m.tnX AND y2 = m.tnY) OR ;

    (x3 = m.tnX AND y3 = m.tnY) OR ;

    (x4 = m.tnX AND y4 = m.tnY) ;

  INTO CURSOR AllSquaresForPoint READWRITE

ENDPROC



PROCEDURE DoMove(tnX, tnY)

INSERT INTO Moves (nPlayer, x, y) VALUES (This.nPlayerTurn, m.tnX, m.tnY)

IF This.nPlayerTurn = 0

  UPDATE AllSquares ;

    SET v0 = v0 + 1 ;

    WHERE (x1 = m.tnX AND y1 = m.tnY) OR ;

    (x2 = m.tnX AND y2 = m.tnY) OR ;

    (x3 = m.tnX AND y3 = m.tnY) OR ;

    (x4 = m.tnX AND y4 = m.tnY)

ELSE

  UPDATE AllSquares ;

    SET v1 = v1 + 1 ;

    WHERE (x1 = m.tnX AND y1 = m.tnY) OR ;

    (x2 = m.tnX AND y2 = m.tnY) OR ;

    (x3 = m.tnX AND y3 = m.tnY) OR ;

    (x4 = m.tnX AND y4 = m.tnY)

ENDIF

This.nPlayerTurn = (This.nPlayerTurn + 1) % 2

ENDPROC



PROCEDURE PrintMoves

SELECT * ;

  FROM Moves ;

  ORDER BY y, x ;

  INTO CURSOR SortedMoves

IF _TALLY = 0

 ? "No moves were done"

 RETURN

ENDIF

? "Position after " + TRANSFORM(RECCOUNT("SortedMoves")) + " moves"

?

LOCAL lnY, lnX

FOR lnY = 1 TO This.nSize

  FOR lnX = 1 TO This.nSize

    IF lnX = SortedMoves.x AND ;

        lnY = SortedMoves.y

      ?? STR(SortedMoves.nPlayer, 1, 0) AT m.lnX

      SKIP 1 IN SortedMoves

    ELSE

      ?? "." AT m.lnX

    ENDIF

  ENDFOR

  ?

ENDFOR

USE IN SELECT("SortedMoves")

ENDPROC



PROCEDURE Init

LOCAL ln1

CREATE CURSOR nm (x I)

FOR ln1 = 1 TO This.nSize

  INSERT INTO nm (x) VALUES (m.ln1)

ENDFOR

SELECT nm1.x x, nm2.x y ;

  FROM nm nm1, nm nm2 ;

  INTO CURSOR AllPoints

SELECT pt1.x x1, pt1.y y1, ;

    pt2.x x2, pt2.y y2 ;

  FROM AllPoints pt1 ;

    INNER JOIN AllPoints pt2 ;

      ON pt2.x < pt1.x AND ;

        pt2.y >= pt1.y AND ;

        pt1.x + pt2.y - pt1.y <= This.nSize AND ;

        pt1.x + pt2.y - pt2.x <= This.nSize ;

  INTO CURSOR edge

* This cursor will hold all possible squares and players statistics

SELECT x1, y1, x2, y2, ;

    x2 + y2 - y1 x3, y2 + x1 - x2 y3, ;

    x1 + y2 - y1 x4, y1 + x1 - x2 y4, ;

    CAST(0 AS Integer) v0, ;

    CAST(0 AS Integer) v1 ;

  FROM edge ;

  INTO CURSOR AllSquares READWRITE

USE IN SELECT("nm")

USE IN SELECT("edge")



* This cursor will hold all players moves

CREATE CURSOR Moves (nPlayer I, x I, y I)



ENDPROC



ENDDEFINE


------------------
WBR, Igor
Ratings: 0 negative/0 positive
Re: Алгоритмы и программы
leonid

Сообщений: 3204
Откуда: Рига
Дата регистрации: 03.02.2006
leonid
19.07.07 18:08:44
Hi, Igor!
Цитата:
На поле 6*6 не хватает всего 2-х точек
Я тоже такую позицию нашел. А вот вничью сыграть не получится. Я перебрал все позиции - нет ничейной. Так что на четных досках, начиная с 6х6 начинающий проигрывает. Осталось разобраться с нечетными.
P.S. Код посмотрю дома, здесь девятки нет.
Ratings: 0 negative/0 positive
Re: Алгоритмы и программы
Igor Korolyov

Сообщений: 34580
Дата регистрации: 28.05.2002
Igor Korolyov
19.07.07 21:06:10
Hi leonid!

Напомни плиз как считается число позиций в таком случае (не учитывая зеркальные - т.е. просто размещения на N полях N/2 однородных объектов).

Для случая нечётных досок как я понимаю ситуация во многом схожая - если не ходить сразу в центр, то всё равно проигрываешь из-за симметричной стратегии - если походить - то по идее противник специальными "симметричными" ходами может привести к проигрышу...

И ещё - мне кажется что основная сложность (для человека) в этой игре - это просто найти квадрат - т.е. если играть на бумажке, то очень сложно определять проиграл ты уже или нет


------------------
WBR, Igor
Ratings: 0 negative/0 positive
Re: Алгоритмы и программы
leonid

Сообщений: 3204
Откуда: Рига
Дата регистрации: 03.02.2006
leonid
20.07.07 10:01:51
Hi Igor!
Igor Korolyov
Напомни плиз как считается число позиций в таком случае (не учитывая зеркальные - т.е. просто размещения на N полях N/2 однородных объектов)
Если я правильно помню, то это "це из эн по эн пополам", т.е. n!/((n/2)!*(n/2)!). Но это по памяти, может и ошибаюсь. Но я перебирал только позиции, которые встречаются при симметричной стратегии. Их поменьше, всего 2^(n/2). Перебрались где-то за пять минут.

Цитата:
Для случая нечётных досок как я понимаю ситуация во многом схожая - если не ходить сразу в центр, то всё равно проигрываешь из-за симметричной стратегии - если походить - то по идее противник специальными "симметричными" ходами может привести к проигрышу...
Все равно проигрываешь, если вообще не ходить в центр. В любой момент ход в центр сбивает симметричную стратегию, а вот "специальные "симметричные"" ходы - это надо подумать. Сразу не очень понятно, что это за ходы.

Цитата:
И ещё - мне кажется что основная сложность (для человека) в этой игре - это просто найти квадрат - т.е. если играть на бумажке, то очень сложно определять проиграл ты уже или нет
Вот это точно. Я попробовал, играешь, играешь, а потом выясняется, что проиграл уже пять ходов назад, или наоборот, выиграл. Так что без компьютера здесь делать нечего.

Я поигрался с твоим кодом вчера вечером, интересные вещи получаются. Если задокументировать в самом начале программы строку 
    o1.DoMove(o1.nSize-m.lnX+1, o1.nSize-m.lnY+1)
т.е. отключить симетричную стратегию за второго игрока, а в функции выбора хода 
SELECT TOP 1 x, y ;

  FROM MoveEstimate ;

  ORDER BY s2, s1, b DESC, n, o3, o2, o1, cnt, rnd ;

  INTO CURSOR BestMove
заменить на 
IF m.tnPlayer=1

    SELECT TOP 1 x, y ;

      FROM MoveEstimate ;

      ORDER BY s2, s1, b DESC, n, o3, o2, o1, cnt, rnd ;

      INTO CURSOR BestMove

else

    SELECT TOP 1 x, y ;

      FROM MoveEstimate ;

      ORDER BY o3, s2, o2, s1, o1, b DESC, n, cnt desc, rnd ;

      INTO CURSOR BestMove

endif
то программа за первого и за второго игрока будет играть разными стратегиями. За первого игрока (которому вроде какбы играть труднее) я поставил другую стратегию, при которой он не столько старается сделать хорошо себе, сколько плохо противнику. Вроде получается, что так первый игрок больше выигрывает, чем проигрывает, то есть вроде бы эта стратегия получше. Вообще здесь можно поиграться стратегиями, просто изменяя ORDER BY, или даже добавляя в него какие-нибудь веса. А потом провести круговой турнир между стратегиями. По 100 партий между каждыми, и выяснить какая сильней. Еще интересно, что иногда побеждает одна стратегия, а иногда другая и количество ходов разное бывает. Это говорит о том, что параметр rnd, хоть и стоит на последнем месте, оказывает существенное влияние. Но поскольку реально влиять он может в основном только на первых ходах, когда у остальных параметров шансы совпасть большие, то получается, что очень много зависит от дебюта, а поэтому программа, чтобы играть действительно сильно, должна знать хорошие дебюты. Впрочем при игре с человеком на доске 7х7 или больше, мне кажется и две приведенные выше стратегии уже будут практически непобедимы.
Ratings: 0 negative/0 positive
Re: Алгоритмы и программы
Igor Korolyov

Сообщений: 34580
Дата регистрации: 28.05.2002
Igor Korolyov
23.07.07 15:47:24
Hi leonid!

Цитата:
Если вообще не ходить в центр
- это по сути аналогично стратегии на чётной доске - т.е. если мы проигрываем ДО наступления последнего хода - то мы проигрываем БЕЗ этого хода
А вот "специальная стратегия" при первом ходе в центр доски - это должно быть просто - попытаться построить квадрат с вершиной в центре - поскольку в центре "не наша" точка - мы не проигрываем, а вот противник как раз и проигрывает
Вообще центральная точка - это точка в которой сходятся вершины наибольшего числа квадратов. Для чётных досок кстати всё так же - чем ближе к центру там больше квадратов "закрывает" точка. Субъективно конечно кажется что это плохой ход, но реально конечно может оказаться что это не так - если у меня в резерве есть "несмертельный" ход, а у противника - нет, то без разницы сколько квадратов я "почти закрыл"

Цитата:
В любой момент ход в центр сбивает симметричную стратегию
Для этого необходимо первыми тремя ходами (инициатива то первоначально у первого игрока) сделать 3D квадрат с пустой вершиной в центре (в силу симметрии у противника будет такой же 3D квадрат и он не сможет сделать ход в центр).
Насчёт того как манипулировать стратегиями ты точно подметил Однако проверяя "руками" мне показалось, что стратегия "насоли врагу" ведёт себя не лучше чем "обезопась себя"... А в случае симметричной стратегии разница вообще практически незаметна...

Я думал насчёт того чтобы отделить реализацию стратегии от основного блока игры - это позволит упростить "соревнование стратегий". Но пока не дошли руки... Для начала стоит вынести настройки (в т.ч. порядок ORDER BY, а в случае "взвешивания" - коэффициенты) и продумать интерфейс взаимодействия стретегии (игрока) с движком. Вспомогательные функции можно оставить и в движке.

P.S. Закомментированный блок соответствует стратегии, когда отделяются только "смертельные" ходы, а все прочие участвуют в оценке - на начальных стадиях это IMHO оказывает особенно большое влияние...

P.P.S. А насчёт игры с человеком - тут всё упирается именно в возможности человека "найти квадраты" - конечно они заведомо меньше чем у компьютера (в среднем - ведь наверняка есть уникумы просто "видящие" позицию - типа тех кто в уме извлекает корни разных степеней из 10-значных цифр )


------------------
WBR, Igor
Ratings: 0 negative/0 positive
Re: Алгоритмы и программы
leonid

Сообщений: 3204
Откуда: Рига
Дата регистрации: 03.02.2006
leonid
27.07.07 15:13:57
Что-то в последнее время все не было времени заняться этим у компьютера, только иногда (в транспорте) получалось в голове подумать. Так вот интересно получается. Если задачу чуть-чуть изменить, и вместо "любых" квадратов рассматривать только "правильные", т.е. такие, у которых стороны параллельны сторонам доски, то на достаточно большой доске ничьей все-равно быть не может. В отличие от "любых" квадратов, перебором этот результат не получишь, а доказательство его совершенно нетривиально (по крайней мере я не знаю достаточно простого). Размер минимальной доски, на которой ничьей быть не может я тоже не знаю, но если оценить на глазок, то должно быть где-то 12х12 - 16х16. Перебором - это слишком много, разве что только если очень сильно пооптимизировать.
Ratings: 0 negative/0 positive
Re: Алгоритмы и программы
leonid

Сообщений: 3204
Откуда: Рига
Дата регистрации: 03.02.2006
leonid
01.08.07 09:49:23
А вот кто не хочет попробовать поиграть с компьютером? Вообще выиграть у компьютера - задача достаточно безнадежная. Единственный вариант - на четной доске ходить вторым и выбрать симметричную стратегию. Ну или очень-очень долго тренироваться, но не думаю, что у кого-нибудь хватит терпения и времени. В алгоритме реализована стратегия, предложенная Игорем (ну или очень похожая на нее).
Ходить с помощью DblClick. Программа позволяет брать ходы обратно с помощью BackSpace. Без этого - ну никак. 

close all

clear all

set talk off

set deleted on



rand(-1)



#DEFINE XCNT 8

#DEFINE YCNT 8



#DEFINE SHAG 40



#DEFINE CHELOVEK 0

#DEFINE COMPUTER 1



declare Sleep in Win32API Integer





create cursor hody (cvet I, hod C(2))



m.xdim=XCNT    

m.ydim=YCNT    

create cursor xcoor (x I)    

create cursor ycoor (y I)    

for i=1 to m.xdim    

    insert into xcoor values (i)    

next    

for i=1 to m.ydim    

    insert into ycoor values (i)    

next    

    

select x,y from xcoor, ycoor into cursor xycoor    



select str(x,1,0)+str(y,1,0) as xy from xycoor into cursor xycoorc

    

select xy1.x as x1, xy1.y as y1, xy2.x as x2, xy2.y as y2 ;    

    from xycoor xy1 join xycoor xy2 on xy1.x<xy2.x and xy1.y<=xy2.y ;    

    into cursor ver12    

    

select x1, y1, x2, y2, x2+y1-y2 as x3, y2+x2-x1 as y3, ;    

        x1+y1-y2 as x4, y1+x2-x1 as y4 ;    

    from ver12 where x1+y1-y2>0 and y2+x2-x1<=m.ydim ;    

    into cursor ver1234    



select str(x1,1,0)+str(y1,1,0) as v1, str(x2,1,0)+str(y2,1,0) as v2, ;    

    str(x3,1,0)+str(y3,1,0) as v3, str(x4,1,0)+str(y4,1,0) as v4, ;

    0 as cher, 0 as bel ;    

    from ver1234 order by 1 into cursor kvadr1



use in select("kvadr")

use dbf("kvadr1") again in 0 alias kvadr

use in select("kvadr1")







oForm=NEWOBJECT("form1")



for m.i=1 to YCNT



    oForm.ADDOBJECT("linex"+allt(str(i)),"line")

    with eval("oForm.linex"+allt(str(i)))

        .Height = 0

        .Left = SHAG

        .Top = SHAG*m.i

        .Width = SHAG*(XCNT-1)

        .visible=.t.

    endwith



next





for m.i=1 to XCNT



    oForm.ADDOBJECT("liney"+allt(str(i)),"line")

    with eval("oForm.liney"+allt(str(i)))

        .Height = SHAG*(YCNT-1)

        .Left = SHAG*m.i

        .Top = SHAG

        .Width = 0

        .visible=.t.

    endwith



next





for m.i=1 to XCNT

    for m.j=1 to YCNT



    oForm.ADDOBJECT("fishka"+allt(str(m.i))+allt(str(m.j)),"fishka")

    with eval("oForm.fishka"+allt(str(m.i))+allt(str(m.j)))

        .Top = SHAG*m.j-SHAG/4

        .Left = SHAG*m.i-SHAG/4

        .visible=.t.

    endwith



    next

next





oform.Show

local m.x, m.y

do while type("oform")="O" and !isnull(oform)

    

    if oform.player(oform.hod+1)=COMPUTER and !oform.game_over

        oform.Vybratj_Hod(@m.x, @m.y)

        oform.shoditj(m.x, m.y)

    endif

    read events

enddo



RETURN





DEFINE CLASS form1 AS form





    Autocenter=.t.

    Height = SHAG*(YCNT+1)

    Width = SHAG*(XCNT+1)

    DoCreate = .T.

    Caption = "Kvadratobojaznj"

    WindowType = 0

    MinButton=.f.

    MaxButton=.f.

    Name = "Form1"

    finished = .f.

    kbd=.t.

    hod=0

    dimension player[2]

    player(1)=CHELOVEK

    player(2)=COMPUTER

    comp_strategy=1

    game_over=.f.

    

    ********************************************************   

    Procedure shoditj

    lparameters m.xcoor, m.ycoor

    local m.hod

    m.hod=Thisform.hod



    m.xy=allt(str(m.xcoor))+allt(str(m.ycoor))

    insert into hody values(Thisform.hod, m.xy)

    update kvadr set cher=cher+1-Thisform.hod, bel=bel+Thisform.hod where ; 

          v1 = m.xy or v2 = m.xy or v3 = m.xy or v4 = m.xy

    Thisform.hod=1-Thisform.hod





    with eval("Thisform.fishka"+allt(str(m.xcoor))+allt(str(m.ycoor)))

        .backstyle=1

        .backcolor=0xFFFFFF*m.hod

    endwith





    select * from kvadr where ;  

          v1 in (select hod from hody where cvet=m.hod) and ;  

          v2 in (select hod from hody where cvet=m.hod) and ;  

          v3 in (select hod from hody where cvet=m.hod) and ;  

          v4 in (select hod from hody where cvet=m.hod);

          into cursor kv







    if _tally>0



        Thisform.setall("enabled", .f.)

        Thisform.game_over=.t.



        Thisform.kbd=.f.

        for m.j=1 to 3

            for m.i=1 to 4

                with eval("Thisform.fishka"+eval("kv.v"+allt(str(m.i))))

                    .backcolor=RGB(255,0,0)

                endwith

            next

            Thisform.refresh

            doevents force

            sleep(250)

            for m.i=1 to 4

                with eval("Thisform.fishka"+eval("kv.v"+allt(str(m.i))))

                    .backcolor=0xFFFFFF*m.hod

                endwith

            next

            Thisform.refresh

            doevents force

            sleep(250)

        next

        for m.i=1 to 4

            with eval("Thisform.fishka"+eval("kv.v"+allt(str(m.i))))

                .backcolor=RGB(255,0,0)

            endwith

        next

        Thisform.refresh

        Thisform.finished=.t.

        Thisform.kbd=.t.

        return

    endif



    *****************************************************

    procedure keypress

    LPARAMETERS nKeyCode, nShiftAltCtrl

    do case

        case nShiftAltCtrl=0 and nKeyCode=127 and Thisform.kbd

            Thisform.rem_hod()

    endcase



    *****************************************************

    procedure unload

    clear events



    *****************************************************

    procedure rem_hod



    select count(*) from hody into array ar1

    if ar1=0

        return

    endif



    select hody

    go bottom



    local m.xy

    m.xy=hody.hod

    

    Thisform.hod=1-Thisform.hod



    if !Thisform.finished

        with eval("Thisform.fishka"+m.xy)

            .backstyle=0

        endwith

    else



        for m.i=1 to XCNT

            for m.j=1 to YCNT

                with eval("Thisform.fishka"+allt(str(m.i))+allt(str(m.j)))

                    if .backcolor=RGB(255,0,0)

                        .backcolor=0xFFFFFF*Thisform.hod

                    endif

                endwith

            next

        next

        

        with eval("Thisform.fishka"+m.xy)

            .backstyle=0

        endwith



        Thisform.finished=.f.



        Thisform.setall("enabled", .t.)

    endif

    update kvadr set cher=cher-1+Thisform.hod, bel=bel-Thisform.hod where ; 

          v1 = m.xy or v2 = m.xy or v3 = m.xy or v4 = m.xy

    select hody

    delete

    select count(*) from hody into array tmpar

    if tmpar>0 and Thisform.player(Thisform.hod+1)=COMPUTER

        Thisform.rem_hod

    endif

    Thisform.game_over=.f.



    **************************************************************

    procedure Vybratj_Hod

    lparameter m.x, m.y

    select xy from xycoorc where xy not in (select hod from hody) into cursor xytmp1

    

    select t1.xy, ;

            sum(iif(k.cher=0 and k.bel=0,001,000)) as n, ;

            sum(iif(k.cher>0 and k.bel>0,001,000)) as b, ;

            sum(iif(k.cher=3 and k.bel=0,001,000)) as s3, ;

            sum(iif(k.cher=2 and k.bel=0,001,000)) as s2, ;

            sum(iif(k.cher=1 and k.bel=0,001,000)) as s1, ;

            sum(iif(k.cher=0 and k.bel=1,001,000)) as o1, ;

            sum(iif(k.cher=0 and k.bel=2,001,000)) as o2, ;

            sum(iif(k.cher=0 and k.bel=3,001,000)) as o3 ;

        from xytmp1 t1 left join kvadr k on ;

              k.v1 = t1.xy or k.v2 = t1.xy or k.v3 = t1.xy or k.v4 = t1.xy ;

        group by 1 into cursor xytmp2



    if Thisform.hod=0

        select * from xytmp2 into cursor xytmp3

    else

        select xy, n, b, o3 as s3, o2 as s2, o1 as s1, s1 as o1, s2 as o2, s3 as o3 ;

            from xytmp2 into cursor xytmp3

    endif

        

    select *, n+b+s3+s2+s1+o1+o2+o3 as cnt, int(rand()*1000) as rnd ;

        from xytmp3 into cursor xytmp4

    

    select top 1 xy from xytmp4 ;

        order by s3, s2, s1, b desc, n, o3, o2, o1, cnt, rnd ;

        into cursor xytmp5

    

    m.x=val(left(xytmp5.xy,1))

    m.y=val(right(xytmp5.xy,1))



ENDDEFINE





DEFINE CLASS fishka AS shape



    Height = SHAG/2

    Width = SHAG/2

    BackStyle = 0

    BorderStyle = 0

    Curvature = 90



    *******************************************************   

    Procedure DblClick

    

    if This.backstyle=1

        return

    endif



    Thisform.shoditj(val(substr(This.name,7,1)),val(substr(This.name,8,1)))

    clear events



ENDDEFINE

P.S.
2Igor
Hi, Igor!
Я выложил новую версию DeFox в разделе Обсуждаем проекты. Там улучшена защита, и в частности вставлено несколько трюков AntiOlly. Сдается мне, что сейчас в нее залезть значительно труднее. Если интересно, посмотри. Вот ссылка
forum.foxclub.ru



Исправлено 1 раз(а). Последнее : leonid, 01.08.07 09:58
Ratings: 0 negative/0 positive
Re: Алгоритмы и программы
mayil
Автор

Сообщений: 277
Откуда: Гянджа, Азербайд
Дата регистрации: 20.06.2006
mayil
11.08.07 22:39:31
Привет всем & Leonid & Igor!

Я продолжаю построение алгоритма игры «Квадратобоязнь»!

Вы провели серьезное исследование сей игры, и сделали важные выводы. Добро!
Однако ж, 99 % партий, например, в шашках также заканчиваются вничью, тем не менее, в шашки еще играют. И даже проводятся первенства!
То же и в шахматах! Теоретически любая шахматная партия ничейная при правильной игре! Так найти эту правильную игру непросто! Так что играть в шахматы также еще будут!
То же и в Квадратобоязни (КВБ - в дальнейшем).
1) Во-первых, применять симметричную стратегию и выигрывать у компа не доставляет мне никакого удовольствия! И не делает мне чести! Мы будем сражаться с ним по-честному!
2) Во-вторых, алгоритм должен быть универсальным - для досок различных размеров. Я беру от 3 до 9 . Этого достаточно. Уже на доске 7х7 игра достаточно сложная - настолько, что когда я просматриваю варианты, у меня начинает болеть голова!
3) Доски буду рассматривать в общем случае прямоугольные.
4) Далее, надо подобрать два взаимно простых натуральных числа, и обозначить ими со-стояния полей, да так, чтобы было взаимно-однозначное соответствие между ситуацией в вершинах квадратов и суммой состояний полей.
Короче, недолго думая принимаем: если поле свободно - его состояние равно 0, если поле занято белой фишкой – фишкой компьютера состояние поля равно 1, если же поле занято черной фишкой человека – пусть его состояние равно 5-ти.

Теперь проверим однозначность:

Состояния полей квадрата Состояние квадрата(сумма состояний вершин его)

0 0 0 0 0 все вершины свободны
0 0 0 1 1 одна вершина занята фишкой компа
0 0 1 1 2 две вершины заняты фишкой компа
0 1 1 1 3 три вершины заняты фишкой компа

0 0 0 5 5 одна вершина занята фишкой человека
0 0 5 5 10 две вершины заняты фишкой человека
0 5 5 5 15 три вершины заняты фишкой человека

0 0 1 5 6 смешанные состояния - безопасные для
0 1 1 5 7 обоих противников
0 1 5 5 11

1 1 1 5 8 закрытые состояния, они в дальнейшем
1 1 5 5 12 не играют никакой роли и исключаются
1 5 5 5 16 из рассмотрения

1 1 1 1 4 проигрыш компа
5 5 5 5 20 проигрыш человека

Продолжение следует………….
Ratings: 0 negative/0 positive
Re: Алгоритмы и программы
mayil
Автор

Сообщений: 277
Откуда: Гянджа, Азербайд
Дата регистрации: 20.06.2006
mayil
09.10.07 22:13:46
[attachment 5251 KVADRO.rar]

Привет всем!
Дал бог терпения закончить программу.
Посмотрите ее - Игра КВАДРАТОБОЯЗНЬ.

Bindevent новая для меня штука. В хелпе трудно разобраться - перевод вроде по-русски, да трудно понять! И потому мне пришлось заранее выставить 81 имэйдж и держать их невидимыми. А при запуске показывать только требуемое для размера игровой доски количество.

Был бы один примерчик по Bindevent-у для анализа! Было бы хорошо! Или , как говорят форумчане "будет счастье".

Папку KVADRO запишите на диск с:.

Замечания и пожелания принимаются без ограничений! Пока.
Ratings: 0 negative/0 positive
Re: Алгоритмы и программы
leonid

Сообщений: 3204
Откуда: Рига
Дата регистрации: 03.02.2006
leonid
11.10.07 10:51:29
А играет она не шибко сильно
[attachment 5277 game.jpg]
Это, естественно, не я ее обыграл, а алгоритм Игоря.
Ratings: 0 negative/0 positive
Re: Алгоритмы и программы
mayil
Автор

Сообщений: 277
Откуда: Гянджа, Азербайд
Дата регистрации: 20.06.2006
mayil
12.10.07 07:53:01
Здравствуй , Leonid!

Да я и сам выигрывал его , правда на доске 5х5.
1) Уровень мастерства проги наверное можно повысить, если расположить строки таблицы DANGER как-то по другому. Но явных критериев нет- чисто эмпирически.
2) Я в дальнейшем намеревался рассмотреть оценочную функцию и ее значения для каждого поля держать в колонке funk таблицы spisok, даже ввел в рассмотрение веса квадратов (табл. katalog, колонка ves ). Но опять же эти веса придется выбирать эмпирически, чисто опытным путем. Ну например, что "вреднее": три квадрата типа 0,1,5,5 или два квадрата 0,1,1,5? Веса в графе ves пока ориентировочные - сырые, это только прикид.
3) щелкнув на поле доски правую кнопку мыши можно увидеть все семейство квадратов данного поля. Чем темнее появившиеся границы, тем более "опасен" сей квадрат. Коли такое разноцветье раздражает ( а меня уде да!) , то замените в графе Couleur все RGB троицы на нули!

Пока.
Ratings: 0 negative/0 positive
Re: Алгоритмы и программы
mayil
Автор

Сообщений: 277
Откуда: Гянджа, Азербайд
Дата регистрации: 20.06.2006
mayil
26.08.08 21:26:44
Задача о шарах. Задайте формулой число шаров, которые можно выложить в виде: и правильного треугольника и квадрата (см. рисунок). Составьте программу и найдите минимальное количество шаров, удовлетворяющее условию задачи (не считая, конечно же, тривиальную единицу).

[attachment 6822 shariki.JPG]
Ratings: 0 negative/0 positive
Re: Алгоритмы и программы
leonid

Сообщений: 3204
Откуда: Рига
Дата регистрации: 03.02.2006
leonid
27.08.08 00:43:50
Вот программу не надо составлять. Не имеет эта задача решения.
Ratings: 0 negative/0 positive
Re: Алгоритмы и программы
Владимир Максимов

Сообщений: 14100
Откуда: Москва
Дата регистрации: 02.09.2000
Владимир Максимов
27.08.08 01:39:56
leonid
Вот программу не надо составлять. Не имеет эта задача решения.

Программу, конечно, не надо. Достаточно формулы.

Количество шаров в треугольнике - это арифметическая прогрессия = (n+1)*n/2
Количество шаров в квадрате - это квадрат = n**2

Здесь n - это количество шаров в одной стороне треугольника или квадрата. Чтобы количество шаров было однаково надо приравнять эти два значения

n**2 = (n+1)*n/2

После решения этого уравнения имеем

n = 1

Т.е. кроме единицы других вариантов нет.
Ratings: 0 negative/0 positive
Re: Алгоритмы и программы
mayil
Автор

Сообщений: 277
Откуда: Гянджа, Азербайд
Дата регистрации: 20.06.2006
mayil
27.08.08 05:52:02
Доброе утро. Как раз программа с простым перебором вывалит вам бесконечное множество решений.
Ratings: 0 negative/0 positive
Re: Алгоритмы и программы
mayil
Автор

Сообщений: 277
Откуда: Гянджа, Азербайд
Дата регистрации: 20.06.2006
mayil
27.08.08 05:57:55
Внимание!Стороны треугольника и квадрата разной длины. Их равенство не требовалось в условии задачи.
Ratings: 0 negative/0 positive
Re: Алгоритмы и программы
Zakharov_slava

Сообщений: 2022
Откуда: Алматы
Дата регистрации: 14.10.2005
Zakharov_slava
27.08.08 07:14:40
А мне кажется или на картинке в треугольнике и в квадрате разное число шаров?
Ratings: 0 negative/0 positive
Re: Алгоритмы и программы
leonid

Сообщений: 3204
Откуда: Рига
Дата регистрации: 03.02.2006
leonid
27.08.08 08:07:27
mayil
Внимание!Стороны треугольника и квадрата разной длины. Их равенство не требовалось в условии задачи.
m^2 = (n+1)*n/2 не имеет решения ни при каких целых m и n больших единицы, а если программа вываливает много решений, значит она неправильно написана. Проверьте на калькуляторе.
Ratings: 0 negative/0 positive
Re: Алгоритмы и программы
Goodwin

Сообщений: 3539
Откуда: Омск
Дата регистрации: 03.05.2006
Goodwin
27.08.08 10:00:26
6, 35, 204...
Ratings: 0 negative/0 positive
Страницы:  1 2 3


:: Список Форумов•Список тем•Поиск•Войти
Извините, только зарегистрированные пользователи могут оставлять сообщения в этом форуме.

On-line: 7 (Гостей: 7)
© 2000-2024 Fox Club 
Яндекс.Метрика