Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 30.08.2019, 22:12   #1
anaschu
Форумчанин
 
Регистрация: 21.09.2012
Сообщений: 372
По умолчанию Выбор направления роста в машине тьюринга (?) или клеточном автомате (?)

у меня в программе есть такая кодировка направления роста растения:

Код:
function TModel.getDirect(C1: TCoord; C2: TCoord): TDirection;
var
  index: integer;
begin
   result := TDirection.dNone; // Во избежание warnings
   // пересчет разности координат в индекс для поиска направления
   index:=(C2.X-C1.X+1)*3+(C2.Y-C1.Y+1);
   case index of
    0: result:=TDirection.dUpLeft;
    1: result:=TDirection.dLeft;
    2: result:=TDirection.dDownLeft;
    3: result:=TDirection.dUp;
    4: result:=TDirection.dNone;
    5: result:=TDirection.dDown;
    6: result:=TDirection.dUpRight;
    7: result:=TDirection.dRight;
    8: result:=TDirection.dDownRight;
   end
end;
Теперь, основываясь на этой кодировке, я хочу ввести такие правила роста, или перемещения записывающей головки машины Тьюринга:

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

Эти правила нужно реализовать вот в этой функции:
Код:
function TModel.getGrowDirect(X: Integer; Y: Integer): TRes;
const
  // Вероятность роста в одну и ту же сторону.
  Probability: array[0..3] of Single = (0.426, 0.625, 0.899, 0.976);
var
  search    : boolean;
  neig      : boolean;
  C         : TCoord;
  //Cells     : array of TRes;
  xx        : Integer;
begin
  result := TRes.Create();
  neig:=false;
  // 1. Пробуем расти в ту же сторону
  search:=true;

  xx:= FField[X, Y].DickLength-1;
  if xx > 3 then xx:=3;
  // 1 - растем в прежнем направлении с вероятностью повышающейся с каждым шагом
  // 2 - чем больше ресурсов, тем вероятнее, что будем поворачивать

  if (Random < Probability[xx]) and (random > FField[X, Y].Source)then begin  //если хх=-1, то сразу False
    // Новая клетка (вероятно) по прежнему направлению роста
    C:=Coord(X,Y)+Coord(FField[X, Y].Direction[1]);
    C:=FField.Tor(C); // клетки с координатами за пределами поля "завернуть" на другую сторону поля
    search:=FField[C.X, C.Y].Exists;  // Если клетка уже занята, то будем искать другую
    if not search then begin
      //setlength(Cells,1);
      //Cells[0] := TRes.Create();
      result.x := C.X;
      result.y := C.Y;
      result.d := FField[X, Y].Direction[1];
      result.s := FField[X, Y].DickLength;
      neig:= checkNeighbors(coord(c.x, c.y), coord(x,y));
      result.n := neig;
      result.i := FField[X,Y].FamlyId;
      result.f := true;
    end;
  end;

  if search or (not neig) then   result:=getGrow(X, Y);    // 2. попытка роста в прежнем направлении не удалась. Ищем хоть что-то
  if not result.f then  exit;


  //    Пока выполняется всегда !!! т.к.  result.n = True
  if not (result.n) then  begin     //т.е. соседи есть
    if  growthNodes1[FField[result.x, result.y].Node] or        //не понятное тройное условие
    //  ((FField[X,Y].DickLength < maxint) or
      (((FStep > 50) and (FField[X,Y].DickLength < FMain.MainForm.getMatherLenght))) then begin
      result.f:=false;
      exit;
    end;
  end;


  // проверка на необходимость и возможность создания дочерней клетки в голодном месте
  if (FField[result.x, result.y].Source<=FLimits.StarvationDeath) then begin
     if (FField[X, Y].Direction[1] = result.d) and
        (FField[X, Y].DickLength >= FMain.MainForm.getMatherLenght) and
        not(growthClan1[clans[result.i]]) and
        (result.d in [dUp, dLeft, dRight, dDown]) then begin
          result.s := FField[X, Y].DickLength;
          result.m := 2;
          exit;
      end else result.f:=false;
  end;
  //видимо это пробный облегченный вариант создания дочерей
  if (FField[X, Y].DickLength >= FMain.MainForm.getMatherLenght) and
     (FField[X, Y].Direction[1] = result.d) and
     (result.d in [dUp, dLeft, dRight, dDown]) then begin
          result.m := 2;
          //result.s := FField[X, Y].DickLength;
  end;
