При этом, при подсчёте вариантов для каждой позиции нужно исключать возможные повторения, которые были подсчитаны на предыдущих шагах (чтобы не вычесть их дважды).
Каков же алгоритм этого?
Модератор: Модераторы
При этом, при подсчёте вариантов для каждой позиции нужно исключать возможные повторения, которые были подсчитаны на предыдущих шагах (чтобы не вычесть их дважды).
Evgen писал(а):{$ifdef fpc}{$mode delphi}{$H+}{$endif}
Если это компилятор FreePascal то
Установить режим компиляции как для Delphi
Установить тип строк типа AnsiString (длинные строки)
Конец Если
Evgen писал(а):я стараюсь в программах разобраться, а не тупо списать, но написать то чего не знаю мне трудно, потому что не знаю,что такое есть, а всего прочитать не успеваю.
Evgen писал(а):зачем устанавливать режим компиляции как для Delphi?
{$B-}
function CountStrings(aStrLength: Integer; const aTabu: shortstring): Integer;
var
TabuLen: Integer;
CurStr: shortstring;
function TabuMatch(aPos: Integer): Boolean;
var
I: Integer;
begin
for I := 1 to TabuLen do
if CurStr[aPos + I] <> aTabu[I] then
exit(False);
Result := True;
end;
procedure Search(CurLen: Integer);
const
Alphabet: array[1..3] of Char = ('A', 'B', 'C');
var
CurChar: Char;
begin
Inc(CurLen);
for CurChar in Alphabet do
begin
CurStr[CurLen] := CurChar;
if (CurLen >= TabuLen) and TabuMatch(CurLen - TabuLen) then
continue;
if CurLen < aStrLength then
Search(CurLen)
else
Inc(Result);
end;
end;
begin
Result := 0;
TabuLen := Length(aTabu);
Search(0);
end;
Дож писал(а):Каков же алгоритм этого?
ABxxxxx
ABABxxx
ABxABxx
ABxxABx
ABxxxAB
ABABABx
ABABxAB
ABxABAB
xABxxxx
xABABxx
xABxABx
xABxxAB
xABABAB
xxABxxx
xxABABx
xxABxAB
Evgen писал(а):зачем устанавливать режим компиляции как для Delphi?
скалогрыз писал(а):для каждой позиции в строке (i) вычисляем сумму всех возможных вариантов для столбца (от 1 до N - length(substr))
program primes;
{$mode objfpc}
function CountBig(Lower, Upper: Int64): Integer;
var
FirstPrimes: array of Integer = nil;
procedure Sieve(Upper: Integer);
var
Prime: array of Boolean = nil;
I, Count: Integer;
J: Int64;
begin
if Upper <= 200 then
SetLength(FirstPrimes, Trunc((1.6 * Upper)/Ln(Upper)) + 1)
else
SetLength(FirstPrimes, Trunc(Upper/(Ln(Upper) - 2)) + 1);
SetLength(Prime, Upper + 1);
FillChar(Pointer(Prime)^, Succ(Upper), 1);
Count := 0;
for I := 2 to Upper do
if Prime[I] then
begin
FirstPrimes[Count] := I;
Inc(Count);
J := Int64(I) * Int64(I);
while J <= Upper do
begin
Prime[J] := False;
Inc(J, I);
end;
end;
SetLength(FirstPrimes, Count);
end;
var
Prime: array of Boolean = nil;
R, I, CurPrime: Integer;
begin
Sieve(Trunc(Sqrt(Upper)) + 1);
R := Upper - Lower;
Result := R + 1;
SetLength(Prime, Result);
FillChar(Pointer(Prime)^, Result, 1);
for CurPrime in FirstPrimes do
begin
I := Lower mod CurPrime;
if I <> 0 then
I := CurPrime - I;
while I <= R do
begin
if Prime[I] then
begin
Prime[I] := False;
Dec(Result);
end;
I += CurPrime;
end;
end;
end;
function CountSmall(Lower, Upper: Integer): Integer;
var
Prime: array of Boolean = nil;
I: Integer;
J: Int64;
begin
SetLength(Prime, Upper + 1);
FillChar(Pointer(Prime)^, Upper + 1, 1);
Result := 0;
for I := 2 to Upper do
if Prime[I] then
begin
if I >= Lower then
Inc(Result);
J := Int64(I) * Int64(I);
while J <= Upper do
begin
Prime[J] := False;
Inc(J, I);
end;
end;
end;
var
A, B: Int64;
Count: Integer;
begin
ReadLn(A, B);
//тут надо бы проверить корректнось A и B
if Trunc(Sqrt(B)) + 1 >= A then
Count := CountSmall(A, B)
else
Count := CountBig(A, B);
WriteLn(Count);
end.
Evgen писал(а):добавлять библиотеки которых нет в паскале нельзя
Evgen писал(а):получил III место
A1 = { SSSS************* }
A2 = { *SSSS************ }
...
Ak = { *************SSSS }
const
PowerOf3: array[0 .. 16] of LongInt = (
1,
3, 9, 27, 81,
243, 729, 2187, 6561,
19683, 59049, 177147, 531441,
1594323, 4782969, 14348907, 43046721
);
for I := 1 to K do begin
for J := 1 to K do begin
T[I, J] := True;
X := I;
while X < I + L do begin
if (J <= X) and (X < J + L) then begin
if S[X - I + 1] <> S[X - J + 1] then
T[I, J] := False;
end;
Inc(X);
end;
end;
end;
for A := 1 to (1 shl K) - 1 do begin
// Проверка лежит ли Ai в A:
// if ((A and (1 shl (I - 1))) <> 0) then begin
end;
//
// Параметры:
//
// L: длина строк
// I: >0 позиция первой строки, =0 особый случай - возвращает L
// J: >I позиция второй строки
//
function Overhang(L, I, J: LongInt): LongInt;
begin
if (I = 0) or (J >= I + L) then
Exit(L);
Exit(J - I);
end;
Вернуться в Free Pascal Compiler
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 4