Форум программистов
 
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail.

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

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


Донат для форума - использовать для поднятия настроения себе и модераторам

А ещё здесь можно купить рекламу за 25 тыс руб в месяц! ) пишите сюда - alarforum@yandex.ru

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

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

Код:
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 байт, 4 просмотров)

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

Я так понимаю, что сегодняшний рандомный рост у меня у растения связан внутри 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% кода сверху не будет нужно
Миниатюры
Нажмите на изображение для увеличения
Название: тестирование_cr.jpg
Просмотров: 22
Размер:	21.0 Кб
ID:	97565  

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

Чё то сложна...решил для начала сильно упростить прогу. потом разбираться с ентим
anaschu вне форума   Ответить с цитированием
Старый 01.09.2019, 02:23   #4
anaschu
Форумчанин
 
Регистрация: 21.09.2012
Сообщений: 324
Репутация: 75
По умолчанию

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

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

Цитата:
Сообщение от 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 Мб, 5 просмотров)

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

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 Кб, 4 просмотров)

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

ну вот. вроде бы всё теперь работает. осталось протестить. видео немного опаздывает от разработки, кстати
https://youtu.be/jVsbmvISs18
Вложения
Тип файла: rar noProp_unit_test_JIeIIIa2.rar (2.68 Мб, 5 просмотров)
anaschu вне форума   Ответить с цитированием
Старый 06.09.2019, 23:59   #8
anaschu
Форумчанин
 
Регистрация: 21.09.2012
Сообщений: 324
Репутация: 75
По умолчанию

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

https://youtu.be/QoOCtUgXReE
Вложения
Тип файла: rar noProp_unit_test_JIeIIIa3.rar (224.7 Кб, 4 просмотров)
anaschu вне форума   Ответить с цитированием
Старый 08.09.2019, 13:31   #9
3D Hunter
Сумрачная тень
Участник клуба
 
Аватар для 3D Hunter
 
Регистрация: 05.03.2009
Адрес: Россия
Сообщений: 689
Репутация: 182
По умолчанию

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

icq: 512-765
skype: alexp.frl
По умолчанию

Да полгода уже ваяет. А что?)
Alex11223 на форуме   Ответить с цитированием
Ответ

Опции темы

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход

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


09:34.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.