end;
Вопрос.
как реализовать правила роста внутри данной процедуры? Я должен работать внутри TModel.getDirect с этим куском:

Код:
case index of
    0: result:=TDirection.dUpLeft;
    1: result:=TDirection.dLeft;
    ....
   end
Тут я перевожу цифры в направление, а теперь мне внутри TModel.getGrowDirect теперь направление переводить в цифры? и, если цифры соотетствуют правилам, производить рост?
Чё то я не соображу, с какого боку тут браться.

Если у кого быстро появится идея или кто уже с подобным работал, поделитесь мыслями, как это делать.

Вот сама прога. Она явно больше 4 мегабайт, так что её сюда не засунуть.
Вот сама прога и файл для неё
https://www.dropbox.com/sh/z7xllh5uq...b_jlih9Ia?dl=0

Кстати, в поле "мин. рес" или "макс рес" надо уменьшить ресурсы в 10 раз
Вложения
Тип файла: rar matrix_2D_154_grad.rar (433 байт, 8 просмотров)
Занимаюсь:1.зверьком- покемончиком для компьютерного затончика. 2 IT-грибами,что бы скушать потом их с вами.3. цифровым обезьянками, как куны ударяют за тянками

Последний раз редактировалось anaschu; 31.08.2019 в 12:09.
anaschu вне форума Ответить с цитированием
Старый 31.08.2019, 12:15   #2
anaschu
Форумчанин
 
Регистрация: 21.09.2012
Сообщений: 372
По умолчанию

Я так понимаю, что сегодняшний рандомный рост у меня у растения связан внутри TModel.getGrowDirect вот с этим куском кода
Код:
if (Random < Probability[xx]) and (random > FField[X, Y].Source)then begin  //если хх=-1, то сразу False
    // Новая клетка (вероятно) по прежнему направлению роста
    C:=Coord(X,Y)+Coord(FField[X, Y].Direction[1]);
    C:=FField.Tor(C); // клетки с координатами за пределами поля "завернуть" на другую сторону поля
    search:=FField[C.X, C.Y].Exists;  // Если клетка уже занята, то будем искать другую
    if not search then begin
      //setlength(Cells,1);
      //Cells[0] := TRes.Create();
      result.x := C.X;
      result.y := C.Y;
      result.d := FField[X, Y].Direction[1];
      result.s := FField[X, Y].DickLength;
      neig:= checkNeighbors(coord(c.x, c.y), coord(x,y));
      result.n := neig;
      result.i := FField[X,Y].FamlyId;
      result.f := true;
    end;
  end;
тут надо убрать рандом, вернее, рандом надо оставить, но рандом надо утихомирить.
А сделать это можно так:
Если все вокруг клетки одинаковые по ресурсам, то , в соответствии с этой строчкой:
Код:
if (Random < Probability[xx]) and (random > FField[X, Y].Source)then begin
Растение может расти в любую сторону. А должно оно расти в строго определенную.
Потому тут нужен не рандом, а перебор, причем перебор по трем столбцам вокруг клетки:
1. левый
2. средний ( кроме клетки, откуда идет перебор)
3. самый правый
Судя по индексовому обозначению направлений, такой перебор будет давать наименьший номер направления

Код:
type
  TRes = class   // класс для возврата значений из функции - поиск клетки для роста
    x : integer; // X
    y : integer; // Y
    s : integer; // количество шагов роста в этом направлении в будущей клетке
    d : TDirection; // направление роста
    f : boolean; // Успешность поиска (надо ли верить другим значениям этого класса)
    m : integer; // тип клетки = 0(иногда используется для "прыжковых" грибов = 3)
    n : boolean; // наличие соседей (результат проверки)
    i : integer; // id семьи клетки
      end;

пока прибизительно так я обрежу алгоритм, то есть 50% кода сверху не будет нужно
Изображения
Тип файла: jpg тестирование_cr.jpg (21.0 Кб, 86 просмотров)
Занимаюсь:1.зверьком- покемончиком для компьютерного затончика. 2 IT-грибами,что бы скушать потом их с вами.3. цифровым обезьянками, как куны ударяют за тянками

