Алгоритм проверки

← →
!_SM_! (2006-06-04 02:40) [0]

Привет! Подскажите пожалуйста алгоритм проверки цифр.
Есть цифры например от 0 до 8, есть группа цифр 5 шт.
Группа считается удовлетворительной если в ней идут
подряд 3 и более одинаковых цифры начиная с начала или с конца
т.е алгоритм игрового автомата. Эту проверку я зделал. Собственно вот вопрос.
Есть цифра например 5, она может заменить любую цифру т.е.
11523 – это 3 единицы
55522 – 3 пятерки (прсто здесь может быть 4 пятерки, и 5 пятерок)
44533 – 3 четверки (начало проверки слева поэтому четверки, собственно не важно)
25252 – 5 двоек
12345 – ничего
31113 – тоже ничего (не сначала и не с конца)
Т.е. придумать функцию типа function ProverkaGruppy(var Dig, DigCount: Byte): Boolean;
Где результатом функции будет истина, если проверка прошла и ложь, если нет,
DigCount – количество одинаковых цифр Dig
Блин, вроде понятно написал.

Примерная проверка но без заменяющей 5.
Function VerGroup(var Dig, DigCount: Byte): Boolean;
Var N: Byte; D: array [1..5] of Byte;
begin
DigCount:=0; Result:=False;
For N:= 1 to 5 do D[N]:=Random(9);
if (D[1] <> D[2]) and (D[4] <> D[5]) then Exit;
if D[1]=D[2] then begin
DigCount:=2;
for N:=3 to 5 do if D[N] <> D[1] then Break else INC(DigCount);
Dig:= D[1];
end;
if D[5]=D[4] then begin DigCount:=2;
for N:=3 downto 1 do if D[N] <> D[5] then Break else INC(DigCount);
Dig:= D[5];
end;
Result:= DigCount > 0;
End;
Спасибо!

← →
PZ (2006-06-04 07:03) [1]

Предлагаю вариант:

Type tMas = array [1..5] of Byte; Var N : Byte; DD : tMas; Function Groop(D : tMas): Boolean; begin Result := False; If (D[1] = D[2]) or (D[2] = 5) then If D[1] = D[3] then Result := True; If D[1] = 5 then If D[2] = D[3] then Result := True; If D[3] = 5 then If D[1] = D[2] then Result := True; If (D[4] = D[5]) or (D[5] = 5) then If D[4] = D[3] then Result := True; If D[4] = 5 then If D[5] = D[3] then Result := True; If D[3] = 5 then If D[4] = D[5] then Result := True; end; procedure TForm1.Button1Click(Sender: TObject); begin Randomize; For N := 1 to 5 do DD[N] := Random(9); If Groop(DD) then ShowMessage(IntToStr(DD[1])+IntToStr(DD[2])+ IntToStr(DD[3])+ IntToStr(DD[4])+IntToStr(DD[5])); end;

← →
Юрий Зотов © (2006-06-04 10:54) [2]

type
TGroup: string[5];
TSubgroup: string[3];

function CheckGroup(const G: TGroup): boolean;

function CheckSubgroup(S: TSubgroup): boolean;
begin
S := StringReplace(S, "5", S[1], [rfReplaceAll]);
Result := (S[1] = S[2]) and (S[2] = S[3])
end;

