Мой софт. - Страница 3 - Форум студентов КФУ

tashi_ork · 05.04.2007, 21:21

Цитата:

Сообщение от Volkodav

Не фигасебе типа ваще всего?? не хило!! типа все остально что твориться в мире типа добротное добро!!!

Я же не сказал что он Зло.Он воплощение Зла.

NightmareZ · 05.04.2007, 23:12

Цитата:

Сообщение от Nelson

►

Рэндзю не такая уж и простая игра, чемпы мира проводятся. Сори, но твоя прога уже на первом ходу допускает грубейшую ошибку, и не видит простых угроз в последующем. Хоть и сделана приятно. Сколько не видел таких прог, ни одной серьезной так и не попалось.
P.S. Выстроить то, что у тебя на фотке, можно, только играя с прогой в поддавки.

Не получилось нормальный AI сделать, хотя не особо вдавался в стратегии.... делал от балды. Мож, как-нить потом проапгрейджу, еси настроение будет.

Код:

unit unitXOAI;

interface

type
  TMyArr = Array of Array of Integer;

function IsWin(var arr: TMyArr; xsize, ysize: Integer): Integer;
procedure AI(var arr: TMyArr; xsize, ysize: Integer);

implementation

function IsWin(var arr: TMyArr; xsize, ysize: Integer): Integer;
var
  i, j, k: Integer;
  tmp: Integer;
begin
  Result := 0;
  
  for i := 0 to xsize - 1 do
    for j := 0 to ysize - 1 do
      if arr[i, j] <> 0 then
      begin

        if arr[i, j] = 1 then
          tmp := -1
        else
          tmp := 1;

        if i + 4 <= xsize - 1 then
          if (arr[i, j] = arr[i + 1, j]) and
             (arr[i, j] = arr[i + 2, j]) and
             (arr[i, j] = arr[i + 3, j]) and
             (arr[i, j] = arr[i + 4, j]) then
          begin
            Result := tmp;

            for k := 0 to 4 do
              if arr[i + k, j] = 1 then
                arr[i + k, j] := 3
              else
                arr[i + k, j] := 4;

            break;
          end;

        if j + 4 <= ysize - 1 then
          if (arr[i, j] = arr[i, j + 1]) and
             (arr[i, j] = arr[i, j + 2]) and
             (arr[i, j] = arr[i, j + 3]) and
             (arr[i, j] = arr[i, j + 4]) then
          begin
            Result := tmp;

            for k := 0 to 4 do
              if arr[i, j + k] = 1 then
                arr[i, j + k] := 3
              else
                arr[i, j + k] := 4;

            break;
          end;

        if (i + 4 <= xsize - 1) and (j + 4 <= ysize - 1) then
          if (arr[i, j] = arr[i + 1, j + 1]) and
             (arr[i, j] = arr[i + 2, j + 2]) and
             (arr[i, j] = arr[i + 3, j + 3]) and
             (arr[i, j] = arr[i + 4, j + 4]) then
          begin
            Result := tmp;

            for k := 0 to 4 do
              if arr[i + k, j + k] = 1 then
                arr[i + k, j + k] := 3
              else
                arr[i + k, j + k] := 4;

            break;
          end;

        if (i + 4 <= xsize - 1) and (j - 4 >= 0) then
          if (arr[i, j] = arr[i + 1, j - 1]) and
             (arr[i, j] = arr[i + 2, j - 2]) and
             (arr[i, j] = arr[i + 3, j - 3]) and
             (arr[i, j] = arr[i + 4, j - 4]) then
          begin
            Result := tmp;

            for k := 0 to 4 do
              if arr[i + k, j - k] = 1 then
                arr[i + k, j - k] := 3
              else
                arr[i + k, j - k] := 4;

            break;
          end;

      end;
end;

