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

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
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 1