Последний раз редактировалось anaschu; 31.08.2019 в 15:17.
anaschu вне форума Ответить с цитированием
Старый 31.08.2019, 15:47   #3
anaschu
Форумчанин
 
Регистрация: 21.09.2012
Сообщений: 372
По умолчанию

Чё то сложна...решил для начала сильно упростить прогу. потом разбираться с ентим
Занимаюсь:1.зверьком- покемончиком для компьютерного затончика. 2 IT-грибами,что бы скушать потом их с вами.3. цифровым обезьянками, как куны ударяют за тянками
anaschu вне форума Ответить с цитированием
Старый 01.09.2019, 01:23   #4
anaschu
Форумчанин
 
Регистрация: 21.09.2012
Сообщений: 372
По умолчанию

Вот упрощение этой проги. Вернее, это её прабабушка.
и вот в этой проге надо обеспечить верхний изначально рассказанный алгоритм так, что бы стало близко к изначальной проге, мда. В то время гитом я не пользовался, так что пошагового календаря изменений у меня нету. Хотя отдельные файлики же у меня есть, так что мона просто позаливать это всё в гит и пусть он вычисляет, чего там менялось с каждым релизом. Чую, придеться мне так раз десять менять прогу, прежде чем придти к чему то похожему. Для её работы требуется csv файл из начального поста. Пожалуй, мне придёться отсюда последовательно усложнять прогу, доведя её до решения изначального вопроса или хотя бы до постановки вопроса. такой постановки, что бы можно было решить в итоге.
делать буду вот тут
git@gitlab.com:anaschu/fungi_test_unit_no_prop.git
Вложения
Тип файла: rar Life_160413.rar (512.0 Кб, 9 просмотров)
Занимаюсь:1.зверьком- покемончиком для компьютерного затончика. 2 IT-грибами,что бы скушать потом их с вами.3. цифровым обезьянками, как куны ударяют за тянками

Последний раз редактировалось anaschu; 01.09.2019 в 12:21.
anaschu вне форума Ответить с цитированием
Старый 03.09.2019, 17:27   #5
anaschu
Форумчанин
 
Регистрация: 21.09.2012
Сообщений: 372
По умолчанию

Цитата:
Сообщение от anaschu Посмотреть сообщение
упростить прогу.
Ну вот код после упрощения и оптимизации

Код:
function TModel.getGrowDirect(X: Integer; Y: Integer): TDirection;
var
  growDirectionResult: TDirection;
  neig: boolean;
  currentCoord, foundCoord: TCoord;
begin
  result := dNone;

  if FField[X, Y].StepBirth >= FStep then begin
    exit;
  end;

  
  neig := false;
  // 1. Пробуем расти в ту же сторону
  result := TryGrowInSameDirection(X, Y);  //
  currentCoord := coord(X, Y);
  foundCoord := currentCoord + Coord(growDirectionResult);
  neig := checkNeighbors(foundCoord, currentCoord);
  
  if (result = dNone) or (not neig) then begin
      result := getGrow(X, Y);    // 2. попытка роста в прежнем направлении не удалась. Ищем хоть что-то
  end;
  
end;
там две вложенгных процедуры

1.

Код:
function TModel.getGrow(X: Integer; Y: Integer): TDirection;
var
  na, ko, L: integer;
  FoundDirectionsToMove: TDirectionArray;
 // CellToMove: TRes;
 //directionToMove: TDirection;
begin
  result := dNone;
  // найти клетки куда можно расти
  NewDirectArea(X, Y, na, ko); //  na,ko   два направления по часовой стрелке
  FoundDirectionsToMove := MakePossibleDirectionsToMove(Coord(X, Y), na, ko);


  if Length(FoundDirectionsToMove) = 0 then begin    // завершаем все, если расти некуда
    exit;
  end;

  result := ChooseDirectionToMove(X, Y, FoundDirectionsToMove);

//  GetGrowSuccess(result, directionToMove);
  
end;
2. Вот, похоже, в ней и надо что то менять

Код:
function TModel.ChooseDirectionToMove(X, Y: integer; FoundDirectionsToMove: TDirectionArray):TDirection;
var
  i, L: integer;
  rr, totalResource: Extended;    //количество ресурсов в пригодных для движения клетках
  newCoord: TCoord;