procedure AI(var arr: TMyArr; xsize, ysize: Integer);

  function CanWin: Boolean;
  var
    i, j, k, w: Integer;
  begin
    Result := False;

    for i := 0 to xsize - 1 do
      for j := 0 to ysize - 1 do
      begin

        //горизонтальные
        if (i <= xsize - 5) and (not Result) then
        begin
          w := 0;

          for k := 0 to 4 do
            if arr[i + k, j] = 1 then
              inc(w)
            else if arr[i + k, j] = 2 then
              w := 0;

          if w = 4 then
            for k := 0 to 4 do
              if arr[i + k, j] = 0 then
              begin
                arr[i + k, j] := 1;
                Result := True;
                break;
              end;
        end;

        //вертикальные
        if (j <= ysize - 5) and (not Result) then
        begin
          w := 0;

          for k := 0 to 4 do
            if arr[i, j + k] = 1 then
              inc(w)
            else if arr[i, j + k] = 2 then
              w := 0;

          if w = 4 then
            for k := 0 to 4 do
              if arr[i, j + k] = 0 then
              begin
                arr[i, j + k] := 1;
                Result := True;
                break;
              end;
        end;

        //диагональные
        if (i <= xsize - 5) and (j <= ysize - 5) and (not Result) then
        begin
          w := 0;

          for k := 0 to 4 do
            if arr[i + k, j + k] = 1 then
              inc(w)
            else if arr[i + k, j + k] = 2 then
              w := 0;

          if w = 4 then
            for k := 0 to 4 do
              if arr[i + k, j + k] = 0 then
              begin
                arr[i + k, j + k] := 1;
                Result := True;
                break;
              end;
        end;

        //диагональные 2
        if (i <= xsize - 5) and (j >= 4) and (not Result) then
        begin
          w := 0;

          for k := 0 to 4 do
            if arr[i + k, j - k] = 1 then
              inc(w)
            else if arr[i + k, j - k] = 2 then
              w := 0;

          if w = 4 then
            for k := 0 to 4 do
              if arr[i + k, j - k] = 0 then
              begin
                arr[i + k, j - k] := 1;
                Result := True;
                break;
              end;
        end;

      end;
  end;

  function DontWinEnemy: Boolean;
  var
    i, j, k, w: Integer;
  begin
    Result := False;

    for i := 0 to xsize - 1 do
      for j := 0 to ysize - 1 do
      begin

        //горизонтальные
        if (i <= xsize - 5) and (not Result) then
        begin
          w := 0;

          for k := 0 to 4 do
            if arr[i + k, j] = 2 then
              inc(w)
            else if arr[i + k, j] = 1 then
              w := 0;

          if w = 4 then
            for k := 0 to 4 do
              if arr[i + k, j] = 0 then
              begin
                arr[i + k, j] := 1;
                Result := True;
                break;
              end;
        end;

        //вертикальные
        if (j <= ysize - 5) and (not Result) then
        begin
          w := 0;

          for k := 0 to 4 do
            if arr[i, j + k] = 2 then
              inc(w)
            else if arr[i, j + k] = 1 then
              w := 0;

          if w = 4 then
            for k := 0 to 4 do
              if arr[i, j + k] = 0 then
              begin
                arr[i, j + k] := 1;
                Result := True;
                break;
              end;
        end;

        //диагональные
        if (i <= xsize - 5) and (j <= ysize - 5) and (not Result) then
        begin
          w := 0;

          for k := 0 to 4 do
            if arr[i + k, j + k] = 2 then
              inc(w)
            else if arr[i + k, j + k] = 1 then
              w := 0;

          if w = 4 then
            for k := 0 to 4 do
              if arr[i + k, j + k] = 0 then
              begin
                arr[i + k, j + k] := 1;
                Result := True;
                break;
              end;
        end;

        //диагональные 2
        if (i <= xsize - 5) and (j >= 4) and (not Result) then
        begin
          w := 0;

          for k := 0 to 4 do
            if arr[i + k, j - k] = 2 then
              inc(w)
            else if arr[i + k, j - k] = 1 then
              w := 0;

          if w = 4 then
            for k := 0 to 4 do
              if arr[i + k, j - k] = 0 then
              begin
                arr[i + k, j - k] := 1;
                Result := True;
                break;
              end;
        end;

      end;
  end;

  function DontEnemyMakeFourInLine: Boolean;
  var
    i, j, k, w: Integer;
  begin
    Result := False;

    for i := 0 to xsize - 1 do
      for j := 0 to ysize - 1 do
      begin

        //горизонтальные
        if (i <= xsize - 4) and (not Result) then
        begin
          w := 0;

          for k := 0 to 3 do
            if arr[i + k, j] = 2 then
              inc(w)
            else if arr[i + k, j] = 1 then
              w := 0;

          if w = 3 then
            for k := 0 to 3 do
              if arr[i + k, j] = 0 then
              begin
                arr[i + k, j] := 1;
                Result := True;
                break;
              end;
        end;

        //вертикальные
        if (j <= ysize - 4) and (not Result) then
        begin
          w := 0;

          for k := 0 to 3 do
            if arr[i, j + k] = 2 then
              inc(w)
            else if arr[i, j + k] = 1 then
              w := 0;

          if w = 3 then
            for k := 0 to 3 do
              if arr[i, j + k] = 0 then
              begin
                arr[i, j + k] := 1;
                Result := True;
                break;
              end;
        end;

        //диагональные
        if (i <= xsize - 4) and (j <= ysize - 4) and (not Result) then
        begin
          w := 0;

          for k := 0 to 3 do
            if arr[i + k, j + k] = 2 then
              inc(w)
            else if arr[i + k, j + k] = 1 then
              w := 0;

          if w = 3 then
            for k := 0 to 3 do
              if arr[i + k, j + k] = 0 then
              begin
                arr[i + k, j + k] := 1;
                Result := True;
                break;
              end;
        end;

        //диагональные 2
        if (i <= xsize - 4) and (j >= 3) and (not Result) then
        begin
          w := 0;

          for k := 0 to 3 do
            if arr[i + k, j - k] = 2 then
              inc(w)
            else if arr[i + k, j - k] = 1 then
              w := 0;

          if w = 3 then
            for k := 0 to 3 do
              if arr[i + k, j - k] = 0 then
              begin
                arr[i + k, j - k] := 1;
                Result := True;
                break;
              end;
        end;

      end;
  end;

  function DontEnemyMakeCross: Boolean;
  var
    i, j: Integer;
  begin
    Result := False;

    for i := 2 to xsize - 3 do
      for j := 2 to ysize - 3 do
        if (arr[i - 2, j] = 0) and
           (arr[i + 2, j] = 0) and
           (arr[i, j - 2] = 0) and
           (arr[i, j + 2] = 0) and
           (arr[i, j] = 0) and
           (arr[i - 1, j] = 2) and
           (arr[i + 1, j] = 2) and
           (arr[i, j - 1] = 2) and
           (arr[i, j + 1] = 2) and
           (not Result) then
        begin
          arr[i, j] := 1;
          Result := True;
          break;
        end;
  end;

  function DontEnemyMakePerekrestok: Boolean;
  var
    i, j: Integer;
  begin
    Result := False;

    //низ-право
    if not Result then
      for i := 1 to xsize - 3 do
        for j := 1 to ysize - 3 do
          if (arr[i - 1, j] = 0) and
             (arr[i, j - 1] = 0) and
             (arr[i, j] = 0) and
             (arr[i + 1, j] = 2) and
             (arr[i + 2, j] = 2) and
             (arr[i, j + 1] = 2) and
             (arr[i, j + 2] = 2) and
             (not Result) then
          begin
            arr[i, j] := 1;
            Result := True;
            break;
          end;

    //низ-лево
    if not Result then
      for i := 2 to xsize - 2 do
        for j := 1 to ysize - 3 do
          if (arr[i + 1, j] = 0) and
             (arr[i, j - 1] = 0) and
             (arr[i, j] = 0) and
             (arr[i - 1, j] = 2) and
             (arr[i - 2, j] = 2) and
             (arr[i, j + 1] = 2) and
             (arr[i, j + 2] = 2) and
             (not Result) then
          begin
            arr[i, j] := 1;
            Result := True;
            break;
          end;

    //верх-лево
    if not Result then
      for i := 2 to xsize - 2 do
        for j := 2 to ysize - 2 do
          if (arr[i + 1, j] = 0) and
             (arr[i, j + 1] = 0) and
             (arr[i, j] = 0) and
             (arr[i - 1, j] = 2) and
             (arr[i - 2, j] = 2) and
             (arr[i, j - 1] = 2) and
             (arr[i, j - 2] = 2) and
             (not Result) then
          begin
            arr[i, j] := 1;
            Result := True;
            break;
          end;

    //верх-право
    if not Result then
      for i := 1 to xsize - 3 do
        for j := 2 to ysize - 2 do
          if (arr[i - 1, j] = 0) and
             (arr[i, j + 1] = 0) and
             (arr[i, j] = 0) and
             (arr[i + 1, j] = 2) and
             (arr[i + 2, j] = 2) and
             (arr[i, j - 1] = 2) and
             (arr[i, j - 2] = 2) and
             (not Result) then
          begin
            arr[i, j] := 1;
            Result := True;
            break;
          end;
  end;

  function RandomMove: Boolean;
  var
    i, j, x, y: Integer;
  begin
    Result := False;

    for i := 0 to 200 do
      if not Result then
      begin
        x := Random(xsize);
        y := Random(ysize);
        if arr[x, y] = 0 then
        begin
          arr[x, y] := 1;
          Result := True;
          break;
        end;
      end;

    if not Result then
      for i := 0 to xsize - 1 do
        for j := 0 to ysize - 1 do
          if arr[i, j] = 0 then
            if not Result then
            begin
              arr[i, j] := 1;
              Result := True;
              break;
            end;
  end;

  function MakeCross: Boolean;
  var
    i, j: Integer;
  begin
    Result := False;

    for i := 1 to xsize - 2 do
      for j := 1 to ysize - 2 do
        if (arr[i, j] = 0) and
           (arr[i + 1, j] = 1) and
           (arr[i - 1, j] = 1) and
           (arr[i, j + 1] = 1) and
           (arr[i, j - 1] = 1) and
           (arr[i + 2, j] = 0) and
           (arr[i - 2, j] = 0) and
           (arr[i, j + 2] = 0) and
           (arr[i, j - 2] = 0) and
           (not Result) then
        begin
          arr[i, j] := 1;
          Result := True;
          break;
        end;
  end;

  function MakeLines(xmin, xmax: Integer): Boolean;

    function MakeHorizontalLines(d: Integer): Boolean;
    var
      i, j, k, w: Integer;
    begin
      Result := False;

      for i := 0 to xsize - 5 do
        for j := 0 to ysize - 1 do
          if ((arr[i, j] = 0) or (arr[i, j] = 1)) and (not Result) then
          begin
            w := 0;

            for k := 0 to 4 do
              if arr[i + k, j] = 1 then
                inc(w)
              else if arr[i + k, j] = 2 then
                w := -5;

            if w >= d then
            begin
              for k := 0 to 4 do
              begin
                if arr[i + k, j] = 1 then
                  w := 5;

                if (arr[i + k, j] = 0) and (not Result) and (w = 5) then
                begin
                  arr[i + k, j] := 1;
                  Result := True;
                  break;
                end;
              end;

              w := 0;

              if not Result then
                for k := 4 downto 0 do
                begin
                  if arr[i + k, j] = 1 then
                    w := 5;

                  if (arr[i + k, j] = 0) and (not Result) and (w = 5) then
                  begin
                    arr[i + k, j] := 1;
                    Result := True;
                    break;
                  end;
                end;
            end;
          end;
    end;

    function MakeVerticalLines(d: Integer): Boolean;
    var
      i, j, k, w: Integer;
    begin
      Result := False;

      for i := 0 to xsize - 1 do
        for j := 0 to ysize - 5 do
          if ((arr[i, j] = 0) or (arr[i, j] = 1)) and (not Result) then
          begin
            w := 0;

            for k := 0 to 4 do
              if arr[i, j + k] = 1 then
                inc(w)
              else if arr[i, j + k] = 2 then
                w := -5;

            if w >= d then
            begin
              for k := 0 to 4 do
              begin
                if arr[i, j + k] = 1 then
                  w := 5;

                if (arr[i, j + k] = 0) and (not Result) and (w = 5) then
                begin
                  arr[i, j + k] := 1;
                  Result := True;
                  break;
                end;
              end;

              w := 0;

              if not Result then
                for k := 4 downto 0 do
                begin
                  if arr[i, j + k] = 1 then
                    w := 5;

                  if (arr[i, j + k] = 0) and (not Result) and (w = 5) then
                  begin
                    arr[i, j + k] := 1;
                    Result := True;
                    break;
                  end;
                end;
            end;
          end;
    end;

    function MakeDiagonalLines(d: Integer): Boolean;
    var
      i, j, k, w: Integer;
    begin
      Result := False;

      for i := 0 to xsize - 5 do
        for j := 0 to ysize - 5 do
          if ((arr[i, j] = 0) or (arr[i, j] = 1)) and (not Result) then
          begin
            w := 0;

            for k := 0 to 4 do
              if arr[i + k, j + k] = 1 then
                inc(w)
              else if arr[i + k, j + k] = 2 then
                w := -5;

            if w >= d then
            begin
              for k := 0 to 4 do
              begin
                if arr[i + k, j + k] = 1 then
                  w := 5;

                if (arr[i + k, j + k] = 0) and (not Result) and (w = 5) then
                begin
                  arr[i + k, j + k] := 1;
                  Result := True;
                  break;
                end;
              end;

              w := 0;

              if not Result then
                for k := 4 downto 0 do
                begin
                  if arr[i + k, j + k] = 1 then
                    w := 5;

                  if (arr[i + k, j + k] = 0) and (not Result) and (w = 5) then
                  begin
                    arr[i + k, j + k] := 1;
                    Result := True;
                    break;
                  end;
                end;
            end;
          end;
    end;

    function MakeDiagonalLines2(d: Integer): Boolean;
    var
      i, j, k, w: Integer;
    begin
      Result := False;

      for i := 0 to xsize - 5 do
        for j := 0 to ysize - 5 do
          if ((arr[i, j] = 0) or (arr[i, j] = 1)) and (not Result) then
          begin
            w := 0;

            for k := 0 to 4 do
              if arr[i + k, j + k] = 1 then
                inc(w)
              else if arr[i + k, j + k] = 2 then
                w := -5;

            if w >= d then
            begin
              for k := 0 to 4 do
              begin
                if arr[i + k, j + k] = 1 then
                  w := 5;

                if (arr[i + k, j + k] = 0) and (not Result) and (w = 5) then
                begin
                  arr[i + k, j + k] := 1;
                  Result := True;
                  break;
                end;
              end;

              w := 0;

              if not Result then
                for k := 4 downto 0 do
                begin
                  if arr[i + k, j + k] = 1 then
                    w := 5;

                  if (arr[i + k, j + k] = 0) and (not Result) and (w = 5) then
                  begin
                    arr[i + k, j + k] := 1;
                    Result := True;
                    break;
                  end;
                end;
            end;
          end;
    end;

    function RandomLines: Boolean;
    var
      i, j, k: Integer;
    begin
      Result := False;

      for j := xmax downto xmin do
        for i := 0 to 10 do
          if not Result then
          begin
            k := Random(4);

            case k of
            0: Result := MakeHorizontalLines(j);
            1: Result := MakeVerticalLines(j);
            2: Result := MakeDiagonalLines(j);
            3: Result := MakeDiagonalLines2(j);
            end;

          end else
            break;
    end;

  begin
    Result := RandomLines;
  end;

