Олимпиадные задачи

Вопросы программирования на Free Pascal, использования компилятора и утилит.

Модератор: Модераторы

Аватара пользователя
Дож
энтузиаст
Сообщения: 900
Зарегистрирован: 12.10.2008 16:14:47

Сообщение Дож »

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

Каков же алгоритм этого?
Evgen
новенький
Сообщения: 19
Зарегистрирован: 03.01.2019 04:10:14

Сообщение Evgen »

Уважаемый скалогриз, я действительно школьник, учусь в 10 калассе и задачки беру с алготестера. Когда пишу вам, то перевожу с украинского на русский (не дослівно). Многие задачи у меня проходят, но не все тесты, так как там накладываются условия на входные данные, память,время.
В задаче с SMS я не понимаю как я могу найти количество комбинаций, которые включают слово S, если у меня нет их, а только их количество как их сгенерировать я не знаю. (сейчас буду разбиратся в програме, которую выслали).
(Ограничения 1≤n≤16, Строка S состоит с символов A и B, а ее длина не превышает 16. (НПР: Вход - n=7; S - "AA": Виход-1224)

Кстати о рекурсии, я знаю что єто такое, но не использовал в зхадачах.
Спасибо

Добавлено спустя 42 минуты 13 секунд:
Не понял, кто выслал код программы, скалогрыз или iskander, но все равно спасибо. В программе разобрался; пропустил на алготестере; прошло только 7 тестов (из 25 возможных);
на 8 тесте лимит времени (время 1,038 сек., а нужно 1 сек.)
Если можно объясните что это за строка в программе и когда ее надо подключать в программу (я кажется где то встречал , это какие то модули, но мне не понятно)
{$ifdef fpc}{$mode delphi}{$H+}{$endif}
Скалогрыз, я стараюсь в программах разобраться, а не тупо списать, но написать то чего не знаю мне трудно, потому что не знаю,что такое есть, а всего прочитать не успеваю.
Большое спасибо.
Если сможете решить проблему времени напишите
Vadim
долгожитель
Сообщения: 4112
Зарегистрирован: 05.10.2006 08:52:59
Откуда: Красноярск

Сообщение Vadim »

Evgen писал(а):{$ifdef fpc}{$mode delphi}{$H+}{$endif}

То, что начинается с символов "{$" - это указания компилятору как нужно компилировать исходник. В переводе на русский:
Если это компилятор FreePascal то
Установить режим компиляции как для Delphi
Установить тип строк типа AnsiString (длинные строки)
Конец Если
Evgen
новенький
Сообщения: 19
Зарегистрирован: 03.01.2019 04:10:14

Сообщение Evgen »

Vadim, зачем устанавливать режим компиляции как для Delphi?
Vadim
долгожитель
Сообщения: 4112
Зарегистрирован: 05.10.2006 08:52:59
Откуда: Красноярск

Сообщение Vadim »

Evgen писал(а):я стараюсь в программах разобраться, а не тупо списать, но написать то чего не знаю мне трудно, потому что не знаю,что такое есть, а всего прочитать не успеваю.

Вы большой молодец! Есть только один нюанс. ;-) Прежде чем писать программу, нужно сначала решить задачу обычными словами, т.е. постараться максимально понятно описать на любом, понятном Вам языке (неважно - русском, украинском, математическом или индейском узелковом, в общем на том, какой понятен без напрягов). А вот уже когда решение будет подробно описано, тогда можно сделать перевод этого описания на язык программирования. Это именно перевод, сочинять самому Вам ничего не придётся. Если говорить по научному - Вы сначала составляете алгоритм решения задачи, а потом уже излагаете этот алгоритм на каком-то языке программирования.

Добавлено спустя 47 секунд:
Evgen писал(а):зачем устанавливать режим компиляции как для Delphi?

А вот об этом Вы должны спросить у того, кто это написал. ;-)
iskander
энтузиаст
Сообщения: 627
Зарегистрирован: 08.01.2012 18:43:34

Сообщение iskander »

Evgen, вот более шустрый вариант рекурсивного перебора(режим OBJFPC):

Код: Выделить всё

