Cбор черники
Все решения задач приведены для PascalABC.
Это задача на поиск максимума в массиве. Необходимо
найти три рядом расположенных куста таких, что сумма количества ягод
максимальна. Необходимо учесть, что грядка круглая. Находясь у первого
куста можно брать ягоды с последнего, а находясь у последнего брать с
первого. Поэтому число элементов массива n+2. Задача состоит в поиску
максимума сумм количества ягод 3-х соседних кустов.
Var n,i,max: integer;
a: array[0..1000] of integer;
f:text;
Begin
Assign(f,'input.txt');
reset(f);
ReadLn(f,n);
for i:=1 to n do
read(f,a[i]);
close(f);
a[n+1]:=a[1];a[0]:=a[n];
max:=a[0]+a[1]+a[2];
for i:=2 to n do
if a[i-1]+a[i]+a[i+1]>max then
max:= a[i-1]+a[i]+a[i+1];
Assign(f,'output.txt');
Rewrite(f);
WriteLn(f,max);
close(f);
end.
Несократимые дроби
Эту задачу можно решить перебором пар чисел от 1 до m и от 1 до n. Из них нужно выбрать те, у которых числитель, больше знаменателя и знаменатель не делится на числитель.Энты
Можно попытаться решить задачу вычисляя количество выученных слов начиная со второго (первый энт узнал два слова), заполняя массив этими значениями, до тех пор, пока минимальное количество слов полученных энтами слов не станет равным заданному. Количество выученных слов каждым Энтом заносится в динамический массив а, т. к. число обученных энтов не известно В процедуре obuch вычисляется число выученных слов. Такая предпосылка дает следующую программу:
uses Containers;
Var k,p,n,min,i: integer;
a: IntArray;
f:text;
procedure obuch(n:integer);
var i,k: integer;
begin
for i:=n to 2*n-1 do
begin
if i mod 2=0 then a[i]:=2*a[i div 2];// молодой
if i mod 2=1 then a[i]:=1+a[i div 2];//старый
end;
end;
Begin
a:=IntArray.Create(1);
Assign(f,'input.txt');
reset(f);
ReadLn(f,k);
Close(f);
a[1]:=2;
n:=1;
min:= 0;
while (min <k) do
begin
WriteLn;
n:=2*n;
a.Resize(a.Size+n);
obuch(n);
min:=a[n];
for i:=n to 2*n-1 do
if a[i]<min then min:=a[i];
end;
p:=0;
for i:=1 to 2*n-1 do
if a[i]=k then inc(p);
a.Destroy;
Assign(f,'output.txt');
Rewrite(f);
WriteLn(f,p);
close(f);
end.
Программа справляется до k=25, а затем переполнение, т.к. число энтов 2k превысит допустимое число индексов. В условии задачи есть предупреждающая фраза"Общее
число энтов в Средиземье больше, чем вы думаете."
Поэтому в массив лучше записывать число энтов, знающих i слов.
Можно заметить, что среди тех, кто будет знать ровно k слов будen как
молодые, так и старые. Старые Энты, которые знают i слов могли
обучиться только у Энтов, которые знали на одно слово меньше, а молодые
тех, кто знал в 2 раза меньше. Остальные слова они получали от Эльфов.
Заметим, что молодые после обучения знают четное число слов. Поэтому,
если a[i] -количество Энтов, знающих ровно i слов, то a[i]=a[i-1], если
i нечетно и a[i]=a[i-1]+a[i/2] иначе. Первый Энт знал 2 слова a[2]=2,
логично также, что a[1]=0., т. к.среди обученных Энтов,
знающих одно слово нет ни одного. Остается в цикле увеличивая значение
i от 3-х до k в результате получить ответ.
var
a: array[0..1000000] of longint;
f:text;
k,i: longint;
Begin
Assign(f,'input.txt');
reset(f);
ReadLn(f,k);
Close(f);
a[1]:=0; a[2]:=1;
for i:=3 to k do
if i mod 2 = 0 then
a[i] := a[i - 1] + a[i div 2]
else
a[i] := a[i - 1];
Assign(f,'output.txt');
Rewrite(f);
WriteLn(f,a[k]);
Cose(f);
end.
Цепочка слов
Если первые три задачи можно решить
опираясь на базовый курс школьной информатики, то для решения этой
нужно владеть рекурсивным алгоритмом ("backtracking"). Первым делом
заполняется из прочитанного текста массив слов. Признаком конца
каждого слова является пробел. Поэтому к тексту нужно добавить пробел.
Первый вариант решения применим для слов записанных заглавными буквами
латиницей. Такой алгоритм работает быстрее. Можно произвести перебор слов которые начинаются с
буквы A, затем B и т. д., пытаясь построить на них цепочку из оставшихся
слов, и т. д.. При этом запоминая в другом массиве лучший результат.
{Перебор по алфавиту}
var sl,sl_temp,sl_res :array [1..100] of string; { для списка и цепочек }
numin
:integer; { реальное количество слов на входе }
pc
:integer; { Длина найденной цепочки}
maxLen
:integer; { Длина наибольшей цепочки }
sym
:char; {Первичная буква для перебора }
procedure read_data; { Начальные установки и чтение данных}
var i,j,k : integer;
st:string; {прочитанная строка из файла}
f:text; {файловая переменная}
begin
assign(f,'input.txt');
reset(f);
read(f,st);
close(f);
numin:=0;
st:=st+' ';
k:=1;//начало первого слова
for i:=1 to length(st) do
if st[i]=' ' then
begin
inc(numin);
sl[numin]:=Copy(st,k,i-k);
k:=i+1;
end;
end;
//------------------------------------------------------------------------------
procedure write_results; { Вывод результатов}
var i : integer;
f:text;
begin
assign(f,'output.txt');
rewrite(f);
if maxLen=numin then
begin
writeln(f,'Можно');
for i:=1 to maxLen do
write(f,sl_res[i],' ');
end
else
writeln(f,'Нельзя');
close(f);
end;
//------------------------------------------------------------------------------
procedure res_temp; { Запоминаем только более длинную цепочку, у которой первая и последняя буквы совпадают}
var i:integer;
begin
if (pc>maxLen) and (sl_temp[1][1]=sl_temp[pc][length(sl_temp[pc])]) then begin
sl_res:=sl_temp;
maxLen:=pc;
end;
end;
{ Возвращает указатель названия по 1-й букве, 0 - такого элемента нет }
function find_next( c:char; n:integer ):integer;
var i:integer;
begin
i:=1; find_next:=0;
while (i<=numin) and (n>0) do begin
if (sl[i][1]=c) then dec(n);
inc(i);
end;
if (n=0) then find_next:=pred(i);
end;
{ Алгоритм построения цепочек.}
procedure sort( c:char; n:integer ); { Метод: перебор с возвратом. "backtracking" }
var i:integer;
begin
i:=find_next(c,n); {поиск следующего по символу, начальному слову}
if (i>0) then begin
inc(pc);
sl_temp[pc]:=sl[i];
sl[i][1]:='_'; { вычеркиваем первую - заменяем на _ подчеркивание}
sort(sl[i][length(sl[i])], 1);
dec(pc);
sl[i][1]:=c; { возвращаем}
sort(c, n+1);
end
else res_temp;
end;
//Программа
begin
read_data;
for sym:='A' to 'Z' do
sort(sym,1);
write_results;
end.
Второй вариант работает с любым набором слов, т. е. с кириллицей и латиницей.
var
sl,sl1,sl_temp,sl_res:array [1..100] of string;{список начальный, рабочий,для вывода временный и окочательный}
lenMax,len :integer; {Максимальная, рабочая длина цепочки}
n,ntemp :integer; {Число слов, слов во вспомогательном списке}
k:integer; {Переменная для цикла}
f:text; {файловая переменная}
{---------------------------------------------------}
Procedure zapoln; {Заполнение списка слов}
var i,j,k : integer;
st:string;
begin
assign(f,'input.txt');
reset(f);
read(f,st);
close(f);
n:=0;
st:=st+' ';
k:=1;
for i:=1 to length(st) do
if st[i]=' ' then
begin
inc(n);
sl[n]:=Copy(st,k,i-k);
k:=i+1;
end;
end;
{-------Занято ли слово--------------------------}
function Free(s:integer;st:string):boolean ;
Var i :integer;
begin
Free:=true;
For i:=1 to s do
if sl_temp[i]=st Then Free:=false;
end;
{-------Обмен на последнее со сдвигом---------------------------}
procedure swap(i:integer);
var j:integer;
temp:string;
begin
temp:=sl1[i];
for j:= i to ntemp-1 do
sl1[j]:= sl1[j+1];
sl1[ntemp]:=temp;
end;
{---------метод: "Перебор с возвратом" - backtracking}
Procedure sort(i:integer); {Сортировка}
var i1:integer;
temp:string;
begin
i1:=1;
len:=i;
ntemp:=n;
While i1<=ntemp do
begin
if (sl_temp[len][length(sl_temp[len])] =sl1[i1][1])and (Free(len,sl1[i1])) then
begin
inc(len);
sl_temp[len]:=sl1[i1];{Запоминаем}
swap(i1); {Найденное в конец временного списка}
dec(ntemp); {"обрезаем" временный список}
sort(len);
end
else
If (len>=lenMax) and (sl_temp[1][1]=sl_temp[len][length(sl_temp[len])]) then
begin {запоминаем лучший вариант}
sl_res:=sl_temp;
LenMax:=len;
end;
inc(i1);
end;
dec(len);{Возврат на одну позицию назад}
end;
{---------------------------------------------------------}
BEGIN
LenMax:=1;
zapoln;
for k:=1 to n do {Принимаем за первое по очереди каждое слово}
begin
ntemp:=n;
sl1:=sl;
len:=1;
sl_temp[len]:=sl1[k];
sort(1);
end;
assign(f,'output.txt');
rewrite(f);
if lenMax=n then
begin
WriteLn(f,'Можно');
for k:=1 to lenMax do {Вывод списка}
Write(f,sl_res[k],' ');
end
else
WriteLn(f,'Нельзя');
Close(f);
END.