begin
  if not CanWin then
    if not DontWinEnemy then
      if not MakeLines(3, 4) then
        if not DontEnemyMakeCross then
          if not DontEnemyMakePerekrestok then
            if not DontEnemyMakeFourInLine then
              if not MakeCross then
                if not MakeLines(1, 2) then
                  RandomMove;
end;

end.

Nelson · 06.04.2007, 00:38

Цитата:

Сообщение от NightmareZ

►

Не получилось нормальный AI сделать, хотя не особо вдавался в стратегии.... делал от балды. Мож, как-нить потом проапгрейджу, еси настроение будет.

Надеюсь, у тебя появится такое желание. Я сам несколько раз пытался составить алгоритм, но каждый раз упирался в быстро растущее число вариантов, даже при 3-4 просмотрах хода вглубь (ход=пара ходов игроков). Игра ждет своих программеров...

NightmareZ · 14.04.2007, 11:19

Наверное, оно всё-таки в ближайшее время не появится

Я ударился в разработку второй версии комплекса по физике.... Это ещё как минимум на год

NOMAD · 05.06.2007, 14:07

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

Antik · 05.06.2007, 17:16

Цитата:

Сообщение от Nelson

►

Надеюсь, у тебя появится такое желание. Я сам несколько раз пытался составить алгоритм, но каждый раз упирался в быстро растущее число вариантов, даже при 3-4 просмотрах хода вглубь (ход=пара ходов игроков). Игра ждет своих программеров...