{$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;

Надеюсь вы уже сумеете самостоятельно использовать эту функцию в своей программе.
Вопрос: почему этот вариант быстрее, ведь на первый взгляд проверок на совпадение в нем больше?

Про ограничения по времени все же пишите сразу.
Правильно ли я понял, что во второй задаче N-1 дорог и из каждого города можно добраться в каждый?
Evgen
новенький
Сообщения: 19
Зарегистрирован: 03.01.2019 04:10:14

Сообщение Evgen »

Спасибо за фукцию (пока еще не разобрался)

Вторая задача:
N городов, N-1 дорога;известно. что по магистрале можно попасть с любого города в любой.
Ограничения:
1 сек, 256 MB
1≤n≤10^5,
1≤a, b, ai, bi≤n,
0≤ci≤109.
Примеры
Вход Виход (3)
3 1 3 (n,a,b)
1 2 4 (номер первого и второго городов, которые соединяются двосторонньой дорогой, мах число товара через эту
дорогу)
2 3 3
скалогрыз
долгожитель
Сообщения: 1804
Зарегистрирован: 03.09.2008 02:36:48

Сообщение скалогрыз »

Дож писал(а):Каков же алгоритм этого?


для каждой позиции в строке (i) вычисляем сумму всех возможных вариантов для столбца (от 1 до N - length(substr))

затем из этой суммы вычитаем, все возможные варианты переборов, где значение столбика может пересекатся с другими позициями. (причём пересекаться в позициях > i
Например:

Код: Выделить всё

ABABxxx
ABxABxx
ABxxABx
ABxxxAB
ABABABx
ABABxAB
ABxABAB

(тут, всё-таки хитрость, зависящая от содержимого строки. Если она целиком состоит из одной буквый, то "пересечения" будут более "плотные"... хотя почему-то есть сомнения, что если подстрока будет целиком из одной и той же буквы состоять, то подсчёт может быть проще)

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

(например для позиции 2)
общее количество будет:

а вычитать нужно будет:

Код: Выделить всё

xABABxx
xABxABx
xABxxAB
xABABAB

(для позиции 3)

а вычитать нужно будет:

Код: Выделить всё

xxABABx
xxABxAB

(о предыдущих стобиках не нужно беспокоится, потому что их уже "вычли" при подсчёте предыдущих столбиках)

Добавлено спустя 3 минуты 29 секунд:
Evgen писал(а):зачем устанавливать режим компиляции как для Delphi?

чтобы компилятор правильно понял синтаксис. Слова одинакове а семантика разная может быть.
Например "дружина" в русском и украинском языках - разные вещи. И чтобы не было непоняток, лучше заранее сказать на какой кирилице пишем! :)
Хотя в данном случае всю строчку с {$ifdef fpc}... вообще можно убрать
iskander
энтузиаст
Сообщения: 627
Зарегистрирован: 08.01.2012 18:43:34

Сообщение iskander »

скалогрыз писал(а):для каждой позиции в строке (i) вычисляем сумму всех возможных вариантов для столбца (от 1 до N - length(substr))

Те же яйца, только в профиль?
iskander
энтузиаст
Сообщения: 627
Зарегистрирован: 08.01.2012 18:43:34

Сообщение iskander »

Evgen, вот решение задачки на подсчет простых чисел на промежутке:

Код: Выделить всё

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
новенький
Сообщения: 19
Зарегистрирован: 03.01.2019 04:10:14

Сообщение Evgen »

Уважаемый Iskander задача с коробками не в полном пролете (просто не идут некоторые тесты в обычном режиме; плохо то, что если не соревнование, то на первом не верном тесте остановка, может остальные правильные, хто его знает). А вот на олимпиадах показываю результаты всех правильных тестов (правда самих тестов мы не видим, только результат). Кстати вчера проходила областная олимпиада и я получил III место (правда таких человек было несколько и я среди них по серединке). спасибо за некоторые ценные советы, они мне пригодились. Правда к задаче с графами не смог подобраться (матрицу смежности построил, а дальше не пошло; в свободное время сяду за графы и деревья; если не смогу разобраться в задачке, то попрошу у вас помощи.
Спасибо за задачу с простыми числами, разберусь, пропущу на алготестере и скажу результат (на неделе, подтяну немножко другие предметы).
С уважением, на добраніч.
iskander
энтузиаст
Сообщения: 627
Зарегистрирован: 08.01.2012 18:43:34

Сообщение iskander »

Evgen писал(а):получил III место

Поздравляю!
Аватара пользователя
Дож
энтузиаст
Сообщения: 900
Зарегистрирован: 12.10.2008 16:14:47

Сообщение Дож »

Описываю решение задачи 1 про SMS.

Всего различных строк длины N может быть 3^N (3 в степени N). Для простоты посчитаем количество строк, которые содержат S. Результат вычтем из 3^N и получим ответ задачи.

Обозначим за L длину строки S, т.е. L=Length(S). Строка S может быть в позициях 1, 2, 3 и т.д. вплоть до k=N-L+1. Т.е. за k мы обозначили самую крайнюю возможную позицию строки S (если S состоит из одного символа, то k=N, а если L=N, то k=1).

Обозначим за A1 множество строк длины N, содержащие подстроку S в позиции 1, за A2 множество строк длины N, содержащие подстроку S в позиции 2, и т.д. вплоть до Ak. Можно себе представлять эти множества так, что часть символов в них зафиксирована, а оставшиеся N-L символов могут быть любыми (будем называть их свободными или незанятыми). Поэтому |Ai|=3^(N-L) для всех i.

Код: Выделить всё

A1 = { SSSS************* }
A2 = { *SSSS************ }
...
Ak = { *************SSSS }


Мы хотим посчитать Изображение. По формуле включения-исключения (доказательство смотрите в википедии или в Верещагин, Шень "Начала теории множеств"):

Изображение

Для вычисления суммы из правой части равенства нужно пробежать все подмножества множества {A1,A2,...,Ak}, т.е. 2^k слагаемых. Как вычислить слагаемое? Во-первых, его знак зависит от чётности "множителей" в нём (если чётное, то знак -). Во-вторых, слагаемое равно нулю, если пересечение нулевое (когда строки не могут быть одновременно на заданных позиция, например, ABA не может быть одновременно на 1 и 2 позициях, поэтому пересечение A1 и A2 пусто). Нужно попарно сравнить на пересечение все множества друг с другом, поэтому сложность этой проверки k*k. Наконец, если пересечение ненулевое, то заданный набор множеств фиксирует некоторые символы в строке, а оставшиеся F символов могут быть любыми, а значит модуль слагаемого равен 3^F.

Сложность алгоритма: O(k * k * 2^k), укладывается в ограничение 1 секунда.

Теперь советы по реализации:

1. Табличка для быстрого возведения 3^F

Код: Выделить всё

const
  PowerOf3: array[0 .. 16] of LongInt = (
    1,
    3, 9, 27, 81,
    243, 729, 2187, 6561,
    19683, 59049, 177147, 531441,
    1594323, 4782969, 14348907, 43046721
  );


2. Удобно перед основным алгоритмом вычислить табличку T[I,J]: Boolean, которая равна True, если на позициях I,J одновременно может стоять строка S:

Код: Выделить всё

  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;


3. Пробежать все непустые подмножества множества {A1,A2,...,Ak} можно обычным циклом от 1 до 2^k - 1, а проверить наличие множества Ai в подмножестве проверкой наличия i-ого бита в числе:

Код: Выделить всё

for A := 1 to (1 shl K) - 1 do begin
  // Проверка лежит ли Ai в A:
  // if ((A and (1 shl (I - 1))) <> 0) then begin
end;


4. Для подсчёта того, сколько незанятых символов оставляют строки пригодится функция, которая по двум строкам говорит сколько новых символов добавляет вторая строка (насколько она "выступает" относительно первой):

Код: Выделить всё

//
//  Параметры:
//
//      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;
Evgen
новенький
Сообщения: 19
Зарегистрирован: 03.01.2019 04:10:14

Сообщение Evgen »

Iskander спасибо за поздравление.
Дож, спасибо за алгоритм. Честно скажу, пока только скопировал, чтоб не пропало. На выходных буду работать и разбираться (изучать новое) у всех идеях которые Вы все мне предложили. Спасибо!!!
Все очень интересно, правда много информации, сразу не успеваю.
Всего доброго.
Ответить