Tin học Game CaroAI viết bằng Pascal

trà nguyễn hữu nghĩa

Cựu Mod Vật Lí |Cây bút Thơ|Thần tượng VH
Thành viên
14 Tháng năm 2017
3,974
7,619
744
21
Phú Yên
Trường THPT Lương Văn Chánh
[TẶNG BẠN] TRỌN BỘ Bí kíp học tốt 08 môn
Chắc suất Đại học top - Giữ chỗ ngay!!

ĐĂNG BÀI NGAY để cùng trao đổi với các thành viên siêu nhiệt tình & dễ thương trên diễn đàn.

Quốc khánh chẳng biết làm gì nên viết Code Share ae chơi.
Nhân tiện muốn test lại cách làm trí tuệ nhân tạo chút :D
Chơi thử rồi cho mình nhận xét nha :p
Cái này chạy được trên cả FP và TP.
Các bạn xem lại chỗ const TocDo chút nha. Để chọn tg chơi hợp lý
Mã:
 Program CaroAI;
 uses crt;
 const
        Trong = 0;
        Nguoi = 1;
        May = 2;
        KTu: array[0..2] of char = (#249,'X','O');
        Mau: array[0..2] of Word = (LightGray,Red,Blue);
        MTC: array[0..7] of integer = (0,2,4,20,100,105,110,115);
        MPT: array[0..7] of integer = (0,1,3,15,55,56,57,58);
        Size = 20;
        TocDo = 200; {TP la 200, FP la 5000}
        tgChoi = 20;

 type TKiemTra = object
 Function Doc(x,y: integer): Boolean;
 Function Ngang(x,y: integer): Boolean;
 Function Xuoi(x,y: integer): Boolean;
 Function Nguoc(x,y: integer): Boolean;
 Function Thang(luot: integer): Boolean;
                end;

 type TAI = object
 Function Doc(x,y,co: integer): integer;
 Function Ngang(x,y,co: integer): integer;
 Function Xuoi(x,y,co: integer): integer;
 Function Nguoc(x,y,co: integer): integer;
 Function MaxTC(x,y: integer): integer;
 Function MaxPT(x,y: integer): integer;
 Procedure DanhCoAI;
                end;
 type ListDaDanh = object
        X,Y,nuoc: array[1..Size*Size] of integer;
        count: integer;
 Procedure SetDD(dx,dy,dnuoc: integer);
                end;

 var
        k: char;
        BanCo: array[1..Size,1..Size] of integer;
        cx,cy,luot: integer;
        Ktra: TKiemTra;
        AI: TAI;
        Dd: ListDaDanh;
        tg,speed: integer;

 Procedure ListDaDanh.SetDD(dx,dy,dnuoc: integer);
 Begin
        inc(count);
        x[count] := dx;
        y[count] := dy;
        nuoc[count] := dnuoc;
 End;

 Procedure HuongDan;
 Begin
        TextColor(White);
        Gotoxy(Size*2 + 15,3);
        Write('G A M E  C A R O ');
        Gotoxy(Size*2 + 3,6);
        Write('Bam phim mui ten de di chuyen con tro.');
        Gotoxy(size*2 + 3,8);
        Write('Bam Enter de danh co.');
        Gotoxy(Size*2 + 3, 10);
        Write('Bam ESC de thoat');
 End;

 Procedure KhoiTao;
 var x,y: integer;
 Begin
        for x := 1 to Size do
                for y := 1 to Size do
                begin
                        Banco[x,y] := Trong;
                end;
        cx := 1;
        cy := 1;
        tg := TgChoi;
        speed := 0;
        Luot := Nguoi;
        HuongDan;
 End;

 Procedure InBanCo;
 var x,y: integer;
 Begin
        for x := 1 to Size do
                for y := 1 to Size do
                begin
                        Gotoxy(x*2,y);
                        TextColor(Mau[BanCo[x,y]]);
                        Write(Ktu[Banco[x,y]]);
                end;
 End;

 Procedure ReView;
 var i: integer;
 Begin
        clrscr;
        KhoiTao;
        for i := 1 to Dd.Count do
        begin
                BanCo[Dd.x[i],Dd.Y[i]] := Dd.nuoc[i];
                InBanCo;
                delay(500);
        end;
 End;

 Procedure DoiLuot;
 Begin
        if Luot = May then Luot := Nguoi else Luot := May;
 End;

 Procedure DanhCo(x,y: integer);
 Begin
                DoiLuot;
                Banco[x,y] := luot;
                Dd.SetDD(x,y,luot);
                InBanCo;
                cx := x;
                cy := y;
 End;

 Procedure DemTG;
 var i: integer;
 Begin
        TextColor(White);
        Gotoxy(Size*2+3,12);
        Write('Thoi Gian: ');
        for i := 1 to tg do
        Write(#219);
        clreol;
 End;

 Function TKiemTra.Doc(x,y: integer): Boolean;
 var i,so: integer;
 Begin
        So := 1;
        if y < size - 4 then
        for i := 1 to 4 do
        if BanCo[x,y] = BanCo[x,y+i] then inc(so)
        else break;
        if so >= 5 then Doc := True else Doc := False;
 End;

 Function TKiemTra.Ngang(x,y: integer): Boolean;
 var i,so: integer;
 Begin
        So := 1;
        if x < size - 4 then
        for i := 1 to 4 do
        if BanCo[x,y] = BanCo[x+i,y] then inc(so)
        else break;
        if so >= 5 then Ngang := True else Ngang := False;
 End;

 Function TKiemTra.Xuoi(x,y: integer): Boolean;
 var i,so: integer;
 Begin
        So := 1;
        if (x < size - 4) and (y < Size - 4) then
        for i := 1 to 4 do
        if BanCo[x,y] = BanCo[x+i,y+i] then inc(so)
        else break;
        if so >= 5 then Xuoi := True else Xuoi := False;
 End;

 Function TKiemTra.Nguoc(x,y: integer): Boolean;
 var i,so: integer;
 Begin
        So := 1;
        if (x < size - 4) and (y > 4) then
        for i := 1 to 4 do
        if BanCo[x,y] = BanCo[x+i,y-i] then inc(so)
        else break;
        if so >= 5 then Nguoc := True else Nguoc := False;
 End;

 Function TKiemTra.Thang(luot: integer): Boolean;
 var x,y: integer;
     cont: Boolean;
 Begin
        Thang := False;
        cont := True;
        for x := 1 to Size do
        begin
                for y := 1 to Size do
                if BanCo[x,y]  = Luot then
                if Doc(x,y)
                or Ngang(x,y)
                or Xuoi(x,y)
                or Nguoc(x,y) then
                begin Thang := True;cont := false;break;end;
        if not cont then break;
        end;
 End;

 Function TAI.Doc(x,y,co: integer): integer;
 var i,so,dp: integer;
 Begin
        So := 0;
        dp := 0;
        for i := y+1 to Size do
        if Banco[x,i] = co then Inc(So)
        else if BanCo[x,i] <> Trong then
        begin
             inc(dp);
             break;
        end
        else break;
        for i := y - 1 downto 1 do
        if Banco[x,i] = co then Inc(So)
        else if BanCo[x,i] <> Trong then
        begin
             inc(dp);
             break;
        end
        else break;
        if so - dp < 0 then so := 0
        else if so - dp >= 3 then so := so + dp
        else so := so - dp;
        Doc := So;
 end;

 Function TAI.Ngang(x,y,co: integer): integer;
 var i,so,dp: integer;
 Begin
        So := 0;
        dp := 0;
        for i := x+1 to Size do
        if Banco[i,y] = co then Inc(So)
        else if Banco[i,y] <> Trong then
        begin
             inc(dp);
             break;
        end
        else break;
        for i := x-1 downto 1 do
        if Banco[i,y] = co then Inc(So)
        else if Banco[i,y] <> Trong then
        begin
             inc(dp);
             break;
        end
        else break;
        if so - dp < 0 then so := 0
        else if so - dp >= 3 then so := so + dp
        else so := so - dp;
        Ngang := So;
 end;

 Function TAI.Xuoi(x,y,co: integer): integer;
 var min,i,so,dp: integer;
 Begin
        So := 0;
        dp := 0;
        if Size - x < Size - y then min := Size - x else min := Size - y;
        for i := 1 to min-1 do
        if BanCo[x+i,y+i] = Co then inc(So)
        else if Banco[x+i,y+i] <> Trong then
        begin
             inc(dp);
             break;
        end
        else break;
        if x < y then min := x else min := y;
        for i := 1 to min-1 do
        if BanCo[x-i,y-i] = Co then inc(So)
        else if Banco[x-i,y-i] <> Trong then
        begin
             inc(dp);
             break;
        end
        else break;
        if so - dp < 0 then so := 0
        else if so - dp >= 3 then so := so + dp
        else so := so - dp;
        Xuoi := So;
 end;

 Function TAI.Nguoc(x,y,co: integer): integer;
 var min,i,so,dp: integer;
 Begin
        So := 0;
        dp := 0;
        if Size - x < y then min := Size - x else min := y;
        for i := 1 to min-1 do
        if BanCo[x+i,y-i] = Co then inc(So)
        else if BanCo[x+i,y-i] <> Trong then
        begin
             inc(dp);
             break;
        end
        else break;
        if Size - y < x then min := Size - y else min := x;
        for i := 1 to min-1 do
        if BanCo[x-i,y+i] = Co then inc(So)
        else if Banco[x-i,y+i] <> Trong then
        begin
             inc(dp);
             break;
        end
        else break;
        if so - dp < 0 then so := 0
        else if so - dp >= 3 then so := so + dp
        else so := so - dp;
        Nguoc := So;
 end;

 Function TAI.MaxTC(x,y: integer): integer;
 var TC: integer;
 Begin
      TC := MTC[Doc(x,y,May)] + MTC[Ngang(x,y,May)] +
      MTC[Xuoi(x,y,May)] + MTC[Nguoc(x,y,May)];
      MaxTC := TC;
 End;

 Function TAI.MaxPT(x,y: integer): integer;
 var PT: integer;
 Begin
      PT := MPT[Doc(x,y,Nguoi)] + MPT[Ngang(x,y,Nguoi)] +
      MPT[Xuoi(x,y,Nguoi)] + MPT[Nguoc(x,y,Nguoi)];
      MaxPT := PT;
 End;

 Procedure TAI.DanhCoAI;
 var dx,dy,x,y,max,TC,PT: integer;
 Begin
        max := 0;
        dx := Size div 2;
        dy := Size div 2;
        for x := 1 to Size do
                for y := 1 to Size do
                if Banco[x,y] = Trong then
                begin
                      TC := MaxTC(x,y);
                      PT := MaxPT(x,y);
                      if TC + PT > Max then
                      begin
                           Max := TC + PT;
                           dx := x;
                           dy := y;
                      end;
                end;
        DanhCo(dx,dy);
 end;


 BEGIN
        repeat
        clrscr;
        DD.Count := 0;
        KhoiTao;
        InBanCo;
        DanhCo(Size div 2,Size div 2);
        DemTg;
        repeat
        k := #0;
        Gotoxy(cx*2,cy);
        if keypressed then k := readkey;
        case k of
        #72: if cy > 1 then dec(cy);
        #80: if cy < Size then inc(cy);
        #75: if cx > 1 then dec(cx);
        #77: if cx < Size then inc(cx);
        #13:
        if BanCo[cx,cy] = Trong then
        begin
                DanhCo(cx,cy);
                tg := TgChoi;
                if not KTra.Thang(Nguoi) then AI.DanhCoAI;
        end;
                end;
        inc(speed);
        if speed = TocDo then begin Dec(tg);speed := 0;Demtg;end;
        until (k = #27) or (tg <= 0) or Ktra.Thang(May) or Ktra.Thang(Nguoi);

        if k <> #27 then
        begin
             repeat
             Gotoxy(Size div 2-7,Size div 2);
             if Ktra.Thang(Nguoi) then Write('Ban Thang Roi')
             else Write('Ban Thua Roi');

             gotoxy(2,Size+2);
             Write('Bam R de xem lai. Bam Enter de choi lai. Bam ESC de thoat.');
             repeat
                k := #0;
                if keypressed then k := readkey;
             until (k = 'r') or (k = #13) or (k = #27);
             if k = 'r' then Review;
             until (k = #27) or (k = #13);
        end;
        until k = #27;
 END.
@son_gohan , @Nguyễn Tùng Ân , @Bùi Thành Công , @Nguyễn Khoa , @ka1412
 

Bùi Thành Công

Học sinh
Thành viên
23 Tháng bảy 2018
87
58
31
19
Nam Định
Thcs Giao Thủy
Quốc khánh chẳng biết làm gì nên viết Code Share ae chơi.
Nhân tiện muốn test lại cách làm trí tuệ nhân tạo chút :D
Chơi thử rồi cho mình nhận xét nha :p
Cái này chạy được trên cả FP và TP.
Các bạn xem lại chỗ const TocDo chút nha. Để chọn tg chơi hợp lý
Mã:
 Program CaroAI;
 uses crt;
 const
        Trong = 0;
        Nguoi = 1;
        May = 2;
        KTu: array[0..2] of char = (#249,'X','O');
        Mau: array[0..2] of Word = (LightGray,Red,Blue);
        MTC: array[0..7] of integer = (0,2,4,20,100,105,110,115);
        MPT: array[0..7] of integer = (0,1,3,15,55,56,57,58);
        Size = 20;
        TocDo = 200; {TP la 200, FP la 5000}
        tgChoi = 20;

 type TKiemTra = object
 Function Doc(x,y: integer): Boolean;
 Function Ngang(x,y: integer): Boolean;
 Function Xuoi(x,y: integer): Boolean;
 Function Nguoc(x,y: integer): Boolean;
 Function Thang(luot: integer): Boolean;
                end;

 type TAI = object
 Function Doc(x,y,co: integer): integer;
 Function Ngang(x,y,co: integer): integer;
 Function Xuoi(x,y,co: integer): integer;
 Function Nguoc(x,y,co: integer): integer;
 Function MaxTC(x,y: integer): integer;
 Function MaxPT(x,y: integer): integer;
 Procedure DanhCoAI;
                end;
 type ListDaDanh = object
        X,Y,nuoc: array[1..Size*Size] of integer;
        count: integer;
 Procedure SetDD(dx,dy,dnuoc: integer);
                end;

 var
        k: char;
        BanCo: array[1..Size,1..Size] of integer;
        cx,cy,luot: integer;
        Ktra: TKiemTra;
        AI: TAI;
        Dd: ListDaDanh;
        tg,speed: integer;

 Procedure ListDaDanh.SetDD(dx,dy,dnuoc: integer);
 Begin
        inc(count);
        x[count] := dx;
        y[count] := dy;
        nuoc[count] := dnuoc;
 End;

 Procedure HuongDan;
 Begin
        TextColor(White);
        Gotoxy(Size*2 + 15,3);
        Write('G A M E  C A R O ');
        Gotoxy(Size*2 + 3,6);
        Write('Bam phim mui ten de di chuyen con tro.');
        Gotoxy(size*2 + 3,8);
        Write('Bam Enter de danh co.');
        Gotoxy(Size*2 + 3, 10);
        Write('Bam ESC de thoat');
 End;

 Procedure KhoiTao;
 var x,y: integer;
 Begin
        for x := 1 to Size do
                for y := 1 to Size do
                begin
                        Banco[x,y] := Trong;
                end;
        cx := 1;
        cy := 1;
        tg := TgChoi;
        speed := 0;
        Luot := Nguoi;
        HuongDan;
 End;

 Procedure InBanCo;
 var x,y: integer;
 Begin
        for x := 1 to Size do
                for y := 1 to Size do
                begin
                        Gotoxy(x*2,y);
                        TextColor(Mau[BanCo[x,y]]);
                        Write(Ktu[Banco[x,y]]);
                end;
 End;

 Procedure ReView;
 var i: integer;
 Begin
        clrscr;
        KhoiTao;
        for i := 1 to Dd.Count do
        begin
                BanCo[Dd.x[i],Dd.Y[i]] := Dd.nuoc[i];
                InBanCo;
                delay(500);
        end;
 End;

 Procedure DoiLuot;
 Begin
        if Luot = May then Luot := Nguoi else Luot := May;
 End;

 Procedure DanhCo(x,y: integer);
 Begin
                DoiLuot;
                Banco[x,y] := luot;
                Dd.SetDD(x,y,luot);
                InBanCo;
                cx := x;
                cy := y;
 End;

 Procedure DemTG;
 var i: integer;
 Begin
        TextColor(White);
        Gotoxy(Size*2+3,12);
        Write('Thoi Gian: ');
        for i := 1 to tg do
        Write(#219);
        clreol;
 End;

 Function TKiemTra.Doc(x,y: integer): Boolean;
 var i,so: integer;
 Begin
        So := 1;
        if y < size - 4 then
        for i := 1 to 4 do
        if BanCo[x,y] = BanCo[x,y+i] then inc(so)
        else break;
        if so >= 5 then Doc := True else Doc := False;
 End;

 Function TKiemTra.Ngang(x,y: integer): Boolean;
 var i,so: integer;
 Begin
        So := 1;
        if x < size - 4 then
        for i := 1 to 4 do
        if BanCo[x,y] = BanCo[x+i,y] then inc(so)
        else break;
        if so >= 5 then Ngang := True else Ngang := False;
 End;

 Function TKiemTra.Xuoi(x,y: integer): Boolean;
 var i,so: integer;
 Begin
        So := 1;
        if (x < size - 4) and (y < Size - 4) then
        for i := 1 to 4 do
        if BanCo[x,y] = BanCo[x+i,y+i] then inc(so)
        else break;
        if so >= 5 then Xuoi := True else Xuoi := False;
 End;

 Function TKiemTra.Nguoc(x,y: integer): Boolean;
 var i,so: integer;
 Begin
        So := 1;
        if (x < size - 4) and (y > 4) then
        for i := 1 to 4 do
        if BanCo[x,y] = BanCo[x+i,y-i] then inc(so)
        else break;
        if so >= 5 then Nguoc := True else Nguoc := False;
 End;

 Function TKiemTra.Thang(luot: integer): Boolean;
 var x,y: integer;
     cont: Boolean;
 Begin
        Thang := False;
        cont := True;
        for x := 1 to Size do
        begin
                for y := 1 to Size do
                if BanCo[x,y]  = Luot then
                if Doc(x,y)
                or Ngang(x,y)
                or Xuoi(x,y)
                or Nguoc(x,y) then
                begin Thang := True;cont := false;break;end;
        if not cont then break;
        end;
 End;

 Function TAI.Doc(x,y,co: integer): integer;
 var i,so,dp: integer;
 Begin
        So := 0;
        dp := 0;
        for i := y+1 to Size do
        if Banco[x,i] = co then Inc(So)
        else if BanCo[x,i] <> Trong then
        begin
             inc(dp);
             break;
        end
        else break;
        for i := y - 1 downto 1 do
        if Banco[x,i] = co then Inc(So)
        else if BanCo[x,i] <> Trong then
        begin
             inc(dp);
             break;
        end
        else break;
        if so - dp < 0 then so := 0
        else if so - dp >= 3 then so := so + dp
        else so := so - dp;
        Doc := So;
 end;

 Function TAI.Ngang(x,y,co: integer): integer;
 var i,so,dp: integer;
 Begin
        So := 0;
        dp := 0;
        for i := x+1 to Size do
        if Banco[i,y] = co then Inc(So)
        else if Banco[i,y] <> Trong then
        begin
             inc(dp);
             break;
        end
        else break;
        for i := x-1 downto 1 do
        if Banco[i,y] = co then Inc(So)
        else if Banco[i,y] <> Trong then
        begin
             inc(dp);
             break;
        end
        else break;
        if so - dp < 0 then so := 0
        else if so - dp >= 3 then so := so + dp
        else so := so - dp;
        Ngang := So;
 end;

 Function TAI.Xuoi(x,y,co: integer): integer;
 var min,i,so,dp: integer;
 Begin
        So := 0;
        dp := 0;
        if Size - x < Size - y then min := Size - x else min := Size - y;
        for i := 1 to min-1 do
        if BanCo[x+i,y+i] = Co then inc(So)
        else if Banco[x+i,y+i] <> Trong then
        begin
             inc(dp);
             break;
        end
        else break;
        if x < y then min := x else min := y;
        for i := 1 to min-1 do
        if BanCo[x-i,y-i] = Co then inc(So)
        else if Banco[x-i,y-i] <> Trong then
        begin
             inc(dp);
             break;
        end
        else break;
        if so - dp < 0 then so := 0
        else if so - dp >= 3 then so := so + dp
        else so := so - dp;
        Xuoi := So;
 end;

 Function TAI.Nguoc(x,y,co: integer): integer;
 var min,i,so,dp: integer;
 Begin
        So := 0;
        dp := 0;
        if Size - x < y then min := Size - x else min := y;
        for i := 1 to min-1 do
        if BanCo[x+i,y-i] = Co then inc(So)
        else if BanCo[x+i,y-i] <> Trong then
        begin
             inc(dp);
             break;
        end
        else break;
        if Size - y < x then min := Size - y else min := x;
        for i := 1 to min-1 do
        if BanCo[x-i,y+i] = Co then inc(So)
        else if Banco[x-i,y+i] <> Trong then
        begin
             inc(dp);
             break;
        end
        else break;
        if so - dp < 0 then so := 0
        else if so - dp >= 3 then so := so + dp
        else so := so - dp;
        Nguoc := So;
 end;

 Function TAI.MaxTC(x,y: integer): integer;
 var TC: integer;
 Begin
      TC := MTC[Doc(x,y,May)] + MTC[Ngang(x,y,May)] +
      MTC[Xuoi(x,y,May)] + MTC[Nguoc(x,y,May)];
      MaxTC := TC;
 End;

 Function TAI.MaxPT(x,y: integer): integer;
 var PT: integer;
 Begin
      PT := MPT[Doc(x,y,Nguoi)] + MPT[Ngang(x,y,Nguoi)] +
      MPT[Xuoi(x,y,Nguoi)] + MPT[Nguoc(x,y,Nguoi)];
      MaxPT := PT;
 End;

 Procedure TAI.DanhCoAI;
 var dx,dy,x,y,max,TC,PT: integer;
 Begin
        max := 0;
        dx := Size div 2;
        dy := Size div 2;
        for x := 1 to Size do
                for y := 1 to Size do
                if Banco[x,y] = Trong then
                begin
                      TC := MaxTC(x,y);
                      PT := MaxPT(x,y);
                      if TC + PT > Max then
                      begin
                           Max := TC + PT;
                           dx := x;
                           dy := y;
                      end;
                end;
        DanhCo(dx,dy);
 end;


 BEGIN
        repeat
        clrscr;
        DD.Count := 0;
        KhoiTao;
        InBanCo;
        DanhCo(Size div 2,Size div 2);
        DemTg;
        repeat
        k := #0;
        Gotoxy(cx*2,cy);
        if keypressed then k := readkey;
        case k of
        #72: if cy > 1 then dec(cy);
        #80: if cy < Size then inc(cy);
        #75: if cx > 1 then dec(cx);
        #77: if cx < Size then inc(cx);
        #13:
        if BanCo[cx,cy] = Trong then
        begin
                DanhCo(cx,cy);
                tg := TgChoi;
                if not KTra.Thang(Nguoi) then AI.DanhCoAI;
        end;
                end;
        inc(speed);
        if speed = TocDo then begin Dec(tg);speed := 0;Demtg;end;
        until (k = #27) or (tg <= 0) or Ktra.Thang(May) or Ktra.Thang(Nguoi);

        if k <> #27 then
        begin
             repeat
             Gotoxy(Size div 2-7,Size div 2);
             if Ktra.Thang(Nguoi) then Write('Ban Thang Roi')
             else Write('Ban Thua Roi');

             gotoxy(2,Size+2);
             Write('Bam R de xem lai. Bam Enter de choi lai. Bam ESC de thoat.');
             repeat
                k := #0;
                if keypressed then k := readkey;
             until (k = 'r') or (k = #13) or (k = #27);
             if k = 'r' then Review;
             until (k = #27) or (k = #13);
        end;
        until k = #27;
 END.
@son_gohan , @Nguyễn Tùng Ân , @Bùi Thành Công , @Nguyễn Khoa , @ka1412

game này khó chơi quá, nên cho chậm lại một chút, chứ nhanh vậy ai mà thắng nổi:p
 

trà nguyễn hữu nghĩa

Cựu Mod Vật Lí |Cây bút Thơ|Thần tượng VH
Thành viên
14 Tháng năm 2017
3,974
7,619
744
21
Phú Yên
Trường THPT Lương Văn Chánh
Top Bottom