Попробуй сделать рекурсивную функцию и какуе-нибудь шкалу "оценки" хода...

NightmareZ · 24.07.2007, 03:45

Выложил исходники нескольких программ (GPL v.2)
--------------------------------------------------------------------

Комплекс физических программ
http://systemhalt.org/index.php?req=Physic

Системы осцилляторов
http://systemhalt.org/index.php?req=Oscillators

Математический калькулятор
http://systemhalt.org/index.php?req=Calculator

NightmareZ · 28.05.2009, 04:45

Чё-та как-та случайно наткнулся на данную тему. И ввиду того, что на данный момент разрабатываю одну программулину, решил выложить инфу о ней сюда.

Итак, программа сейчас называется FlowchartBuilder. Возможно, к релизу придумаю что-нибуть более звучное. Предназначается она для создания блок-схем, диаграмм и тому подобных вещей.

В отличие от монстроподобного Visio, предполагается, что в итоге весить она будет всего несколько Мб (на данный момент проинсталенная она занимает меньше чем пол метра).
В отличие от убогого Dia, предолагается, что в итоге она не будет убогой

В разработке использую три ЯП: C#, VB.NET и F#.
Для работы нуждается в .NET Framework 3.5

Блог о разработке: http://flowchartbuilder.blogspot.com/
Альфа версию качаем тут: http://flowchartbuilder.blogspot.com...rsion-025.html (345 kb)

Дистриб выкладываю пока только под винду. Хотя, под Mono программа вполне работает, но сейчас времени нету заниматься ещё другими системами. Как только доведу до релиза, займусь заточкой под MacOS. Линух же меня не особо интересует.

+ Высокое качество => ТУТ видео

Makarov · 01.11.2009, 05:11

Сегодня первый раз запустил FlowchartBuilder под Ubuntu.

Minos · 01.11.2009, 16:46

под wine, как я понял?