begin
  result := dNone;

  totalResource := CalculateSumResources(X, Y, FoundDirectionsToMove);

  rr := Random()*totalResource;   // Выбираем случайное значение из массива вариантов, но клетка с большими ресурсами имеет больше вероятность
  L := -1;
  for i := 0 to Length(FoundDirectionsToMove) - 1 do begin
    newCoord := Coord(X, Y) + Coord(FoundDirectionsToMove[i]);
    newCoord := FField.Tor(newCoord, isTorEnabled);
    if not FField.IsInside(newCoord) then begin
      continue;
    end;
    totalResource := totalResource - FField[newCoord.X, newCoord.Y].Source;
    if totalResource <= rr then begin
      L := i;
      break;
    end;
  end;

  if L > -1 then begin
    result := FoundDirectionsToMove[L];
  end;

end;

Я пробовал в этой функции убрать Random из rr := Random()*totalResource; так, что бы просто у меня rr := totalResource

В принципе после этого + некоторые изенения, росло в одну сторону , да. Но протестировать при этом ветвление было невозможным, ветвлвление вообще ушло.

Цитата:
Сообщение от anaschu Посмотреть сообщение
Вот упрощение этой проги. Вернее, это её прабабушка.
ни в прабабушке, ни в бабушке нет норм способов работы с кодом- там все плохо. Оказалось, надо работать даже с усложненным, но более правильно построенным кодом- который приведен в последних сообщениях этой ветки форума
Вложения
Тип файла: rar mushroomlife.rar (2.47 Мб, 8 просмотров)
Занимаюсь:1.зверьком- покемончиком для компьютерного затончика. 2 IT-грибами,что бы скушать потом их с вами.3. цифровым обезьянками, как куны ударяют за тянками

Последний раз редактировалось anaschu; 03.09.2019 в 17:40.
anaschu вне форума Ответить с цитированием
Старый 05.09.2019, 16:54   #6
anaschu
Форумчанин
 
Регистрация: 21.09.2012
Сообщений: 372
По умолчанию

NewDirectArea дает веер направлений в связи с бывшим направлнием.
MakePossibleDirectionsToMove  - дает все хоть какие то ресурсные направления.
ChooseDirectionToMove- среди ресурсных выбирает самое ресурсное

додумался сделать вот это:

Код:
function TModel.getDirectForNoProp(C1: TCoord; C2: TCoord): integer;
var
  index: integer;
begin
   result := 4; // Во избежание warnings
   // пересчет разности координат в индекс для поиска направления
   Result:=(C2.X-C1.X+1)*3+(C2.Y-C1.Y+1);

end;

Код:
type
  TRes = class   // класс для возврата значений из функции - поиск клетки для роста
    x: integer; // X
    y: integer; // Y
    s: integer; // количество шагов роста в этом направлении в будущей клетке
    growthDirection: TDirection; // напрваление роста
    searchSuccess: boolean; // Успешность поиска (надо ли верить другим значениям этого класса)
    cellType: TCellType; // тип клетки = 0(иногда используется для "прыжковых" грибов = 3)
    haveNeighbors: boolean; // наличие соседей (результат проверки)
    cellFamilyID: integer; // id семьи клетки
    cellClanId: integer;
    r:extended; //количество ресурсов
    d:integer; //направление
  end;
Код:
//выбираем клетку движения из найденых возможных клеток
function TModel.ChooseDirectionToMove(X, Y: integer; FoundDirectionsToMove: TDirectionArray):TDirection;
var
  i, L,z, forDir: integer;
  rr, totalResource, fordifres: Extended;    //количество ресурсов в пригодных для движения клетках
  Coord1,newCoord: TCoord;
  Cells     : TResArray;
  cell: Tres;
  D0:extended;
