Ускова О.Ф., Горбенко О.Д. Олимпиадные задачи по программированию. Лучшие решения. Часть 5
Подождите немного. Документ загружается.
Таблица СЕССИЯ содержит сведения о результатах сдачи
студентами четырех экзаменов: номер личного дела , оценка 1, оценка 2,
оценка 3, оценка 4, результат сдачи сессии. Последний может принимать
одно из следующих значений: "отл" (за все отличные оценки ), "хр1" (за одну
четверку и все остальные пятерки ), "хор" (за две четверки и более), "нхр " (за
удовлетворительные и неудовлетворительные оценки ).
Таблица СТИПЕНДИЯ содержит информацию об условиях
назначения студентов на стипендию: результат сдачи сессии и процент
стипендии.
Задание:
1. Создайте структуры таблиц СТУДЕНТ, СЕССИЯ и СТИПЕДИЯ,
установите ключевые поля .
2. Заполните созданные таблицы СТУДЕНТ, СЕССИЯ и
СТИПЕНДИЯ.
3. Постройте запрос ПРОЕКТ ПРИКАЗА , позволяющий выводить
фамилию, имя, отчество и номер группы студентов, которым
может быть назначена стипендия, а также размер назначаемой
стипендии в процентах от минимальной стипендии.
4. Постройте запрос СУММА, основанный на сформированном
ранее запросе ПРОЕКТ ПРИКАЗА , вычисляющий размер
стипендии при минимальной стипендии 200 р.
5. Постройте запрос ФОНД, основанный на сформированном ранее
запросе СУММА, подводящий итоговые суммы стипендии для
каждой группы .
Количество записей в таблицах определить самостоятельно. Учесть, что
в базе данных должны содержаться сведения о студентах, не получающих
стипендию, получающих 100%, 150% и 200% от минимальной стипендии.
Задача 2.
Фирма производит две модели А и В сборных книжных полок. Их
производство ограничено наличием сырья (высококачественных досок) и
временем машинной обработки . Для каждого изделия модели А требуется 3
м
2
досок, а для изделия В - 4 м
2
. Фирма может получить от своих
поставщиков до 1700 м
2
досок в неделю . Для каждого изделия модели А
minus := true;
end;
if (s1[1] in ['0'..'9']) then begin
{Если стоит цифра - интерпретируем ее}
def := true;
val(s1, m1, code);
if minus then m1 := -m1;
end else begin
{Если стоит идентификатор - вычисляем его}
def := FindVar(s1, stvar); l := 1;
if def then def := GetExpression(stvar, l, m1);
end;
end;
if def then begin
{Если получено значение - сохраняем его }
GetMnog := true;
x := m1;
end else GetMnog := false;
end;
{
Функция чтения терма в текущей строке st начиная с позиции k
При успешной интерпретации терма функция возвращает true
и в переменную x помещает значение терма
}
function GetTerm(var st : string; var k, x : integer) : boolean;
var
def : boolean;
m1, m2, k1 : integer;
op : string;
begin
def := GetMnog(st, k, m1); {Чтение первого множителя }
k1 := k;
op := GetWord(st, k);
if op = '*' then begin
{Если стоит умножение - то читаем второй множитель
31
50
требуется 12 мин. машинного времени, а для изделия модели В - 30 мин. В
неделю можно использовать 160 ч машинного времени. Каждое изделие
модели А приносит 2 долл. прибыли , а каждое изделие модели В -
4 долл.
прибыли .
Сколько изделий каждой модели следует фирме выпускать в неделю
для получения максимальной прибыли с условием полного использования
ресурсов (досок и машинного времени )?
Задача 3.
Создать средствами PowerPoint титульный лист книги . Ссылки на
разделы оглавления должны указывать на страницы , в которых есть только
указанный заголовок (ничего, кроме заголовка на странице делать не надо).
Графические вставки – на усмотрение автора.
Избранные решения
Программа № 1
Монеты
Автор решения: Сидоренко Станислав Владленович, студент 2 курса
факультета ПММ, призер олимпиады
const monety:array[1..11] of
integer=(5,10,20,50,100,200,500,1000,2000,5000,10000);
{массив содержит достоинства всех монет в центах}
var Rsum:real; {денежная сумма }
sum,Num:longint; {денежная сумма в центах и искомое
число вариантов}
fi,fo:text;{входной и выходной файлы}
function Number(sum:longint;last:integer):longint;
{Находит искомое число вариантов
Параметр sum - денежная сумма в центах, для которой
производится расчёт.
last - номинал минимальной монеты, которая была
добавлена в комбинацию
begin
p := pFirst; GetPointVar := nil;
while (p <> nil) do begin
if (p^.name = name) then begin
GetPointVar := p;
exit;
end;
p := p^.next;
end;
end;
{Ссылка на существующую далее функцию}
function GetExpression(var st : string; var k, x : integer) : boolean; forward;
{
Функция чтения множителя в текущей строке st начиная с позиции k
При успешной интерпретации множителя функция возвращает true
и в переменную x помещает значение множителя
}
function GetMnog(var st : string; var k, x : integer) : boolean;
var
def, minus : boolean;
m1, code, l, last : integer;
s1, stvar : string;
begin
s1 := GetWord(st, k); minus := false;
if (s1 = '(') then begin
{Если открывается скобка - то далее будет выражение}
def := GetExpression(st, k, m1);
{Читаем закрывающую скобку }
GetWord(st, k);
end else begin
if (s1 = '-') then begin
{Если стоит минус - поднимаем флаг и перечитываем слово}
s1 := GetWord(st, k);
32
49
}
var i:byte;
n:longint;{переменная для временного хранения числа
комбинаций}
begin
if sum<0 then number:=0 {Для отрицательной суммы
число вариантов =0}
else if sum=0 then number:=1 {Для нулевой суммы есть
только один вариант}
else
begin
n:=0;
for i:=1 to 11 do if last>=monety[i] then
n:=n+number(sum-monety[i],monety[i]);
{Число вариантов выдачи суммы в J центов
равно сумме слагаемых N(J-L,L), где
L - все возможные монеты и купюры
достоинства не выше Last. Это число вычисляем
рекурсивно}
number:=n
end;
end;
begin {main}
Assign(fi,'input.txt');
Reset(fi);
Assign(fo,'output.txt');
rewrite(fo);
{инициализируем файлы}
repeat
Readln(fi,Rsum);
sum:=Round(Rsum*100);{представляем сумму в виде
целого числа}
if sum<>0 then
end;
{
Функция поиска идентификатора в списке существующих идентификаторов
по имени name
В случае успеха функция возвращает true и в переменную st
помещает строку для его вычисления, указанную ранее во входном файле
}
function FindVar(var name : string; var st : string) : boolean;
var p : pVar;
b : boolean;
begin
p := pFirst; FindVar := false;
{Перебираем весь список}
while (p <> nil) do begin
if (p^.name = name) then begin
{Если иден-тор найден - возвращаем строку для вычисления и выходим}
st := p^.defstr;
FindVar := true;
exit;
end;
p := p^.next;
end;
end;
{
Функция поиска идентификатора в списке существующих идентификаторов
по имени name.
В случае успеха функция возвращает указатель на структуру данных,
содержащую этот идентификатор.
В противном случае возвращается nil.
}
function GetPointVar(var name : string) : PVar;
var p : pVar;
b : boolean;
33
48
begin
num:=number(sum,sum);{вычисляем число
вариантов}
writeln(fo,Rsum:5:2,num:12) {зписываем в файл }
end;
until sum=0;{конец файла }
close(fi);
close(fo);
end.
Программа № 2
Автор другого варианта решения Виктор Гайдай, студент III курса
факультета ПММ, призер олимпиады
const N_IN = 'Input.txt'; { Имена входного и выходного файлов }
N_OUT = 'Output.txt';
COIN_NUM = 10; { Число различных номиналов монет }
type TCoins = array [1..COIN_NUM] of Integer;
const COINS : TCOINS = (1, 2, 4, 10, 20, 40, 100, 200, 400, 1000);
{ Упорядоченные по возрастанию номиналы монет; за "единицу
измерения" денежных сумм в программе всюду принят наибольший общий
делитель всех монетных номиналов - 5 центов. Таким образом , 1 = $0.05, 2 =
$0.10 и так далее. В эту таблицу не включена монета в $100, так как по
условию все обрабатываемые денежные суммы не превышают $50. }
MAX_SUM = 1000; { Та самая "максимальная возможная" сумма - $50 }
COEFF = 20; { Множитель для перевода суммы в долларах в условные
внутрипрограммные единицы }
var f_in, f_out : Text; { Входной и выходной файлы }
r : Real;
sum, i, j : Integer;
n : LongInt;
table : array [0..MAX_SUM, 1..COIN_NUM] of LongInt;
{ Таблица количества вариантов. table[i,j] - это число способов, которыми
{
Функция выделения слова из строки
st - входная строка
k - позиция, с которой необходимо начать поиск
После выполнения процедуры k смещается вправо на днину слова
}
function GetWord(var st : string; var k : integer) : string;
var
i, ibeg : integer;
begin
if k > length(st) then begin {В случае если слов больше нет выходим}
GetWord := '';
exit;
end;
i := k;
while (st[i] = ' ') do inc(i); {Пропускаем все ведущие пробелы }
ibeg := i; {Запоминаем место начала слова}
{Если встретился знак операции, то }
if (st[i] in ['*', '+', '-', '(', ')', ':']) then begin
{Если это знак присваивания - то возвращаем его (2 символа )}
if (st[i] = ':') then begin
k := i+2;
GetWord := copy(st, ibeg, 2);
{Иначе возвращаем один символ}
end else begin
k := i+1;
GetWord := st[i];
end
{Если это не знаки операций, то это идентификатор. Выделяем его}
end else begin
while (i <= length(st)) and (not (st[i] in ['*', '+', '-', '(', ')', ':', ' '])) do inc(i);
k := i;
GetWord := copy(st, ibeg, i-ibeg);
end;
34
47
можно выдать денежную сумму i, используя только монеты с номиналом
не
больше COINS[j]. При выполнении программы эта таблица будет
постепенно
заполняться . }
lastrow : Integer; { Последняя заполненная строка таблицы table }
BEGIN
{ Открываем входной и выходной файлы }
assign (f_in, N_IN);
assign (f_out, N_OUT);
reset (f_in);
rewrite (f_out);
{ В начале заполнена лишь нулевая строка таблицы table }
lastrow := 0;
for j := 1 to COIN_NUM do
table[0,j] := 1; { Существует лишь один способ "выдать нулевую сумму":
вообще ничего не давать }
{ Считываем в цикле по одной денежной сумме и обрабатываем её }
readln (f_in, r);
repeat
{ Переводим считанную сумму в условные единицы }
sum := round (r * COEFF);
{ Если для этой суммы строка в таблице table ещё не заполнена -
"дозаполняем " table }
if sum > lastrow then
begin
for i := (lastrow + 1) to sum do
{ Заполняем i-ю строку таблицы }
for j := 1 to COIN_NUM do
{ Заполняем клетку table[i,j] }
begin
{ Итак, надо определить, сколькими способами можно выдать сумму
i, используя только монеты с номиналом , НЕ БОЛЬШИМ , чем
COINS[j].
end;
var
s:tStr;
begin
assign(input,'input.txt');{ переопределяем стандартный файл ввода}
ReSet(input);
assign(output,'output.txt');{переопределяем стандартный файл вывода}
ReWrite(output);
Per.Top:=0;
while not eof do { пока не конец файла , делаем }
begin
Readln(s); {читаем очередную строку из файла }
Analyse(s) {анализируем строку }
end;
ReSetPerem;
close(output) {закрываем файл вывода}
end.
Программа № 5
Приведем еще один вариант решения этой задачи , выполненный студентом 3
курса факультета ПММ Выростковым Дмитрием, победителем школы -
олимпиады 2002 года, именным стипендиатом информационной компании
«Информсвязь-Черноземье»
type
PVar = ^TVar;
TVar = record {Тип переменной}
name : string; {Имя переменной}
defstr : string; {Строка для ее вычисления}
next : PVar; {Указатель на следующий элемент списка}
end;
var
PFirst : PVar; {Указатель на первый элемент в списке}
fi, fo : text; {Входной и выходной файлы }
35
46
Это число складывается из двух чисел.
Во-первых, можно использовать только монеты с номиналом ,
МЕНЬШИМ , чем COINS[j], то есть заглянуть в клетку левее: }
if j > 1 then
table[i,j] := table [i,j-1]
else
table[i,j] := 0;
{ Во-вторых, можно взять отнять от суммы одну монету с
номиналом , РАВНЫМ COINS[j], и посмотреть выше по таблице ,
сколькими способами можно выдать оставшуюся , меньшую сумму: }
if COINS[j] <= i then
table[i,j] := table[i,j] + table[i-COINS[j],j];
end;
lastrow := sum; { Теперь таблица заполнена до строки с номером sum }
end;
{ Осталось только посмотреть в таблице , сколькими способами можно
выдать сумму sum, используя ВСЕ монеты , и вывести результат в выходной
файл }
n := table[sum,COIN_NUM];
writeln (f_out, r : 4 : 2, ' ', n);
{ Считываем следующую денежную сумму }
readln (f_in, r);
until r = 0; { Продолжаем работу , пока не встретим признак конца входного
файла }
{ Закрываем входной и выходной файлы }
close (f_in);
close (f_out);
END.
Программа № 3
Еще одно решение этой же задачи , данное членом жюри школы -олимпиады и
автором текста задачи Вадимом Митрофановичем Мельниковым,
неоднократным призером олимпиад по информатике в школьные и
студенческие годы.
const
begin
DelTree(Per.Info[Per.Top].Value);
Dec(Per.Top)
end
end;
procedure Let(s:tStr);
{соответствует команде присваивания}
var
i,l:integer;
begin
i:=Pos(' ',s);l:=length(s);
while (i<>0) do
begin
s:=copy(s,1,i-1)+copy(s,i+1,l-i);
Dec(l);
i:=Pos(' ',s)
end;
i:=Pos(':=',s);
SetPeremValue(copy(s,1,i-1),
copy(s,i+2,l-i-1))
end;
procedure Analyse(s:tStr);
{анализ строки }
var
t:string[6];{дополнительная переменная}
begin
t:=copy(s,1,6);{копируем первые 6 символов из строки или всю строку , если
символов меньше}
if t='PRINT ' then PRINT(copy(s,7,length(s)-6)) {если ключевое слово PRINT,
то вызываем процедуру печати }
else if t='RESET' then RESETPerem {если ключевое слово RESET,
вызываем процедуру RESETPerem}
else Let(s) {иначе - операция присваивания}
36
45
ncoin = 10; { количество монет }
maxsum = 5000; { максимальная сумма в центах }
ncount = maxsum div 5;
coin : array[1..ncoin] of integer = { достоинства монет и купюр }
(5,10,20,50,100,200,500,1000,2000,5000);
var
{ count[i,j] - количество вариантов для суммы 5*i центов, монетами
с номиналом меньше или равными coin[j]
}
count:array [1..ncount,1..ncoin] of longint;
i,sum,c:integer;
fsum:real;
cnt:longint;
finp,fout:text;
begin
for i:=1 to ncount do { 5-ти центовые монеты дают только один вариант }
count[i,1] := 1;
for c:=2 to ncoin do
begin
for i:=1 to ncount do
begin
sum := i*5;
cnt := count[i,c-1]; { эти варианты можно получить более мелкими
монетами }
while sum >= coin[c] do
begin
sum := sum - coin[c];
if sum=0 then
cnt := cnt+1
else
cnt := cnt + count[sum div 5,c-1];
end;
count[i,c] := cnt;
end;
end;
переменных}
if (i>Per.Top) or StackIn(t) then er:=1 {значение не определено}
else
begin
StackAdd(t); {добаляем имя переменной в стек}
Value(Per.Info[i].Value,rez,er); {вычиляем текущее значение
переменной}
StackDel {удаляем имя переменной из стека}
end
end;
if (er=0) and (p^.zn) then Rez:=-Rez { учитываем знак выражения}
end;
procedure PRINT(s:tStr);
{соответствует команде PRINT s}
var
i,e,r:integer;
begin
i:=1;
while (i<=Per.Top) and (s<>Per.Info[i].Name) do Inc(i);
if (i>Per.Top) then
writeln('не определено')
else
begin
StackClear;
Value(Per.Info[i].Value,r,e);
if e=0 then writeln(r) else writeln('не определено')
end
end;
procedure RESETPerem;
{соответствует команде RESET}
begin
while Per.Top>0 do
37
44
assign(finp,'INPUT.TXT');
assign(fout,'OUTPUT.TXT');
reset(finp);
rewrite(fout);
readln(finp,fsum);
while fsum>0 do
begin
sum:= trunc(fsum*100 + 0.5 );
writeln(fout,count[sum div 5,ncoin]);
readln(finp,fsum);
end;
close(finp);
close(fout);
end.
Программа № 4
Калькулятор для Пети
Автор решения – Просин Сергей
, студент 2 курса факультета ПММ,
победитель щколы - олимпиады 2001 года, именной стипендиат
информационной компании «Информсвязь- Черноземье», занявший 2 место в
школе - олимпиаде 2002 года.
program Calc;
const max=100;{максимальное кол-во используемых переменных}
type
tStr=string[200]; {тип Строка}
tName=string[50]; {тип Имя переменной}
pTree=^tTree; {описываем дерево -формулу }
tTree=record
Elem:tName;
zn:boolean; {знак выражения}
l,r:pTree
end;
tPerem=record {тип Переменная}
Name:tName;
Value:pTree
begin
if p<>nil then
begin
PrintTree(h+1,p^.l);
for i:=1 to h do write(' ');if p^.zn then writeln('(-,',p^.Elem,')')
else writeln('(+,',p^.Elem,')');
PrintTree(h+1,p^.r)
end
end;
procedure Value(p:pTree;var Rez:integer;var er:integer);
{возвращает в переменную Rez значение дерева-формулы pTree если er=0
иначе значение не определено}
var
a,b,i:integer;
t:tName;
begin
t:=p^.Elem;
if (t='+')or(t='-')or(t='*') then
begin {в узле знак}
Value(p^.l,a,er);
if er=0 then Value(p^.r,b,er);
if er=0 then
if t='+' then
Rez:=a+b
else if t='-' then
Rez:=a-b
else Rez:=a*b
end
else if t[1] in ['0'..'9'] then {в узле число }
Val(t,rez,er)
else
begin {в узле переменная}
i:=1;
while (i<=Per.Top) and (t<>Per.Info[i].Name) do Inc(i); {ищем в массиве
38
43
end;
tPeremAr=record {массив переменных}
Top:integer;
Info:array[1..max] of tPerem
end;
tStack=record {массив имен пременных - используется при выявлении
рекурсивных определений}
Top:integer;
Info:array[1..max] of tName
end;
var
Per:tPeremAr; {объявляем массив переменных}
Stack:tStack; {массив имен пременных}
function StackIn(name:tName):boolean;
{проверка на содержание имени в стеке }
var
i:integer;
begin
i:=1;
while (i<=Stack.Top) and (Stack.Info[i]<>name) do Inc(i);
StackIn:=(i<=Stack.Top)
end;
procedure StackAdd(name:tName);
{ добавляем имя в стек}
begin
Inc(Stack.Top);
Stack.Info[Stack.Top]:=Name
end;
procedure StackDel;
{удаляем имя из стека}
begin
Dec(Stack.Top)
end;
procedure DelTree(p:pTree);
{удаление дерева-формулы }
begin
if p<>nil then
begin
DelTree(p^.l);
DelTree(p^.r);
Dispose(p)
end
end;
procedure SetPeremValue(name:tName;s:tStr);
{присваивание пременной name дерева-формулы s}
var
i:integer;
begin
i:=1;
while (i<=Per.Top) and (name<>Per.Info[i].Name) do Inc(i);
if (i>Per.Top) then
begin
Inc(Per.Top);
Per.Info[i].Name:=Name;
InitTree(s,Per.Info[i].Value)
end
else
begin
DelTree(Per.Info[i].Value);
InitTree(s,Per.Info[i].Value)
end
end;
procedure PrintTree(h:integer;p:pTree);
{печать дерева - нигде не используется , использовалась на стадии отладки }
var
i:integer;
39 42
procedure StackClear;
{очистка стека}
begin
Stack.Top:=0
end;
procedure InitTree(s:tStr;var p:pTree);
{инициализация дерева-выражения}
var
sc,i,l,n:integer;
flag,end_flag,zn:boolean;
{sc - кол-во открытых скобок
l - длина строки
n - позиция знака в выражении
end_flag - признак окончания обработки строки
zn - знак выражения}
begin
New(p);p^.zn:=false; {инициализируем новый узел}
l:=length(s);
repeat {начало обработки строки }
flag:=false;zn:=true;
i:=1;n:=0;sc:=0;
while not flag and (i<=l) do {ищем знак в выражении}
begin
case s[i] of
'(': begin Inc(sc);zn:=true end;
')': begin Dec(sc);zn:=false end;
'*': begin zn:=true;if sc=0 then n:=i end;
'+','-':if sc=0 then if not zn then begin n:=i;flag:=true end;
else zn:=false;
end;
Inc(i)
end;
end_flag:=true;
if (n=0) then {обрабатываем ситуацию -...-(выражение) - определяем знак
выражения}
begin
while (s[1]='-') do
begin
Dec(l);
p^.zn:=not p^.zn;
end_flag:=false;
s:=copy(s,2,l)
end;
if (s[1]='(') and (s[l]=')') then {убираем скобки }
begin
l:=l-2;
end_flag:=false;
s:=copy(s,2,l)
end
end
until end_flag; {конец обработки выражения}
{заполняем узел}
if n=0 then
begin
p^.l:=nil;
p^.r:=nil;
p^.Elem:=s
end
else
begin
p^.Elem:=s[n];
InitTree(copy(s,1,n-1),p^.l); {обрабатываем левую часть выражения}
InitTree(copy(s,n+1,l-n),p^.r);{ правую часть}
end
end;
40 41