begin
Result := CheckSubgroup(Copy(G, 1, 3) or CheckSubgroup(Copy(G, 3, 3)
end;

← →
Юрий Зотов © (2006-06-04 10:56) [3]

Маленькая опечаточка, конечно. Должно быть так:
type
TGroup = string[5];
TSubgroup = string[3];

← →
Юрий Зотов © (2006-06-04 11:12) [4]

И так:
Result := CheckSubgroup(Copy(G, 1, 3)) or CheckSubgroup(Copy(G, 3, 3))

← →
Юрий Зотов © (2006-06-04 14:41) [5]

Еще подумал...
Алгоритм CheckSubgroup оставляет желать лучшего (не сработает, если S[1]="5") - но идея, надеюсь понятна, а доработать - не проблема (найти в S первый символ, не равный "5", а потом заменить им все символы "5").

← →
!_SM_! (2006-06-04 22:38) [6]

Спасибо Юрий. Вот че придумал:
type TDz = array [1..5] of Byte; var Form1: TForm1; Dz: TDz; function CheckGr(const D: TDz; var z,cz: Byte; var S: String): Boolean; function CheckSubGr(D1,D2,D3: Byte): Boolean; procedure DReplace(const D: Byte); begin if D1=5 then D1:=D; if D2=5 then D2:=D; if D3=5 then D3:=D; z:=D; end; begin if(D1=5)and(D2<>5) then DReplace(D2) else if ((D1=5)and(D2=5)and(D3<>5)) then DReplace(D3) else DReplace(D1); Result:=((D1=D2)and(D2=D3))or((D1=5)and(D2=D3))or((D1=5)and(D2=5))or((D2=5)and(D 3=5)); end; var N: Byte; begin Result:=False; z:=0; cz:=0; for N:=1 to 5 do S:=S+IntToStr(D[N]); if CheckSubGr(D[1], D[2], D[3]) then begin Result:=True; Cz:=3; if(D[4]=z)or(D[4]=5)then begin INC(Cz); if(D[5]=z)or(D[5]=5)then INC(Cz); end; S:=""; for N:=1 to Cz do S:=S+IntToStr(Dz[N]); end else if CheckSubGr(D[5], D[4], D[3]) then begin Result:=True; Cz:=3; if(D[2]=z)or(D[2]=5) then begin INC(Cz); if(D[1]=z)or(D[1]=5)then INC(Cz); end; S:=""; for N:=5 downto 6-Cz do S:=S+IntToStr(Dz[N]); end; end; procedure TForm1.Button2Click(Sender: TObject); var z,cz: Byte; S: String; begin Dz[1]:=sed1.AsInteger; Dz[2]:=sed2.AsInteger; Dz[3]:=sed3.AsInteger; Dz[4]:=sed4.AsInteger; Dz[5]:=sed5.AsInteger; if CheckGr(Dz, Z, CZ, S) then lbArr.Caption:=Format("Выбрано %d - %d штук "", [Z,CZ])+S+""" else lbArr.Caption:="Неудача ""+S+"""; end;
Вроде то че надо. Тестирую....

Слишком много. Строк 15 для такой задачки - это было бы нормально.

Говорят, что если формула длиннее 5 дюймов, то она заведомо неверна. Доля истины в этой шутке есть.

← →
!_SM_! (2006-06-04 23:40) [8]

Согласен... если поубирать переменные Z, CZ, S то и будет менее 15
их я вставил для проверки...тестирования....
Тут мож чего лишнего наворотил:
Result:=((D1=D2)and(D2=D3))or((D1=5)and(D2=D3))or((D1=5)and(D2=5))or((D2=5 )and(D 3=5));
Главное работает.
ВОТ:
function CheckGr(const D: TDz): Boolean; function CheckSubGr(D1,D2,D3: Byte): Boolean; procedure DReplace(const D: Byte); begin if D1=5 then D1:=D; if D2=5 then D2:=D; if D3=5 then D3:=D; end; begin if(D1=5)and(D2<>5) then DReplace(D2) else if ((D1=5)and(D2=5)and(D3<>5)) then DReplace(D3) else DReplace(D1); Result:=((D1=D2)and(D2=D3))or((D1=5)and(D2=D3))or((D1=5)and(D2=5))or((D2=5)and(D 3=5)); end; var N: Byte; begin Result:=CheckSubGr(D[1], D[2], D[3]) or CheckSubGr(D[5], D[4], D[3]) end;

Думал сейчас напишу что-нибудь свое и понял, что то, что приходит в голову не двусмысленно напоминает код Юрия Зотова. Тем не менее, вот оно, перед вами. Кажется, должно работать :)

function CheckGroup(const Group : String; Joker : Char; SubgroupLength : Integer) : Boolean; function CheckSubgroup(Start : Integer) : Boolean; var i : Integer; begin Result := false; if (Start > length(Group) - SubgroupLength + 1) or (Start <= 0) then Exit; for i := Start + 1 to Start + SubgroupLength - 1 do if (Group[i] <> Group[Start]) and (Group[i] <> Joker) then Exit; Result := true; end; begin if (SubgroupLength > 1) then Result := CheckSubgroup(1) or CheckSubgroup(length(Group) - SubgroupLength + 1) else Result := true; end;

Алгоритм проверки Найти похожие ветки