begin
  setlength(Cells,0);
  result := dNone;
  for forDir := 0 to 8 do
  //totalResource := CalculateSumResources(X, Y, FoundDirectionsToMove);

  Coord1:= Coord(X,Y)  ;
  L := -1;
  newCoord := Coord(X, Y) + Coord(FoundDirectionsToMove[0]);
  newCoord := FField.Tor(newCoord, isTorEnabled);
  fordifres := FField[newCoord.X, newCoord.Y].Source;
  for i := 0 to Length(FoundDirectionsToMove) - 1 do begin
    newCoord := Coord(X, Y) + Coord(FoundDirectionsToMove[i]);
    newCoord := FField.Tor(newCoord, isTorEnabled);
    if not FField.IsInside(newCoord) then begin
      continue;
    end;
    if (fordifres < FField[newCoord.X, newCoord.Y].Source)then
    begin
      setlength(Cells,length(Cells)+1);
      //Cells[length(Cells)] := nil;
     // Cells[length(Cells)+1] := nil;
      Cell := TRes.Create();
      Cell.x := newCoord.X;
      Cell.y := newCoord.Y;
      Cell.r:= FField[newCoord.X, newCoord.Y].Source;
      Cell.d := getDirectForNoProp(Coord1, newCoord);
      Cells[length(Cells)-1] := Cell;
    end;
  end;

  D0:=8;

  if (length(Cells)>1) then begin
  for I := 1 to length(Cells) do
    begin
    if (D0 > Cells[i].d)then
    D0:=Cells[i].d;
    l:=i;
    end;

  end;
  Result:= getDirect(Coord1,NewCoord);

end;
Вложения
Тип файла: rar noProp_unit_test_JIeIIIa.rar (343.0 Кб, 13 просмотров)
Занимаюсь:1.зверьком- покемончиком для компьютерного затончика. 2 IT-грибами,что бы скушать потом их с вами.3. цифровым обезьянками, как куны ударяют за тянками

Последний раз редактировалось anaschu; 05.09.2019 в 20:02.
anaschu вне форума Ответить с цитированием
Старый 06.09.2019, 11:23   #7
anaschu
Форумчанин
 
Регистрация: 21.09.2012
Сообщений: 372
По умолчанию

ну вот. вроде бы всё теперь работает. осталось протестить. видео немного опаздывает от разработки, кстати
https://youtu.be/jVsbmvISs18
Вложения
Тип файла: rar noProp_unit_test_JIeIIIa2.rar (2.68 Мб, 14 просмотров)
Занимаюсь:1.зверьком- покемончиком для компьютерного затончика. 2 IT-грибами,что бы скушать потом их с вами.3. цифровым обезьянками, как куны ударяют за тянками
anaschu вне форума Ответить с цитированием
Старый 06.09.2019, 22:59   #8
anaschu
Форумчанин
 
Регистрация: 21.09.2012
Сообщений: 372
По умолчанию

не те индексы роста- растет не налево вверх, а налево. но в целлом да, не вероятностный вариант сделан, работает на 80% так, как нужно.

https://youtu.be/QoOCtUgXReE
Вложения
Тип файла: rar noProp_unit_test_JIeIIIa3.rar (224.7 Кб, 7 просмотров)
Занимаюсь:1.зверьком- покемончиком для компьютерного затончика. 2 IT-грибами,что бы скушать потом их с вами.3. цифровым обезьянками, как куны ударяют за тянками
anaschu вне форума Ответить с цитированием
Старый 08.09.2019, 12:31   #9
3D Hunter
Сумрачная тень
Форумчанин
 
Аватар для 3D Hunter
 
Регистрация: 05.03.2009
Сообщений: 689
По умолчанию

мне интересно, вы тут решили live-журнал сваять на форуме?
"ковыряю изнутри" (с)
3D Hunter вне форума Ответить с цитированием
Старый 08.09.2019, 13:24   #10
Alex11223
Старожил
 
Аватар для Alex11223
 
Регистрация: 12.01.2011
Сообщений: 19,500
По умолчанию

Да полгода уже ваяет. А что?)
Ушел с форума, https://www.programmersforum.rocks, alex.pantec@gmail.com, https://github.com/AlexP11223
ЛС отключены Аларом.
Alex11223 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Выбор направления в ВУЗе danil123 Свободное общение 3 23.07.2013 18:27
Задача на машине Тьюринга Dark Raven Помощь студентам 0 15.02.2012 13:38
Выбор направления.... wade25 C# (си шарп) 2 26.03.2011 12:00
Деление с остатком на машине Тьюринга rtyrus Помощь студентам 0 21.05.2010 00:10
Совет по Машине Тьюринга Rusic Общие вопросы Delphi 0 19.05.2010 18:33