Программирование - основа информатики и этому есть несколько причин. Во-первых,

ВВЕДЕНИЕ В КУРС ПРОГРАММИРОВАНИЯ
Если бы мы писали программы с детства, то с
годами, возможно, научились бы их читать.
А.Перлис
Программирование - основа информатики и этому есть несколько причин. Во-первых,
ЭВМ изначально разрабатывались как расчетные устройства. Во-вторых, без
программирования не было бы всего арсенала программ, которым владеют нынешние
пользователи. В-третьих, при изучении программирования, одновременно приобретаются
навыки работы с компьютером в целом. Это включает набор и редактирование текста,
изучение файловой системы и т.п. А если грамотно подобрать примеры, то можно даже
писать собственные программы управления простейшими базами данных или
форматирования текстовых файлов, реализовывать графический или другой анализ решения
многих математических, физических, химических, биологических и даже филологических
задач. Стоит ли говорить, что в этом случае программирование положительно влияет на
развитие логического и алгоритмического мышления.
Наиболее приемлемым методом обучения программированию является обучение
теоретическим основам алгоритмизации на базе стандартного языка. При этом не
обязательно вдаваться в глубины языка. Те читатели, которых он заинтересует, могут
сделать это и сами. Даный курс не ставит перед собой цель охватить весь спектр задач и
показать средства реализации их на языке программирования. Цель курса – дать старт,
показать основы программирования и пробудить интерес читателя к дальнейшему изучению
как алгоритмов, приемов решения задач, так и языков и систем программирования. Рабочими
средами курса являются Бейсик и Паскаль.
Бейсик и Паскаль первоначально создавались как учебные языки, но со временем
получили широкое распространение в качестве стандартных языков. В предлагаемом курсе
нет полного описания этих языков программирования, поскольку кроме справочников по
этим языкам вряд ли можно предложить что-то лучшее. Курс рассчитан на изучение основ
самого программирования, т.е. приемов и методов решения задач с помощью одной из этих
инструментальных сред, соответственно показаны только те операторы и функции, с
помощью которых можно решить 98% существующих задач по программированию.
Читателю предлагается самостоятельно сделать выбор языка программирования, или не
делать его, а изучать параллельно, поскольку каждый язык имеет свои преимущества.
В содержание теоретических и практических занятий курса включен максимальный
минимум задач – от простейших, до сложных и нестандартных. Ряд задач дан с решениями
на обоих языках, решение части задач предложено только на одном из них, к некоторым
даны только пояснения. В конце каждого занятия приведены задания для самостоятельной
работы, а в конце книги – указания к их решению.
Автор надеется что данный курс окажется полезным для школьников, учителей и
студентов и с благодарностью примет все замечания и пожелания по данной книге.
3
ЛИНЕЙНЫЙ АЛГОРИТМ И ПРОСТЫЕ ВЫЧИСЛЕНИЯ
Если вы не знаете, что ваша программа
должна делать, стоит ли ее начинать?
Э.Дейкстра
Переменные и выражения.
Написание любой программы на любом языке программирования по своей сути
является ничем иным как автоматизированной обработкой данных. Для программной
обработки в ЭВМ данные представляются в виде величин и их совокупностей.
Величина - это элемент данных с точки зрения их семантического
(смыслового) содержания или обработки.
Смысловое разбиение данных производится во время постановки задачи и разработки
алгоритма ее решения (входные, выходные и промежуточные).
Исходные (входные) - это данные, известные перед выполнением задачи, из условия.
Выходные данные - результат решения задачи.
Данные, которые не являются ни аргументом, ни результатом алгоритма, а
используются только для обозначения вычисляемого промежуточного значения, называются
промежуточными.
С понятием величины связаны следующие характеристики (атрибуты):
 имя - это ее обозначение и место в памяти;
 тип - множество допустимых значений и множество применимых операций
к ней;
 значение - динамическая характеристика, может меняться многократно в
ходе исполнения алгоритма. Во время выполнения алгоритма в каждый
конкретный момент величина имеет какое-то значение или не определена.
Постоянной называется величина, значение которой не изменяется в процессе
исполнения алгоритма, а остается одним и тем же, указанным в тексте алгоритма.
Переменной называется величина, значение которой меняется в процессе исполнения
алгоритма.
Данные представляются в программе в виде переменных (реже постоянных)
величин, каждая из которых имеет имя, тип и значение
Программирование основано на математике, и также как и в математике,
вычисляемые в программе значения представляются посредством выражений. Тип
выражения определяется типами входящих в него величин, а также выполняемыми
операциями.
В Бейсике нет необходимости заранее задавать тип величины - тип переменных
(кроме символьных) определяет сам интерпретатор языка. В Паскале же, наоборот, указание
типов величин является обязательным и первостепенным в прямом смысле слова этапом
написания программы.
4
Различают переменные следующих простых типов:
целые
вещественные
логические
символьный
строковый
integer
real
boolean
char
string
[-32768; 32767]
(-2-38;238)
0 (false), 1 (true)
любой допустимый символ
не более 255 символов
Простые переменные могут организовываться в наборы и структуры данных массивы, множества, файлы. Работа со структурами данных будет рассмотрена нами позже.
Ввод и вывод данных
Обмен информацией с ЭВМ предполагает использование определенных средств
ввода-вывода. В ЭВМ основным средством ввода является клавиатура, вывода - дисплей.
Процедура, которая в режиме диалога с клавиатуры присваивает значение для
переменной величины, называется процедурой ввода.
В языке Бейсик для этой цели служит оператор INPUT:
INPUT "поясняющее сообщение"; список переменных
Например,
INPUT "Введите числа А и В"; А,В
В языке Паскаль аналогичную функцию выполняет оператор read (readln):
read(список переменных)
Например,
read(a,b)
Оба оператора ввода в Паскале идентичны по своему назначению, но отличие
оператора readln заключается в том, что после своего завершения он переводит курсор на
следующую экранную строку. Оператор INPUT выполняет эту операцию, называемую
«перевод строки», автоматически.
Как только в программе встречается вызов процедуры ввода, ЭВМ приостанавливает
выполнение программы и ждет, пока пользователь введет с клавиатуры соответствующие
значения, которые по очереди будут присваиваться переменным, перечисленным в списке
ввода.
В Бейсике ввод нескольких значений следует разделять запятыми,
в Паскале - пробелами
Значения вводимых данных одновременно отображаются на экране дисплея. После
нажатия клавиши Еnter, когда все переменные примут свои значения из входного набора
данных, определенного пользователем, выполнение программы продолжается с оператора,
следующего за оператором ввода.
Процедура, которая выводит содержимое переменных на экран, называется
процедурой вывода на экран.
В Бейсике используется оператор PRINT:
PRINT "Значения А и В"; А,В
5
В Паскале используется оператор write (writeln) (различие аналогично оператору
ввода read – есть или нет «перевода строки»):
writeln(‘Значения А и В ’,a, ‘ ’,b)
В списке вывода операторов может быть либо одно выражение, либо
последовательность таких выражений. Обратите внимание, что в Бейсике несколько
выражений разделяются между собой запятыми или точкой с запятой, а в Паскале – только
запятыми. Причем в Паскале вывод идет слитно и для удобства восприятия приходится
искусственно разделять выводимые величины пробелами. В Бейсике точка запятой при
выводе «превращается» в один пробел (и кроме этого “запрещает” перевод строки, если
стоит в качестве завершающего символа), а запятая «трансформируется» в зону, кратную
восьми пробелам. Кроме того, поясняющие сообщения (величины строкового типа) на
Бейсике заключаются в двойные кавычки, а в Паскале – в одинарные (апострофы).
Линейный алгоритм и вычисления.
Линейный алгоритм является аналогом обычного последовательного решения какойлибо задачи, когда все действия записываются поочередно. В программировании реализация
линейного алгоритма является наиболее простой конструкцией, т.к. подразумевает
выполнение всего трех этапов:
1. Ввод данных
2. Вычисления с помощью операторов присваивания
3. Вывод данных
Оператор присваивания — один из самых простых и наиболее часто используемых
операторов в любом языке программирования. Он предназначен для вычисления нового
значения некоторой переменной, а также для определения значения, возвращаемого
функцией. В общем виде оператор присваивания можно записать так:
переменная = выражение.
При записи алгебраических выражений используют арифметические операции
(сложение, умножение, вычитание, деление), функции, круглые скобки.
Порядок действий (приоритет) при вычислении значения выражения:
1) вычисляются значения в скобках;
2) вычисляются значения функций;
3) выполняются унарные операции (смена знака и возведение в степень);
4) выполняются операции умножения и деления;
5) выполняются операции сложения и вычитания.
Рассмотрим пример программы линейного алгоритма.
Пример 1-1. Длина отрезка задана в дюймах (1 дюйм = 2,54 см). Перевести значение
длины в метрическую систему, т.е. выразить ее в сантиметрах.
CLS
INPUT "Длина в дюймах";D
M=D*2.54
PRINT "Длина в сантиметрах";M
очистка экрана
ввод исходных данных
вычисление
вывод результата
6
uses crt;
подключение
var d,m: real;
begin
clrscr;
write(‘Длина в дюймах:’);
readln(d);
m:=d*2.54;
writeln(‘Длина в сантиметрах ’,m);
readln;
end.
модуля работы с экраном
объявление переменных
очистка экрана
вывод пояснения
ввод исходных данных
вычисление
вывод результата
Различия в написании программ видны сразу. Программа на Паскале заметно больше
и тем самым дает ощущение «мощи» языка. Однако, при многих «плюсах», Паскаль заметно
уступает Бейсику в вопросе оформления программ. Так, для соблюдения главного правила
хорошего тона по отношению к пользователю программы – очистки экрана – в Бейсике нам
было достаточно указать один оператор, а в Паскале пришлось еще и подключать
дополнительный модуль, т.к. сам по себе Паскаль не имеет функций работы с экраном.
Обязателен в Паскале и раздел описания переменных – var - , в котором требуется указать
имена и типы величин, используемых в программе. Неоспоримо «лучше» и оператор INPUT
в плане вывода поясняющих сообщений – в Паскале подобная «фишка» реализуется связкой
write – readln. Далее, для того чтобы увидеть результат на экране без возврата в среду
программирования, в Паскале нам пришлось ставить дополнительный оператор ввода. В
принципе, это не является обязательным, но программирование это не только умение
логически мыслить и составлять программы, но и умение красиво и понятно оформить
исходный текст самой программы и продумать интерфейс ее работы. Тем не менее, при
решении сложных задач, например, олимпиадных, преимущества языка Паскаль
неоспоримы.
Можно сказать, что исторически сложился и стиль написания программ: для операторов и переменных
на Бейсике используются прописные символы, в Паскале же, наоборот, строчные.
Обратите также внимание, что знак равенства, используемый в выражениях на языке
Бейсик, в Паскале заменен на знак присваивания - :=. И самое главное замечание: каждая
строка в программе на языке Паскаль должна обязательно завершаться точкой с
запятой.
Стандартные функции
При решении любых задач, а особенно задач, связанных с вычислением какого-либо
математического выражения, возникает необходимость вычислений стандартных функций.
Ниже предлагается систематизированная таблица наиболее часто используемых функций
языков программирования. Различия между Бейсиком и Паскалем читателю предлагается
найти самостоятельно.
Этого "джентльменского" набора достаточно для решения большинства задач. Если
же в задаче встречается "редкая" функция, то обычно ее выражают через стандартные.
Например, котангенс числа записывают как cos(x)/sin(x).
При записи сложных выражений следует внимательно относиться к скобкам и
запомнить простое правило: число открывающих скобок всегда должно быть равно
количеству закрывающих.
7
Функция
Смысл
abs
|x|
sqr
x
SQR(X)
2
-
SQR(X)
SQR(4)=16
x
-
SQRT(X)
SQRT(36)=6
X
sqrt
sin
cos
tan
mod
Sin x
cos x
tg x
остаток от
деления
Бейсик
Паскаль
ABS(X)
-
SIN(X)
COS(X)
TAN(X)
-
a MOD b
INT(a)
-
-
round(b)
усечение до
целого
FIX(E)
-
-
trunc(g)
\
div
деление
нацело
A\ B
-
a div b
exp
ex
ln
ln x
int
округление
round
fix
trunc
степень
a
b
EXP(X)
LOG(X)
ln(x)
A^B
exp(b*ln(a))
Значения
ABS(-1)=1
ABS(2)=2
SQR(25)=5
cинус числа
косинус числа
тангенс числа
5 mod 2 = 1
6 mod 3 = 0
INT(4.4)=4
INT(6.8)=7
round(4.4)=4
round (6.8)=7
FIX(4.4)=4
FIX(6.8)=6
trunc(4.4)=4
trunc(6.8)=6
6\4=1
12 div 5 = 2
экспонента
числа
натуральный
логарифм
степень числа
Пример 1-2. Треугольник задан величинами своих сторон. Найти его площадь.
CLS
INPUT “Введите значения сторон”;A,B,C
P=(A+B+C)/2
S=SQR(P*(P-A)*(P-B)*(P-C))
PRINT “Площадь треугольника”;S
формула Герона
var
a,b,c: integer;
p,s: real;
begin
write('A=');
readln(a);
write('B=');
readln(b);
write('C=');
readln(c);
p:=(a+b+c)/2;
s:=sqrt(p*(p-a)*(p-b)*(p-c));
writeln('S=',s:6:2);
end.
Управление выводом на экран
Написание программы предполагает создание диалога с пользователем и вывода
результата на экран. Правилом хорошего тона в программировании, как уже было замечено
выше, считается использование подсказок при вводе значений ("Введите число"),
расшифровка результата ("Сумма чисел равна") и поясняющих сообщений при работе
программы ("Корней нет и не будет!"). Кроме того, в последнем примере на Паскале при
выводе результата мы использовали так называемый формат (шаблон) вывода. Первое
число резервирует общее число знаков в выводимом числе, второе – количество знаков после
десятичной точки. Это необходимо для того, чтобы вместо малопонятной записи
8
1.34576848Е+01 (что кстати означает 1.34576848*101) на экране отобразилось вполне
понятное нам число 13.46. В Бейсике для подобного «фокуса» используется расширенный
оператор вывода PRINT USING, в котором символы «решетки» задают требуемый формат
вывода величины:
PRINT USING “####.###”; список переменных
В любом случае, последовательная структура программы подразумевает и
последовательный вывод на экран. Тем не менее в Бейсике и Паскале есть операторы,
позволяющие организовать вывод в любом месте экрана.
Экран в текстовом режиме содержит 25 строк по 80 символов. Соответственно,
каждое знакоместо имеет свои координаты. Так, знакоместо 6-40 определяет символ,
находящийся в 40-м столбце 6-й строки экрана. Буквой Х обозначим номер строки, буквой
Y- номер столбца.
В Бейсике выводом на экран управляет оператор LOCATE X,Y, а в Паскале –
функция gotoxy(x,y)
Следующим за ними оператор ввода или вывода начнет вывод сообщений, начиная с
знакоместа Х-У. Т.о., если мы хотим вывести строку "HELLO, WORLD" в центре экрана, то
мы можем сделать это так:
LOCATE 12, 34
PRINT "HELLO, WORLD"
Аналогично на Паскале:
gotoxy(12,34);
writeln(‘Hello world’);
Задания для самостоятельного решения
А. Запишите указанные ниже выражения по правилам языка программирования.
A) a 
x 1  y
( y  x) 2 y  x
B) b  1  y  x 

2
3
1 x2  y2
1  cos( y  2)
C) a 
x 4  sin z
E) a 
D) b  y 
x
x2
y 
y  x3
2
1  sin 2 ( x  y )
F)b  x 
2  x  2  x2 y2 1
x

x
y
y
Проанализируйте следующие задачи, определите входные и выходные данные.
Составьте список переменных, укажите тип каждой из них
Составьте программы на языке Бейсик и Паскаль, проверьте правильность решения
с помощью контрольных входных и выходных данных.
9
А. За год размер квартплаты повышалась дважды. Первый раз на А%, а второй на
В%. Год назад сумма оплаты составляла К рублей в месяц. Вычислить текущий размер
квартплаты.
В. Известен объем продукции, выпускаемый N предприятиями отрасли. Вычислить
средний объем продукции, выпускаемый одним предприятием.
С. Дана длина ребра куба. Найти объем куба и площадь его боковой поверхности.
D. На производство 1 кв. метра ткани затрачивают 15 минут. Определить
количество ткани, выпущенное за Т часов при ширине полотна L.
Практикум
ЗАДАЧИ …БЕЗ АЛГОРИТМОВ
Строго говоря, каждая задача имеет алгоритм решения. Однако, условимся на время,
что задача имеет алгоритм решения только в том случае, если используются специальные
алгоритмические конструкции. Иными словами задачу линейного алгоритма будем называть
задачей без алгоритма.
Действительно, многие сложные на первый вид задачи решаются без каких-то либо
алгоритмов, а лишь простыми вычислениями, основанными на простых логических
рассуждениях или готовых математических формулах. Хорошим примером является
следующая задача:
Пример 1-3. Владелец автомобиля приобрел новый карбюратор, который экономит
50% топлива, новую систему зажигания, которая экономит 30% топлива и новые
поршневые кольца, которые экономят 20% топлива. Верно ли, что его автомобиль теперь
сможет обходится совсем без топлива? Найти фактическую экономию топлива.
Ответ на первый вопрос возникает естественно: нет, в любом случае какое-то
количество бензина машина будет расходовать. Но какое? Простое суммирование или
нахождение среднего значения исходных данных дадут нам неверный результат. Обратив
внимание на то, что исходные значения заданы в процентах, находим в справочнике

p  
p 
p 
формулу сложных процентов p   1  1 1  2 1  3   1 * 100% , вычисление по
 100  100  100  
которой и даст нам верный результат.
Практически тот же подход используется и при решении большинства задач «на
время», на перевод величин в разных системах мер, на экономию операций при выполнении
некоторых действий. Здесь хорошими помощниками являются функции остатка от деления и
целого деления, а также математические ухищрения.
Пример 1-4. Решить задачу обмена значениями двух переменных, не используя
дополнительных переменных и предполагая, что значениями целых переменных могут быть
произвольные целые числа.
Обозначим начальные значения переменных a и b через a0 и b0. Тогда, математически
очевидно следующее:
a=a+b
{a=a0+b0, b=b0}
b=a-b
{a=a0+b0,b=a0)
a=a-b
{a=b0, b=a0}
10
Реализовав эти вычисления на языке программирования получим решение нашей
задачи:
CLS
INPUT
INPUT
A = A
B = A
A = A
PRINT
"ЧИСЛО A"; A
"ЧИСЛО B"; B
+ B
- B
- B
"A="; A, "B="; B
var a,b:integer;
begin
write('Input A: ');
readln(a);
write('Input B: ');
readln(b);
a:=a+b;
b:=a-b;
a:=a-b;
writeln('A = ',a,' B = ',b);
readln;
end.
Пример 1-5. Часовая стрелка образует угол  с лучом, проходящим через центр
циферблата и через точку, соответствующую 12 часам. По значению угла определить
время, показываемое часами.
Циферблат разбит на 12 равных частей (часов). Циферблат, как окружность, имеет
360 градусов. Значит, один полный час равен 30 градусам. Т.е. кол-во полных часов
определяется выражением  div 30. Далее. За один полный час, т.е. за 30 градусов хода
часовой стрелки, минутная совершает полный оборот, т.е. 360 градусов. Значит, 1 минута
равна 2 градусам и количество минут в текущем часе будет равно ( mod 30)*2. Точность
определения времени по углу часовой стрелки равна  1 минута.
CLS
INPUT "ВВЕДИТЕ УГОЛ";FI
CHAS=FI\30
MIN=(FI MOD 30)*2
PRINT "ТЕКУЩЕЕ ВРЕМЯ";CHAS;"ЧАС";MIN;"МИН"
var fi,chas,min: integer;
begin
write ('Введите угол ');
readln(fi);
chas:=fi div 30;
min:=(fi mod 30)*2;
write('Текущее время ',chas,' час',min,' мин');
end.
11
САМОСТОЯТЕЛЬНАЯ РАБОТА
1-1-1. Временной интервал.
Заданы моменты начала и конца некоторого промежутка времени в часах, минутах
и секундах (в пределах одних суток). Найти продолжительность этого промежутка в тех
же единицах измерения.
1-1-2. Округленное время.
Текущее время (часы, минуты, секунды) задано тремя переменными: h, m, s.
Округлить его до целых значений минут и часов. Например, 14 ч 21 мин 45 с преобразуется в
14 ч 22 мин или 14 ч, а 9 ч 59 мин 23 с – соответственно в 9 ч 59 мин или 10 ч.
1-1-3. Угловое время
Задан угол между часовой стрелкой и линией, соединяющей центр циферблата и
точку в 12 часов. Определить сколько времени пройдет до того момента, когда:
а) стрелки часов совпадут
б) стрелки часов станут перпендикулярны
в) стрелки часов образуют ровную линию (угол в 180 градусов)
1-1-4. Русские единицы длины.
1 верста = 500 саженей; 1 сажень = 3 аршина; 1 аршин = 16 вершков; 1 вершок =
44,45 мм. Длина некоторого отрезка составляет p метров. Перевести ее в русскую
неметрическую систему.
1-1-5. Хитрая степень
Возвести заданное число x в степень n, не используя многократного умножения и
возведения в степень выше квадрата.
1-1-6. Число наоборот
Данное четырехзначное число записать наоборот. Например: 6584 - 4856.
1-1-7. Сравните числа
Найти наибольшее и наименьшее из двух заданных чисел A и B
1-1-8. Деньги, деньги…
Некоторая сумма денег выражена в копейках, например, 317, 5050, 100. Записать
данную сумму в рублях и копейках, т.е. в виде: 3 руб. 17 коп., 50 руб. 50 коп, 1 руб 00 коп.
(Количество копеек всегда выражается двумя цифрами)
12
УСЛОВНЫЙ АЛГОРИТМ И ЕГО МОДИФИКАЦИИ
У каждой программы по крайней мере два назначения: что она должна делать и чего не должна.
А.Перлис
Условный оператор
На практике решение большинства задач не удается описать с помощью программ
линейной структуры. Такая ситуация возникает тогда, когда решение задачи зависит от
какого-либо условия. При этом после проверки некоторого условия выполняется та или иная
последовательность операторов, т.е. происходит нарушение естественного порядка
выполнения операторов. Для этих целей используют управляющие операторы.
Условный алгоритм хранит в себе такое количество возможностей, что практически
все задачи содержат в себе данную алгоритмическую конструкцию. В то же время, следует
отметить «своенравность» условного алгоритма. Чтобы «приручить» его, необходимо
научиться правильно составлять условия. В принципе все условия основаны на какой-либо
закономерности, и именно этому будет посвящено наше сегодняшнее занятие.
Условный оператор используется для реализации разветвлений в программе, которые
происходят при выполнении некоторого условия и имеет следующую структуру,
одинаковую для Бейсика и Паскаля:
IF <логическое выражение> THEN серия1 ELSE серия2;
Данная запись читается как: ЕСЛИ <логическое выражение> ТО … ИНАЧЕ …
Серия – один или несколько операторов языка. Если операторов несколько, то в
Бейсике их следует разделять знаком двоеточия, а в Паскале – заключать в операторные
скобки begin…end, не забывая при этом в конце каждой строки ставить точку с запятой.
Если логическое выражение, выступающее в качестве условия, принимает значение
False (ложь), то выполняются операторы, расположенные после else (серия2), если True
(истина), - операторы, следующие за then. При записи логического выражения следует
избегать знака = (равно) для действительных (вещественных) переменных, так как они
представляются с некоторой точностью (до определенного знака), а поэтому может не
произойти совпадения значений выражений, стоящих слева и справа от знака равно. Для
устранения указанного недостатка следует требовать выполнения условия с заданной
точностью, т.е. вместо отношения X = Y рекомендуется, например, использовать такой
прием:
ABS(X - Y) < 1E-8
т.е абсолютная разница сравниваемых величин не превышает некоторой весьма малой
величины.
Поскольку развилка может быть неполной, т.е. требуется рассмотрение только одного
варианта, то возможна и неполная форма записи условного оператора:
IF <логическое выражение> THEN серия;
Условный оператор реализует разветвление вычислительного процесса по двум
направлениям, одно из которых осуществляется при выполнении условия, другое - в
противном случае. Для реализации разветвлений более чем по двум направлениям
необходимо использовать несколько условных операторов. Рассмотрим примеры.
Пример 2-1. Дано число a. Вычислить f(a), если
13
INPUT "Введите число:"; A
IF A<=0 THEN F=0 ELSE IF A<=1 THEN F=A^2-A ELSE F=SQR(A)-SIN(3.14*A^2)
PRINT "Значение функции F(x) при x = ";A;"равно";F
var a,f:real;
begin
writeln('Введите число: ');
readln(a);
if a <= 0 then
f:= 0
else
if a <= 1 then f: = sqr(a) - a
else f: = sqr(a) - sin(pi * sqr(a));
writeln('значение функции f(x) при x = ', a:10:4, ' равно ', f:10:4);
end.
Логические функции
Рассмотрим следующую задачу.
Пример 2-2. Даны действительные числа x, y. Если x и y отрицательны, то каждое
значение заменить модулем; если отрицательно только одно из них, то оба значения
увеличить на 0,5; если оба значения неотрицательны и ни одно из них не принадлежит
отрезку [0,5; 2,0], то оба значения уменьшить в 10 раз; в остальных случаях x и y оставить
без изменения.
Разработаем алгоритм решения задачи, после чего напишем программу.
Алгоритм запишем словесно:
1) ввести значения x, y;
2) если x<0 и y<0, найти их модули и перейти к п. 5, иначе перейти к
следующему пункту;
3) если x<0 или y<0, увеличить каждую величину на 0,5 и перейти к п.5,
иначе перейти к следующему пункту;
4) если ни x, ни y не принадлежат отрезку [0,5; 2,0], уменьшить их в 10
раз;
5) вывести значения x и y;
6) конец.
Обратите внимание на "связки" в нашем условном алгоритме:
и y<0,
x<0 или y<0
ни x, ни y
если x<0
если
если
Эти смысловые союзы образуют смысловую логическую связку двух или более
условий в одно. В программировании они называются логическими функциями. Основных
логических функций четыре:
AND
(ЛОГИЧЕСКОЕ И),
OR
(ЛОГИЧЕСКОЕ ИЛИ)
NOT
(ЛОГИЧЕСКОЕ НЕ)
XOR
(ИСКЛЮЧАЮЩЕЕ ИЛИ)
Последняя функция весьма специфична, поэтому ее рассмотрение пока отложим.
14
Для того, чтобы понять как работают логические функции, используем так
называемые таблицы истинности, которые позволяют увидеть, какое значение примет та
или иная логическая функция при различных входных условиях.
Логические функции могут принимать только одной значение из двух - ИСТИНА или
ЛОЖЬ (TRUE - FALSE). Часто истинность обозначают цифрой 1, а ложность - цифрой 0.
X
0
0
1
1
Y
0
1
0
1
X AND Y
0
0
0
1
X OR Y
0
1
1
1
NOT X
1
1
0
0
Обратите внимание на значения функций. Функция отрицания НЕ дает всегда
противоположное исходному значение. Функция И истинна только в том случае, когда оба
связанных условия истинны. Функция же ИЛИ истинна, если хотя бы одно из связываемых
условий истинно.
Если в таблице истинности между аргументами поставить знак сложения для функции ИЛИ, а для
функции И поставить знак умножения и сравнить арифметический результат со значением функций, то станет
понятно, почему функцию ИЛИ называют также «логическое сложение», а функцию И – «логическое
умножение».
Перенесем наш словесный алгоритм в среду программирования. Отметим следующий
факт: при использовании логических функций требуется заключение связываемых условий в
обычные скобки.
INPUT "Введите два числа";X,Y
IF X<0 AND Y<0 THEN X=ABS(X): Y=ABS(Y)
IF X<0 OR Y<0 THEN X=X+0.5: Y = Y + 0.5
IF NOT (((X>=0.5) AND (X <= 2))OR((Y>=0.5) AND (Y<=2))) THEN X=X/10:
Y=Y/10
PRINT "Результат:"
PRINT "X="; X, "Y=";Y
var x, y : real;
begin
write('введите два числа '); readln(x, y);
if (x<0) and (y<0) then
begin x:=abs(x); y:=abs(y) end
else
if (x<0) or (y<0) then begin
x:=x+0.5; y:=y+0.5 end
else
if not (((x>=0.5) and (x<=2))
or ((y>=0.5) and (y<=2))) then
begin x:=x/10; y:=y/10 end;
writeln('результат:'); writeln('x= ', x:6:3); writeln('y= ', y:6:3)
end.
Попробуйте самостоятельно разобрать следующие задачи.
Пример 2-3. Написать программу решения обычного квадратного уравнения.
INPUT "Bведите A,B,C";a,b,c
d=b^2-4*a*c
IF d<0 THEN PRINT "действительных корней нет" ELSE
IF d=0 THEN x=(-b)/(2*a): PRINT "корень уравнения:";x
ELSE x=(-b+sqr(d))/(2*a): PRINT "1-й корень уравнения:";x:
x=(-b-sqr(d))/(2*a): PRINT "2-й корень уравнения:";x
Примечание: 3,4,5,6 строки текста программы набираются в одну строку без переносов.
var a,b,c,d,x:real;
15
begin
writeln('введите A,B,C');
readln(a,b,c);
d:=sqr(b)-4*a*c;
if d<0 then begin
writeln('Действительных корней нет');
end else if d=0 then begin
x:=(-b)/(2*a);
writeln('корень уравнения: ',x);
end else begin
x:=(-b+sqrt(d))/(2*a);
writeln('1-й корень уравнения: ',x);
x:=(-b-sqrt(d))/(2*a);
writeln('2-й корень уравнения: ',x);
end
end.
Пример 2-4. Какая из двух точек на плоскости, заданная своими координатами
ближе к началу координат?
INPUT "Bведите A(X1,Y1) и B(X2,Y2)"; x1,y1,x2,y2
d1:=sqr(y1^2+x1^2)
d2:=sqr(y2^2+x2^2)
IF d1<d2 THEN PRINT "Точка A ближе" ELSE IF d1>d2 THEN PRINT "Точка B
ближе" ELSE PRINT "Одинаково"
Примечание: 4,5 строки текста программы набираются в одну строку без переносов.
var x1,y1,x2,y2,d1,d2:real;
begin
writeln('введите A(X1,Y1) и B(X2,Y2)');
readln( x1,y1,x2,y2 );
d1:=sqrt(sqr(y1)+sqr(x1));
d2:=sqrt(sqr(y2)+sqr(x2));
if d1<d2 then writeln('Точка A ближе')
else if d1>d2 then writeln('Точка B ближе')
else writeln('Одинаково');
end.
Структурный условный оператор в языке Бейсик
Язык Паскаль отличается своей структурированностью, что позволяет писать на нем
программы, весьма строгие по своей структуре и более легкие для понимания. Однако,
версия языка Бейсик, известная как Microsoft Qbasic также имеет возможности структурного
программирования. В частности, условный оператор IF можно записать в таком виде:
IF условие THEN
[серия1]
ELSE
[серия2]
END IF
Например:
INPUT "1 или 2", i
IF i=1 OR i=2 THEN
PRINT "OK"
ELSE
PRINT "Неверно"
END IF
Т.е. применение структурной формы записи условного оператора облегчает как
понимание программы, так и практически исключает возможность логических ошибок,
16
поскольку отпадает необходимость записи серий операторов через двоеточие и структура
проверки условия выглядит более наглядно, также как и в Паскале.
Функция XOR
В ходе данной лекции мы упомянули логическую функцию
ИСКЛЮЧАЮЩЕЕ ИЛИ. Таблица значений для этой функции выглядит так:
X
0
0
1
1
Y
0
1
0
1
XOR
-
X XOR Y
0
1
1
0
Смысл и применение этой функции покажем на основе одной из распространенных
задач.
Пример 5. Дана последовательность целых чисел. Известно, что все числа в ней
встречаются четное количество раз, кроме одного, которое встречается нечетное число
раз. Составьте программу, которая определяет это число.
Рассмотрим следующую операцию сложения по модулю числа 2, т.е. в двоичной
системе счисления: 0+0=0, 1+0=1, 0+1=1 и 1+1=0. Многозначные числа будем складывать
поразрядно после двоичного разложения каждого из слагаемых. Так определенная операция
сложения обладает следующими свойствами: a+0=a, a+a=0, a+b=b+a, (a+b)+c=a+(b+c). Этих
свойств достаточно, чтобы показать, что такая сумма чисел, удовлетворяющих условиям
задачи, как раз и будет искомым числом. Действительно, числа, которые встречаются четное
количество раз, дают в результате сложения 0 (после перегруппировки слагаемых), а, так как
только одно из них встречается нечетное число раз, то оно и останется после всех сложений.
В математике и программировании описанное сложение еще называют исключающим
ИЛИ, а в языках программирования это сложение реализовано как операция XOR над
целыми числами.
Итак, решения нашей задачи на языках программирования будут такими:
x = 0
WHILE NOT y=0
INPUT y
x = x XOR y
WEND
PRINT x
var x,y:integer;
begin
x:=0;
while not (y=0) do {ввод 0 - означает конец
последовательности}
begin
readln(y); x:=x xor y;
end;
writeln(x);
end.
Циклическая структура WHILE будет рассмотрена нами на следующем занятии. Пока же следует
принять ее "как есть", тем более, что смысл ее прост: "ПОКА выполняется какое-либо условие – выполнять
указанные действия".
17
Оператор выбора
Кроме условного оператора в качестве управляющей структуры довольно часто
используется оператор выбора CASE. Эта структура позволяет переходить на одну из ветвей
в зависимости от значения заданного выражения - селектора выбора. Ее особенность
состоит в том, что выбор решения здесь осуществляется не в зависимости от истинности или
ложности условия, а является вычислимым. Оператор выбора позволяет заменить несколько
операторов развилки (в силу этого его ещё называют оператором множественного
ветвления).
В конструкции CASE вычисляется выражение K и выбирается ветвь, значение метки
которой совпадает со значением K. После выполнения выбранной ветви происходит выход
из конструкции CASE. Если в последовательности нет метки со значением, равным K, то
управление передается внешнему оператору, следующему за конструкцией CASE (в случае
отсутствия альтернативы ELSE; если она есть, то выполняется следующий за ней оператор, а
уже затем управление передается внешнему оператору).
Запись оператора выбора:
на Бейсике:
на Паскале:
SELECT CASE К
CASE выражение1
серия 1
CASE выражение2
серия 2
...
CASE ELSE
серия
END SELECT
CASE K OF
A1: серия 1;
A2: серия 2;
...
AN: серия N
ELSE серия N + 1
END;
Любая из указанных серий операторов может состоять как из единственного
оператора, так и нескольких (в этом случае, как обычно в Паскале, операторы, относящиеся к
одной метке, должны быть заключены в операторные скобки begin..end).
Выражение K здесь может быть любого порядкового типа (к таким типам относятся
все целые типы, логический тип, перечисляемый тип, диапазонный тип, базирующийся на
любом из указанных выше типов).
Пример 2-6. В старояпонском календаре был принят двенадцатилетний цикл. Годы
внутри цикла носили названия животных: крысы, коровы, тигра, зайца, дракона, змеи,
лошади, овцы, обезьяны, петуха, собаки и свиньи. Написать программу, которая позволяет
ввести номер года и печатает его название по старояпонскому календарю.
Справка: 1996 г.— год крысы — начало очередного цикла.
Поскольку цикл является двенадцатилетним, поставим название года в соответствие
остатку от деления номера этого года на 12.
INPUT "Введите год"; Year
God=Year MOD 12
SELECT CASE God
CASE 0
PRINT "Год Обезьяны"
CASE 1
PRINT "Год Петуха"
...
CASE 11
PRINT "Год Овцы"
END SELECT
18
var year : integer;
begin
write('введите год '); readln(year);
case year mod 12 of
0 : writeln('Год Обезьяны');
1 : writeln('Год Петуха');
2 : writeln('Год Собаки');
3 : writeln('Год Свиньи');
4 : writeln('Год Крысы');
5 : writeln('Год Коровы');
6 : writeln('Год Тигра');
7 : writeln('год Зайца');
8 : writeln('Год Дракона');
9 : writeln('Год Змеи');
10 : writeln('Год Лошади');
11 : writeln('Год Овцы')
end;
end.
Следующие примеры демонстрируют уникальные особенности операторов выбора в
каждом из рассматриваемых языков программирования.
Пример 2-7. Найти наибольшее из двух действительных чисел, используя оператор
выбора (Паскаль).
var max, x, y : real;
begin
write('Введите два неравных числа:');
readln(x, y);
case x > y of
true : max := x;
false : max := y
end;
writeln('Максимальное из двух есть ', max : 12 : 6)
end.
Пример 2-8. По введенному значению степени риска напечатать его текстовое
обоснование (Бейсик).
INPUT "Введите уровень риска (1-5): "; TOTAL
SELECT CASE TOTAL
CASE IS >= 5
PRINT "МАКСИМУМ РИСКА"
CASE 2 TO 4
PRINT "СРЕДНЯЯ СТЕПЕНЬ РИСКА"
CASE 1
PRINT "БЕЗОПАСНО"
END SELECT
Обратите внимание на необычную запись условий, а также на указание диапазона
значений. Однако такая возможность есть только в языке Бейсик.
Задания для самостоятельного решения
А. Расстояние между пунктами А и В равно R.. Из пункта А в пункт В выезжает
машина со скоростью V1. Одновременно из пункта В в пункт А выезжает еще одна машина
со скоростью V2. Определите расстояние между машинами через час. Предусмотреть
случай, когда скорость машин может быть больше расстояния.
В. Дано натуральное число n (n  9999). Является ли это число палиндромом
(перевёртышем) с учётом четырёх цифр, как, например, числа 2222, 6116, 1441 и т.д.?
С. Даны натуральные числа a, b, c, которые обозначают число, месяц, год.
Определить день недели, на который падает указанная дата. Исследуемая дата лежит в
диапазоне от 1582 до 4902 года. Как установлено, в этом случае номер дня недели
19
(воскресенье имеет номер 0, понедельник – номер 1,…, суббота – номер 6) равен остатку от
деления на 7 значения выражения [2.6m-0.2]+d+y+[y/4]+ [c/4]-2c, где d-номер дня в месяце
(1,2,…); m-номер месяца в году, нумерация начинается с марта (март имеет номер 1,
апрель-номер 2,…, декабрь – номер 10, январь и февраль считаются месяцами с номерами
11 и 12 предыдущего года); у-две младшие цифры года (00,…,99); с- две старшие цифры года
(15,…49); [х] означает целую часть числа х. Для создания более универсального календаря,
охватывающего все годы, можно использовать непосредственный подсчет, основанный на
том, что 1 января 1 года нашей эры было понедельником.
Практикум
ЗАДАЧИ С УСЛОВИЯМИ
Пример 2-9. Проверить данное число на «простоту».
Мы знаем, что простое число делится только на единицу и на само себя. Это
аксиоматично и не требует проверки. Нам надо лишь проверить делимость числа на другие
числа. Рассуждая логически, если число не будет делиться хотя бы на одно из «базовых»
простых чисел 2, 3, 5, и 7, то оно будет простым. Используя функцию «логического
сложения», получаем простое решение на Бейсике:
IF (A MOD 2)=0 OR (A MOD 3)=0 OR (A MOD 5)=0 OR (A MOD 7)=0 THEN
PRINT ”НЕ ПРОСТОЕ” ELSE PRINT “ПРОСТОЕ”
И чуть проще на Паскале:
if ((a mod 2) or (a mod 3) or (a mod 5) or (a mod 7)) then
writeln(‘Не простое’) else writeln (‘Простое’);
Здесь мы видим принцип использования математической закономерности для
построения условия. В данном примере явно видно ограничение на величину входного
числа, но в данном случаем нам важен принцип. Используя такой же подход для решения
других задач, можно существенно облегчить решение. Хорошим примером в это плане
являются “шахматные” задачи.
Рассмотрим шахматную доску в следующем представлении:
8
7
6
5
4
3
2
1
1
2
3
4
5
20
6
7
8
Будем считать, что каждая клетка задается парой натуральных чисел, не
превышающих восьми, причем первая цифра соответствует номеру строки, а вторая –
номеру столбца. Введем обозначения: (k,l) для одной и (m,n) для другой клетки.
Пример 2-10. Заданы координаты двух клеток шахматной доски. Определить,
различны ли они по цвету.
Выпишем для примера координаты черных и белых клеток:
Черные клетки
(2,1)
(5,4)
Белые клетки
(1,7)
(2,8)
Внешне никакой закономерности не проявляется, однако, стоит нам сложить
координаты, как закономерность сразу становится явной: сумма координат клеток одного
цвета одинакова по четности: если сумма координат одной клетки одинаково четна или
нечетна с суммой координат другой клетки, то клетки одного цвета.
if ((k+l mod 2=0) and (m+n mod 2=0)) or ((k+l mod 2<>0) and (m+n mod 2<>0))
then writeln (‘YES’) else writeln(‘NO’);
Пример 2-11. На одной клетке стоит одна из данных фигур: ладья, слон, ферзь.
Заданы координаты другой клетки. Определить, «бьет» ли данная фигура заданную клетку
поля.
Для ладьи задача решается просто: если координаты столбца или строки обоих
клеток совпадают, то угроза существует.
Немного сложнее обстоит дело со слоном. Использование решения предыдущей
задачи в предположении, что слон «ходит» только по клеткам своего цвета не даст нам
правильного решения во всех возможных случаях. Попробуем найти закономерность для
клеток одной диагонали.
Пусть слон стоит на клетке (4,4). Тогда под его удар попадают клетки:
(5,3)
(6,2)
(7,1)
(3,5)
(2,6)
(1,7)
(5,5)
(6,6)
(7,7)
(8,8)
(3,3)
(2,2)
(1,1)
Для сравнения возьмем «безопасную» клетку: (2,1)
Мы видим, что разность по модулю между координатами клеток одной диагонали
постоянна. Объединив условия для ладьи и слона, получим условие для ферзя.
Зная простые геометрические законы для базовых фигур (или найдя их в справочнике)
можно решить и простейшие геометрические задачи.
Пример 2-12. Может ли шар радиуса r пройти через ромбообразное отверстие с
диагоналями p и q?
Рассмотрев ромб как два равных треугольника и используя соотношения для
окружности вписанной в треугольник, можно вывести условие для данной задачи. Не
исключены и другие варианты решения. Например, можно рассмотреть два подобных
прямоугольных треугольника (в одной четвертой части ромба), и по принципу подобия и
тереме Пифагора вывести соотношение самостоятельно. Один треугольник – четвертая часть
ромба, другой - образованный высотой в этом треугольнике.
21
И, наконец, анализируя значения остатков от деления данного числа на какое-либо
другое, можно легко решить такие задачи, как следующая.
Пример 2-13. Для заданного возраста человека вывести фразу вида «Человеку 21
год», «Человеку 15 лет», «Человеку 34 года».
Проанализируем ряд возрастов человека. После 20 лет получается, что если последняя
цифра числа 1, то мы должны сказать год; если 2,3,4 - года, если 5-9 и 0 - лет.
До 20 лет, получается аналогично, но с исключением: с 5 до 20 включительно мы
говорим лет. На основе этого можно записать правила: если остаток от деления числа на
десять равен 1, то вывести "год"; если остаток от деления на десять равен 2,3 или 4, то
вывести "года"; если остаток от деления на десять равен 0, 5, 6, 7, 8 или 9, то вывести "лет".
Но если число находится в промежутке от 5 до 20, то вывести "лет" независимо от значения
остатка.
CLS
INPUT "ВВЕДИТЕ ВОЗРАСТ"; N
O=N MOD 10
IF O=1 AND NOT (N>4 AND N<21) THEN PRINT N; "ГОД"
IF O>1 AND O<5 AND NOT(N>4 AND N < 21) THEN PRINT N; "ГОДА"
IF O>=5 AND O<=9 OR O=0 OR (N>4 AND N<21) THEN PRINT N; "ЛЕТ"
var n,o: integer;
begin
write('Введите возраст ');
readln(n);
o:=n mod 10;
if (o=1) and (not((n>4) and (n<21))) then writeln(n, ' год');
if (o>1) and (o<5) and (not((n>4) and (n<21))) then writeln(n, ' годa');
if (o>=5) and (o<=9) or (o=0) or ((n>4) and (n<21)) then writeln(n, ' лет');
end.
22
САМОСТОЯТЕЛЬНАЯ РАБОТА
1-2-1. Угроза коня
На одной клетке стоит конь. Заданы координаты другой клетки. Определить,
«бьет» ли конь заданную клетку поля.
1-2-2. Шахматный этюд.
У белых на доске остался король. У черных конь, ладья и слон. Оцените позицию
белых: шах, мат, пат или обыкновенная позиция.
1-2-3. Головоломка жестянщика
Можно ли из круглой заготовки радиуса r вырезать две прямоугольные пластины с
размерами a x b и c x d?
1-2-4. Считаем ворон
Дано число К (К<100). Напечатать фразу вида «К ворон», где К – выражено
прописью данного числа: двадцать одна ворона, тридцать ворон и т.д.
1-2-5. Анализ числа
Составить программу-анализатор вводимого с клавиатуры целого числа по двум
признакам - его разрядности и знака.
1-2-6. Точка графика
Составьте программу, определяющую, пройдет ли график функции y = 5x2 – 7 x + 2
через заданную точку с координатами (a,b). Координаты – вещественные.
1-2-7. Электрическая цепь
По заданным значениям одного из сопротивлений цепи и ее полного сопротивления
определить, имеет ли место в данной цепи параллельное соединение проводников.
1-2-8. Точки на плоскости
Даны координаты двух точек A(x1,y1) и B(x2,y2) в прямоугольной системе координат.
Какая из этих точек находится дальше: а) от начала координат? б) от окружности
данного радиуса с центром в начале координат?
1-2-9. Идентификация треугольника
Составьте программу, которая по трем введенным вами числам определит, могут
ли эти числа быть длинами сторон треугольника, и если да, то определить вид этого
треугольника (остроугольный, прямоугольный или тупоугольный).
1-2-10. Счастливый билет
С клавиатуры вводится шестизначный номер трамвайного билета. Определить,
является ли билет счастливым.
23
ЦИКЛИЧЕСКИЕ И ИТЕРАЦИОННЫЕ АЛГОРИТМЫ
Легко сделать что-то переменным. Хитрость в том,
чтобы измерять продолжительность постоянства.
А.Перлис
Цикл с параметром
Командой повторения или циклом называется такая форма организации действий,
при которой одна и та же последовательность действий повторяется до тех пор, пока
сохраняется значение некоторого логического выражения. При изменении значения
логического выражения на противоположное повторения прекращаются (цикл завершается).
Различают циклы с известным числом повторений (цикл с параметром) и итерационные
(с пред- и постусловием).
Рассмотрим вначале первый из них. Он весьма прост в использовании.
В цикле с известным числом повторений параметр изменяется в заданном диапазоне.
Если в цикле изменяется простая переменная, то она является параметром цикла; если в
цикле изменяется переменная с индексом, то индекс этой переменной является параметром
цикла.
Для организации цикла с известным числом повторений в Бейсике и в Паскале
используется оператор FOR.
Структура цикла, организованного с помощью этого оператора, на языке Бейсик имеет
вид:
FOR i:=a TO b STEP k
<операторы>
NEXT
Здесь I — параметр, изменяющийся в цикле; A, B — выражения порядкового типа,
обозначающие начальное, конечное значение параметра цикла. Шаг изменения номера
параметра цикла равен k. Параметр k может быть как положительным, так и отрицательным.
Соответственно, цикл может работать как по возрастанию, так и по убыванию значений
своего параметра. По умолчанию шаг равен 1, если условие решения подразумевает
использование порядковых значений, то указание ключевого слова STEP необязательно.
Структура цикла, организованного с помощью этого оператора, на языке Паскаль имеет
вид:
for i := a to b do begin <операторы> end;
или
for i := a downto b do begin <операторы> end;
Шаг изменения номера параметра цикла равен 1, если в заголовке цикла стоит to и –1
при downto. Возможность указания произвольного шага в языке Паскаль отсутствует: в
таких случаях приходится использовать циклы с условиями
Порядок выполнения цикла с шагом 1 следующий: вычисляются значения начального
и конечного значений параметра цикла; параметр если I принимает начальное значение; если
I меньше или равно конечному значению, исполняется тело цикла; значение параметра цикла
увеличивается, т.е. i=i+1; проверяется условие I<=B (для отрицательного шага условие
I>=B) и при его выполнении цикл повторяется. Выход из цикла осуществляется, если I>B
(I<B для шага 1), и выполняется оператор, следующий за оператором цикла. Если A>B (или
A<B для шага -1), то цикл не исполняется ни разу.
Если в операторе цикла с параметром начальное или конечное значение параметра
заданы переменными или выражениями, то значения этих переменных должны быть
определены в программе до оператора цикла. Не следует внутри цикла изменять параметр
цикла, его начальное и конечное значения с помощью операторов присваивания или ввода.
24
Пример 3-1. Написать программу вывода на экран таблицы степеней числа 2.
CLS
FOR i=1 TO 10
PRINT "2x";i;"=";2^i
NEXT
var i:integer;
begin
for i:=1 to 10 do
writeln('2x',i,'=',exp(i*ln(2)):3:0);
end.
Обратите внимание на необходимость использования в последнем операторе формата
вывода без знаков после запятой. Вычисляя любую встроенную математическую функцию,
компилятор Паскаля обязательно сделает результат вещественным.
Достаточно часто цикл с параметром используется при разработке программ
обработки массивов. Обычное же его применение состоит в нахождении сумм,
произведений, или расчете и выводе на экран таблиц значений.
Пример 3-2. Найти сумму всех четных чисел от 1 до 100.
CLS
FOR I=2 TO 100 STEP 2
S=S+I
NEXT
PRINT "S=";S
Пример
3-3.
Дано
натуральное
n,
действительное
x.
Вычислить
Разработаем алгоритм решения задачи:
1) ввести данные - количество слагаемых n и число x;
2) присвоить переменной, в которой будем хранить степени sin x,
значение 1; S := 0;
3) присвоить параметру цикла значение 1;
4) если значение параметра цикла меньше n, перейти к следующему
пункту, иначе к п. 9;
5) вычислить очередную степень sin x;
6) добавить вычисленное значение к сумме;
7) увеличить параметр цикла на 1;
8) перейти к п.4;
9) вывести на печать сумму S;
10) конец.
Реализуем наш алгоритм на языке Паскаль.
var s, x, pr : real; n, i : integer;
begin
write('введите число слагаемых и x: '); readln(n, x);
pr:=1;{эта переменная хранит последовательные степени sinx}
s:=0;
for i:=1 to n do
begin
pr:=pr*sin(x); {очередная степень sin(x)}
s:=s+pr
end;
writeln('сумма равна ', s:7:3)
end.
25
Циклы могут быть вложенными, т.е. при выполнении одного цикла, внутри него
выполняется еще один или даже несколько циклов. Однако, следует иметь ввиду, что время
выполнения вложенных циклов прямо пропорционально произведению конечных значений
их параметров.
Итерационные алгоритмы
По сравнению с циклом с параметром, рассмотренном нами выше, итерационные
циклы являются универсальными. Для организации итерационных циклов используются
операторы цикла с предусловием - цикл "ПОКА" и цикла с постусловием - цикл "ДО"
Эти операторы не задают закон изменения параметра цикла, поэтому необходимо
перед циклом задавать начальное значение параметра с помощью оператора присваивания, а
внутри цикла изменять текущее значение этого параметра.
Соответствующие структуры циклов на языке Бейсик:
Цикл «ПОКА»
Цикл «ДО»
WHILE B
<операторы>
WEND
DO WHILE | UNTIL С
<операторы>
LOOP
Соответствующие структуры циклов на языке Паскаль:
Цикл «ПОКА»
Цикл «ДО»
while B do
begin
repeat
<операторы>
until C;
<операторы>
end;
Здесь B, C - логические выражения.
Для оператора цикла с предусловием проверяется значение логического выражения,
если оно имеет значение true, то операторы, входящие в цикл, выполняются, в противном
случае осуществляется выполнение оператора, следующего за циклом.
Цикл с постусловием выполняется хотя бы один раз. Затем проверяется значение
логического выражения, если оно false, то операторы, входящие в цикл, выполняются, в
противном случае осуществляется выход из цикла.
Входить в цикл можно только через его начало, т.е. нельзя входить внутрь цикла с
помощью управляющего оператора, т.к. в этом случае параметр цикла не определен.
Использование итерационных циклов не исключает использования обычного цикла с
параметром.
Пример 3-4. Дано натуральное число n. Получить все простые делители числа.
CLS
INPUT "ВВЕДИТЕ НАТУРАЛЬНОЕ ЧИСЛО:";N
PRIZNAK=1: 'Признак того, не является ли введенное число простым
'Пока параметр цикла не превысил квадратного корня из данного числа,
' продолжаем поиск простых делителей
FOR I=2 TO INT(SQR(N))
IF N MOD I = 0 THEN
PRIZNAK=0 :'Введенное число не является простым
LOGPER=0: ' Логическая переменная, принимающая значение
'True, если нашлись делители I, отличные от 1 и I
VSP=2
DO UNTIL (VSP>(((I\2)+ 1))) OR LOGPER=1
IF (I MOD VSP=0) AND (I<>VSP) THEN LOGPER=1
VSP=VSP+1
LOOP
IF LOGPER=0 THEN PRINT I :'Если число I простое, печатаем его
ENDIF
IF PRIZNAK=1 THEN PRINT N
NEXT
26
var n, i, vsp : integer;
log_per, priznak : boolean;
begin
write('введите натуральное число: ');
readln(n);
priznak := true; {признак того, не является ли введенное число простым}
{пока параметр цикла не превысил квадратного корня из данного числа,
продолжаем поиск простых делителей}
for i := 2 to round(sqrt(n)) do
if n mod i = 0 then
begin
priznak := false;
{введенное число не является простым}
log_per := false; {логическая переменная, принимающая значение true,
если нашлись делители i, отличные от 1 и i}
vsp := 2;
repeat
if (i mod vsp = 0) and (i <> vsp) then log_per := true;
vsp := vsp + 1
until (vsp > i div 2 + 1) or log_per;
if not(log_per) then writeln(i) {если число i простое, печатаем его}
end;
if priznak then writeln(n); end.
В задачах на использование итерационных алгоритмов реализуется тот или иной
циклический процесс, который выполняется либо за заранее известное число шагов, либо до
достижения некоторого условия. В последнем случае полезно подстраховаться от
зацикливания ("вечного цикла"), которое может возникнуть из-за разных ошибок в
программе и алгоритме, из-за некорректных данных, либо вследствие накопления
погрешностей. Для этого достаточно подставить лимит числа шагов.
В итерационных алгоритмах заданная погрешность используется для проверки
модуля разности найденного приближенного и точного значений, однако если последнее
неизвестно, допустимо оценивать разность между соседними итерациями (приближениями),
либо, например, при решении уравнений, модуля разности между левой и правой частей
уравнения или при отыскании корня функции - модуля ее значения.
Часто в задачах для вычисления очередного слагаемого удобно рекуррентно
использовать предыдущее слагаемое, а не использовать дополнительный цикл.
Поясним все вышесказанное на примере.
Пример
3-5.
Проверить
справедливость
следующего
разложения
и оценить скорость сходимости, найдя число слагаемых, необходимое
x x2
xn
e 1 
 ... 
 ...
1! 2!
n!
x
для достижения заданной погрешности .
Подобное разложение существует для всех функций. Обычно функции раскладываются в так
называемые ряды Тейлора или ряды Маклорена. Именно таким образом и происходит вычисление
функций в процессоре компьютера.
Для заданного х вычислим левую часть, используя встроенную функцию eps(x), и
n
будем вычислять частичную сумму ряда правой части S n   x
i 0
i
i!
до тех пор, пока она не
будет отличаться от заданной левой части менее, чем на заданную погрешность. Заметим,
что для вычисления каждого слагаемого ряда требуется возведение в степень (трудоемкая
операция) и вычисление факториала (а это дополнительный цикл). Но, каждое очередное
x
слагаемое можно рекуррентно вычислить через предыдущее, просто умножив его на , что
i
требует всего двух операций.
27
LIMIT=100 :'ограничение на число шагов
INPUT "Введите аргумент и погрешность";X, EPS
Y=EXP(X):' левая часть
S=1:' частичная сумма
U=1:' первое слагаемое
N=1:' число шагов
WHILE (ABS(Y-S)>EPS) OR (N<LIMIT)
U=U*X/N:' очередное слагаемое
S=S+U
N=N+1
WEND
IF N>=LIMIT THEN
PRINT N;"шагов не хватило для достижения заданной точности"
ELSE
PRINT "Левая часть: ";Y
PRINT "Правая часть: ";S
PRINT "Погрешность ";S;" достигнута за ";N;" шагов"
ENDIF
const limit=100; {ограничение на число шагов}
var
x, eps, y, s, u: real;
n: integer;
begin
write('введите аргумент и погрешность');
readln (x, eps);
y:=exp(x); {левая часть}
s:=1; {частичная сумма}
u:=1; {первое слагаемое}
n:=1; {число шагов}
repeat
u:=u*x/n; {очередное слагаемое}
s:=s+u;
n:=n+1;
until (abs(y-s)<=eps) or (n>=limit);
if n>=limit then
writeln(n,' шагов не хватило для достижения заданной точности');
else begin
writeln('левая часть: ',y:15:6); writeln('правая часть: ',s:15:6);
writeln('погрешность ',s:10:6,' достигнута за ',n,' шагов'); end
еnd.
Владение циклическими операторами итерационного характера позволяет в полной
мере реализовать "дуракоустойчивость" программы, т.е. защиту от некорректных исходных
данных. Программа должна отвергать некорректные данные и устойчиво работать при
корректных. Пусть, например, по условию нашей задачи 0<х, кроме того, разумно
потребовать . Тогда ввод значений можно организовать так:
OKAY=0
………
WHILE OKAY<>1 {повторять, пока не поумнеет}
INPUT
"Введите
аргумент
от
0
до
3.14
и
положительную
погрешность";X,EPS
IF (X>0) AND (X<=3.14) AND (EPS>0) THEN OKAY=1
IF NOT OKAY=1 THEN PRINT "Что-то не то, повторите ввод!"
WEND
var okay: boolean;
………
repeat {повторять, пока не поумнеет}
write('введите аргумент от 0 до 3.14 и положительную погрешность ');
readln(x,eps);
okay:=(x>0) and (x<=3.14) and (eps>0);
if not okay then writeln('что-то не то, повторите ввод!');
until okay;
28
Еще одно применение итерационного цикла можно найти при разработке интерфейса
программ. Например, в Паскале можно использовать функцию ожидания нажатой клавиши
keypressed:
…………
writeln('нажмите любую клавишу для завершения работы…');
repeat
until keypressed;
end.
Задания для самостоятельного решения
А. В учебном заведении задается начало учебного дня, продолжительность урока,
продолжительность перемен (малой, обычной и большой) и их место в расписании,
количество уроков. Получить расписание звонков на весь учебный день.
В. Найти сумму всех трехзначных четных чисел
С. Дано натуральное число. Найти сумму цифр данного числа.
Практикум
ЕГО ВЕЛИЧЕСТВО ЦИКЛ
Пример 3-6. Известно время (в часах) начала и окончания работы некоторого
пригородного автобусного маршрута с одним автобусом на линии, а также
протяженность маршрута в минутах (в один конец) и время отдыха на конечных
остановках. Составить суточное расписание этого маршрута (моменты отправления с
конечных пунктов) без учета времени на обед и пересменку.
Задав все начальные значения и реализовав через условные операторы работу с
числами по «законам времени», можно получить простое и элегантное решение этой задачи.
var n,k,h,tn,tk,p,t,ch,m:integer;
begin
writeln('введите начало и конец маршрута в часах ч/з пробел');
readln(n,k);
writeln('введите время маршрута в минутах');
readln(p);
writeln('введите время простоя в конечных точках в мин.: начало конец');
readln(tn,tk);
n:=n*60; {перевод начала работы в мин.}
k:=k*60; {перевод конца работы в мин.}
t:=n;
writeln('Время отправления в конечных точках маршрута');
repeat
t:=t+tn; ch:=t div 60; m:=t-ch*60; write(ch,':');
if (9>m) and (m>=0) then write('0',m,' -- ') else write(m,' -- ');
t:=t+p+tk;ch:=t div 60; m:=t-ch*60;write(ch,':');
if (9>m) and (m>=0) then writeln('0',m) else writeln(m);
t:=t+p;
until t>=k;
readln;
end.
Решение следующей задачи демонстрирует использование вложенных циклов.
29
Пример 3-7. У гусей и кроликов вместе 64 лапы. Сколько может быть гусей и
кроликов (вывести все возможные сочетания)?
PRINT ”ГУСЕЙ”, “КРОЛИКОВ”
FOR I=0 TO 32
FOR J:=0 TO 16
IF I*2+J*4=64 THEN PRINT I,,J
NEXT
NEXT
Пример 3-8. Суточный рацион коровы составляет u кг сена, v кг силоса и w кг
комбикорма. В хозяйстве, содержащем стадо из k голов, осталось s кг сена, t кг силоса и f кг
комбикорма. В стаде ежедневно погибает р% коров; ежедневно q% оставшегося сена
сгнивает; r% силоса разворовывается колхозниками; t% комбикорма продает "налево"
зав.фермой. Когда нельзя будет кормить всех оставшихся коров по полному рациону? Какой
из видов кормов кончится раньше других?
Var
u:real; { количество сена (кг) в ежедневном рационе }
v:real; { количество силоса (кг) в ежедневном рационе }
w:real; { количество комбикорма (кг) в ежедневном рационе }
s:real; { запас сена (кг) }
t:real; { запас силоса (кг) }
f:real; { запас комбикорма (кг) }
p:real; { (% за день) коров погибает }
q:real; { (% за день) сена сгнивает}
r:real; { (% за день) силоса разворовывается}
t1:real;{ (% за день) комбикорма продается}
k:integer;{ число голов коров }
i:integer; {счетчик}
Begin
{присвоим переменным исходные значения}
u:=2; v:=3; w:=4.5; s:=17300; t:=90900; f:=96600;
p:=5; q:=3; r:=7; t1:=6; k:=180;
i:=0;
while (k>0)and(s>=0)and(t>=0)and(f>=0) do begin
{за утро сгнивает сено, а работники колхоза успевают разворовать запасы}
s:=s-(s*q)/100; {сено сгнило}
t:=t-(t*r)/100; {силос разворовали}
f:=f-(f*t1)/100; {комбикорм продали}
{а потом вспоминают про коров и начинают их кормить!}
s:=s-(u*k);{коровам дают сено...}
t:=t-(v*k);{...силос...}
f:=f-(w*k);{... и комбикорм}
{но не все коровы выдерживают такое отношение к себе...}
{некоторые из них к вечеру погибают :( }
k:=Trunc(k*(1-p/100));
i:=i+1; {так подходит к концу еще один день}
End;
writeln('Через ',i,' дней коров нельзя будет кормить по полному рациону,
потому что ');
{если они все к тому времени не погибнут...}
If s<=0 then Writeln('кончилось сено!');
if t<=0 then Writeln('кончился силос!');
if f<=0 then Writeln('кончился комбикорм!');
if k<=0 then Writeln('кончились коровы!');
repeat until keypressed;
End.
30
CLS
INPUT "Kоличество сена (кг) в ежедневном рационе"; u
INPUT "Kоличество силоса (кг) в ежедневном рационе"; v
INPUT "Kоличество комбикорма (кг) в ежедневном рационе"; w
INPUT "3апас сена (кг)"; s
INPUT "3апас силоса (кг)"; t
INPUT "3апас комбикорма (кг)"; f
INPUT "% за день коров погибает"; p
INPUT "% за день сена сгнивает"; q
INPUT "% за день силоса разворовывается"; r
INPUT "% за день комбикорма продается"; t1
INPUT "Число голов коров"; k
WHILE (k > 0) AND (s >= 0) AND (t >= 0) AND (f >= 0)
'за утро сгнивает сено, а работники колхоза успевают разворовать запасы
s = s - (s * q) / 100: ' сено сгнило
t = t - (t * r) / 100: ' силос разворовали
f = f - (f * t1) / 100: ' комбикорм продали
'а потом вспоминают про коров и начинают их кормить!
s = s - (u * k): 'коровам дают сено...
t = t - (v * k): '...силос...
f = f - (w * k): '... и комбикорм
'но не все коровы выдерживают такое отношение к себе...
'некоторые из них к вечеру погибают
k = FIX(k * (1 - p / 100))
'так подходит к концу еще один день
i = i + 1
WEND
PRINT "Через "; i; "дней коров нельзя будет кормить по полному рациону,
потому что ";
'если они все к тому времени не погибнут...
IF s <= 0 THEN PRINT "кончилось сено!"
IF t <= 0 THEN PRINT "кончился силос!"
IF f <= 0 THEN PRINT "кончился комбикорм!"
IF k <= 0 THEN PRINT "кончились коровы!"
Очень хорошей иллюстрацией использования циклов являются задачи на перевод
числа из одной системы счисления в другую.
В следующих задачах используются массивы, поэтому читателю рекомендуется ознакомиться со
следующей лекцией и вернуться к данному практикуму.
При решении различных задач, в частности, задач на сжатие информации требуется
представление исходной информации (чисел, знаков) в иной системе счисления, чем
десятичная. Сам механизм перевода чисел из одной системы счисления в другую довольно
широко описан в литературе и рассматривается в базовом школьном курсе ОИВТ, поэтому
мы уделим внимание только программной реализации перевода между системами счисления.
Как известно, перевод из десятичной системы в другую осуществляется
последовательным делением исходного числа на основание требуемой системы до тех пор
пока это возможно, с последующей записью полученных остатков в обратном порядке.
31
INPUT A
RES$=""
WHILE A<>0
D=A MOD 2
RES$=STR$(D)+RES$
A=A \ 2
WEND
PRINT RES$
const digits:array [0..1] of char = ('0','1');
var a: integer;
res:string; d:0..1;
begin
readln(a); res:='';
while (a<>0) do begin
d:=a mod 2; res:=digits[d]+res;
a:=a div 2;
end;
writeln(res);
end.
Можно обойтись и без символьных переменных, но в этом случае нам нужен будет
дополнительный массив для хранения разрядов двоичного числа, причем размерность
массива придется рассчитывать заранее:
DIM RES(16)
INPUT A
K=1
WHILE A<>0
D=A MOD 2
RES(K)=D: A=A \ 2: K=K+1
WEND
FOR I=1 TO K-1
PRINT RES(K-I);
NEXT
var res:array [1..16] of 0..1;
a, i,k,d: integer;
begin
readln(a); k:=1;
while (a<>0) do begin
d:=a mod 2; res[k]:=d;
a:=a div 2; k:=k+1; end;
for i:=1 to k-1 do
write(res[k-i]);
writeln;
end.
Перевод в восьмеричную систему осуществляется аналогично, достаточно в
программах поменять основу системы счисления (2 на 8).
Для шестнадцатеричной системы счисления перевод несколько усложняется из-за
наличия специфических цифр A…F.
Для перевода десятичного числа в шестнадцатеричное программа аналогична для
двоичной системы счисления, только массив возможных значений является строго
определенным:
const digits:array [0..15] of char = ('0','1','2','3','4','5','6','7',
'8','9','A','B','C','D','E','F');
var res:string; d:0..15;
….
32
При реализации механизма перевода на Бейсике придется организовывать ручной
ввод и замену элементов массива, для элементов больших 9.
Вариант без использования массива:
INPUT A
RES$ = ""
WHILE A <> 0
d = A MOD 16
IF d < 10 THEN
RES$ = STR$(d) +
ELSE
IF d = 10 THEN RES$
IF d = 11 THEN RES$
IF d = 12 THEN RES$
IF d = 13 THEN RES$
IF d = 14 THEN RES$
IF d = 15 THEN RES$
END IF
A = A \ 16
WEND
PRINT RES$
RES$
=
=
=
=
=
=
"A"
"B"
"C"
"D"
"E"
"F"
+
+
+
+
+
+
RES$
RES$
RES$
RES$
RES$
RES$
При использовании массива суть остается та же самая, только символьная переменная
заменяется на соответствующий элемент результирующего массива.
Обратная операция, перевод из двоичной и шестнадцатеричной системы в
десятичную затруднений не вызывает: поразрядное сложение цифр числа, возведенных в
степень своего разряда:
'двоичное число в десятичное
INPUT A$
DIGITS$(0)="0": DIGITS$(1)="1"
RES=0: VES=1
FOR I=LEN(A$) TO 1 STEP -1
J=0
WHILE (DIGITS$(J)<>MID$(A$,I,1))
J=J+1
WEND
RES=RES+VES*J: VES=VES*2
NEXT
PRINT RES
'шестнадцатеричное число в десятичное
DIM DIGITS$(15)
DIGITS$(0)="0":DIGITS$(1)="1":………:DIGITS$(15)="F":
INPUT A$
RES=0: VES=1
FOR I=LEN(A$) TO 1 STEP -1
J=0: MID$(A$, I, 1) = UCASE$(MID$(A$, I, 1))
WHILE (DIGITS$(J)<> MID$(A$,I,1))
J=J+1
WEND
RES=RES+VES*J: VES=VES*16
NEXT
PRINT RES
END
33
{двоичное число в десятичное}
const digits:array [0..1] of char = ('0','1');
var
a:string;
res,ves:longint; i,j:integer;
begin
readln(a); res:=0; ves:=1;
for i:=length(a) downto 1 do begin
j:=0;
while (digits[j]<>x[i]) do inc(j);
res:=res+ves*j;
ves:=ves*2;
end;
writeln(res);
end.
{шестнадцатеричное число в десятичное}
const digits:array [0..15] of char =
('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
var
a:string;
res,ves:longint; i,j:integer;
begin
readln(a); res:=0; ves:=1;
for i:=length(a) downto 1 do begin
j:=0; a[i]:=UpCase(a[i]);
while (digits[j]<>x[i]) do inc(j);
res:=res+ves*j;
ves:=ves*16;
end;
writeln(res);
end.
34
САМОСТОЯТЕЛЬНАЯ РАБОТА
1-3-1. Парикмахер
Для каждого посетителя парикмахерской известно время его прихода и
продолжительность его обслуживания. Сколько клиентов обслужит мастер за смену в Т
часов?
1-3-2. Гуси и кролики
Решите приведенную выше задачу с использованием только одного (!) цикла
1-3-3. Площади прямоугольников
Прямоугольник на плоскости задается четырьмя числами – его габаритами.
Последовательно вводятся габариты К прямоугольников. Найти площадь их пересечения, не
запоминая самих габаритов.
В задачах 4-7 необходимо вывести список указанных чисел в "K" колонок
1-3-4. Числа –1
Шестизначные четные числа, делящихся без остатка на сумму своих цифр. К=10.
1-3-5. Числа –2
Трехзначные числа, делящихся без остатка на произведение своих цифр. Поставить
защиту от возможного деления на ноль. К=5.
1-3-6. Числа –3
Пятизначные симметричные нечетные числа, (например 34543 или 70507). К=5.
1-3-7. Числа –4
3.4 Шестизначные "счастливые" числа (сумма первых трех цифр равна сумме трех
последних), кратные семи. К=10.
1-3-8. Числа –5
Даны два двузначных числа А и В. Из этих чисел составили два четырехзначных
числа: первое число получили путем написания сначала числа A, а затем В; для получения
второго сначала записали В, а потом А. Найти числа А и В, если известно, что первое
четырехзначное число нацело делится на 99, а второе – на 49.
1-3-9. Проблема первоклассника
У первоклассника Пети m рублей. Мороженое стоит k рублей. Петя решил
наесться досыта мороженого, для этого он покупал по одному мороженому и съедал ее до
тех пор, пока ему хватало денег. Как Пете узнать, сколько денег останется у него в конце
концов? Учтите, что Петя делить еще не умеет, а умеет только вычитать и складывать.
Сколько мороженых он может съесть?
35
ПРОСТЕЙШИЕ ОПЕРАЦИИ НАД МАССИВАМИ
Все, что мы делаем в программировании –
это частный случай чего-то более общего,
и зачастую мы осознаем это чересчур быстро.
Н.Вирт
Одномерные массивы
Массив - это пронумерованная последовательность величин одинакового типа,
обозначаемая одним именем. Элементы массива располагаются в последовательных ячейках
памяти, обозначаются именем массива и индексом. Каждое из значений, составляющих
массив, называется его компонентой (или элементом массива).
Массив данных в программе рассматривается как переменная структурированного
типа. Массиву присваивается имя, посредством которого можно ссылаться как на массив
данных в целом, так и на любую из его компонент.
Переменные, представляющие компоненты массивов, называются переменными с
индексами в отличие от простых переменных, представляющих в программе элементарные
данные. Индекс в обозначении компонент массивов может быть константой, переменной или
выражением целого типа.
Если за каждым элементом массива закреплен только один его порядковый номер, то
такой массив называется линейным. Вообще количество индексов элементов массива
определяет размерность массива. По этом признаку массивы делятся на одномерные
(линейные), двумерные, трёхмерные и т.д. Двумерные массивы будут рассмотрены нами
далее.
Числовая последовательность четных натуральных чисел 2, 4, 6, ..., N представляет
собой линейный массив, элементы которого можно обозначить А(1)=2, А(2)=4, А(3)=6, ...,
А(К)=2*(К+1), где К — номер элемента, а 2, 4, 6, ..., N — значения. Индекс (порядковый
номер элемента) записывается в круглых скобках после имени массива. Например, A(7) седьмой элемент массива А; D(6) - шестой элемент массива D.
Для размещения массива в памяти ЭВМ отводится поле памяти, размер которого
определяется типом, длиной и количеством компонент массива. В языке Бейсик массив
описывается так:
DIM имя массива (конечное значение индекса)
Например, DIM b(5), r(34) - описываются массив В, состоящий из 5 элементов и
массив R, состоящий из 34 элементов.
В языке Паскаль массив описывается в разделе переменных:
имя массива:array[начальное значение..конечное значение индекса]
of базовый тип;
Аналогично, для указанного примера, описание массивов будет следующим:
var b:array [1..5] of real, r:array [1..34] of integer;
Заполнить массив можно с помощью оператора присваивания. Этот способ
заполнения элементов массива особенно удобен, когда между элементами существует какаялибо зависимость, например, арифметическая или геометрическая прогрессии, или элементы
связаны между собой реккурентным соотношением.
36
Пример 4-1. Заполнить одномерный массив элементами, отвечающими следующему
соотношению: a1=1; a2=1; ai=ai-2+ai-1 (i = 3, 4, ..., n).
INPUT N :' Ввод количества элементов
DIM A(N) :' объявление массива
A(1)=1: A(2)=1
FOR I=3 TO N
A(I)=A(I-1)+A(I-2)
NEXT
Read(N); {Ввод количества элементов}
A[1]:= 1;
A[2]:= 1;
FOR I := 3 TO N DO
A[I] := A[I - 1] + A[I - 2];
Другой вариант присваивания значений элементам массива
значениями, полученными с помощью датчика случайных чисел.
—
заполнение
Пример 4-2. Заполнить одномерный массив с помощью датчика случайных чисел
таким образом, чтобы все его элементы были различны.
DIM A(100)
INPUT N
A(1) = -32768 + RND(1) * 65535
FOR I = 2 TO N
LGP = 1
DO
A(I) = -32768 + RND(1) * 65535
J = 1
WHILE LGP = 1 AND (J <= (I - 1))
LGP = A(I) <> A(J)
J = J + 1
WEND
LOOP WHILE LGP = 1
NEXT
FOR I = 1 TO N
PRINT A(I);
NEXT
var a: array[1..100] of integer;
i,j,n:integer; log:Boolean;
begin
write(''); ReadLn(N);
randomize; A[1] := -32768 + random(65535);
for I := 2 To N do
begin
log := True;
repeat
A[i] := -32768 + random(65535); J := 1;
while Log and (j <= (i - 1)) Do
begin Log := a[i] <> a[j]; j:=j+1; End
until Log
end;
for i := 1 to N do write(a[i]:7,' '); writeln
end.
Ввод значений элементов массива с клавиатуры используется обычно тогда, когда
между элементами не наблюдается никакой зависимости. Например, последовательность
чисел 1, 2, -5, 6, -111, 0 может быть введена в память следующим образом:
37
DIM A(20)
INPUT "ВВЕДИТЕ КОЛИЧЕСТВО ЭЛЕМЕНТОВ МАССИВА";N
FOR I=1 TO N : PRINT "ВВЕДИТЕ A(";I;")"; : INPUT A(I) : NEXT
var N,I:integer; a:array[1..20] of integer;
begin
write('Введите количество элементов массива '); readln(N);
for I:=1 to N do begin
write('Введите A[', I, '] '); readln(A[I]); end;
end.
Над элементами массивами чаще всего выполняются такие действия, как
а) поиск значений;
б) сортировка элементов в порядке возрастания или убывания;
в) подсчет элементов в массиве, удовлетворяющих заданному условию.
Cумму элементов массива можно подсчитать по формуле S=S+A[I] первоначально
задав S=0. Количество элементов массива можно подсчитать по формуле К=К+1,
первоначально задав К=0. Произведение элементов массива можно подсчитать по формуле
P = P * A[I], первоначально задав P = 1.
Пример 4-3. Дан линейный массив целых чисел. Подсчитать, сколько в нем различных
чисел.
Идея решения: заводим вспомогательный массив, элементами которого являются
логические величины (0 - если элемент уже встречался ранее, 1-иначе)
DIM A(50),LO(50)
INPUT "ВВЕДИТЕ КОЛИЧЕСТВО ЭЛЕМЕНТОВ МАССИВА";N
FOR I=1 TO N
PRINT "ВВЕДИТЕ A(";I;")";
INPUT A(I)
LO(I)=1:' ЗАПОЛНЯЕМ ВСПОМОГАТЕЛЬНЫЙ МАССИВ ЗНАЧЕНИЯМИ TRUE
NEXT
KOL=0
' ПЕРЕМЕННАЯ, В КОТОРОЙ БУДЕТ ХРАНИТЬСЯ КОЛИЧЕСТВО РАЗЛИЧНЫХ ЧИСЕЛ
FOR I=1 TO N
IF LO(I)=1 THEN
KOL=KOL+1
FOR K=I TO N
' ВО ВСПОМОГАТЕЛЬНЫЙ МАССИВ ЗАНОСИМ ЗНАЧЕНИЕ FALSE,
' ЕСЛИ ЧИСЛО УЖЕ ВСТРЕЧАЛОСЬ РАНЕЕ ИЛИ СОВПАДАЕТ С ТЕКУЩИМ
' ЭЛЕМЕНТОМ A(I)
LO(K)=(A(K)<>A(I)) AND LO(K)
NEXT
ENDIF
NEXT
PRINT "КОЛИЧЕСТВО РАЗЛИЧНЫХ ЧИСЕЛ:"; KOL
var
I, N, K, Kol:integer;
A:array [1..50] of integer; Lo:array [1..50] of boolean;
begin
write('Введите количество элементов массива: '); readln(N);
for I:=1 to N do begin write('A[',I,']='); readln (A[I]);
Lo[I]:=true; {Заполняем вспомогательный массив значениями true}
end;
kol:=0;
{переменная, в которой будет храниться количество различных чисел}
for I:=1 TO N do
if Lo[I] then begin kol:=kol+1;
for K:=I to N do
{Во вспомогательный массив заносим значение False,
если число уже встречалось ранее или совпадает с текущим
элементом A[I]}
lo[K]:=(A[K]<>A[I]) and Lo[K]; end;
writeln('Количество различных чисел: ', Kol)
end.
Тест: N = 10; элементы массива - 1, 2, 2, 2, -1, 1, 0, 34, 3, 3. Ответ: 6.
38
Пример 4-4. Дан линейный массив. Упорядочить его элементы в порядке
возрастания.
Идея решения: пусть часть массива (по K-й элемент включительно) отсортирована.
Нужно найти в неотсортированной части массива минимальный элемент и поменять
местами с (K+1)-м
DIM A(30)
INPUT "ВВЕДИТЕ КОЛИЧЕСТВО ЭЛЕМЕНТОВ МАССИВА"; N
FOR I = 1 TO N
PRINT "ВВЕДИТЕ A("; I; ")";
INPUT A(I)
NEXT
FOR I = 1 TO N
FOR j = 1 TO N - 1
IF A(j) >= A(j + 1) THEN SWAP A(j), A(j + 1)
NEXT
NEXT
FOR I = 1 TO N
PRINT A(I);
NEXT
var N,I,J,K,Pr:integer; A:array[1..30] of integer;
begin
write('Введите количество элементов: '); readln(N);
for I:=1 to N do
begin
write('Введите A[',I,']'); readln(A[I]);
end;
writeln;
for I:=1 to N-1 do
begin
K:=I;
for J:=I+1 to N do
if A[J]<=A[K] then K:=J;
pr:=A[I]; A[I]:=A[K]; A[K]:=Pr;
end;
for I:=1 to N do write(A[I], ' ');
end.
Если два массива являются массивами эквивалентых типов, то возможно
присваивание одного массива другому. Такая операция возможна только в Паскале. При
этом все компоненты присваиваемого массива копируются в тот массив, которому
присваивается значение. Типы массивов будут эквивалентными, если эти массивы
описываются совместно или описываются идентификатором одного и того же типа.
Например, в описании
Type Massiv = Array[1..10] Of Real;
Var A,B: Massiv; C,D:Array[1..10] Of Real; E:Array[1..10] Of Real;
типы переменных A, B эквивалентны, и поэтому данные переменные совместимы по
присваиванию; тип переменных C, D также один и тот же, и поэтому данные переменные
также совместны по присваиванию. Но тип переменных C, D не эквивалентен типам
переменных A, B, E, поэтому, например, A и D не совместны по присваиванию. Эти
особенности необходимо учитывать при работе с массивами.
Матрицы
При решении практических задач часто приходится иметь дело с различными
таблицами данных, математическим эквивалентом которых служат матрицы. Такой способ
организации данных, при котором каждый элемент определяется номером строки и номером
столбца, на пересечении которых он расположен, называется двумерным массивом или
39
матрицей. Если же матрица имеет только одну строку, или один столбец, то она называется
вектором. В принципе одномерный массив всегда является вектором.
Например, данные о планетах Солнечной системы представлены следующей
таблицей:
Планета
Меркурий
Венера
Земля
Марс
Юпитер
Сатурн
Расст. до
Солнца
57.9
108.2
149.6
227.9
978.3
1429.3
Относ. объем
Относ. масса
0.06
0.92
1.00
0.15
1345.00
767.00
0.05
0.81
1.00
0.11
318.40
95.20
Их можно занести в память компьютера, используя понятие двумерного массива.
Положение элемента в двумерном массиве определяется двумя индексами. Они показывают
номер строки и номер столбца. Индексы разделяются запятой. Например: A(7, 6), D(56, 47).
Все операции над матрицами аналогичны операциям с одномерными массивами.
Единственным отличием является то, что практически всегда необходимо использование
вложенных циклов, первый из которых обеспечивает "проход" строк, а второй - "проход"
столбцов в каждой из них.
При описании массива задается требуемый объем памяти под двумерный массив,
указываются имя массива и в квадратных скобках диапазоны изменения индексов. При
выполнении инженерных и математических расчетов часто используются переменные более
чем с двумя индексами. При решении задач на ЭВМ такие переменные представляются как
компоненты соответственно трех-, четырехмерных массивов и т.д.
Однако описание массива в виде многомерной структуры делается лишь из
соображений удобства программирования как результат стремления наиболее точно
воспроизвести в программе объективно существующие связи между элементами данных
решаемой задачи. Что же касается образа массива в памяти ЭВМ, то как одномерные, так и
многомерные массивы хранятся в виде линейной последовательности своих компонент, и
принципиальной разницы между одномерными и многомерными массивами в памяти ЭВМ
нет. Однако порядок, в котором запоминаются элементы многомерных массивов, важно себе
представлять. В большинстве алгоритмических языков реализуется общее правило,
устанавливающее порядок хранения в памяти элементов массивов: элементы многомерных
массивов хранятся в памяти в последовательности, соответствующей более частому
изменению младших индексов.
Пример 4-5. Получить массив А(3,2), элементы которого в каждой строке
последовательны числу 456.
DIM A (3,2)
FOR I=1 TO 3
FOR J=1 TO 2
A(I,J)=456+I
NEXT
NEXT
var i, j : integer;
a : array [1..3, 1..2] of integer;
begin
for i:=1 to 3 do
for j:=1 to 2 do a[i,j]:=456+i
end.
40
Пример 4-6. Заполнить матрицу порядка n по следующему образцу:
1
2
3
...
n-1
n
2
1
2
...
n-2
n-1
3
2
1
...
n-3
n-2
...
...
...
...
...
...
n-2
n-3
n-4
...
2
3
n-1
n-2
n-3
...
1
2
n
n-1
n-2
...
2
1
и вывести ее на экран.
DIM A(10,10)
FOR I=1 TO 10
FOR J=I TO 10
A(I,J)=J-I+1
A(J,I)=A(I,J)
NEXT
NEXT
FOR I=1 TO 10
FOR J=1 TO 10
PRINT A(I,J);
NEXT
PRINT
NEXT
var i, j, k, n : integer; a : array [1..10, 1..10] of integer;
begin
write('введите порядок матрицы: '); readln(n);
for i := 1 to n do
for j := i to n do begin
a[i,j]:=j-i+1; a[j,i]:=a[i,j];
end;
for i := 1 to n do begin
for j := 1 to n do write(a[i, j]:4);
writeln;
end
end.
Обратите внимание на организацию вывода матрицы на экран. Сначала мы выводим
все элементы строки друг за другом, используя оператор PRINT с разделителем в виде
точки с запятой (или оператор write), а затем переходим на новую строку пустым
оператором PRINT (writeln).
Пример 4-7. Дана целочисленная квадратная матрица. Найти в каждой строке
наибольший элемент и поменять его местами с элементом главной диагонали.
DIM A(15, 15)
FOR I=1 TO 15
FOR J=1 TO 15
PRINT "A(";I;",";J;")"; : INPUT A(I,J)
NEXT
NEXT
FOR I=1 TO 15
MAX=A(I,1): IND=1
FOR J=2 TO 15
IF A(I,J)>MAX THEN MAX=A(I, J):IND=J
NEXT
SWAP A(I,I),A(I,IND)
NEXT
FOR I=1 TO 15 : FOR J=1 TO 15
PRINT A(I,J);
NEXT
PRINT
NEXT
41
var
n, i, j, max,ind, vsp : integer;
a : array [1..15, 1..15] of integer;
begin
write('введите количество элементов в массиве: '); readln(n);
for i := 1 to n do
for j := 1 to n do
begin
write('a[', i, ',', j, '] '); readln(a[i, j])
end;
for i := 1 to n do
begin
max:= a[i, 1]; ind:=1;
for j := 2 to n do
if a[i, j]>max then begin max:=a[i, j];ind:=j; end;
vsp:=a[i,i]; a[i,i]:=a[i,ind]; a[i,ind] := vsp
end;
for i := 1 to n do begin writeln;
for j := 1 to n do write(a[i,j]:3);
end; writeln
end.
Задания для самостоятельного решения
А. В массиве Q(x,r) найти количество всех чисел по модулю меньших заданного Т.
B. Числовая прямая разбита на отрезки точками А1, А2,…, Аn. Выясните какому из
отрезков принадлежит заданная точка Х.
C. Сформируйте двумерный массив N*N по следующему правилу: элементы главной
диагонали приравнять 1, ниже главной диагонали – 0, а выше – сумме индексов в строке.
D. Сожмите массив, выбросив каждый второй его элемент (дополнительные
массивы не использовать).
E. Выясните, является ли предложенный двумерный массив размером N*N
магическим квадратом, т.е. массивом, суммы элементов которого по столбцам, по
строкам и по обеим диагоналям равны.
F. Из предложенного одномерного массива размерностью S сформируйте двумерный
массив так, чтобы первая строка нового массива содержала четные по номеру элементы
исходного массива, а вторая – нечетные. Предусмотрите случай нечетности.
G. В заданном массиве К(F,F) найдите сумму элементов в каждой строке.
Сформируйте одномерный массив, содержащий полученные суммы, расположенные по
возрастанию (убыванию).
I. Дана таблица из 20 элементов. Найдите количество элементов этой таблицы,
больших среднего арифметического всех элементов.
J. Дана таблица из N элементов. Найдите разность максимального и минимального
элементов.
K. В произвольном массиве определить наибольшее количество подряд идущих
одинаковых элементов.
L. В массиве произвольной размерности подсчитать количество отрицательных и
сумму положительных элементов.
M. Все нулевые элементы массива из 20 элементов расположить в начале и
подсчитать их количество
N. Элементы заданного массива произвольной размерности расположить в
обратном порядке.
O. Осуществить циклический сдвиг элементов массива Т(20) на v позиций влево, т.е.
получить массив tv+1,…,t20,t1,…,tv . При этом необязательно v<20.
P. Известно время t1,t2,…,tn , за которое некоторую работу может выполнить
каждый из n работников бригады, работая в одиночку. Сколько времени понадобится
бригаде на выполнение этой работы, если они будут работать совместно и при условии
что никто из рабочих не "сачкует"? Что означает «сачкование» работника в численном
выражении?
42
Практикум
УСЛОВИЯ, ЦИКЛЫ, МАССИВЫ
Начнем наш очередной практикум с классической задачи.
Пример 4-8. Расположить на шахматной доске восемь ферзей так, чтобы они не
угрожали друг другу.
Прикинем, как искать эти расстановки. Поставим первого ферзя на какую-нибудь
клетку. Затем поставим второго ферзя на первую клетку и проверим, что ему не угрожает
первый. Если угрожает, то передвинем второго ферзя и снова проверим и т.д. Когда второй
ферзь окажется на допустимой клетке, возьмем третьего ферзя и будем двигать его, пока он
не окажется в допустимой позиции и т.д.
Обозначим через i порядковый номер ферзя (которого мы пытаемся поставить), а
через j - порядковый номер попытки установить этого ферзя после того, как положение
предыдущих фиксировано.
Продолжим рассмотрение нашей задачи. Итак, размещая одного ферзя за другим, мы,
в идеале, разместим последнего, восьмого, ферзя и выведем на экран получившуюся
расстановку. Однако, если прилетит розовая птица обламинго, т.е. мы не сможем поставить
на доску очередного ферзя, мы должны будем вернуться на ход назад и перейти к новому
варианту расстановки предыдущего ферзя. И затем, увеличив номер ферзя, продолжить
просмотр вариантов постановки.
В этих движениях "вперед" и "назад" и заключается основная трудность решения
данной задачи, поскольку такая схема перебора не укладывается в готовые схемы циклов
языков программирования.
Подытожим грубо наши рассуждения. Мы движемся "вперед", увеличивая номер
ферзя. Для каждого очередного ферзя мы движемся "вбок", подбирая допустимый вариант, и
переходим "вперед" к следующему ферзю, если вариант найден. Если же такое невозможно,
то мы возвращаемся на шаг "назад" и продолжаем движение "вбок", начиная с последнего
варианта, рассмотренного на этом ходе. Установив последнего ферзя, мы записываем
полученное решение.
Итак, решаем…
Для записи положения ферзей можно завести два массива X и Y по 8 элементов
каждый. НО! В среднем каждого нового ферзя мы пытаемся поставить на 32 поля. Это
грозит нам 8321030 вариантами!!! Очевидно, что каждый из ферзей стоит на своей
вертикали, значит i-го ферзя будем ставить на i-ю вертикаль, а искать будем только позицию
по горизонтали. Такой подход обеспечит нам всего 88106 вариантов, что вполне приемлемо
по времени поиска. Следовательно, нам понадобится только один массив.
Число найденных вариантов обозначим k.
Движение "вперед" начинается просто:
i=i+1
j=0
if i>8 then записываем найденный вариант.
Поиск вариантов (движение "вбок") тоже ничего сложного не содержит:
j=j+1
if j>8 then возвращаемся назад, т.е. i=i-1
if i=0 then конец работы
Проверку на взаимное расположение можно взять из решения задачи 1 занятия 2, или
сделать ее через логическую переменную, так, как будет показано в тексте примера.
Остается только расположить все элементы программы по порядку и дописать
необходимые конструкции. Поскольку как уже было сказано выше мы не укладываемся в
схемы стандартных циклов, то будем использовать метки строк и оператор безусловного
перехода goto. Хотя такой подход к программированию и не приветствуется, в нашем
случае мы пожертвуем оптимальностью кода ради простоты программы.
43
CLS
DIM y(8)
i = 0: k = 0
50 i = i + 1: j = 0: IF i >
DO
60 j = j + 1: IF j > 8 THEN
nedop = 0
FOR p = 1 TO i - 1
nedop = nedop OR y(p) =
NEXT
IF nedop THEN 60
y(i) = j: GOTO 50
100 k = k + 1
PRINT : PRINT "Вариант - ";
FOR p = 1 TO 8
PRINT y(p);
NEXT
120 i = i - 1
j = y(i)
LOOP WHILE i <> 0
END
8 THEN 100
120
j OR y(p) - p = j - i OR y(p) + p = j + i
k
label 50,60,100,120;
var y: array [1..8] of integer;
i,j,k,p: integer;
nedop: boolean;
begin
i:=0;
k:=0;
50:
i:=i+1;
j:=0;
if i>8 then goto 100;
repeat
60:
j:=j+1;
if j>8 then goto 120;
nedop:=false;
for p:=1 to i-1 do
nedop:=(nedop)
or
((y[p]+p)=(j+i));
if nedop then goto 60;
y[i]:=j;
goto 50;
100:
k:=k+1;
writeln;
writeln('Вариант - ',k);
for p:=1 to 8 do
write(y[p],' ');
120:
i:=i-1;
j:=y[i];
until i=0;
end.
(y[p]=j)
or
((y[p]-p)=(j-i))
or
Всего находится 92 варианта. Интерпретация расположения весьма проста: первое
число - позиция ферзя на 1-й вертикали, второе - на 2-й, и т.д.
Если требуется найти только одну допустимую расстановку, то алгоритм можно
упростить следующим образом.
44
1. Создаем двумерный массив 8x8 в котором будем метить поля, находящиеся под
боем ферзей.
2. i=1.
3. Проверяем массив на то, есть ли еще в нем непомеченные поля. Если таких
полей нет и i
меньше или равен 8, то начинаем все сначала( то есть i=1 и
убираем все метки из массива)
4. Случайным образом определяем поле не занятое меткой.
5. Помечаем это поле и все поля которые находятся по боем ферзя,
поставленного в это поле.
6. Увеличиваем i на 1.
7. Если i>8, то выводим результат, иначе переходим к строке 3.
type
fe = record
x,y: byte;
end;
var board: array [1..8,1..8] of boolean;
ferzi: array [1..8] of fe;
x,y,i: byte; flag: boolean; tmp: string;
begin
Randomize;
for x:=1 to 8 do for y:=1 to 8 do board[x,y]:=false;
i:=1;
repeat
flag:=true;
for x:=1 to 8 do for y:=1 to 8 do flag:=board[x,y];
if flag then begin i:=1;
for x:=1 to 8 do for y:=1 to 8 do board[x,y]:=false; end;
repeat
x:=Random(8)+1; y:=Random(8)+1;
until (not board[x,y]);
ferzi[i].x:=x; ferzi[i].y:=y;
board[x,y]:=true;
for x:=1 to 8 do for y:=1 to 8 do
begin
if (x=ferzi[i].x) or (y=ferzi[i].y) then board[x,y]:=true;
if abs(ferzi[i].x-x)=abs(ferzi[i].y-y) then board[x,y]:=true;
end;
Inc(i);
until i>8;
writeln(' abcdefgh');
for y:=1 to 8 do
begin
write(y);
for x:=1 to 8 do
begin
tmp:='+'; for i:=1 to 8 do
if (x=ferzi[i].x) and (y=ferzi[i].y) then tmp:='”';
write(tmp);
end;
writeln;
end;
end.
Обратите внимание на реализацию двумерного массива через запись.
Пример 4-9. На шахматной доске стоят ферзь и конь. Расположение каждой
фигуры задано ее координатами, причем 1-е число номер столбца, 2-е - номер строки.
Требуется написать программу, которая определяет количество полей, которые находятся
под боем этих фигур.
45
var
a : array [-1..10,-5..14] of byte;
b : array [1..2,1..8] of integer;
i, j, ife, jfe, ik, jk, ch : integer;
f1, f2 : text;
begin
b[1,1]:= 1; b[2,1]:= 2;
b[1,2]:= 1; b[2,2]:=-2;
b[1,3]:= 2; b[2,3]:= 1;
b[1,4]:= 2; b[2,4]:=-1;
b[1,5]:=-2; b[2,5]:= 1;
b[1,6]:=-2; b[2,6]:=-1;
b[1,7]:=-1; b[2,7]:= 2;
b[1,8]:=-1; b[2,8]:=-2;
readln(jfe,ife); readln(jk,ik);
for i:=1 to 8 do
for j:=1 to 8 do a[i,j]:=0;
for i:=1 to 8 do
for j:=1 to 8 do
begin
if (i=ife) then a[i,j]:=1;
if (j=jfe) then a[i,j]:=1;
if (i-j=ife-jfe) then a[i,j]:=1;
if (i+j=ife+jfe) then a[i,j]:=1;
end;
for i:=1 to 8 do
a[ik+b[1,i], jk+b[2,i]]:=1;
a[ife,jfe]:=0; a[ik,jk]:=0;
if ife=ik then
if jfe<jk then for j:=jk+1 to 8 do a[ife,j]:=0
else for j:=1 to jk-1 do a[ife,j]:=0;
if jfe=jk then
if ife<ik then for i:=ik+1 to 8 do a[i,jfe]:=0
else for i:=1 to ik-1 do a[i,jfe]:=0;
if ife-jfe=ik-jk then
if ife<ik then for i:=ik+1 to 8 do a[i,i-ik+jk]:=0
else for i:=1 to ik-1 do a[i,jk+i-ik]:=0;
if ife+jfe=ik+jk then
if ife<ik then for i:=ik+1 to 8 do a[i,jk+ik-i]:=0
else for i:=1 to ik-1 do a[i,jk-i+ik]:=0;
ch:=0;
for i:=1 to 8 do
for j:=1 to 8 do ch:=ch+a[i,j];
{Печать поля для проверки}
writeln;
for i:=8 downto 1 do
begin
write(i,' ');
for j:=1 to 8 do
if (i=ife) and (j=jfe) then write('Ф') else
if (i=ik) and (j=jk) then write('К') else
if a[i,j]=1 then write('+') else write(' ');
writeln
end;
writeln(' abcdefgh');
writeln(ch);
end.
46
CLS
DIM a(12, 20), b(2, 8)
b(1, 1) = 1: b(2, 1) = 2
b(1, 2) = 1: b(2, 2) = -2
b(1, 3) = 2: b(2, 3) = 1
b(1, 4) = 2: b(2, 4) = -1
b(1, 5) = -2: b(2, 5) = 1
b(1, 6) = -2: b(2, 6) = -1
b(1, 7) = -1: b(2, 7) = 2
b(1, 8) = -1: b(2, 8) = -2
INPUT jfe, ife
INPUT jk, ik
FOR i = 1 TO 8
FOR j = 1 TO 8
a(i, j) = 0
NEXT
NEXT
FOR i = 1 TO 8
FOR j = 1 TO 8
IF i = ife THEN a(i, j) = 1
IF j = jfe THEN a(i, j) = 1
IF (i - j) = (ife - jfe) THEN a(i, j) = 1
IF (i + j) = (ife + jfe) THEN a(i, j) = 1
NEXT
NEXT
FOR i = 1 TO 8
a(ik + b(1, i), jk + b(2, i)) = 1
NEXT
a(ife, jfe) = 0: a(ik, jk) = 0
IF ife = ik THEN
IF jfe < jk THEN
FOR j = jk + 1 TO 8
a(ife, j) = 0
NEXT
ELSE
FOR j = 1 TO jk - 1
a(ife, j) = 0
NEXT
END IF
END IF
IF jfe = jk THEN
IF ife < ik THEN
FOR i = ik + 1 TO 8
a(i, jfe) = 0
NEXT
ELSE
FOR i = 1 TO ik - 1
a(i, jfe) = 0
NEXT
END IF
END IF
IF (ife - jfe) = (ik - jk) THEN
IF ife < ik THEN
FOR i = ik + 1 TO 8
a(i, i - ik + jk) = 0
NEXT
ELSE
FOR i = 1 TO ik - 1
a(i, jk + i - ik) = 0
NEXT
END IF
END IF
IF (ife + jfe) = (ik + jk) THEN
IF ife < ik THEN
47
FOR i = ik + 1 TO 8
a(i, jk + ik - i) = 0
NEXT
ELSE
FOR i = 1 TO ik - 1
a(i, jk - i + ik) = 0
NEXT
END IF
END IF
ch = 0
FOR i = 1 TO 8: FOR j = 1 TO 8
ch = ch + a(i, j)
NEXT: NEXT
REM Печать поля для проверки
PRINT
FOR i = 8 TO 1 STEP -1
PRINT i; " ";
FOR j = 1 TO 8
IF (i = ife) AND (j = jfe) THEN
PRINT "Ф";
ELSE
IF (i = ik) AND (j = jk) THEN
PRINT "К";
ELSE
IF a(i, j) = 1 THEN PRINT "+";
END IF
END IF
NEXT
PRINT
NEXT
PRINT "
abcdefgh":
PRINT ch
ELSE PRINT " ";
Пример 4-10. Реализовать на двух массивах выполнение строевых команд "ряды
сдвой" и "сомкнись". Т.е. из массива А элементы с четными индексами нужно перенести в
начало массива В, а оставшиеся - сдвинуть к началу массива А.
Пересылка из А в В очевидна и выполняется в одном цикле с пересчетом индексов.
Для удаления образовавшихся "пустот" в А возможны следующие подходы:
- передвинуть элементы, начиная с 3-го и до конца, на одну позицию, затем,
начиная с 5-го, еще на одну позицию и так далее - за несколько проходов массива
А;
- передвигать каждый раз элемент массива А на новое место, вычисляя каждый раз,
на сколько позиций он сдвинется - при этом требуется только один проход
массива;
- совместить пересылку в В со сдвигом в А - все в одном цикле.
Очевидно, что наиболее эффективен третий подход. Его реализация весьма проста:
k:=n div 2; {n - кол-во элементов в А}
for i:=1 to k-1 do begin
b[i]:=a[2*i]; {пересылка}
a[i+1]:=a[2*i+1]; {сдвиг}
end;
b[k]:=a[2*k]; {последняя пересылка: сдвигать нечего}
И о размерностях массивов. Размерность массива А должна быть четной, а
размерность массива В - ровно в 2 раза меньше.
48
Пример 4-11. В данном массиве найти количество различных элементов.
Самое простое решение:
1. Сортируем массив (причем, неважно, по возрастанию или по убыванию)
2. В отсортированном массиве проверяем на равенство рядом стоящие пары:
а1 и а2, а2 и а3 и т.д. Если равенство не наблюдается, то соответственно
это различные элементы.
Пример 4-12. В массиве Z(m) найти число чередований знака, т.е. число переходов с
плюса на минус или наоборот. Например, в последовательности 0,-2,0,-10,2,-1,0,0,3,2,-3
четыре чередования (ноль не имеет знака)
Алгоритм решения прост: вначале выбрасываем все нулевые элементы (или
перемещаем их в конец массива), а затем, как и в задаче 2 проверяем попарно произведение
элементов. При условии, что произведение становится отрицательным - имеет место факт
знакочередования.
var z:array[1..20] of integer;
m,k,n:integer;
begin
z[1]:=0; z[2]:=-2; z[3]:=0; z[4]:=-10; z[5]:=2; z[6]:=-1;
z[7]:=0; z[8]:=0; z[9]:=3; z[10]:=2; z[11]:=-3;
for m:=1 to 11 do write (' ',z[m]); writeln;
for n:=1 to 11 do begin
for m:=1 to 11 do begin
if z[m]=0 then begin z[m]:=z[m+1]; z[m+1]:=0; end;
end;
end;
for m:=1 to 11 do write (' ',z[m]); writeln;
for m:=1 to 10 do if z[m]*z[m+1]<0 then k:=k+1;
write (' Число чередований знака в данном массиве равно ',k);
readln; end.
CLS
DIM z(21): z(21) = 0
10 INPUT "Число элементов ", n
if n>20 then goto 10
FOR i = 1 TO n
PRINT "Введи z("; i; ")"; : INPUT z(i)
NEXT
FOR i = 1 TO n
FOR j = 1 TO n - 1
IF z(j) = 0 THEN SWAP z(j), z(j + 1)
NEXT
NEXT
FOR j = 1 TO n - 1
IF z(j) * z(j + 1) < 0 THEN z(21) = z(21) + 1
NEXT
PRINT "Число чередований знака в данной последовательности равно"; z(21)
Пример 4-13. Поле размером mxn заполнено прозрачными и непрозрачными
кубиками. Найти все столбцы поля, все непрозрачные кубики которых невидимы для
наблюдателя, расположенного слева.
const n=4;m=5; {размеры массива}
var a:array[1..n,1..m] of integer;
b:array[1..n] of integer; {вспомогательный массив, в котором
храниться номер столбца, в котором впервые в этой строчке
встретилась 1}
i,j,k,max:integer;
flag,est,bilo:boolean;
begin
writeln('see -->'); {чтобы не забыли с какой стороны смотрим}
49
randomize;
for i:=1 to n do begin {автозаполнение и распечатка матрицы}
for j:=1 to m do begin {1-непрозрачный}
a[i,j]:=random(2);
{0-прозрачный}
write(a[i,j]:4);
end; writeln; end;
for i:=1 to n do {заполнение массива b}
begin
j:=1; flag:=true;
while (j<=m) and flag do begin
if a[i,j]=1 then begin b[i]:=j; flag:=false; end;
inc(j); end; end;
writeln;
bilo:=false;{индикатор существования "невидимых" столбцов}
for j:=2 to m do
{проход по столбцам, первый столбец заведомо "плохой"}
begin
flag:=true;{видит ли этот столбец наблюдатель}
est:=false;
{встретилась ли 1 в столбце, считаем, что если в столбце
не было 1, то столбец не удовлетворяет условию задачи, в целом же
это не так важно, и легко исправляется исключением этой переменной}
for i:=1 to n do {проход по столбцу вниз по 1}
if (a[i,j]=1) then begin est:=true;
if b[i]>=j then flag:=false; {если хотя бы один
непрозрачный кубик виден, то отмечаем это}
end;
if flag and est then begin writeln(j,'столбец содержит непрозрачные
кубики и все они невидимы для наблюдателя'); bilo:=true; end;
end;
if not bilo then writeln ('все слишком прозрачно');
readln; end.
САМОСТОЯТЕЛЬНАЯ РАБОТА
1-4-1. Лотерея
Дана таблица выигрышей денежной лотереи: K(n) - массив номеров выигравших
билетов, упорядоченный по возрастанию, S(n) - суммы выигрышей. Определить суммарный
выигрыш для пачки купленных билетов с номерами L(m).
1-4-2. Подматрица
В матрице, состоящей из нулей и единиц, найти квадрат заданного размера
(квадратную подматрицу), состоящий целиком из нулей.
1-4-3. Латинский квадрат
Латинским квадратом порядка n называется квадратная таблица размером n n,
каждая строка и каждый столбец которой содержит все числа от 1 до n. Для заданного n
в матрице L (n,n) построить латинский квадрат порядка n.
1-4-4. Суммы по косой.
Просуммировать элементы матрицы A (n,n) по каждой из линий, параллельных
главной диагонали. Напечатать полученные суммы.
1-4-5. Замочная скважина.
Даны мозаичные изображения замочной скважины и ключа. Пройдет ли ключ в
скважину? То есть, даны матрицы K (m1, n1) и L (m2, n2), m1 > m2, n1 > n2, состоящие из
нулей и единиц. Проверить, можно ли наложить матрицу L на матрицу K так, чтобы
каждой единице матрицы L соответствовал нуль в матрице K?
50
1-4-6. Задачка для Штирлица
Шифровка текста с помощью решетки заключается в следующем. Решетка, т.е.
квадрат из клетчатой бумаги 10х10 клеток, некоторые клетки в котором вырезаны,
совмещается с целым квадратом 10х10 клеток и через прорези на бумагу наносятся первые
буквы текста. Затем решетка поворачивается на 900 и через прорези записываются
следующие буквы. Это повторяется еще дважды. Таким образом, на бумагу наносится 100
букв текста. Решетку можно изображать квадратной матрицей порядка 10 из нулей и
единиц (нуль изображает прорезь).
Даны последовательность из 100 букв и матрица ключ.
А) Зашифровать данную последовательность.
Б) Расшифровать данную последовательность.
1-4-7. Идем в школу
Даны натуральное число n, действительные числа a,b, x1 , y1 ,…, xn , yn . Пара а, бкоординаты школы микрорайона, а пары xi , yi (i=1,…, n)-соответственно координаты
домов этого микрорайона. Найти
расстояние от домов до школы и среднее
арифметическое этих расстояний.
1-4-8. Оценка судей
В некоторых видах спортивных состязаний выступление каждого спортсмена
независимо оценивается несколькими судьями, затем из всей совокупности оценок
удаляются наиболее высокая и наиболее низкая, а для оставшихся оценок вычисляется
среднее арифметическое этих расстояний. Написать программу выставления оценок.
51
ПРОСТЕЙШИЕ ГРАФИЧЕСКИЕ ПОСТРОЕНИЯ
Все нужно проектировать сверху вниз, за исключением фундамента, с которого нужно начинать.
А.Лавлейс
Любое изображение состоит из точек. Если посмотреть на экран монитора или
телевизора через увеличительное стекло, то мы увидим, что экран представляет собой
мозаику точек, каждая из которых окрашена в тот или иной цвет.
В информатике экранная точка называется пикселем. Как и любая другая точка на
плоскости, пиксель имеет координаты.
С помощью программ, по-разному располагая и окрашивая точки, вы можете
формировать геометрические фигуры, рисовать диаграммы и графики функций, красочные
картинки и т.п. Комбинируя программными средствами можно создавать различные
визуальные эффекты – от нарядного калейдоскопа до имитации движения людей и
предметов. Это называется анимацией.
Оператор SCREEN
При запуске среды программирования экран компьютера автоматически готов для
вывода текста. Однако если вы хотите рисовать, то должны установить один из графических
режимов экрана. В Бейсике это сделать это можно, используя оператор SCREEN.
SCREEN номер режима
Графические режимы характеризуются количеством точек по вертикальной и
горизонтальной осям экрана. Начало системы координат, т.е. точка с координатами (0,0),
расположена в верхнем левом углу экрана. Последняя точка находится в нижнем правом
углу.
(0,0)
640
(320,240)
480
(639,479)
Режим
1
2
7
8
9
10
11
12
Число точек
320 х 200
640 х 200
320 х 200
640 х 200
640 х 350
640 х 350
640 х 480
640 х 480
Цвета
4
2
16
16
16
2
2
16
Перечень доступных режимов экрана показан в таблице
Для перехода в графический режим на Паскале потребуется немного больше усилий.
Программа, работающая с графикой, всегда (!) будет иметь следующую структуру:
Uses graph;
Var gd,gm: integer;
подключаем модуль работы с графикой
gd: переменная для видеодрайвера
gm: переменная для режима экрана
Begin
Gd:=Detect;
определяем тип видеодрайвера
Gm:=0;
устанавливаем режим экрана 640х480
InitGraph(gd,gm,’’);
оператор инициализации графики
Внимание: в каталоге с исходным или
компилированным модулем программы
должен находиться файл egavga.bgi.
В противном случае между апострофами
следует вписать путь к этому файлу
<операторы построения изображения>
CloseGraph;
выход из графического режима
End.
52
1
2
3
Точки
Отдельный пиксель можно “зажечь” заданным цветом любой из двух универсальных
команд графического режима в языке Бейсик:
PRESET (X,Y) [,C]
PSET (X,Y)[,C]
Формат команд одинаков: сначала указываются координаты точки, а затем, если
необходимо – номер цвета точки. Если цвет указан, действие команд совершенно одинаково:
точка окрашивается цветом С. Если цвет опущен, PSET окрашивает точку текущим цветом
символов, а PRESET – текущим цветом фона (она будет невидимой).
В Паскале аналогичную функцию выполняет оператор PutPixel(X,Y,C). Формат
команды: сначала указываются координаты точки, а затем, номер цвета точки.
Пример 5-1. Изобразить на экране три точки в виде светофора.
SCREEN 9
PSET (240, 100), 4
PSET (240, 120), 14
PSET (_____, _____), 2
точка красного цвета
точка желтого цвета
точка зеленого цвета
PutPixel (240, 100, 4);
PutPixel (240, 120, 14);
PutPixel (_____, _____, 2);
В этом и некоторых других примерах читателю предоставляется возможность самому закончить
программы, а также поэкспериментировать, что в случае с графикой приводит к интересным, а иногда и
неожиданным, результатам.
Прямые линии – отрезки
Оператор LINE предназначен для рисования отрезка, соединяющего две произвольные
точки экрана. В Бейсике команда имеет вид
LINE(X1,Y1)-(X2,Y2)[,C]
X1,Y1 - координаты начала отрезка, X2,Y2 - координаты конца отрезка, С - цвет.
В Паскале оператор построения линии записывается в виде Line (X1,Y1,X2,Y2)
Например:
LINE (10,10)-(100,165) или
Line (10,10,100,165)
будет нарисован отрезок от точки с координатами 10,10 до точки с координатами 100,165.
Рисование прямоугольников
Конечно, можно нарисовать прямоугольник с помощью операторов LINE, повторяя их
четыре раза для рисования четырех сторон, но можно для этой цели выбрать более простой
путь. В Бейсике достаточно указать параметр ‘В’. Приведем запись оператора в полном
виде:
LINE(X1,Y1)-(X2,Y2)[,C],B[F]
X1, Y1 – координаты левой верхней вершины прямоугольника
X2, Y2 – координаты правой нижней вершины прямоугольника
В – параметр, указывающий на рисование прямоугольника.
F – параметр, указывающий на рисование закрашенного прямоугольника.
В Паскале для построения прямоугольника используется прямой семантический
оператор Rectangle(X1,Y1,X2,Y2). Смысл координат такой же, как и в Бейсике.
Пример 5-2. Нарисовать несколько вложенных прямоугольников.
SCREEN ____
LINE (10,10)-(200,200),,В
LINE (20,20)-(190,190),,В
LINE (_____, _______) - (_____, _______) _____
LINE (_____, _______) - (_____, _______) _____
53
Rectangle
Rectangle
Rectangle
Rectangle
(10,10,200,200);
(20,20,190,190);
(_____, _______,_____, _______);
(_____, _______,_____, _______);
Работаем в цвете
Способность монитора воспроизводить 16 цветов позволяет выбрать цвет рисования и
цвет фона.
Формат в Бейсике:
COLOR [C] [,F]
С-цвет символов
F-цвет фона
В Паскале:
SetColor(C)
С-цвет символов
SetBkColor(F) F-цвет фона
Таблица. Коды и соответствующие цвета.
Код
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Цвет
Черный
Синий
Зеленый
Голубой
Красный
Пурпурный
Коричневый
Светло-серый
Темно-серый
Светло-синий
Светло-зеленый
Светло-голубой
Светло-красный
Светло-пурпурный
Желтый
Белый
(black)
(blue)
(green)
(cyan)
(red)
(magenta)
(brown)
(lightgray)
(darkgray)
(lightblue)
(lightgreen)
(lightcyan)
(lightred)
(lightmagenta)
(yellow)
(white)
Обратите внимание на следующие моменты.
1. По умолчанию цвет рисования - белый
2. Оператор цвета в Бейсике практически не используется: в каждом операторе есть
возможность прямо указать цвет рисования
3. В Паскале операторы цвета обязательны (если вы не рисуете все белым) и их
придется использовать каждый раз для смены цвета рисования.
4. В Паскале вместо номера цвета можно использовать указанные англоязычные
наименования.
Окружности, дуги, сектора
С помощью оператора CIRCLE можно нарисовать окружность.
Формат в Бейсике:
CIRCLE(X,Y),R[,C]
X,Y – координаты центра окружности
R – радиус окружности
Чтобы нарисовать дугу, эллипс или сектор окружности необходимо добавить новые
параметры в оператор CIRCLE.
CIRCLE(X,Y),R,C,N,K,A
X,Y – координаты центра окружности;
R – радиус окружности;
C – цвет;
N – начальная точка дуги, заданная в радианах;
K – конечная точка дуги, заданная в радианах;
A – отношение значений Y- радиуса и Х - радиуса.
54
Для рисования окружности используются только параметры X,Y и радиус. Для
рисования дуги необходимо добавить значения параметров начальной и конечной точек.
Значения параметров начальной и конечной точек задаются в радианах и должны иметь
значения между 0 и 2π радиан (2π =6.28). При рисовании дуги отсчет идет от начальной
точки дуги до конечной в направлении против часовой стрелки.
При отрицательных значениях этих параметров начальные и конечные точки дуги
соединяются с центром соответствующей окружности. Таким образом, на экране получается
изображение сектора окружности. Если отрицательным является значение только одного
параметра, то и соединяться с центром окружности будет только одна точка дуги.
900 /2
1800

0/3600
0/2
3/2 2700
Пример 5-3:
CIRCLE (100,100) , 30
CIRCLE(180,100) , 30 , 3 , 1 , 2
CIRCLE(260,100) , 30 , 3 , -2,-1
Circle (100,100, 30);
Arc (180,100, 1 , 2, 30);
PieSlice (260,100, 2 , 1, 30);
Для рисования эллипса нужно ввести в оператор CIRCLE коэффициент отношения
радиусов по осям Y и X - k. Этот параметр определяет степень сжатия эллипса и может
иметь любое положительное значение. При значении 0<k<1 эллипс вытянут по оси Х, при
значении 1<k<2 эллипс вытянут по оси Y.
Пример 5-4:
CIRCLE (100,100) , 30
CIRCLE(180,100) , 30 , , , , 0.3
CIRCLE(260,100), 30 , , , , 1.5
Ellipse (100,100, 0, 6.28, 30, 30);
Ellipse (180,100, 0, 6.28, 30 , 9);
Ellipse (260,100, 0, 6.28, 30 , 45);
Разберем теперь те же самые действия в Паскале.
С помощью оператора Circle(X,Y,R) можно нарисовать окружность.
С помощью оператора Ellipse(X,Y,N,K,XR,YR) можно нарисовать эллипс.
С помощью оператора Arc(X,Y,N,K,R) можно нарисовать дугу окружности.
С помощью оператора PieSlice(X,Y,N,K,R) можно нарисовать сектор окружности.
Здесь XR, YR – радиусы эллипса по осям, N – начальная точка дуги; K – конечная
точка дуги. Значения параметров начальной и конечной точек задаются в градусах
55
«Разберите» программы и напишите, за что отвечает каждый из операторов
SCREEN 9
CIRCLE (100,100) , 70
CIRCLE (75,75) , 10 , , , , .2
CIRCLE (125,75) , 10 , , , , .2
CIRCLE (100,100) , 5 , , , , 2
LINE (100,40) – (90,60)
LINE (100,40) – (110,60)
LINE (100,40) – (100,60)
CIRCLE (100,110) , 20 , , 3.14 , 0
Circle (100,100,70);
Ellipse (75,75, 0, 360, 10, 5);
Ellipse (125,75, 0, 360, 10, 5);
Ellipse (100,100, 0, 360, 5, 10);
Line (100,40, 90,60);
Line (100,40,110,60);
Line (100,40,100,60);
Arc (100,110, 90, 0, 20);
Закрашивание областей
Рисование на экране по своей сути является контурным. Для получения реалистичных
изображений используют оператор закрашивания областей. Закрашивание областей в
Бейсике производится оператором PAINT
PAINT(X,Y),C,S
X,Y – координаты точки внутри закрашиваемой области
С - цвет закрашивания
S – цвет границы
Цвет границы не должен совпадать с цветом закрашивания и наоборот!!!
Закрашивание областей в Паскале является двух шаговым. Первый шаг – выбор цвета
и способа закрашивания
SetFillStyle(S,C)
S – стиль (способ закрашивания) С - цвет закрашивания
Стили закрашивания:
0 – сплошное закрашивание цветом фона
1 – сплошное закрашивание цветом рисования
2-11 – закрашивание по образцу
Второй шаг – использование операторов закрашивания и построения закрашенных
областей
С помощью оператора FloodFill(X,Y,С) можно закрасить любую произвольную
область. Здесь С – цвет границы (в Бейсике наоборот)
Пример 5-5: Нарисовать знак запрета проезда («кирпич»)
SCREEN 12
CIRCLE (320,240),100, 5
LINE(250,220)-(390,260),5,B
PAINT(320,200), 4, 5
PAINT(320,240), 15 ,5
56
SetColor(5);
Circle (320,240,100);
Rectangle(250,220,390,260);
SetFillStyle(1,red);
FloodFill(320,200,5);
SetFillStyle(1,white);
FloodFill(320,240,5);
С помощью оператора Bar(X1,Y1,X2,Y2) можно нарисовать закрашенный
прямоугольник. Здесь X1,Y1, X2, Y2 – координаты начала и конца диагонали
соответственно, прямоугольник рисуется и закрашивается в соответствии с первым шагом.
Аналогично, с помощью оператора FillEllipse(X,Y, XR,YR) можно нарисовать
закрашенный эллипс или круг.
Попробуйте, используя операторы Bar и FillEllipse можно записать нашу программу в
следующем виде:
SetColor(___);
SetFillStyle(____,
FillEllipse(_____,
SetFillStyle(____,
Bar(_____, ______,
______);
______, ______, ______);
______);
______, ______);
Графическое “перо” DRAW
Оператор языка Бейсик DRAW позволяет управлять движением графического “пера” с
помощью графических команд. Формат оператора
DRAW строка символов
В строке символов записывается последовательность графических команд, причем
каждая команда обозначена латинской буквой и целым числом (например, Е10, С2 и т.д.).
Число обозначает, на сколько экранных точек нужно сместиться в указанном направлении.
Движение пера начинается с текущей позиции графического курсора. Этой позицией
является последняя точка при рисовании. В начале эта точка имеет координаты 0,0.
H
U
Команда
Mx,y
B
N
E
L
R
G
D
F
An
TAn
Cn
Sn
P n,m
Выполняемое действие
Переместить в точку с координатами (x,y)
Переместить, но не рисовать
Переместить, затем вернуться в начальное
положение
Задать угол поворота 90*n (n=0,1,2,3)
Задать угол направления (n = -360…360)
Задать цвет
Задать масштаб (n = 1…225)
Закрасить область (n-цвет области, m- цвет
контура)
Пример 5-6 Нарисовать «елочку»
SCREEN 12
DRAW "BM320,240F45L45F50L50F55L45D20L10U20"
DRAW "L50E55L50E50L45E45"
57
Задания для самостоятельного решения
Используя описанные операторы построения изображений, нарисуйте следующие
полноцветные картинки.
Практикум
ГРАФИЧЕСКИЕ ЗАДАЧИ
Графику в программах можно использовать не только для создания «красивостей», но и
для иллюстрации решений.
Построение графиков на плоскости
Построение графиков на плоскости можно разделить на три этапа:
1 этап: выбор координатной системы и масштаба графика
2 этап: задание функциональной зависимости y=f(x)
3 этап: расчет таблицы значений и построение графика
SCREEN 12
LINE(320,0)-(320,480),3
LINE(0,240)-(640,240),3
FOR X=A TO B
Y=F(X)
PSET(X+320,240-INT(Y)),14
NEXT
setcolor(3);
line(320,0,320,480);
line(0,240,640,240);
for x:=a to b do begin
y:=f(x);
putpixel(x+320, 240-round(y),14);
end;
Использование дополнительных коэффициентов в операторах построения точек
графика поясняет приведенный рисунок.
58
Выполнение данной программы приведет к тому, что на экране отобразится некоторое
точек по указанной нами зависимости.
Модернизируем программу для улучшенного отображения графика функции. Для
увеличения количества точек, образующих график, без изменения начального и конечного
значений интервала достаточно изменить шаг увеличения аргумента. Заменим фрагмент
программы с циклом построения графика на следующий:
FOR X=A TO B STEP 0.01
x:=a;
while x<=b do begin
y:=f(x);
putpixel(round(x*10)+320, 240-round(y*10),14);
x:=x+0.1;
end;
Следует также учитывать, что все математические закономерности, а именно область
допустимых значений функции, имеют смысл и при построении графиков с помощью
программы. Поэтому следует быть внимательным при выборе начального и конечного
значений аргумента, а также при необходимости исключать точки, в которых функция не
имеет значения.
Визуализация трехмерного пространства
В отличие от двухмерной системы координат, привычной нам на плоскости, система
координат в пространстве отличается наличием третьей координатной оси.
Построим на экране пространственную систему координат. Начало системы
расположим в центре экрана, ось Х проведем вправо, ось Z – вверх, ось Y – влево вниз.
Конечными точками будем считать границы экрана.
320,240
Построение поверхностей
Будем называть поверхностью некоторую фигуру в пространстве, которую можно
получить каким-либо перемещением обычной простой фигуры.
Построение поверхностей можно также разделить на три этапа:
1 этап: выбор базовой фигуры
2 этап: определение начальных и конечных параметров базовой фигуры
3 этап: задание изменяемых величин и построение поверхности
Рассмотрим построение цилиндра, как наиболее простой фигуры.
Обозначим центры верхней и нижней частей цилиндра. Мы
видим, что у нас изменилась только координата Y. Следовательно,
задав изменение этой координаты и записав оператор построения
эллипса в этих пределах мы получим ряд эллипсов, которые визуально
образуют цилиндр. Радиус особого значения не имеет, важно лишь
соблюсти соотношение 1:2, характерное для «идеального» эллипса.
59
FOR Y=100 TO 200 STEP 3
CIRCLE(450,Y),50,,,,0.5
NEXT
y:=100;
while y<=200 do begin
ellipse(450, y, 0, 360, 50, 25)
y:=y+3;
end;
Внешний вид цилиндра будет зависеть от значения шага изменения величины y.
Построим теперь более сложную поверхность, называемую однополостным
гиперболоидом. Эта поверхность получается вращением параболы вокруг своей оси.
Рассмотрим эту фигуру.
Мы видим, что помимо изменения координаты по оси Y у нас имеет
место и изменение радиуса эллипсов, из которых получается наша фигура.
Следовательно, нам необходимо найти зависимость величины радиуса от
величины координаты.
Запишем фрагмент программы для построения этой поверхности:
FOR Y=_______ TO ______ STEP 3
R=______________________
CIRCLE(_____, Y),R,,,,R/(R\2)
NEXT
y:=________;
while y<=________ do begin
r:=______________________________;
ellipse(_____, y, 0, 360, r, round(r/2));
y:=y+3;
end;
Обратите внимание на то, что величины радиусов обязательно округляются.
По аналогичному принципу постройте следующие поверхности:
а) куб
б) однополостный параболоид (вращение правой или левой части
параболы перпендикулярно ее оси)
Подсказка:
а)
б)
Анимация и движение
Использование циклов в графических программах также необходимо при
программировании простейшей анимации. В качестве примера приведем несколько таких
задач. Следует отметить, что все динамические программы используют относительные
координаты графических объектов и строятся по следующей схеме:
1. Задание способа изменения координат объекта через цикл
2. Рисование объекта
3. Организация временной задержки (паузы)
4. Стирание объекта
Самым простым примером является организация движения точки по экрану:
60
FOR X=0 TO 640
PSET(X,240),14
FOR T=0 TO 5000: NEXT
PRESET(X,240)
NEXT
изменение координаты
рисуем точку
пауза
стираем точку
for x:=0 to 640 do begin
putpixel(x,240,14);
delay(1000);
putpixel(x,240,0);
end;
изменение координаты
рисуем точку
пауза
стираем точку
Значение параметра паузы подбирается
восприятию эффекта анимации.
Также легко построить и «бегущий» отрезок.
экспериментально
FOR X=0 TO 640
LINE(X,240)-(X+20,240),4
FOR T=0 TO 5000: NEXT
LINE(X,240)-(X+20,240),0
NEXT
по
наилучшему
длина отрезка 20 пикселов
for x:=0 to 640 do begin
setcolor(4); line (x,240,x+20,240);
delay(1000);
setcolor(0); line (x,240,x+20,240);
end;
Задав нужное количество повторений, можно запрограммировать эффект прыгающего мяча.
FOR K=0 TO 5
FOR Y=240 TO 440
CIRCLE(320,Y),40,2
FOR T=0 TO 5000: NEXT
CIRCLE(320,Y),40,0
NEXT
FOR Y=440 TO 240 STEP -1
CIRCLE(320,Y),40,2
FOR T=0 TO 5000: NEXT
CIRCLE(320,Y),40,0
NEXT
NEXT
количество повторений
движение вниз
движение вверх
for k:=0 to 5 do begin
количество повторений
for y:=240 to 440 do begin
setcolor(2); circle(320,y,40);
delay(3000);
движение вниз
setcolor(0); circle(320,y,40);
end;
for y:=440 downto 240 do begin
setcolor(2); circle(320,y,40);
delay(3000);
движение вверх
setcolor(0); circle(320,y,40); end;
end;
Интересна и реализация эффекта солнечного затмения.
CIRCLE(320,240),80,4: PAINT(320,240),14,4
FOR X=200 TO 320
CIRCLE(X,240),80,0
FOR T=0 TO 5000: NEXT
NEXT
Интересные эффекты можно получить, используя оператор закрашивания. Например,
эффект неоновой рекламы получается чередованием закрашивания различными цветами
заранее нарисованного контура какой-либо надписи.
САМОСТОЯТЕЛЬНАЯ РАБОТА
61
1-5-1. Гистограмма
Столбчатая диаграмма (гистограмма) представляет собой набор прямоугольников,
основания которых равны, а высоты пропорциональны числовым величинам, взятым из некоторой
совокупности. Для большей наглядности прямоугольники диаграммы обычно закрашивают в разные
цвета.
1-5-2. Диаграмма
Даны семь действительных положительных чисел 1 ,  2 ………  7 . Построить секторную
диаграмму для этих значений.
1-5-3. Часы
Получить на экране изображение действующих электронных часов, показывающих текущие
время. Шаблоны используемых цифр должны соответствовать обычному для электронных часов
семисегментному шаблону.
1-5-4. Кодированное изображение
Дана целочисленная квадратная матрица порядка n. Каждый элемент матрицы ставится в
соответствие точке, принадлежащей квадратной области экрана размером nn точек. Левый
верхний угол области имеет координаты 00. Соответствие между элементами матрицы и
точками области экрана устанавливается следующем образом: элемент матрицы, стоящий в
строке с номером i и в столбце с номером j, соответствует точке экрана, находящейся на
пресечении строки точек области с номером i и столбца точек с номером j. Полагая, что каждый
элемент матрицы задает цвет соответствующей точке экрана, получить на экране изображение,
закодированное в матрице А.
1-5-5. Кодированное изображение-1
Даны 2 целочисленные квадратные матрицы порядка n. В каждой из матриц закодировано
изображение прямоугольной области экрана размером n*n точек с координатами левого верхнего
угла 0,0. Все элементы обеих матриц – это числа, равные нулю, если точка составляет фон, или
единице, если точка - часть изображения. Получить на экране изображение, являющиеся:
а) пересечением изображений, закодированных в первой и второй матрицах;
б) объединением изображений, закодированных в первой и второй матрицах.
1-5-6. Калейдоскоп
Построение калейдоскопа выполнять следующим образом. В центре экрана должен быть
изображен правильный шестиугольник, вершины которого соединены с его
центром. Исходный треугольник должен быть рассечен несколькими прямыми,
количество и расположение которых выбирается с помощью датчика случайных
чисел. Каждая из полученных таким образом частей треугольника должна быть
закрашена случайным цветом. После этого изображение в каждом следующем
треугольнике при движении по или против часовой стрелки должно быть
получено симметричным отображением изображения, сформированного в
предыдущем треугольнике, относительно их общей стороны. Организовать
динамическую смену изображения на экране.
1-5-7. Спирограф
Спирограф – это зубчатый диск радиуса В, расположенный внутри колеса радиуса А. Диск вращается
против часовой стрелки и всегда находится в зацеплении с внешним колесом. В диске имеется небольшое
отверстие на расстоянии D от центра диска, в которое помещается карандаш. Грифель карандаша в
процессе вращения вычерчивает рисунок; вычерчивание заканчивается, когда карандаш возвращается в
исходное положение. Уравнение кривой, вычерчиваемой грифелем в параметрической форме имеет вид:
x=(A-B)cos t + D cos,
y=(A-B)sin t – D sin,
 = (A/B)t, D<B<A, t[0,2n], n=B/НОД(А,В)
Реализовать программу, моделирующую спирограф.
62
ДОПОЛНИТЕЛЬНЫЕ СРЕДСТВА ЯЗЫКОВ ПРОГРАММИРОВАНИЯ
Через пять лет у нас будет один суперязык
программирования, только мы не можем
установить начало этого пятилетнего периода.
У.Роджерс.
Работа со строками
Языки Бейсик и Паскаль имеют набор функций для работы с символьными
переменными. В Паскале строковая величина определяется типом string, в Бейсике
признаком строковой переменной является символ $. Длина строки не может превышать 255
символов. Бейсик автоматически резервирует место в памяти равное максимальной длине
строки, в Паскале возможно предварительное указание длины строки (в виде string[g],
где g – предполагаемая длина строки.) Кроме того, Паскаль имеет тип char для хранения
строки в один символ. Паскаль рассматривает строку как массив символов, поэтому имеется
возможность обращаться напрямую к любому символу строки, что будет показано ниже в
примерах.
Функции LEN (Бейсик) и length (Паскаль) предназначены для определения длины
символьного выражения
LEN (строковая величина)
length (строковая величина)
В Бейсике существует несколько функций, позволяющих выделять символы из
текстового выражения.
Функция LEFT$ возвращает строку символов из n левых символов
LEFT$(строка, n)
Например:
T$=”контрабас”
A$=LEFT$(T$,6)
PRINT A$
контра
Функция RIGHT$ возвращает строку символов из n правых символов
RIGHT$(строка, n)
Например:
T$=”контрабас”
A$=RIGHT$(T$,3)
PRINT A$
бас
Если число n больше длины текста, то обе функции возвращают весь исходный текст.
Функция MID$ возвращает фрагмент из текста: n символов, начиная с k-го символа.
MID$(cтрока,k,[n])
Например:
T$=”информатика”
A$=MID(T$,3,5)
PRINT A$
форма
Если n не указано, то функция возвращает символы начиная с к-го и до конца текста.
В Паскале все описанные операции реализуются функцией copy
copy(cтрока,k,n)
Кроме этого, Паскаль содержит ряд специфических функций.
Функция insert(строка1, строка2, k) вставляет строку2 в строку1 начиная с
позиции k.
63
Например:
var a,b: string;
begin
a:=’логика’; b:=’сти’;
insert(a,b,5);
writeln(a);
логистика
end.
Функция delete(строка, k, n) удаляет в строке n символов начиная с позиции k.
Например:
var a: string[9];
begin
a:=’логистика’;
delete(a,5,3);
writeln(a);
end.
логика
Функция pos(строка1, строка2) возвращает в качестве
позиции, с которой строка2 входит в строку1 (0 – если нет)
результата номер
В Бейсике аналогичную операцию можно выполнить при помощи функции
INSTR(строка1, строка2)
Кроме вышеперечисленных функций над строками также определена операция
конкатенации (сложения).
Пример 6-1. Задан текст. Подсчитать каких букв в тексте больше “а” или “о” и на
сколько.
LINE INPUT “Введите текст”;T$
L=LEN(T$)
KA=0 : KO=0
FOR I=1 TO L
IF MID$(T$,I,1)=”A” OR MID$(T$,I,1)=”a” THEN KA=KA+1
IF MID$(T$,I,1)=”O” OR MID$(T$,I,1)=”o” THEN KO=KO+1
NEXT I
IF KA>KO THEN PRINT “Букв а больше, чем о на “;KA-KO
IF KO>KA THEN PRINT “Букв o больше, чем a на “;KO-KA
IF KA=KO THEN PRINT “Букв а и о равное количество “
var
t: string;
i,ka,ko: integer;
begin
readln(t);
l:=length(t);
for i:=1 to l do begin
if copy(t,i,1)=’A’ or copy(t,i,1)=’a’ then inc(ka);
if copy(t,i,1)=’O’ or copy(t,i,1)=’o’ then inc(ko);
end;
if ka>ko then writeln(‘Букв а больше, чем о на ’, ka-ko);
if ko>ka then writeln(‘Букв o больше, чем a на ’, ko-ka);
if ko=ka then writeln(‘Букв а и о равное количество’);
end.
Обратите внимание на оператор LINE INPUT. Отличие его от стандартного оператора
ввода в Бейсике заключается в том, что при его выполнении на экране не появляется знак
вопроса. В программе на Паскале отметьте использование функции inc, которая увеличивает
свой аргумент на единицу. Ее «антонимом» является функция dec.
Попробуйте также поэкспериментировать с функцией INPUT$(n), которая вводит с клавиатуры
указанное в параметре число символов.
64
Пример 6-2. Задан текст. Подсчитать сколько предложений в тексте.
LINE INPUT “введите текст”;T$
L=LEN(T$)
К=0
FOR I=1 TO L
IF MID$(T$,I,1)=”.” OR
MID$(T$,I,1)=”!”
OR
MID$(T$,I,1)=”?”
THEN
K=K+1
NEXT I
PRINT “В тексте “;K;” предложений”
readln(t);
k:=0;
for i:=1 to length(t) do
if (t[i]=’.’) or (t[i]=’!’) or (t[i]=’?’) then inc(k);
writeln(k);
Пример 6-3. Дано слово “информатика”. Составить из букв этого слова 3 новых
слова.
T$=”информатика”
T1$=MID$(T$,3,3)+MID$(T$,7,1)
T2$=MID$(T$,5,1)+LEFT$(T$,1)+MID$(T$,3,1)+MID$(T$,6,2)
T3$=MID$(T$,2,1)+MID$(T$,4,2)+RIGHT$(T$,2)
PRINT T1$;”,“;T2$;”,“;T3$
фора рифма норка
t:=’ информатика’;
writeln(copy(t,3,3)+copy(t,7,1));
writeln(copy(t,5,1)+t[1]+copy(t,3,1)+copy(t,6,2));
delete(t,1,1); delete(t,2,1); delete(t,4,4);
writeln(t);
фора
рифма
норка
Пример 6-4. Дано слово. Выяснить является ли это слово перевертышем, то есть
читается слева направо и наоборот одинаково. Например “казак”.
LINE INPUT “Введите слово”;T$
M$=””
FOR I=LEN(T$) TO 1 STEP -1
M$=M$+MID$(T$,I,1)
NEXT I
IF T$=M$ THEN PRINT “Да, является” ELSE PRINT “Нет, не является”
readln(t);
m:=’’;
for i:=length(t) downto 1 do
m:=m+copy(t,i,1);
if t=m then writeln(‘Да’) else writeln(‘Нет’);
Процедуры и функции.
Довольно часто в программах встречаются моменты когда необходимо повторение
одних и тех же вычислений или операций несколько раз. Мы имеем возможность
использовать циклы, но как быть в том случае, если нам необходимо 20 раз выполнить один
и тот же цикл, но каждый раз с разными начальными значениями? В этом случае нам
придется использовать подпрограммы, если только мы не хотим получить несколько
килобайт исходного текста программы. Поясним на примере.
65
Пример 6-5. Получить на экране рисунок следующего
вида. Центральная окружность радиуса R, на этой окружности
симметрично располагаются 4 окружности радиуса R/2 каждая.
На каждой из этих 4-х окружностях аналогичным образом
строятся ещё 4 и т.д. Рисование прекращается, если радиус
последних становится меньше некоторого числа k. Рисование
окружностей будем производить относительно центральной
окружности с центром (x,y). Центр первой окружности (x+r,y), второй - (x,y+r), третьей - (x-r,y), четвертой - (x,y-r).
DEFINE SUB KRUG(X,Y,R)
SCREEN 12
CALL KRUG(320,240,120)
END
SUB KRUG (X,Y,R)
IF R>K THEN
KRUG(X+R,Y,R\2)
KRUG(X,Y+R,R\2)
KRUG(X-R,Y,R\2)
KRUG(X,Y-R,R\2)
CIRCLE(X,Y),R
END IF
END SUB
uses graph;
var gd,gm,mx,my:integer;
ch :char;
procedure krug(x,y,r:integer);
begin
if r>k then begin
krug(x+r,y,r div 2);
krug(x,y+r,r div 2);
krug(x-r,y,r div 2);
krug(x,y-r,r div 2); end;
circle(x,y,r);
end;
BEGIN
gd:=Detect gm:=0; InitGraph(gd,gm,'');
krug(320, 240, 120);
readln;
closegraph;
END.
Обратите внимание, что процедура рисования окружности вызывает саму себя. Такой
прием называется рекурсией.
В более простых случаях в Бейсике можно применить оператор GOSUB…RETURN
Помимо стандартных числовых или символьных функций пользователь может
определить и свои собственные. Иногда при решении задач возникает необходимость
вычисления одного и того же выражения при различных значениях величин, входящих в это
выражение. Вот тогда и применяются функции, определяемые пользователем.
66
Пример 6-6. Вычислить сложное выражение, используя определяемую функцию для
вычисления повторяющейся в нем части.
 x  y2 
1  m2
c d2

K
5
 tg

cos(1  m)
cos(c  d )
cos(
x

y
)


DEF FNF(A,B)=ABS((A+B^2)/COS(A-B))
INPUT “ВВЕДИТЕ 5 ЗНАЧЕНИЙ”;M,C,D,X,Y
K=FNF(1,M)+5*SQR(FNF(C,D))+TAN(FNF(X,Y))
PRINT “K=”;K
var m,c,d,x,y,k: real;
function f(a,b:real):real;
begin
f:=abs((a+sqr(b))/cos(a-b))
end;
BEGIN
readln(m,c,d,x,y);
k:=f(1,m)+5*sqrt(f(c,d))+sin(f(x,y))/cos(f(x,y));
writeln(k);
END.
Имя определяемой функции должно быть уникально: оно не может повторять имя
другой процедуры, переменной или функции.
Практикум
ПРАКТИЧЕСКИЕ ЗАДАЧИ
Геометрия
Задачи этого раздела основаны на простейших геометрических зависимостях и
требуют базовых знаний по геометрии и теории векторов в задачах повышенной сложности.
Рассмотрим несколько типовых задач этого раздела.
Пример 6-7. Пересекаются ли 2 отрезка, заданные координатами своих концов?
Пусть отрезок A имеет координаты (ax1,ay1,ax2,ay2), а отрезок B задан координатами
(bx1,by1,bx2,by2), тогда, выполнив вычисление
v1=(bx2-bx1)*(ay1-by1)-(by2-by1)*(ax1-bx1)
v2=(bx2-bx1)*(ay2-by1)-(by2-by1)*(ax2-bx1)
v3=(ax2-ax1)*(by1-ay1)-(ay2-ay1)*(bx1-ax1)
v4=(ax2-ax1)*(by2-ay1)-(ay2-ay1)*(bx2-ax1)
Intersection=(v1*v2<0) AND (v3*v4<0);
получим значение переменной Intersection TRUE - если отрезки пересекаются, а если
пересекаются в концах или вовсе не пересекаются, то возвращается значение FALSE.
Пример 6-8. Определить с какой стороны отрезка (вектора) лежит точка?
Если вектора a и b соответственно, то:
а*b = ax*by - ay*bx = la*lb*sin()
ax,ay,bx,by - координаты концов векторов, la - длина вектора a
lb - длина вектора b,  - угол для вектора a, - угол для вектора b
При общей начальной точке двух векторов их векторное произведение больше нуля,
если второй вектор направлен влево от первого, и меньше нуля, если вправо.
67
Если известны две точки, то вектор, основанный на них можно получить вычитанием
двух векторов направленных из начала координат. Например, есть точка A и точка B:
вектор|AB| = Вектор|B| - Вектор|A|, иными словами AB_x = Bx-Ax, AB_y= By-Ay
Таким образом, получается: если есть вектор |AB|, заданный координатами ax,ay,bx,by
и точка px,py, то для того чтобы узнать лежит ли она слева или справа, надо узнать знак
произведения: (bx-ax)*(py-ay)-(by-ay)*(px-ax)
s=(bx-ax)*(py-ay)-(by-ay)*(px-ax)
IF s>0 THEN WP=1 ELSE IF s<0 THEN WP=-1 ELSE WP=0
WP=1 - точка слева от вектора
WP=-1 - точка справа от вектора
WP=0 - точка на векторе, прямо по вектору или сзади вектора
Пример 6-9. Пусть есть треугольник ABC и точка P. Определить, лежит ли точка
внутри треугольника.
Используем решение предыдущей задачи. Обходим треугольник по часовой стрелке.
Точка должна лежать справа от всех сторон, если она внутри. Написание алгоритма
оставляется за читателем.
Расширим эту задачу.
Пример 6-10.
а) Треугольник на плоскости задается целочисленными координатами вершин.
Для заданной точки Z(x,y) определить, принадлежит ли она стороне треугольника
или лежит внутри или вне его.
б) Многоугольник на плоскости задается координатами своих N вершин в
порядке обхода их по контуру по часовой стрелке (контур самопересечений не
имеет). Для заданной точки Z(x,y) определить, принадлежит ли она стороне
многоугольника или лежит внутри или вне его.
Можно, конечно, из точки Z провести отрезки ко всем 3-м вершинам треугольника, и
посмотреть: если сумма площадей трех треугольников ZAB, ZBC, ZCA равна площадей
ABC, то точка внутри, иначе – снаружи, но так как все вычисления в машине проводятся с
ограниченной точностью, то проверка на равенство ПРАКТИЧЕСКИ НИКОГДА не даст
правильного ответа. Вы почти всегда будете получать, что Z – вне ABC, несмотря на
действительное расположение точки Z.
Попробуем решить задачу по-другому. Принадлежность точки стороне проверяется
просто: если концевые точки стороны A(x1, y1) и B(x2, y2), то, если точка Z(x, y)
принадлежит стороне, то должно существовать такое число p, 0<=p<=1, что
x=p*x1+(1-p)*x2
y=p*y1+(1-p)*y2
(тут используется то, что если прямая проходит через A и B, то точки прямой имеют
координаты (p*x1+(1-p)*x2, p*y1+(1-p)*y2), p – действительное число. При 0<=p<=1 мы
получаем отрезок между точками A и B).
Далее, проведем из точки Z прямую, параллельную оси OX (ее уравнение будет x=u)
и проверим, сколько сторон треугольника пересекает полулуч, идущий от точки Z,
например, вправо. Если 0, то Z – вне треугольника, если 1 – то внутри, если 2 – то снаружи
(определение пересечения прямой и стороны – задача 1).
Надо конкретно обработать случай, когда прямая пересекает одну из вершин
треугольника (например, A). Может быть 2 случая:
Z
Z
A
Случай 1.
A
Случай 2.
68
В случае 1, когда оба ребра, входящих в вершину A, лежат по одну сторону от
прямой, количество пересечений можно считать равным двум (или нулю), в случае 2, когда
ребра лежат по разные стороны от прямой, число пересечений примем равным 1. Проверка,
по разные или по одну сторону от прямой лежат концевые точки отрезков уже нами
выполнялась. Если прямая проходит по стороне, то число пересечений будем считать
равным 2.
Аналогично можно проверить, лежит ли точка Z внутри многоугольника (в
алгоритме безразлично, выпуклый он или нет). Мы подсчитываем число пересечений луча
со сторонами – если оно нечетное, то точка внутри, если четное – то снаружи.
Пример 6-11. На гранях двух равных правильных тетраэдров N и M написаны
числа N1,N2,N3,N4 и M1,M2,M3,M4. Можно ли совместить тетраэдры так, чтобы на
совпадающих гранях оказались одинаковые числа?
При всей видимой сложности задачи, она имеет неожиданно простое решение.
Рассматриваем нумерацию граней как элементы массивов. Сортируем каждый из массивов с
помощью некоторого алгоритма (например, с помощью "пузырьковой" сортировки),
подсчитывая количество обменов (пусть KN и KM). Если отсортированные массивы
совпадают и (KN–KM) кратно 2, то тетраэдры совпадают. Обмен двух граней можно
трактовать как отражение тетраэдра в зеркале.
Множества
Сразу оговоримся, что в задачах этого раздела нельзя использовать тип "множество"
Паскаля, т.к. он не поддается вводу и выводу и ограничен по мощности. Для задания
множеств следует использовать массивы чисел или записей.
Итак, что же такое множество? Говоря простым языком, можно сказать, что
множество- это ограниченный по размеру набор данных одного типа. Множества можно
разделить на числовые и нечисловые. Мощностью множества А называют число элементов
в нем, при этом предполагается, что все элементы различны.
В плане программирования теория множеств нашла широкое применение в
геометрических задачах, поэтому можно рассматривать эту тему как продолжение
предыдущей. Тем не менее, не исключается применение множеств и для решения задач
другого рода, основанных на обработке неупорядоченного набора данных.
Для начала несколько определений.
Объединением (обозначается А  В) двух множеств называется множество,
содержащее все элементы обеих множеств.
Пересечением (обозначается А  В) двух множеств называется множество,
содержащее только те элементы, которые есть в каждом из множеств.
Расстоянием между двумя множествами геометрических точек называется
наименьшее расстояние между двумя точками, принадлежащими разным множествам.
Расстояние между двумя геометрическими фигурами - это расстояние между множествами
точек, составляющими эти фигуры. Очевидно, что если фигуры пересекаются, то расстояние
между ними равно 0. Геометрические точки задаются координатами, для материальных
точек задается еще и масса.
Координаты центра тяжести совокупности n материальных точек или фигур находятся
по формулам:
n
1 n
1 n
xc 
x
m
y

y
m
M

mi ,
 i i c M

i i
M i 1
i 1
i 1
где xi, yi, mi - координаты i-й точки (центра тяжести фигуры) и ее масса (площадь фигуры).
69
Площадь многоугольника на плоскости, образованного не самопересекающейся ломаной
А1А2А3…Аn, может быть найдена по формуле
S
n 1
 s
i 2
1,i ,i 1
,
где s1,i,i+1 - площадь треугольника А1AiAi+1, знак зависит от знака внутреннего угла
треугольника.
Рассмотрим типовую задачу.
Пример 6-12. На клетчатом поле mxn задано матричное изображение некоторой
геометрической области (не обязательно связной). Найти площадь и центр тяжести этой
области.
Проиллюстрируем решение задачи следующей программой. Исходные данные - набор
нулей и единиц получается случайным образом. Решение иллюстрируется графическим
изображением фигуры и ее центра тяжести.
max = 100
DIM a(max, max)
CLS: RANDOMIZE(1)
INPUT "Кол-во строк и столбцов:"; m, n
FOR i = 1 TO m
FOR j = 1 TO n
a(i, j) = INT(RND(1) + .5)
PRINT a(i, j);
NEXT
NEXT
massa = 0: x0 = 0: y0 = 0
FOR i = 1 TO m
FOR j = 1 TO n
IF a(i, j) = 1 THEN
massa = massa + 1
x0 = x0 + j: y0 = y0 + i
END IF
NEXT
NEXT
x0 = x0 / massa: y0 = y0 / massa
PRINT " Координаты центра -"; x0; y0
PRINT "Площадь -"; massa
WHILE INKEY$=""
WEND
SCREEN 9
IF 640 / n > 320 / m THEN k = FIX(320 / n) ELSE k = FIX(640 / n)
FOR i = 1 TO m
FOR j = 1 TO n
x = (j - 1) * k + 5
y = (i - 1) * k + 5
LINE (x, y)-(x + k, y + k), 15, B
IF a(i, j) = 1 THEN PAINT (x + 1, y + 1), 7, 15
NEXT
NEXT
CIRCLE (FIX((x0 - .5) * k) + 5, FIX((y0 - .5) * k) + 5), FIX(k / 2), 2
PAINT (FIX((x0 - .5) * k) + 5, FIX((y0 - .5) * k) + 5), 4, 2
70
uses crt,graph;
const max=100;
var a: array [1..max, 1..max] of integer;
i,j,n,m,k,massa,x,y,gd,gm: integer;
x0,y0: real;
begin
clrscr;
writeln('Кол-во строк и столбцов:');
readln(m,n);
randomize;
for i:=1 to m do
for j:=1 to n do
a[i,j]:=random(2);
massa:=0; x0:=0; y0:=0;
for i:=1 to m do
for j:=1 to n do
if a[i,j]=1 then begin
massa:=massa+1;
x0:=x0+j;
y0:=y0+i;
end;
x0:=x0/massa;
y0:=y0/massa;
writeln('Координаты центра -',x0:4:2,y0:4:2);
writeln('Площадь -',massa);
readln;
gd:=Detect;
InitGraph(gd,gm,'');
if GetMaxX/n>GetMaxY/m then k:=trunc(GetMaxY/m) else k:=trunc(GetMaxX/n);
setfillstyle(1,7);
for i:=1 to m do
for j:=1 to n do
begin
x:=(j-1)*k+5; y:=(i-1)*k+5;
rectangle(x,y,x+k,y+k);
if a[i,j]=1 then floodfill(x+1,y+1,15);
end;
setfillstyle(1,12);
fillellipse(trunc((x0-0.5)*k)+5,trunc((y0-0.5)*k)+5,
trunc(k/2),trunc(k/2));
readln;
closegraph;
end.
"Длинная" арифметика
Пока мы находимся в пределах целых чисел, не превышающих 32768 (граница типа
integer), решение подобных задач не вызывает особых затруднений.
Известно, что тип представления числа в ЭВМ накладывает ограничения на величину
числа. Кроме того, в программах могут содержаться “скрытые” ошибки из-за переполнения
типа в результате арифметических операций. В таком случае при успешной компиляции
решения задачи
нет, даже приблизительного. Чтобы
гарантировать правильность
программы или для получения высокой точности вычислений удобно использовать
специальные приемы, позволяющие обойти ограничения по стандартным типам.
71
Давайте попробуем посчитать факториал числа, т.е. произведение всех чисел от 1 до
данного числа.
N=1
N=2
N=3
N=4
N=5
N=6
N=7
N=8
N=9
N = 10
N = 11
N = 12
N = 13
...
N = 30
N = 31
...
1
2
6
24
120
720
5040 (граница типа Integer)
40320
362880
3628800
39916800
479001600 (граница типа LongInt)
6227020800
...
265252859812191058636308480000000
8222838654177922817725562880000000
...
Чтобы получить значения факториала для N>12 требуется специальное представление
целых в ЭВМ, искусственно создаваемое программистом.
Числа, для представления которых в стандартных компьютерных типах данных не
хватает количества двоичных разрядов, называются “длинными”. Реализация
арифметических операций над такими числами получила название “длинной” арифметики.
Рассмотрим число S = 30! = 265252859812191058636308480000000
Представим его в виде:
S = 2 6525 2859 8121 9105 8636 3084 8000 0000 =
0∙(104)0+ 8000∙(104)1 +3084∙(104)2 + 8636∙(104)3 + 9105∙(104)4 + 8121∙(104)5 +
+2859∙(104)6+ + 6525∙(104)7 +2∙(104)8
Это является по определению развернутой формой записи числа S в системе
счисления с основанием 104. Т.е. "длинное" число представлено в 10000-10 системе
счисления (читается десятитысячно-десятичная система счисления).
Сформируем в соответствии с данным представлением массив А, в котором A0 –
хранит количество значащих “цифр”, а элементы A1-Aa0 – содержат значения “цифр”
“длинного” числа, причем каждая цифра меньше 10000 (основание применяемой системы
счисления).
Индекс элемента в
массиве А
Значение
0
1
9
0
2
3
4
5
6
7
8
8000 3084 8636 9105 8121 2859 6525
Работа



9
2
с “длинными” числами в общем случае сводится к следующим задачам:
ввод числа в типовой массив из текстового файла или строковой переменной
вывод числа на печать из типового массива
выполнение арифметических действий с числом, например умножение
“длинного” на “короткое”, и запись результата в типовой массив.
Продемонстрируем на примере учебной программы реализацию этих задач, соблюдая
следующие соглашения:
 вывод или ввод “длинного” числа организуется при помощи строкового типа данных
 хранение “длинного” числа организуется в специально созданном типовом массиве
 арифметические действия программист осуществляет по правилам позиционной pчной системы счисления (общие для любого основания p).
72
Договоримся, что следующие переменные несут соответствующие назначения:
MaxDig - максимальное количество цифр в числе
A - массив для хранения значения "длинного" числа
R - "короткое" число для умножения на S
Rez - массив результата умножения
S - число и подстрока "цифра"
c- количество чисел в "цифре"
Osn - основание Osn-10 системы счисления
K - кол-во цифр S, по с-чисел ровно
k0 - кол-во цифр S, в старшем разряде
ch - хранит подстроку
i,j - счетчики для циклов
MaxDig=50
DIM a(MaxDig), rez(MaxDig)
s$="265252859812191058636308480000000"
PRINT "Символьное";s$
INPUT "3адайте количество чисел в 'цифре'";c
osn=1
FOR i=1 TO c
osn=osn*10
NEXT
PRINT "Основание выбранной системы счисления -";osn;"-10"
'Заполнение массива:
'1. заполним старший разряд S в массиве A
k0=LEN(s$) mod c:
'сколько чисел в старшей цифре
k=LEN(s$)\c:
'количество цифр в числе S
'подсчет количества цифр в числе S
IF k0<>0 THEN a(0)=k+1 ELSE a(0)=k
Ch$=MID$(s$,1,k0): 'символьное представление старшей цифры
a(a(0))=VAL(ch$) :' числовой перевод строки в "цифру"
'2. заполняем остальные разряды
i=1
FOR j=1 TO k
ch$=MID$(s$,LEN(s$)-c*j+1,c): 'вырезаем по с символов
a(i)= VAL(ch$)
: 'переводим в числа
i=i+1
NEXT
FOR i=a(0) TO 1 STEP -1
PRINT "a[";i;"]=";a(i)
NEXT
PRINT "a[0]=";a(0);"- число значащих 'цифр' в S"
'распечатка массива типа, хранящего S
PRINT "Числовое":
FOR i=a(0) TO 1 STEP -1
'преобразуем цифру в строку
ch$=STR$(a(i))
'дополняем 0-ми, если цифра содержит
'чисел меньше,чем с
IF LEN(ch$)<c THEN
FOR j=1 TO c-LEN(ch$)
PRINT "0";
NEXT
END IF
PRINT ch$; :'печатаем цифру
NEXT
73
'умножим "длинное" S на "короткое" R
PRINT: PRINT
INPUT "3адайте число R";R
FOR i=1 TO a(0)
'заполняем i-й разряд
IF a(i)*R+Rez(i)<=Osn THEN
Rez(i)=a(i)*R+Rez(i)
ELSE
' переполнение разряда
Rez(i)=(a(i)*R + Rez(i)) mod osn
'формируем перенос в следующий разряд
Rez(i+1)=(a(i)*R + Rez(i+1)) \ osn
ENDIF
NEXT
'определим величину c[0]'
IF rez(a(0)+1]>0 THEN rez(0)=a(0)+1 ELSE rez(0)=a(0)
PRINT "Результат умножения S на R:";
FOR i=rez(0) TO 1 STEP -1
'преобразуем цифру в строку
ch$=STR$(rez(i))
'дополняем 0-ми, если цифра содержит
'чисел меньше,чем с
IF LEN(ch$)<c THEN
FOR j=1 TO c-LEN(ch$)
PRINT "0";
NEXT
END IF
PRINT ch$; : NEXT : END
uses crt;
const MaxDig=50; {максимальное количество цифр в числе}
type TMs=Array[0..MaxDig]of LongInt;
var
S:string; {число и подстрока "цифра"}
c:byte;{количество чисел в "цифре"}
Osn : LongInt; {основание Osn-10 системы счисления}
A : TMs; {массив для хранения значения "длинного" числа}
k: integer; {кол-во цифр S, по с-чисел ровно}
k0: integer; {кол-во цифр S, в старшем разряде}
ch: string; {хранит подстроку}
i,j : integer;{ для for}
Code: integer; {номер "неправильного" символа (для Val)}
{_____________}
R : LongInt; {"короткое" число для умножения на S}
Rez : TMs; {типовой массив результата умножения}
{*****************************************************}
Procedure Print(a:TMs); {распечатка числа S из типового массива A}
begin
For i:=a[0] downto 1 do
begin
{преобразуем цифру в строку}
Str(a[i],ch);
{дополняем 0-ми, если цифра содержит чисел меньше, чем с}
If Length(ch)<c then
for j:=1 to c-length(ch) do Write('0');
Write(ch); {печатаем цифру}
end;
end;{Print}
{***************}
BEGIN
ClrScr;
s:='265252859812191058636308480000000';
WriteLn('"Символьное": S=',s); { - распечатка s в символьном виде}
Write('задайте количество чисел в "цифре" для S:');ReadLn(c);
osn:=1; for i:=1 to c do osn:=osn*10;
WriteLn('Основание выбранной системы счисления =',osn,'-10');
WriteLn('Типовой массив A: (распечатка числовых значений "цифр")');
{Заполнение массива типа:}
74
{1. заполним старший разряд S в массиве типа A}
k0:=Length(s) mod c; {сколько чисел в старшей цифре}
k:= Length(s) div c; {количество цифр в числе S}
{подсчет количества цифр в числе S}
if k0<>0 then a[0]:=k + 1 else a[0]:=k;
ch:=copy(s,1,k0);{символьное представление старшей цифры}
Val(ch,a[a[0]],code);{числовой перевод строки в "цифру"}
{2. заполняем остальные разряды}
i:=1;
for j:=1 to k do
begin
ch:=copy(s,length(s)-c*j+1,c);{вырезаем по с символов}
Val(ch,a[i],code);{переводим в числа}
inc(i);
end;
for i:=a[0] downto 1 do WriteLn('
a[',i,']=',a[i]);
WriteLn('
a[0]=',a[0],' - число значащих "цифр" в S');
{распечатка массива типа, хранящего S}
Write('"Числовое":
S='); Print(a);
{умножим "длинное" S на "короткое" R}
WriteLn;WriteLn;
Write('задайте число R (тип LongInt): '); Readln(R);
For i:=1 to a[0] do
begin
{заполняем i разряд}
if a[i]*R+Rez[i]<=Osn then Rez[i]:=a[i]*R+Rez[i]
Else { переполнение разряда}
begin
Rez[i]:=(a[i]*R + Rez[i]) mod Osn;
{формируем перенос в следующий разряд:}
Rez[i+1]:=(a[i]*R + Rez[i+1]) div Osn;
end;
end;
{определим величину c[0]}
If rez[a[0]+1]>0 then rez[0]:=a[0]+1 else rez[0]:=a[0];
WriteLn('Результат умножения S на R:');{- печатаем результат умножения}
print(a);WriteLn('*',R,'=');
Print(Rez);
ReadKey;
END.
Из приведенного примера можно легко вычленить основные блоки программы для
работы с длинными числами и использовать их для решения подобных задач.
75
САМОСТОЯТЕЛЬНАЯ РАБОТА
1-6-1. Римский счет
Перевести заданное целое число в систему римского счета.
1-6-2. Факториалы
Вычислить факториалы всех чисел от 1 до 100
1-6-3. Цифры и числа
Дано натуральное k. Напечатать k-ю цифру в последовательности
12345678910111213…, в которой выписаны подряд все натуральные числа.
1-6-4. Два треугольника
Два треугольника заданы координатами своих вершин. Выяснить, лежит ли какойлибо из треугольников целиком внутри другого. Если да, построить стороны треугольников
и закрасить область, принадлежащую внешнему треугольнику и не принадлежащую
внутреннему. Построения сторон и закраску области выполнить одним цветом. Если ни
один из треугольников не лежит целиком внутри другого, построить стороны
треугольников, используя для каждого треугольника свой цвет.
1-6-5. Охота на зайца
Заяц, хаотично прыгая, оставил след в виде замкнутой самопересекающейся прямой,
охватывающей территорию его владения. Отрезки ломаной заданы длиной прыжка и его
направлением по азимуту. Найти площадь минимального по площади выпуклого
многоугольника, описанного вокруг этой территории.
76
МНОЖЕСТВА
Отнюдь не у всякой формы имеется содержание,
а ежели и так, то порою оно совершенно бесформенно.
К.Прутков
Множество – это набор элементов, не организованных в порядке следования. Из курса
математики известно, что множеством является любая совокупность элементов
произвольной природы. Понятие множества в программировании значительно уже
математического понятия.
Под множеством в Паскале понимается конечная совокупность элементов,
принадлежащих некоторому базовому типу.
В качестве базовых типов могут использоваться: перечислимые типы данных,
символьный и байтовый типы или диапазонные типы на их основе.
Множество имеет зарезервированное слово set of и вводится следующим описанием
type
<имя типа> = set of < имя базового типа >;
var
< идентификатор,... >:< имя типа >;
Например:
type
SetByte = set of byte;
{множество, определённое над типом byte}
Chisla = set of 10 ... 20;
{множество, определённое в диапазоне от 10 до 20}
Symbol = set of char;
{множество, определённое на множестве символов}
Month = (January, February, March, April, May, June, July,
September, October, November, December);
Season: set of Month;
{тип множества, определённый на базе перечислимого типа Month}
August,
var
Letter, Digits, Signs : Symbol
{множествa, определённые над символьным типом}
Winter, Spring, Summer, Autumn, Vacation, WarmSeason: Season;
Index : Chisla=[12, 15, 17];
Operation : set of (Plus, Minus, Mult, Divis);
Param: set of 0..9=[0, 2, 4, 6, 8];
Для того, чтобы дать переменной множества какое-то значение, используют либо
конструктор множества - перечисление элементов множества через запятую в квадратных
скобках
Sign:=['+', '-'];
b:=[ 'k', 'l', 'd' ]
либо определение через диапазон:
Digits:=['0'..'9'];
WarmSeason := [May .. September];
Обе формы конструирования могут сочетаться:
Vacation:=[January, February, June .. August];
77
Объединение множеств (+)
Объединением 2-х множеств называется третье множество, которое содержит элементы,
которые принадлежат хотя бы одному из множеств операндов, при этом каждый элемент
входит в множество только один раз.
Объединение множеств записывается как операция сложения.
type
Symbol = set of char;
var
SmallLatinLetter, CapitalLatinLetter, LatinLetter : Symbol;
begin
. . . . . .
SmallLatinLetter :=['a'..'z'];
CapitalLatinLetter := ['A'..'Z'];
LatinLetter := SmallLatinLetter+CapitalLatinLetter;
. . . . . .
end.
В операции объединения множеств могут участвовать и отдельные элементы
множества.
Разность множеств (-)
Разностью 2-х множеств является третье множество, которое содержит элементы 1-го
множества, не входящие во 2-е множество.
Если в вычитаемом множестве есть элементы, отсутствующие в уменьшаемом, они не
влияют на результат.
Summer := WarmSeason-Spring-Autumn;
Summer := WarmSeason-May-September;
В языке Паскаль имеются встроенные процедуры для включения элемента в множество
и исключения из множества
Include(Var S : set of T; Element : T);
Exclude(Var S : set of T; Element : T);
где S - множество элементов типа Т, а Element - включаемый элемент.
78
Пересечение множеств
Пересечением множеств называется множество, содержащее элементы одновременно
входящие в оба множества операндов. Операция обозначается знаком умножения.
Summer := WarmSeason*Vacation;
Равенство множеств
Множества считаются равными, если все элементы, содержащиеся в одном множестве
присутствуют в другом, и наоборот. В соответствии с этим правилом для множеств
определяются логические операции "=" и "<>".
Проверка включения
Одно множество считается входящим в другое, если все элементы содержатся во
втором, при этом обратное в общем случае может быть несправедливо.
Логические операции проверки вхождения одного множества в другое записываются
через операции больше или равно и меньше или равно:
if S1<=S2 then writeln ('S1 входит в S2');
if S1>=S2 then writeln ('S2 входит в S1');
Проверка принадлежности
Логическая операция проверки принадлежности элемента множеству записывается
через оператор in.
Использование множеств и оператора in позволяет, в частности, сделать эффективнее
проверку правильности вводимых символов.
Например, для проверки допустимости введенного символа можно использовать
следующее условие:
(Reply='y') or (Reply='Y') or (Reply='n') or (Reply='N')
Но если ввести множество
EnabledSymbol : set of char = ['Y', 'y', 'N', 'n'];
проверяемое условие можно записать в более компактной форме:
Reply in AllowSymbol
Пример 7-1. Описать множество М(1..50). Сделать его пустым. Вводя целые числа с
клавиатуры, заполнить множество 30 неповторяющимися элементами.
В разделе описания переменных опишем множество целых чисел от 1 до 50,
переменную Х целого типа, которую будем использовать для считывания числа-кандидата в
множество, и целую переменную i используем для подсчета количества введенных чисел.
В начале программы применим операцию инициализации множества М:=[ ], так как оно
не имеет элементов и является пустым. Заполнение множества элементами произведем с
использованием оператора цикла Repeat, параметр которого i будет указывать порядковый
номер вводимого элемента. Операцию заполнения множества запишем оператором
присваивания М:=M+[X]. Контроль заполнения множества запишем с использованием
операции проверки принадлежности in. Если условие X in M выполняется, выведем
сообщение о том, что число Х помещено в множество.
Текст программы описания и заполнения множества будет таким:
79
var
M : set of 1..50;
X, i : integer;
begin
M := [ ];
i :=1;
repeat
write('Введите ',i,'-й элемент множества'); readln(X);
if (X in M) then begin
write(Х, ' уже содержится в множестве');
i := i-1; end
else begin
write(‘Элемент ’,Х, ' помещен в множество');
M := M+[X]; end;
i := i+1;
until i>30;
end.
Пример 7-2. Описать множества гласных и согласных букв русского языка, определить
количество гласных и согласных букв в предложении, введенном с клавиатуры.
Зададим тип Letters - множество букв русского языка, затем опишем переменные этого
типа: Glasn - множество гласных букв, Sogl - множество согласных букв. Вводимое с
клавиатуры предложение опишем переменной Text типа String. Для указания символа в
строке Text применим переменную i типа byte. Для подсчета количества гласных и
согласных букв опишем переменные G и S. Проверку принадлежности символов,
составляющих предложение множествам гласных или согласных букв русского языка
запишем с использованием оператора повтора For, параметр i которого, изменяясь от 1 до
значения длины предложения, будет указывать порядковый номер символа в предложении.
Принадлежность очередного символа предложения множеству гласных или согласных букв
запишем операцией in. Если выполняется условие Text[i] in Sogl, тогда увеличивается на 1
счетчик S. Если выполняется условие Text[i] in Glasn, тогда увеличивается на 1 счетчик G.
Если не выполняется ни первое, ни второе условие, значит, очередной символ в
предложении не является гласной или согласной буквой русского языка.
type
Letters = set of 'A'..'я';
var
Glasn, Sogl : Letters;
Text : String;
i, G, S : byte;
begin
Glasn:=['A','я','Е','е','И','и','О','о','У','у','Э','э','Ю','ю','Я','я'];
Sogl:=['Б'..'Д','б'..'д','Ж','ж','З','з','К'..'Н','к'..'н','П'..'Т','п'..'т'
,'Ф'..'Щ','ф'..'щ','ь'];
write('Введите предложение '); readln(Text);
G := 0; S := 0;
for i:=1 to length(Text) do begin
if Text[i] in Glasn then G:=G+1;
if Text[i] in Sogl then S:=S+1; end;
writeln('В предложении " ', Text, ' " ', G, ' гласных и ', S, ' согласных
букв');
end.
80
Пример 7-3. Найти все простые числа с помощью «решета Эратосфена» в числовом
интервале [1..N].
Идея метода "решета Эратосфена" заключается в следующем: сформируем множество
М, в которое поместим все числа заданного промежутка. Затем последовательно будем
удалять из него элементы, кратные 2, 3, 4, и так далее до целой части числа [N/2], кроме
самих этих чисел. После такого "просеивания" в множестве М останутся только простые
числа.
var M : set of byte;
i, k, N : Integer;
begin
writeln('Введите размер промежутка (до 255) '); readln(N);
M:=[2..N];
for k := 2 to N div 2 do
for i := 2 to N do
if (i mod k=0) and (i<>k) then M := M-[i]
for i := 1 to N do
if i in M then write(i, ‘ ‘);
end.
Задания для самостоятельного решения
А. Подсчитать количество различных (значащих) цифр в десятичной записи
натурального числа n.
В. Вывести на экран в возрастающем порядке все цифры не входящие в десятичную
запись натурального числа n.
Практикум
РАЗМНОЖЕНИЕ C ОГРАНИЧЕНИЯМИ
Рассмотрим специальную процедуру ввода положительных целых чисел, которая
запрещает набор иных символов, кроме цифр и ограничивает число используемых символов.
procedure ReadWord(Var Result : Word; x, y, MaxLength : byte);
const ValidSymbol : set of char=['0'..'9',#8,#13];
var Str : string; Code : integer; Key : char;
begin
GoToXY(x, y);
Str:='';
repeat
repeat
Key := ReadKey
until Key in ValidSymbol;
case Key of
{анализ вводимых символов}
'0'..'9' :
{нажата цифра}
if length(Str)>=MaxLength {если длина больше заданной}
then begin
Sound(100); {звуковой сигнал} Delay(200); NoSound; end;
else {если длина меньше заданной}
begin
write(Key);
Str:=Str+Key; {добавление символа в строку}
end;
#8 : {нажата клавиша BackSpace}
if length(Str)>0 {если строка не пустая}
then begin
81
delete(Str, length(Str),1); {удаление из строки}
GoToXY(WhereX-1, WhereY); {возврат курсора}
write(''); {запись пробела вместо символа}
GoToXY(WhereX-1, WhereY); {возврат курсора}
end
else {если строка пустая}
begin Sound(100); Delay(200); NoSound; end;
#13 : {нажата клавиша Enter}
begin
val(Str,Result,Code);{преобразование строки в число}
exit {выход из подпрограммы}
end;
end; {конец оператора Case}
until False; {бесконечный цикл}
end;
В заголовке процедуры Result - возвращаемое число; MaxLength - максимальное число
цифр в записи числа; х, у - координаты начальной позиции вывода. Процедура формирует
текстовую строку Str, состоящую из цифр. При нажатии клавиши Enter строка преобразуется
в целочисленную переменную.
В начале программы курсор направляется в заданную точку, и текстовой строке
присваивается пустое значение. Далее начинается бесконечный цикл, заданный оператором
Repeat ... Until False. Выход из цикла происходит вместе с выходом из процедуры по команде
Exit. "Бесконечность" цикла обеспечивает произвольное число повторов и исправлений при
вводе числа.
Процедура реагирует только на нажатие цифровых клавиш, клавиш Enter и BackSpace.
Назначение клавиш - традиционное: Enter используется для завершения процедуры,
BackSpace - для стирания последнего введенного символа.
Цикл
repeat Key := ReadKey until Key in ValidSymbol;
проверяет вводимые символы на допустимость. Множество допустимых символов
ValidSymbol определено в процедуре как константа, онон включает цифровые символы и
символы, соответствующие клавишам Enter и BackSpace. Первая имеет символьный код #13,
вторая - #8.
Далее оператор Case производит выбор одного из трех направлений - обработка нажатой
цифры, обработка клавиши BackSpace или обработка клавиши Enter. При нажатой цифре
сначала проверяют, не достигло ли число цифр максимального значения. Число цифр
определяется функцией Length, аргумент которой - редактируемая строка. Если длина уже
достигла максимального значения, выдается звуковой сигнал. Если длина вводимой строки
меньше максимальной, то в строку дописывается символ, и он же выводится на экран
процедурой Write.
При нажатии клавиши BackSpace должен быть стерт последний введенный символ.
Вначале производится проверка, есть ли в строке символы. Если строка пуста, подается
звуковой сигнал, если нет - начинается удаление символа. Для этого строка уменьшается на
один элемент процедурой Delete, курсор возвращается назад на одну позицию, на место
стираемой цифры записывается символ пробела, затем курсор снова возвращается на
позицию назад. курсор возвращается назад на одну позицию оператором GoToXY(WhereX-1,
WhereY), который использует функции WhereX и WhereY для определения текущего
положения и уменьшает координату х на 1.
После нажатия Enter строка преобразуется в целочисленную переменную процедурой
Val и происходит выход из процедуры ReadWord по команде Exit.
В этой процедуре показано, что ввод данных и другие процедуры, связанные с работой
оператора, должны, как правило, иметь защиту от ошибочных действий. В данном примере
это обеспечивается тем, что процедура блокирует неправильные нажатия клавиш и
ограничивает длину строки.
82
Поскольку все проверки усложняют программу, требование защиты от возможных
ошибок программиста не является обязательным. Вопрос в том - надеется ли программист на
свою аккуратность при использовании собственных процедур.
В качестве аналогичного примера можно написать программу которая допускает ввод
данных только на русском, или, наоборот, на английском языке.
Еще одним применением множеств может стать разгадывание математических ребусов.
Например:
МУХА
+
МУХА
СЛОН
Каждая буква - это цифра, разным буквам соответствуют разные цифры.
Необходимо заменить буквы цифрами так, чтобы получилось верное равенство. Найти все
решения.
Для решения этой задачи используется метод перебора с возвратом. Используем
множество S1 для хранения цифр слова МУХА, причем будем вносить в него цифры
последовательно, учитывая уже внесенные цифры. Начальное значение S1 - пустое
множество. после выбора всех цифр первого слова создаем его числовой эквивалент и
числовой образ слова СЛОН. Выделяем цифры СЛОНа (множество S2)и если слова состоят
из разных цифр (то есть пересечение S1 и S2 пустое) и все цифры СЛОНа разные (то есть
пересечение множеств цифр тоже пустое), то выводим решение на экран. Если же нет, то
идет возврат - удаляем из множества S1 последнюю внесенную цифру и пытаемся выбрать
еще одно значение. Таким образом, мы перебираем все возможные варианты и выводим на
экран только те, которые удовлетворяют равенству.
Заметим, что значение буквы М в слове МУХА может иметь значения от 1 до 4, а буква
А в этом же слове не может быть равна 0.
type MN = set of 0..9;
var m, u, h, a : 0..9;
n1, n2 : Integer;
s, l, o, n : 0..9;
S1, S2 : MN;
procedure Print(x, y : Integer);
begin
writeln(x:5); writeln('+'); writeln(x:5);
writeln(' '); writeln(y:5);
end;
begin
S1 := [ ]; S2 := [ ];
for m := 1 to 4 do begin S1 := S1+[m];
for u := 0 to 9 do
if not(u in S1) then begin
S1 := S1+[u];
for h := 0 to 9 do
if not (h in S1) then begin
S1 := S1+[h];
for a := 1 to 9 do
if not (a in S1) then begin
S1 := S1+[a];
n1 := 1000*m+100*u+10*h+a;
n2 := 2*n1;
s := n2 div 1000;
l :=n2 div 100 mod 10;
83
o := n2 div 10 mod 10;
n := n2 mod 10;
S2 := [s, l, o, n];
if(S1*S2=[]) and ([s]*[l]*[o]*[n]=[])
then Print (n1, n2);
S1 := S1-[a];
end;
S1 := S1-[h];
end;
S1 := S1-[u];
end;
S1 := S1-[m];
end; end.
Задания для самостоятельного решения
А Даны две таблицы по 10 элементов в каждой. Найдите наименьшее среди тех
чисел первой таблицы, которые не входят во вторую таблицу (считая, что хотя бы одно
такое число есть).
В. Решите программно следующие ребусы:
а) П Ч Ё Л К А x 7 = ЖЖЖЖЖЖ
б) ВЕТКА + ВЕТКА = ДЕРЕВО
в) КАПЛЯ + КАПЛЯ + КАПЛЯ = ОЗЕРКО
С. Изобразите графически следующий процесс, используя аппарат множеств. Задано
множество точек. Стянуть это множество к его центру тяжести, уменьшая расстояние
между точками в заданное количество раз.
84
ЗАПИСИ
Организация и структурирование данных самая сложная задача программиста. .
Д.Кнут
Довольно часто вполне оправданным является представление некоторых элементов в
качестве составных частей другой, более крупной логической единицы – нам естественно
сгруппировать информацию о номере дома, названии улицы и городе в единое целое и
назвать адресом, а объединенную информацию о дне, месяце и годе рождения - датой. В
языке Паскаль для представления совокупности разнородных данных служит
комбинированный тип запись.
Запись и массив схожи в том, что обе эти структуры составлены из ряда отдельных
компонент. В то же время, если компоненты массива должны быть одного типа, записи
могут содержать компоненты разных типов.
Приведем пример описания переменной, имеющей структуру записи:
Var
Address : Record
HouseNumber : Integer;
StreetName : String[20];
CityName : String[20];
PeopleName : String;
End;
Отметим, что поля StreetName и CityName имеют одинаковый тип: String[20]. Поскольку
в описании эти поля могут располагаться в любом порядке, то можно сократить описание
записи с полями одинакового типа. Сокращенное описание записи Address выглядит
следующим образом:
Var Address : Record
HouseNumber : Integer;
StreetName, CityName : String[20];
PeopleName : String;
End;
Каждая компонента записи называется полем. В переменной записи Address поле с
именем HouseNumber само является переменной типа Integer, поле StreetName двадцатисимвольной строкой и т.д.
Для того чтобы обратиться к некоторому полю записи, следует написать имя
переменной и имя поля. Эти два идентификатора должны разделяться точкой.
Оператор, который присваивает полю HouseNumber значение 45, выглядит так:
Address.HouseNumber := 45;
Таким же образом присваиваются значения другим полям записи Address.
Каждое поле записи Address можно рассматривать как обычную переменную, которую
можно напечатать или использовать в расчетах. Вместе с тем запись может использоваться
как единое целое. В этом случае надо ввести тип записи.
Предположим, имеется следующее описание:
Type Date = Record
Day : 1..31;
Month : (Jan, Feb, Mar, Apr, May, Jun, Jul, Aug, Sep, Oct, Nov, Dec);
Year : Integer;
End;
Var
HisBirth, MyBirth : Date;
85
После приведенного описания переменные HisBirth и MyBirth имеют тип записи Date.
Помимо действий над отдельными полями записей HisBirth и MyBirth можно выполнять
операции над всей записью. Следующий оператор присваивания устанавливает равенство
значений записей HisBirth и MyBirth :
HisBirth := MyBirth;
Для переменных одного типа можно проверить выполнение отношения равенства или
неравенства ("=", "<>").
Поля записи в свою очередь тоже могут быть массивами, множествами, записями.
Соблюдение всех правил перечисления индексов и имен полей при составлении ссылок
является довольно утомительным занятием, часто приводящим к ошибкам. В некоторых
программах, содержащих большое количество обращений к одному и тому же полю, такое
положение приводит к однообразному повторению. Чтобы облегчить выполнение
многократных ссылок для описанных структур вводится оператор with
Общая форма записи:
with <имя переменной> do <оператор>
В рамках оператора, определяемого внутри оператора with, к полям определяемой
переменной можно обращаться просто по имени. Оператор with позволяет более компактно
представлять часто используемые переменные. Например:
with Residence do
begin
writeln(HouseNumber,' ',StreetName);
writeln(CityName,',',StateName,',' ,PostCode);
end;
Операторы with могут быть вложенными. Однако недопустимым является
использование вложенных операторов with, в которых указываются поля одного типа,
поскольку возникает неоднозначность конструкции. Следует очень внимательно подходить к
использованию вложенных операторов with, применение которых не только может привести
к ошибкам, но также к потере наглядности структуры программы. Хотя оператор with
является стандартным средством сокращения, его полезность должна еще проявиться.
Конечной целью всякого хорошего программиста является написание не только короткой, но
и понятной программы.
Пример 8-1. В массиве хранятся данные об лучших учениках города: школа, фамилия,
класс. Вывести список учеников, которые учатся в восьмом классе.
uses crt;
type uchenik=record
shkola : integer;
fam : string[15];
klass : integer;
end;
var
i,n,a,j : integer;
massiv : array[1..100] of uchenik;
рrocedure poisk;
begin
for i:=1 to n do
if massiv[i].klass=8 then
with massiv[i] do
writeln(shkola:4,' ',fam:15,' ',klass); end;
begin
86
clrscr;
write('Bведите число учеников ');
readln(n);
for i:=1 to n do
begin
writeln('введите через пробел номер школы и фамилию ученика ');
with massiv[i] do
begin
readln(shkola,fam);
write('введите класс ученика (только число) ->');
readln(klass);
end;
end;
writeln('ученики 8-ых классов:');
writeln('школа фамилия класс');
writeln('---------------------------------');
poisk;
readkey;
end.
Записи с вариантами.
Записи, рассмотренные выше - это записи с фиксированными частями. Они имеют в
различных ситуациях строго определенную структуру. Соответственно записи с вариантами
в различных ситуациях могут иметь различную структуру.
Предположим, что написана программа для введения списка библиографических
ссылок. Если известно, что все входы в этом списке - ссылки на книги, то можно
использовать следующее описание:
const kol = 1000;
type
entry = record
author, title, publisher, city : string;
year : 1..2000;
end;
var
list : array[1..kol] of entry;
Предположим, что содержание списка содержит ссылки на журнальные статьи. Если
ограничиваться только записями с фиксированными частями, то следует описать различные
массивы для каждого вида записей. Использование записей с вариантами позволяет
образовать структуру, каждый вход которой соответствует содержанию записи. Опишем
новый тип, в котором перечислены различные входы:
type entrytype = (book, magazine);
Теперь можно привести скорректированное описание Entry
type entry = record
author, title : string;
year: 1..2000;
case entrytype of
book : (publisher, city : string);
magazine : (magname : string,
volume, issue : integer)
end;
Это описание делится на две части: фиксированную и вариантную. Поля Author,
Title, Year составляют фиксированную часть. Оставшаяся часть описания Entry
образует вариантную часть, структура которой может меняться в пределах двух
альтернативных определений.
87
Первая строка вариантной части представляет оператор case, который отличается тем,
что в качестве селектора применяется идентификатор типа. Значения EntryType
используются в качестве имен двух альтернатив определения записи. Когда эта компонента
имеет значение Book, можно обращаться к полям
Autor, Title, Year,
Publisher, City.
С другой стороны, когда она принимает значение Magazine, то можно обращаться к
полям Author, Title, Year, MagName, Volume, Issue.
Kаким образом можно узнать , что List[3] содержит ссылку на книгу, а List[4] ссылку на журнал? Естественное решение этой проблемы заключается в добавлении в
каждой записи нового поля, называемого полем тега. Язык Паскаль позволяет за счет
совмещения задать описание поля тега в сокращенной форме:
type entry = record
author, title: string;
year:1..2000;
case tag: entrytype of
book: (publisher, city : string);
magazine: (magname : string,
volume, issue: integer)
end;
Поле, названное TAG, является переменной типа EntryType. Когда запись содержит
ссылку на книгу, TAG следует присвоить значение Book. Когда запись содержит ссылку на
журнал, TAG следует присвоить значение Magazine.
Вариантная часть может содержать произвольное число альтернатив. Хотя
перечисляемые типы предпочтительнее, так как они более понятны, тем не менее для
именования альтернатив записи с вариантами могут использоваться идентификаторы
произвольного порядкового типа.
Очевидно, что один и тот же идентификатор поля не может дважды использоваться при
описании записи, даже если он применяется в определении различных альтернатив записи с
вариантами. Если же это условие не выполняется, то обращение к такому идентификатору
приведет к непредсказуемому результату.
Пример 8-2. В массиве хранятся данные об учениках класса: фамилия, имя, отчество,
адрес (улица, дом , квартира) и домашний телефон (если есть). Вывести список учеников, у
которых нет телефона.
uses crt;
type uchenik=record
name:string[10];
fam:string[15];
otch:string[15];
ulica:string[20];
dom:string[5];
kvartira: integer;
case tel: boolean of
false:();
true:(telefon:string[15]);
end;
var
massiv : array[1..100] of uchenik;
i,n: integer;
otvet: 0..1;
begin
clrscr; textcolor(9);
write('введите число учеников->');
readln(n);
for i:=1 to n do begin
88
with massiv[i] do
begin
write('введите имя ',i,'-го ученика ->');
readln (name);
write('введите фамилию ',i,'-го ученика ->');
readln(fam);
write('введите отчество ',i,'-го ученика ->');
readln(otch);
write('введите улицу ',i,'-го ученика ->');
readln(ulica);
write('введите дом ',i,'-го ученика ->');
readln(dom);
write('введите квартиру ',i,'-го ученика ->');
readln(kvartira);
write('есть ли у ',i,'-го ученика телефон (0-нет, 1-да->');
readln(otvet);
if otvet=1 then begin
tel:=true;
write(''введите телефон ',i,'-го ученика ->');
readln(telefon);
end;
end;
end;
textcolor(red);
writeln('список учеников, до которых нельзя дозвониться:');
for i:=1 to n do begin
with massiv[i] do
if tel=false then begin
writeln('имя:',name);
writeln('фамилия:',fam);
writeln('отчество:',otch);
writeln('улица:',ulica);
writeln('дом:',dom);
writeln('квартира:',kvartira);
end;
end;
readkey;
end.
89
ФАЙЛЫ
Нет предела совершенству….
К.Прутков
Типизированные файлы.
До сих пор мы рассматривали задачи, в которых во время выполнения программы
данные поступают с клавиатуры, а результаты выводятся на экран дисплея. Поэтому ни
исходные данные, ни результаты не сохраняются. Всякий раз при выполнении одной и той
же программы, особенно во время отладки, приходится заново вводить данные. В языке
Паскаль есть возможность записать их на диск. для этого необходимо оформить исходные
данные и результаты в виде файлов, которые хранятся на диске точно так же как и
программы.
Один и тот же физический файл можно по-разному представить в программе. Язык
Турбо Паскаль предлагает три вида такого представления:
 типизированные файлы,
 текстовые файлы,
 нетипизированные файлы.
Типизированный файл - последовательность элементов одного типа.
Описание файлового типа имеет синтаксис:
file of < тип элементов>;
Например:
type student = record
name: string;
year: byte;
sessia: array [1..10] of byte;
end;
var
vf1: file of char;
vf2: file of student;
vf3: file of string;
Файловые переменные имеют специфическое применение. Над ними нельзя выполнять
никаких операций (присваивать значение, сравнивать и др.). Их можно использовать только
для выполнения операций с файлами (чтения, записи, удаления файла и т.д.). кроме того,
через файловую переменную можно получить информацию о конкретном файле (тип,
параметры, имя файла и т.д.).
Процедуры и функции для работы с файлами любого типа
До начала работы с файлами устанавливается связь файловой переменной с именем
дискового файла. Очень важно различать собственно файл (область памяти на магнитном
носителе с некоторой информацией) и переменную файлового типа в некоторой Pascalпрограмме. Считается, что файловая переменная является представителем некоторого
дискового файла в программе. Для того, чтобы реализовать доступ к файлу на магнитном
диске, программа должна связать его с файловой переменной. Для этого необходимо
сопоставить переменную с именем файла. Это имя представляется в виде строки,
содержащей полное имя файла и, может быть, маршрута к файлу, который формируется по
общим правилам операционной системы MS-DOS.
90
Например,
assign (vf1, 'с:\МуDir\Result.dat');
Если путь не указан, программа будет искать файл только в своем рабочем каталоге и,
как это принято в системе DOS, по указанным в файле аutoехес.bat путям.
Процедура assign не должна использоваться для открытого файла.
Не разрешается связывать с одним физическим файлом различные файловые
переменные в программе.
До тех пор, пока файловая переменная не связана с каким-либо дисковым файлом,
никакие операции с ней в программе невозможны.
Можно связать файловую переменную с еще не существующим дисковым файлом,
если в дальнейшем планируется его создание.
После того, как файловая переменная с помощью процедуры Аssign связана с
конкретным дисковым файлом, можно выполнить любую допустимую операцию с ним.
Все файлы, открытые в результате работы программы, должны быть закрыты при
завершении программы процедурой closе.
При выполнении этого оператора закрывается физический файл на диске и фиксируются
изменения, связанные с использованием данного файла. Обратите внимание на
необходимость закрытия файлов во всех ветвях программы, в том числе в различных
аварийных ситуациях.
Незакрытые файлы нарушают файловую структуру на диске, что может привести
к серьезным проблемам.
Открытие нового файла для записи производится процедурой rewrite, единственный
аргумент которой - переменная файлового типа. Эта процедура создает на диске новый файл,
имя которого связано с файловой переменной процедурой Аssign. Указатель работы с
файлом помещается в начальную позицию.
Если файл с таким именем уже существует, он становится пустым, то есть его
предыдущее содержание теряется.
Подготовку существующего файла для чтения выполняет процедура reset. Эта
процедура ищет уже существующий файл на диске и открывает его для работы, помещая
указатель в начальную позицию. Если файл с установленным в Аssign именем не найден,
возникает ошибка ввода/вывода.
Файл в данный момент времени может быть в одном из двух состояний: либо
только для записи, либо только для чтения.
Однако, типизированные файлы допускают чтение и запись вне зависимости от
режима, в котором они были открыты.
Чтение из файла и запись в файл производятся стандартными процедурами read
(readln) и write (writeln).
Аргументы же этих процедур можно в общем виде представить как
(МуFilе, var1, var2, ...., varN);
Первый аргумент - переменная файлового типа, далее следует список записываемых
(считываемых) переменных, тип которых должны соответствовать объявленному типу
файла. При выполнении этих операций текущий указатель файла смещается на число
позиций, равное числу переменных.
91
Положение элементов в файле нумеруется, начиная с номера 0 для первого элемента.
После последнего элемента файла автоматически записывается признак конца файла.
Определить число элементов в файле позволяет функция FileSize. Если достигнут конец
файла, то функция ЕОF возвращает значение Тruе.
Если есть необходимость нарушения последовательной записи или чтения из файла,
текущий указатель, может быть изменен процедурой seek(МуFilе,n), где n - требуемое
положение указателя. Текущую позицию указателя дает функция FilePos (МуFilе).
Пример 9-1. Составить программу, которая переписывает существующий файл,
заменяя все латинские буквы на заглавные.
var
filename:string; {строка, содержащая имя файла}
fvar: file of char; {переменная файлового типа}
index: integer;
letter: char; {читаемый из файла символ}
begin
write('Имя файла: ');
readln (filename);
assign (fvar,filename); {связь имени файла и переменной}
reset (fvar); {открытие файла для чтения и записи}
while not eof (fvar) do {цикл до конца файла}
begin
read (fvar, letter); {чтение символа из файла}
letter:=upcase(letter); (преобразование букв)
seek(fvar,filepos(fvar)-1); {перемещение указателя назад на 1 позицию}
write(fvar,letter); {запись преобразованной буквы}
end;
close(fvar) {закрыть файл}
end.
Тeкстовые файлы
Во многих задачах допускается хранение файлов на диске как символьных данных. При
считывании файла в оперативную память машины символы файла преобразуются в тот тип
данных, который объявлен в программе. Файлы символьных данных называются текстовыми
файлами. Текстовые файлы имеют тип text.
Структура текстовых файлов отличается от структуры обычных файлов (которые
представляют из себя линейную последовательность элементов одного типа) тем, что
содержимое текстового файла рассматривается как последовательность строк переменной
длины, разделённых специальной комбинацией, называемой "конец строки". Как правило,
эта комбинация строится из управляющего кода "перевода каретки" (CR, символ #13), за
которым, возможно, следует управляющий код "перевод строки" (LF, символ #10).
Признаком конца строки считается нажатие клавиши ввода.
Текстовый файл завершается специальным кодом "конец файла" (символ #26). В
большинстве случаев знание конкретной кодировки управляющих символов не обязательно
ввиду наличия файловых операций, автоматически учитывающих эти символы.
Текстовый файл можно схематически представить в следующем виде:
. . . . . . . . . . . . . .#13#10
. . . . . . . . . . . . . . . . . . . .#13#10
. . . . . . . . . . . . . . . . .#13#10
#26
Описанная структура текстовых файлов хорошо согласуется с интуитивно понимаемым
построением текстовой информации и полностью совпадает со стандартной структурой
текстов, используемой во многих текстовых редакторах.
Представителем текстового файла в Pascal-программе является переменная файлового
типа, которая должна быть описана с указанием стандартного типа text:
92
var textfile : text;
Слово text не является зарезервированным словом, а считается идентификатором
стандартного типа, наряду с идентификаторами integer, real и т.д.
Ввод-вывод для текстовых файлов подчиняется тем же общим правилам, что и для
обычных типизированных файлов; однако имеется несколько важных особенностей.
Во-первых, для одного текстового файла нельзя одновременно производить операции и
ввода, и вывода. Это означает, что после открытия текстового файла процедурой reset
возможно только чтение информации из файла, после процедуры rewrite - только запись
в файл.
Во-вторых, обмены с текстовыми файлами всегда являются строго последовательными,
то есть после чтения из файла элемента с порядковым номером N следующая операция
чтения даст элемент с номером N+1. Иными словами, прямой доступ к любому элементу
текстового файла невозможен.
Часто при обработке текстовых файлов используется специфичная для них функция
EOLN, позволяющая определить достигнут ли конец строки. Если достигнут - значение
функции равно True, а если нет - False. Таким образом, для анализа конкретных символов
строк файла можно применить вложенный цикл типа:
while not eof(FileName) do {пока нет конца файла }
while not eoln(FileName) do {пока нет конца строки файла }
begin
{группа операторов обработки символов очередной строки}
end;
Для текстовых файлов определена также процедура открытия файла для дополнения
append - процедура открывает существующий файл для присоединения. Если файл уже
открыт, то он сначала закрывается, а затем открывается заново. Текущая позиция
устанавливается на конец файла. После обращения файлу данной процедурой, он становится
доступным только по записи и EOF принимает всегда значение True.
Пример 9-2. Дан текстовый файл, содержащий скобки. Проверить численное
соответствие закрытых и открытых скобок
var f : тext;
put, s: string;
a, i : integer;
begin
a:=0; {счетчик скобок}
put:='c:\primer4.txt'; {полный путь до файла }
assign(t, put); reset(f);
while not eof(f) do begin
readln(f, s); {считываем cтроку в переменную s}
for i := 1 to length(s) do begin {просматриваем строку до конца}
if s[i] = '(' {если встретилась открытая скобка,}
then a:=a+1;{то счетчик увеличиваем на 1}
if s[i] = ')' {если встретилась закрытая скобка,}
then a:=a-1;{то счетчик уменьшаем на 1}
end; end;
close(f);{закрытие файла}
if a <> 0{если скобок одинаковое кол-во, то а=0}
then writeln('no') else writeln('yes'); end.
Нетипизированные файлы.
Нетипизированные файлы - это файлы, поддержка которых осуществляется с
максимально возможной скоростью. Введение таких файлов в систему Турбо Паскаль было
вызвано стремлением повысить эффективность программ, участвующих в интенсивном
93
обмене с внешними наборами данных. Эти файлы в отличие от уже рассмотренных не имеют
строго определенного типа.
Нетипизированный файл рассматривается в Паскале как совокупность символов или
байтов. Представление char или byte не играет никакой роли, важен лишь объем занимаемых
данных.
Такое представление стирает различия между файлами независимо от типа их
объявления. На практике это приводит к тому, что любой файл, подготовленный как
текстовый или типизированный, можно открыть и начать работу с ним, как с
нетипизированным набором данных.
Для определения в программе нетипизированного файла служит зарезервированное
слово file:
var MyFile : file;
Внутренняя поддержка таких файлов выглядит наиболее близкой к аппаратной
поддержке работы с внешними носителями. За счет этого достигается максимально
возможная скорость доступа к наборам данных. Для нетипизированных файлов не нужно
терять время на преобразование типов и поиск управляющих последовательностей,
достаточно считать содержимое файла в определенную область памяти.
Нетипизированный файл является файлом прямого доступа, что говорит о возможности
одновременного использования операций чтения и записи.
Для таких файлов самым важным параметром является длина записи в байтах. Открытие
нетипизированного файла с длиной записи в 1 байт можно выполнить следующим образом:
rewrite(MyFile, 1) или reset(MyFile, 1)
Второй параметр, предназначенный только для использования с нетипизированными
файлами, задает длину записи файла на сеанс работы.
Особенность аппаратной поддержки заключается в том, что при обращении к внешнему
устройству минимально возможным объемом для считывания являются 128 байт. В
стремлении добиться наибольшей эффективности файловых операций в Турбо Паскале
принято соглашение, по которому длина записи нетипизированного файла по умолчанию
составляет 128 байт. Поэтому после открытия файла с помощью вызовов:
rewrite(MyFile) или reset(MyFile)
все процедуры и функции, обслуживающие файлы прямого доступа, работают с записями
длиной 128 байт.
Каждый пользователь для своих программ может выбрать наиболее подходящий
размер записи.
Турбо Паскаль не накладывает каких-либо ограничений на длину записи
нетипизированного файла, за исключением требования положительности и ограничения
максимальной длины 65535 байтами (емкость целого типа word). При этом следует
учитывать два обстоятельства.
Во-первых, для обеспечения максимальной скорости обмена данными следует задавать
длину, которая была бы кратна длине физического сектора дискового носителя информации
(512 байт).
С другой стороны, нужно помнить, что общий размер файла может не быть кратен
выбранному размеру записи (последняя запись может быть неполной). Для того, чтобы
гарантированно обеспечить полное чтение всего файла, рекомендуется установить размер
записи равным 1.
Более того, фактически пространство на диске выделяется любому файлу порциями кластерами, которые в зависимости от типа диска могут занимать 2 и более смежных
секторов. Как правило, кластер может быть прочитан или записан за один оборот диска,
поэтому наивысшую скорость обмена данными можно получить, если указать длину записи,
равную длине кластера.
94
При работе с нетипизированными файлами могут применяться все процедуры и
функции, доступные типизированным файлам.
Для чтения информации из нетипизированного файла и записи информации в него
только для данного типа файлов в Турбо Паскаль введены две новые процедуры,
поддерживающие операции ввода-вывода с более высокой скоростью.
Процедура BlockRead. Формат обращения:
blockread(Var F : file; Var Buf; Kolblocks : word; result : word);
Процедура считывает из файла F определенное число блоков в память, начиная с
первого байта переменной Buf.
Параметр Buf представляет любую переменную, которая будет участвовать в обмене
данными с дисками. Эту переменную нужно описать в программе так, чтобы ее размер не
был меньше размера записи, установленного в параметрах rewrite или reset (как правило, для
этих целей используется некоторый массив).
Параметр Kolblocks задает число считываемых блоков, которые должны быть
прочитаны за одно обращение к диску.
Параметр result является необязательным и содержит после вызова процедуры число
действительно считанных записей.
Использование параметра result подсказывает, что число считанных блоков может быть
меньше, чем задано параметром Kolblocks. Если result указан при вызове, то ошибки вводавывода в такой ситуации не произойдет.
Кроме того, что переменная F должна быть описана как нетипизированный файл, она
должна быть связана с конкретным физическим диском процедурой assign. Файл должен
быть открыт процедурой reset.
Процедура BlockWrite. Формат обращения:
blockwrite(Var F : file; Var Buf; Kolblocks : word; result : word);
Процедура предназначена для быстрой передачи в файл F определенного числа записей
из переменной Buf. Все параметры процедуры blockwrite аналогичны параметрам процедуры
blockread. Разница лишь в том, что файл должне быть подготовлен для записи процедурой
rewrite. Содержимое переменной Buf целиком помещается в файл, начиная с текущей записи.
Обе процедуры выполняют операции ввода-вывода блоками. Объем блока в байтах
определяется по формуле:
Объем = Kolblocks * recSize,
где recSize - размер записи файла, заданный при его открытии. Суммарный объем разового
обмена не должен превышать 64 Кбайт. Помимо скорости передачи данных преимущество
этих процедур заключается в возможности пользователя самостоятельно определять размер
буфера для файловых операций. Эта возможность играет значительную роль в тех задачах,
где необходимо жесткое планирование ресурсов. Программист должен позаботиться о том,
чтобы длина внутреннего представления переменной Buf была достаточной для размещения
всех байт при чтении информации с диска.
Дело в том, что чтение информации из файла в буфер, равно как и запись из буфера в
файл, производится без типового контроля. Поэтому несоблюдение указанного условия
может привести к порче соседних с буфером данных или к помещению на файл посторонней
информации.
Если при чтении указана переменная Buf недостаточной длины или если в процессе
записи на диск не окажется нужного свободного пространства, то произойдет следующее.
Если последний параметр result в этих вызовах не задан, то возникает ошибка ввода-вывода;
если параметр result задан, то ошибка не будет зафиксирована, а после выполнения
процедуры его значение не будет совпадать с значением параметра Kolblocks. Последнее
обстоятельство можно проверить, сравнив два указанных значения. После завершения
процедуры указатель смещается на result записей.
95
Пример 9-3. Составить программу, которая создает нетипизированный файл из 100
чисел и выводит на экран k-ый элемент.
type filetype = file;
var
f: filetype;
p, b, k : byte;
begin
assign(f, 'myfile');
rewrite(f,1);
randomize;
for k := 1 to 100 do begin
p:= random(100); blockwrite(f, p, 1);
end;
close(f);
reset(f,1);
for k:=1 to 100 do begin
blockread(f, p, 1);
write(p,' ');
end;
write('Bведите номер нужного элемента ');
readln(k);
seek(f, k-1);
blockread(f, p, 1);
writeln(k,'-ий элемент файла равен ', p);
close(f);
end.
Задания для самостоятельного решения
А. Среди N абитуриентов, сдававших экзамены по информатике, математике и
английскому языку, выбрать всех отличников и всех учащихся, набравших в сумме не
меньше проходного балла. Данные о проходном балле вводятся с клавиатуры.
В. Составить программу, выдающую справку о номере квартиры, в которой
проживает жилец. В доме имеется N квартир и проживает M человек. Пользователь
вводит фамилию жильца. Если в доме поживает несколько жильцов с такой фамилией,
то выдается сообщение о необходимости ввести инициалы. Если инициалы у нескольких
жильцов совпадают, то необходимо ввести год рождения. Если с такими данными
найдется один жилец (несколько), то вывести номер (номера) квартир, где он (они)
проживают и все введенные о нем (них) сведения. Если жильца с такой фамилией нет,
то вывести сообщение об этом.
С. Составить программу, собирающую данные об авиакомпаниях и выдающую
справку туристу до запрашиваемого места. Справка должна содержать:
1. название авиакомпании;
2. название рейса;
3. номер рейса;
4. тип самолета;
5. даты вылета (содержатся в массиве);
6. наличие мест в 1 и 2 классах;
7. стоимость перелета.
В случае покупки билета, файл записей должен быть соответственно изменен.
96
Практикум
ПРИКЛАДНЫЕ ЗАДАЧИ
Пример 9-4. Из текстового файла прочитать находящиеся там символы, заменить их
на символы, отличающиеся своими кодами от исходных на определенную величину,
меняющуюся от символа к символу (шифрация методом простой одноалфавитной
подстановки). Поместить эти символы в новый файл, разместив в нем предварительно
число перекодированных символов и таблицу смещений кодов.
const nofcod = 20; {размер таблицы смещений кодов}
var
firstfile : text; {исходный файл}
secondfile : file; {результирующий файл}
firstname, secondname : string;
iores : byte; {код результата работы с файлом}
nofsymb : longint; {число символов в файле}
codes : array[1..nofcod] of byte; {таблица смещений кодов символов}
buffer : array [1..nofcod] of char; {буфер для символов}
i: word;
{процедура записи в файл с проверкой}
procedure writeandcontrol (var buf, amount : word);
var result : word; {число переданных символов}
begin
blockwrite (secondfile, buf, amount, result);
if result <> amount then begin
writeln('Нет места на диске ');
halt;
end;
end;
begin
write('Введите имя исходного файла: ');
readln(firstname);
assign(firstfile, firstname);
reset(firstfile);
write('Введите имя результирующего файла: ');
readln(secondname);
assign(secondfile, firstname);
rewrite(secondfile, 1); {размер блока в один байт}
{установка счетчика символов и запись его в файл}
nofsymb := 0; writeandcontrol(nofsymb, 4);
{задание таблицы смещений кодов символов, запись ее в файл}
randomize;
for i := 1 to nofcod do codes[i] := random(256);
{перекодировка символов и запись содержимого полных буферов в файл}
i := 0;
while not eof(firstfile) do begin
inc(nofsymb); inc(i);
if eoln(firstfile) then begin
buffer[i] := chr((13+codes[i]) mod 256);
if i=nofcod then begin
writeandcontrol(buffer, nofcod);
i := 0;
end;
inc(i);
buffer[i] := chr((10+codes[i]) mod 256);
readln(firstfile);
end;
else
97
begin
read(firstfile, symbol);
buffer[i] := chr((ord(symbol)+codes[i]) mod 256);
end;
if i = nofcod then begin
writeandcontrol(buffer, nofcod);
i := 0;
end;
{запись в файл завершающей части символов}
if i <> 0 then begin
writeandcontrol(buffer, i);{запись числа символов}
nofsymb := filesize(secondfile)-nofcod-4;
seek(secondfile, 0);
writeandcontrol(nofsymb, 4);
close(secondfile);
readln;
end.
В этой программе в результирующий файл окончательно будут записаны: общее
количество перекодированных символов, таблица смещений кодов символов и
перекодированные символы. Файл используется как файл без типа с размером блока в 1 байт,
который устанавливается процедурой rewrite.
Пример 9-5. С помощью нетипизированного файла проанализировать файлы с
расширением .mp3 в заданном пользователем каталоге и создать текстовый файл,
содержащий следующую информацию: название песни, исполнитель, имя файла.
uses crt;
var f : file;
c : char; s : string;
i : longint;
dirinfo : seachrec;
txt : text;
procedure extract;
begin
assign(f, dirinfo.name);
reset(f, 1); {размер буфера записи равен 1 байту}
l := filesize(f); {переменной l присваиваем размер файла в байтах}
seek(f, l-125); {ставим указатель, на 125 символов от конца файла}
while not eof(f) do
begin
blockread(f, c, 1); {читаем посимвольно}
s := s + c; {формируем строковую переменную, содержащую нужный тэг}
end;
close(f);
writeln(txt, copy(s, 1, 30)+'-'+copy(s, 31, 30)+'-'+dirinfo.name);
{записываем выделенную информацию в файл)}
end;
begin
clrscr;
assing(txt,'list.txt'); rewrite(txt);
findfirst('*.mp3', arhive, dirinfo);
while doserror=0 do
begin
s := ''; extract;
findnext(dirinfo);
end;
close(txt); end.
98
Пример 9-6. С помощью нетипизированного файла преобразовать файл c расширением
.BMP следующим образом: разделить рисунок на две части по горизонтали, верхнюю часть
поместить на место нижней, разделить её на две части по вертикали и поменять их
местами.
При исследовании файлов с расширением ВМР выяснилось следующее их описание в
зависимости от количества употребляемых цветов:
16 цветов - 118 байт, 256 цветов - 1086 байт, 24 бита - 55 байт. Это количество байт
влияет на значение переменное Кol в программе.
uses crt;
const
n=1234; {установка размера буфера}
kol=118;
var
f1, f2 : file;
name1, name2 : string;
buf : array [1..n] of byte;
allsize, picsize, halfsize : longint;
i : integer;
begin
write('имя файла >'); readln(name1);
name2 := name1;
if pos('.', name2) <> 0 then begin
delete(name2, pos('.', name2), lenth(name2)-pos('.', name2)+1);
name2 := name2+'.tmp';
assign(f1, name1); reset(f1, 1);
assign(f2, name2); rewrite(f2, 1);
allsize := filesize(f1); {размер всего файла}
picsize := allsize-kol; {размер всего файла без описания}
halfsize := picsize div 2; {половина файла}
blockread(f1, buf, kol);
blockwrite(f2, buf, kol);
seek(f1, kol+halfsize-1);
for i := 1 to halfsize div n do
begin
blockread(f1, buf, n); {считываем и записываем из середины файла}
blockwrite(f2, buf, n);
end;
blockread(f1, buf, halfsize mod n);
{переписываем оставшиеся байты из не полностью заполненного буфера}
blockwrite(f2, buf, halfsize mod n); seek(f1, kol-1);
blockread(f1, buf, halfsize mod n);
blockwrite(f2, buf, halfsize mod n);
close(f1); close(f2);
end;
end.
Задачи для самостоятельного решения
А. Составить программу формирования и отображения на экране генеалогического
древа семьи с функцией поиска всех потомков или всех предков для указанного лица с
графическим или текстовым интерфейсом.
В. Составить программу «Ежедневник» с базой данных по намечаемым делам –
дата, время, длительность, место. Автоматическое напоминание ближайшего события.
Удаление вчерашних дел или перенос их на будущее. Анализ накладок – пересечений при вводе
или переносе дел. В начале дня и конце дня – напоминание всех дел на сегодня и завтра
соответственно. Графический интерфейс.
99
УКАЗАТЕЛИ
Когда нельзя, но очень
нужно, то можно…
Народная мудрость
В любой вычислительной системе память относится к таким ресурсам, которых всегда
не хватает. Управление памятью - одна из главных забот программиста, так как для него
очень важно создавать программы, эффективно использующие память, ведь во время
выполнения программы память необходима для следующих элементов программ и данных:
 сама программа пользователя;
 системные программы времени выполнения, которые осуществляют вспомогательные
действия при работе программы пользователя;
 определяемые пользователем структуры данных и константы;
 точки возврата для программ;
 временная память для хранения промежуточных результатов при вычислении
выражений;
 временная память при передаче параметров;
 буферы ввода-вывода, используемые как временные области памяти, в которых
хранятся данные между моментом их реальной физической передачи с внешнего
устройства или на него и моментом инициализации в программе операции ввода или
вывода;
 различные системные данные (информация о статусе устройств ввода-вывода и др.).
Из этого перечня видно, что управление памятью касается широкого класса объектов.
До сих пор мы использовали простейший способ распределения памяти - статическое
распределение, т. е. распределение памяти при трансляции программы. То есть когда
объявляется переменная а: аrray[1..100] of integer, то тем самым дается
указание компилятору выделить память размера, соответствующего заданному типу, т.е.
2*100=200 байт. Если в программе на нужный программный объект мы ссылаемся по имени
А[3], то машинный код содержит ссылку на номер ячейки памяти (адрес байта), начиная с
которой размещается этот объект.
Адреса задаются двумя 16-тиразрядными словами (тип word) - сегментом и смещением.
Каждое из них способно адресовать 216=65536 байт (64 Кбайт). Для адресации пространства
размером в 1 Мбайт требуется 20 разрядов. Сегменты адресуют память с точностью до
параграфа - фрагмента памяти в 16 байт. Смещение адресует память с точностью до байта,
но впределах сегмента. Реальный (абсолютный) адрес складывается из значения сегмента,
сдвинутого на 4 разряда влево (умноженного на 16), и смещения. Т.е.
Address:= Segment*16+Offset;
Программа на Паскале получает один сегмент данных, поэтому область памяти, в
которой могут быть размещены статические переменные программы, ограничена 64
Кбайтами. При попытке исполнить программу, требующую большего размера памяти, будет
выдана ошибка:
Error 49: Data Segment too large{Слишком большой сегмент данных}
При динамическом распределении памяти есть возможность запросить блоки размером
до одного сегмента (64 Кбайт) каждый, причем их можно требовать в пределах основной
памяти (640 Кбайт) в реальном режиме и без программных ограничений в защищенном.
Бывают такие данные, размер которых выясняется только при выполнении программ.
Кроме того, иногда мы не знаем, будет существовать некоторый объект или нет.
Например, в программе для обработки текстов требуется организовать поиск слов,
определенных пользователем. Естественно, что определить заранее длину слова, которое
будет задано, невозможно. Часто программный объект, причем значительного размера,
бывает нужен на непродолжительное время. Использование статических программных
объектов в таких случаях очень неэффективно, поскольку программа должна быть
100
рассчитана на максимальные размеры объектов. Область памяти, в которой могут быть
размещены статические переменные, ограничена, и, рассчитывая на максимальный размер
переменных, мы ограничиваем их количество. В Паскале, кроме статических,
предусмотрены динамические объекты. Память под них отводится во время исполнения
программы, а когда программный объект можно удалить, память освобождается.
И статические, и динамические переменные вызываются по их адресам. Без адреса не
получить доступ к нужной ячейке памяти, но, используя статические переменные,
непосредственно адрес не указывается, а происходит обращение к переменной по имени.
Компилятор размещает переменные в памяти и подставляет нужные адреса в коды команд.
Адресация динамических переменных происходит через указатели. В Паскале можно
определить переменные, которые имеют тип указатель, их значения определяют адрес
объекта. Для работы с динамическими переменными в программе должны быть
предусмотрены:
 выделение памяти под динамическую переменную;
 присвоение указателю на динамическую переменную адреса выделенной памяти
(инициализация указателя);
 освобождение памяти после использования динамической переменной.
Программист сам должен резервировать место под переменную, определять значения
указателей, освобождать память - удалять динамические переменные. Для использования
динамической переменной где-то в статике должен быть указатель на нее. Компилятор
предусматривает место под указатель, об инициализации указателя должен заботиться
программист.
Вместо любой статической переменной можно использовать динамическую, но без
реальной необходимости этого делать не стоит. Переменные простых типов нет смысла
размещать в динамической области, поскольку они занимают меньше места, чем указатель
на них. Например, указатель на целое занимает 4 байта, само целое - 2 байта. Кроме того, при
динамическом распределении памяти удлиняется текст программы, снижаются наглядность
и быстродействие. Это объясняется тем, что, во-первых, нужно во время исполнения
программы определять значения указателей, а во-вторых, усложняется доступ к значению
переменной.
Указатели и их объявление
Для работы с динамическими программными объектами в Паскале предусмотрен
ссылочный тип или тип указателей. В переменной ссылочного типа хранится ссылка на
программный объект (адрес объекта). Указатель состоит из сегмента и смещения. По
правилам Паскаля указатели на разные типы данных имеют различные типы, причем эти
типы несовместимы, т.е. указатели на разные типы данных не могут ссылаться на один
объект.
Чтобы связать ссылочный тип с определенным типом данных, используется символ ^,
помещаемый перед именем типа. Например, имеется тип массив:
type a = array[1..100] of integer;
Тип указателя на такой объект:
type ta=^a;
Переменные ссылочного типа могут определяться как статические, при этом по общим
правилам объявления переменных возможна запись с явным и неявным определением
ссылочного типа.
type
var
a=array[1..100] of integer; {тип массив из 100 целых чисел}
ta=^a; {тип указатель на тип а}
b:ta; {указатель на тип а}
c:^a; {указатель на тип а}
Для получения данных, соответствующих указателю, символ "^" приводится после
имени указателя. Действия с элементами массива типа А могут быть описаны через действия
над указателями В и С.
101
B^[i]:=i;
{i-му элементу массива, на который указывает В, присвоить значение i}
C^[i]:=B^[i];
{i-му элементу массива, на который указывает С, присвоить значение
i-го элемента массива, на который указывает В}
После выполнения этого кода i-е элементы массивов, на которые указывают В и С,
будут равны.
Указатели могут ссылаться на любой тип данных, кроме файлового.
Обратите внимание, что указатель является обычной статической переменной, а
переменная, на которую он указывает - динамической.
Схематически можно представить себе указатель так:
Указательная переменная Р может быть в трех состояниях.
1. Содержать адрес какой-либо переменной, память под которую уже выделена.
2. Содержать специальный пустой адрес Nil.
3. Находиться в неопределенном состоянии.
В неопределенном состоянии указатель бывает в начале работы программы до первого
присваивания ему или конкретного адреса, или пустого адреса Nil, а также после
освобождения области памяти на которую он указывает.
Схематически различия между состоянием Nil и неопределенным состоянием можно
изобразить так:
Использование имени указателя в программе означает обращение к адресу ячейки
памяти, на которую он указывает. Чтобы обратиться к содержимому ячейки, на которую
указывает указатель, требуется после его идентификатора поставить символ ^. Эта операция
еще называется разыменованием.
Для представления указателя на строку с завершающим нулем в Паскале имеется
предопределенный тип PChar.
Этот тип описывается следующим образом:
type pchar = ^char;
102
Паскаль поддерживает набор расширенных правил, позволяющих работать со строками
с завершающим нулем, используя тип PChar.
Иногда связи между ссылкой и переменной не существует по смыслу задачи, в этом
случае с указателем нельзя связать никакой объект, а ссылка должна быть пустой.
Зарезервированное слово Nil обозначает константу со значением указателя, который ни на
что не указывает. После присвоения
P := Nil;
указатель не будет указывать ни на какой объект. Значение Nil совместимо с любым
ссылочным типом.
Операции "=" и "<>" могут использоваться для сравнения операндов типа указатель. Два
указателя равны только в том случае, если они ссылаются на один и тот же объект.
Переменной-указателю можно присвоить значение другого указателя того же типа. В
языке существует универсальный тип указателя - pointer. Используя тип pointer как
промежуточный, можно присвоить значение одного указателя другому и при несовпадении
их типов.
Для инициализации указателей в Паскале предусмотрены специальные процедуры и
функции.
Переменной-указателю можно присвоить значение с помощью процедуры new,
операции @ или функции Ptr.
Процедура new отводит блок памяти в области для динамических переменных и
сохраняет адрес этого блока в указателе.
Операция @ ориентирует переменную-указатель на область памяти, содержащую уже
существующую переменную. Ее можно применять к статическим переменным,
динамическим переменным, процедурам и функциям.
Функция Ptr ориентирует переменную-указатель на определенный адрес в памяти. Тип
результата - указатель того же типа, что и Nil, т.е. он может быть назначен любой
переменной-указателю.
Оператор @ с переменной
Использование @ с обычной переменной (не параметром процедуры) несложно.
Например:
type a = array [0..99] of char; {тип массива символов}
var x: array [0..49] of integer; {массив целых чисел}
pa:^a; {указатель на массив символов}
Объявлены переменные двух разных типов: массива целых из 50 элементов и
ссылочного на тип А (массив из 100 символов). Чтобы указатель рА указывал на массив Х,
надо присвоить ему адрес Х:
рА := @Х; {Указатель на массив целых чисел}
Теперь pA^ ссылается на массив целых, но по своей природе он указатель на массив
символов, поэтому при обращении pA^[i] мы получаем содержимое отдельных байтов
массива Х в символьной форме.
Пример 10-1. Компонентам массива целых чисел присваиваются сдвинутые на 65
значения индекса, затем печатается массив целых чисел. Далее переменной-указателю на
символьный массив присваивается адрес массива целых чисел. Снова распечатывается
массив, но по адресам значений. В итоге, вместо последовательности чисел будет
напечатана последовательность ASCII символов от А до z с пробелами.
103
type a = array [0..99] of char; {тип a - массив 100 символов}
var x : array [0..49] of integer; {массив целых чисел}
pa : ^a; {указатель на массив символов}
i : integer;
begin
for i := 0 to 49 do
begin
x[i] := 65+i {65 - код буквы а}
write(x[i], ' '); {печать чисел}
end;
pa := @x; {указателю на а присваивается адрес массива целых чисел}
writeln;
for i := 0 to 99 do
write(pa^[i],' '); {печать символов}
end.
Попытка исполнить последний оператор до оператора pA := @X привела бы к ошибке,
поскольку указатель на массив был бы неопpеделен. Массив Х имеет значения 65..114,
которые не выходят за пределы младшего байта двухбайтовых элементов типа word. В
старших байтах этой переменной - нули. При побайтной печати массива младшие байты
выводятся как буквы алфавита, а старшие - как символ #0, который процедурой write
интерпретируется как пробел.
Список.
Списком называется структура данных, каждый элемент которой посредством указателя
связывается со следующим элементом.
Из определения следует, что каждый элемент списка содержит поле данных (Data) (оно
может иметь сложную структуру) и поле ссылки на следующий элемент (Next). Поле ссылки
последнего элемента должно содержать пустой указатель (Nil).
Схематически это выглядит так:
Пример 10-2. Сформировать список, содержащий целые числа 3, 5, 1, 9.
Для этого сначала определим запись типа S с двумя полями. В одном поле будут
содержаться некоторые данные (в нашем случае числа 3, 5 , 1 и 9), а в другом поле будет
находится адрес следующего за ним элемента.
Поле данных вообще говоря может содержать в себе сколько угодно полей; это зависит от конкретно
поставленной задачи.
type ukazatel = ^s;
s = record
data : integer;
next : ukazatel ;
end;
Таким образом, мы описали ссылочный тип, с помощью которого можно создать наш
связанный однонаправленный список.
Заметим, что все элементы списка взаимосвязаны, т. е. где находится следующий
элемент, "знает" только предыдущий. Поэтому самое главное в программе, это не потерять,
104
где находится начало списка. Поэтому на начало списка будем ставить указатель с именем
Head и следить за тем, чтобы на протяжении выполнения программы значение этого
указателя не менялось.
Теперь опишем переменные для решения нашей задачи:
var
head, {указатель на начало списка}
x {вспомогательный указатель для создания очередного элемента списка}
: ukazatel ;
Создадим первый элемент:
New(x); {выделим место в памяти для переменной типа S}
x^.Data := 3; {заполним поле Data первого элемента}
x^.Next := Nil; {заполним поле Next первого элемента: указатель в Nil}
Head := x; {поставим на наш первый элемент указатель головы списка}
Таким образом, к выделенной области памяти можно обратиться через два указателя.
Продолжим формирование списка, для этого нужно добавить элемент в конец списка.
Поэтому вспомогательная переменная указательного типа х будет хранить адрес последнего
элемента списка. Сейчас последний элемент списка совпадает с его началом.
Поэтому можно записать равенства:
Head^.Next = x^.Next;
Head^.Data = x^.Data;
Head = x;
Выделим область памяти для следующего элемента списка.
New(x^.Next);
Присвоим переменной х значение адреса выделенной области памяти, иначе,
переставим указатель на вновь выделенную область памяти:
x:= x^.Next;
Определим значение этого элемента списка, иначе, заполним поля:
x^.Data := 5;
x^.Next := Nil;
105
Итак, теперь у нас список содержит два элемента. Понятно, чтобы создать третий и
четвертый элементы, нужно проделать те же самые операции.
Оформим создание списка в виде процедуры, в которой его элементы вводятся с
клавиатуры.
procedure init(var u : ukazatel);
var x : ukazatel;
digit : integer; {значение информационной части элемента списка}
begin
writeln('введите список ');
head:=nil; {список пуст}
writeln ('введите элементы списка. конец ввода 0');
read(digit);
if digit <> 0 then {формируем и вставляем первый элемент списка}
begin
new(x);
x^.next := nil;
x^.data := digit;
head:= x
read(digit);
while digit<>0 do begin
new(x^.next); {формируем и вставляем элемент в конец списка}
x := x^.next;
x^.next := nil;
x^.data := digit;
read(digit);
end;
writeln;
end;
Просмотр списка
Просмотр элементов списка осуществляется последовательно, начиная с его начала.
Указатель р последовательно ссылается на первый, второй, и т.д. элементы списка до тех
пор, пока весь список не будет пройден. При этом с каждым элементом списка выполняется
операция вывода на экран. Начальное значение р – адрес первого элемента списка p^. Если р
указывает на конец списка, то его значение равно Nil, то есть
while p<>nil do
begin
write(p^.data, ' ');
p:=p^.next;
end;
Создание списка путем вставления элементов в начало.
Дан некоторый список:
Рассмотрим как добавить в этот список некоторый элемент, например 2. То есть
получить такой список:
106
Выполним следующие действия:
New(x); {Создание новой динамической переменной}
x^.Data := 2; {Информационное поле созданного элемента}
x^.Next := Head; {Присоединим элементы списка и к созданному элементу}
u := x; {Изменим значение указателя начала списка}
Нужный элемент вставлен.
Упорядочивание списка. Вставка элемента в середину списка.
Сформируем список целых чисел упорядоченный по неубыванию, т.е. каждый
следующий элемент списка должен быть больше или равен предыдущему. Для решения этой
задачи рассмотрим основные части алгоритма.
После ввода очередного числа с клавиатуры определяем его место в списке. Заметим,
что при этом элемент может быть вставлен либо в начало списка, либо в конец его, либо во
внутрь. Первый и второй случаи мы уже рассмотрели выше. Остановимся на третьем случае.
Для того чтобы вставить в список элемент со значением Digit между двумя элементами,
нужно найти эти элементы и запомнить их адреса (первый адрес – в переменной dx, второй –
в рх), после чего установить новые связи с переменной, в которой хранится значение Digit.
Графически это можно представить так:
Операторы, выполняющие данную задачу будут следующими:
New(x);
107
x^.Data := Digit;
px^.Next := x;
x^.Next := dx;
Ниже показана процедура , которая ищет место в списке и вставляет элемент,
переданный ей как параметр. В результате сразу получается упорядоченный список. Адрес
первого элемента списка хранится в глобальной переменной Head.
procedure insinto(digit : integer; var head : ukazatel );
var
dx, px, x : ukazatel ;
begin
new(x);
x^.data := digit;
x^.next := nil;
if head = nil then {если список пуст, то вставляем первый элемент}
head := x
else {если список не пуст, то просматриваем его до тех пор, пока не
отыщется подходящее место для x^ или не закончится список}
begin
dx := head;
px := head;
while (px<>nil) and (px^.data<=digit) do begin
dx := px;
px :=px^.next;
end;
if px=nil then {пройден весь список}
dx^.next := x {элемент добавляется в конец списка}
else {пройден не весь список} begin
x^.next := px;
if px=head then
head := x {вставляем в начало списка}
else dx^.next := x; {вставляем внутрь списка}
end;
end;
end;
Удаление элемента из начала списка
Изобразим удаление графически:
Фрагмент программы:
x := head; {запомним адрес первого элемента списка}
head := head^.next; {теперь head указывает на второй элемент списка}
dispose(x); {освободим память, занятую переменной x^}
Удаление элемента из середины списка
Для этого нужно знать адреса удаляемого элемента и элемента, находящегося в списке
перед ним.
Изобразим удаление графически:
108
x := head; {переменная х для хранения адреса удаляемого элемента}
{найдем адреса нужных элементов списка}
while (x<>nil) and (x^.data<>digit) do
begin
dx := x;
x := x^.next
end;
dx^.next := x^.next;
dispose(x);
Удаление элемента из конца списка
Удаление элемента из конца списка производится, когда указатель dx показывает на
предпоследний элемент списка, а х – на последний.
Изобразим удаление графически:
Найдем предпоследний элемент:
x := head; dx :=head;
while x^.next<>nil do begin
dx := x; x := x^.next; end;
{удаляем элемент x^ из списка и освобождаем занимаемую им память}
dx^.next := nil; dispose(x);
Теперь опишем процедуру удаления элементов из списка в общем случае:
procedure del(gigit : integer; var u : ukazatel );
var x, dx : ukazatel ;
begin
x := head;
while x<>nil do
if x^.data=digit then begin
if x=y then begin
head := head^.next;
dispose(x);
x := head;
end;
109
else begin
dx^.next := x^.next;
dispose(x);
x := dx^.next;
end;
end;
else begin
dx := x;
x := x^.next;
end;
end;
Стек
Стек – это линейный список, в котором добавление новых элементов и удаление
существующих производится только с одного конца, называемого вершиной стека.
Стек часто называют структурой LIFO [сокращение LIFO означает Last In – First Out
(последний пришел, первый вышел)]. Это сокращение представляет удобный способ
запомнить механизм работы стека
Изобразим стек графически:
При программировании на Паскале стек реализуется чаще всего в виде
однонаправленного списка. Каждый элемент структуры содержит указатель на следующий.
Считается лишь, что для этого списка не существует обход элементов. Доступ возможен
только к верхнему элементу структуры.
Стек предполагает вставку и удаление элементов, поэтому он является динамической,
постоянно меняющейся структурой.
Стеки довольно часто встречаются в практической жизни. Простой пример: детская
пирамидка. Процесс ее сборки и разборки подобен процессу функционирования стека.
Итак, если стек – это список, то добавление или извлечение элементов происходит с
начала и только с начала (или возможно с конца и только с конца) списка.
Значением указателя, представляющего стек, является ссылка на вершину стека, каждый
элемент стека содержит поле ссылки.
Таким образом, описать стек можно следующим образом:
type exst = ^st;
st=record
data : integer;
next : exst;
end;
var stack : exst; {текущая переменная}
Если стек пуст, то значение указателя равно Nil.
110
Занесение элемента в стек
Занесение элемента в стек производится аналогично вставке нового элемента в начало
списка. Процедура занесения элемента в стек должна содержать два параметра: первый
задает вершину стека, в который нужно занести элемент, второй – заносимое значение
элемента стека.
Процедура формирования стека будет иметь следующий вид:
procedure formstack;
var stack : exst; {текущая переменная}
digit : integer;
procedure writestack(var u : exst; digit : integer);
var x : exst;
begin
new(x); {выделяем память под хранение нового элемента стека}
x^.data := digit; {заполняем поле данных элемента}
x^.next := u; {новый элемент "связываем" со стеком}
u := x; {созданный элемент определяем как вершину стека}
end;
begin
stack := nil; {инициализация стека}
writeln('введите элементы стека. окончание ввода – 0');
read(digit);
while digit <> 0 do
begin
writestack(stack, digit);
read(digit);
end;
end;
Извлечение элемента из стека
В результате выполнения этой операции некоторой переменной i должно быть
присвоено значение первого элемента стека и значение указателя на начало списка должно
быть перенесено на следующий элемент стека.
procedure readstack(var u : exst; var i : integer);
var
x : exst;
begin
i := u^.data; {считываем значение поля данных в переменную}
x := u; {запоминаем адрес вершины стека}
u := u^.next; {переносим вершину стека на следующий элемент}
dispose(x); {освобождаем память, занятую уже ненужным элементом стека}
end.
Недостатком описанной процедуры является предположение о том, что стек не пуст.
Для его исправления следует разработать логическую функцию проверки пустоты
обрабатываемого стека.
Очереди
Очередью называют линейный список, элементы в который добавляются только в конец,
а исключаются из начала. При программировании на Паскале также считается, что для
очереди не существует обход элементов.
Доступ возможен только к нижнему элементу
структуры.
Итак, очередь – это вид связанного списка, в
котором извлечение элементов происходит с начала
списка, а добавление новых элементов – с конца.
111
Очередь является динамической структурой – с
течением времени изменяется и ее длина, и набор
составляющих ее элементов.
Опишем очередь на языке Паскаль:
type
exo=^o;
o=record
data:integer;
end;
next:exo;
Над очередью определены только две операции:
занесение элемента в очередь и извлечение элемента
из очереди. В очереди, в силу ее определения,
доступны две позиции: ее конец, куда заносятся
новые элементы, и ее начало, откуда извлекаются
элементы. Поэтому для работы с очередью
необходимо описать две переменные:
Var BeginO, EndO : EXO;
где BeginO – соответствует началу очереди и будет использоваться для вывода элемента
из очереди, EndO – соответствует концу очереди и будет использоваться для добавления
новых элементов в очередь.
Занесение элемента в очередь
Занесение элемента в очередь соответствует занесению элемента в конец списка.
procedure writeo(var begino, endo : exo; c : integer);
var
u : exo;
begin
new(u);
u^.data := c; u^next := nil;
if begino =nil {проверяем пуста ли очередь} then
begino := u {ставим указатель начала очереди на первый созданный элемент}
else
endo^.next := u; {ставим созданный элемент в конец очереди}
endo := u; {переносим указатель конца очереди на последний элемент}
end;
Извлечение элемента из очереди
Процедура извлечения элемента из очереди аналогична удалению элемента из начала
списка. Поскольку извлечение элемента из пустой очереди осуществить нельзя, опишем
логическую функцию, проверяющую, есть ли элементы в очереди.
procedure reado(var begino, endo : exo; var c : integer);
var u:exo;
function freeo(x1 : exo): boolean;
begin freeo := (x1=nil); end;
begin
if freeo(begino) then writeln('очередь пуста');
else begin
c:=begino^.data; {считываем искомое значение в переменную с}
u:=begino; {ставим промежуточный указатель на первый элемент очереди}
begino:=begino^.next;{указатель начала переносим на след. элемент}
dispose(u); {освобождаем память, занятую уже ненужным первым элементом}
end;
end;
112
Пример 10-3. За один просмотр файла действительных чисел и с использованием
очереди напечатать элементы файла в следующем порядке: сначала – все числа, меньшие а,
затем – все числа из отрезка [а, b], и наконец – все остальные числа, сохраняя исходный
порядок в каждой из этих трех групп чисел. Числа а и b задает пользователь.
type exo = ^o;
o = record
data : integer;
next : exo;
end;
var i : real;
min, vibr, other, endmin, endvibr, endother : exo;
f: file of real;
stroka : string;
procedure writeo(var begino, endo : exo; c : real);
. . .
procedure printo(u : exo);
. . .
begin
min := nil;
vibr := nil;
other := nil;
endmin := nil;
endvibr := nil;
endother := nil;
writeln ('введите имя файла >');
readln(stroka);
writeln ('введите промежуток >');
readln(a, b);
assign(f, stroka);
reset(f);
while not eof(f) do begin
read(f, i);
if i<a then writeo(min, x, i)
else
if (i>=a) and (i<=b) then writeo(vibr, x, i)
else writeo(other, x, i)
end;
close(f);
writeln('числа, меньшие ', а); print(min);
writeln('числа из промежутка [', а, b, ']'); print(vibr);
writeln('числа, большие ', b); print(other);
end.
Кольцо
Koльцо - это вид связанного списка, в котором указатель последнего элемента ссылается
на первый элемент.
Графически кольцо можно представить в виде:
113
При программировании на Паскале считается, что для кольца существует обход
элементов и доступ возможен к любому элементу структуры. Кольцо является динамической
структурой – в зависимости от пользователя программы может изменяется длина и набор
составляющих его элементов.
Опишем кольцо на языке программирования:
type typecircle = ^k;
k = record
data : integer;
next : typecircle;
end;
var circle1 : typecircle;
Формирование кольца
Рассмотрим процедуру формирования кольца. Для работы этой процедуры заводятся
две локальные переменные типа TypeCircle для хранения адресов промежуточного и
завершающего звена списка, последним оператором преобразуемого в кольцо.
procedure fofmk(var u : typecircle);
var x, y : typecircle;
i, n : integer;
begin
write('введите количество звеньев кольца: ');
readln(n);
for i := 1 to n do begin
new(x); {выделяем память для хранения нового элемента кольца}
write('введите данные в звено: ');
readln(i);
x^.data := i; {заносим информацию в поле данных}
if u=nil {если кольцо еще не создано} then
u := x {то указатель первого элемента ставим на новый элемент}
else
y^.next := x; {присоединяем новый элемент к последнему элементу}
y := x; {переносим указатель у на последний элемент}
end;
x^.next := u; {преобразуем получившийся список в кольцо}
end;
Над кольцом определены три операции: занесение элемента в кольцо, извлечение
элемента из кольца и обход кольца.
Обход кольца
Для того чтобы обойти кольцо и вывести на экран содержащуюся в нем информацию,
необходимо в локальной переменной типа TypeCircle запомнить адрес первого выводимого
элемента. В этом случае можно избежать повторения и зацикливания программы. Вывод
данных можно начинать с любого элемента кольца; это зависит от адреса первого элемента,
переданного в процедуру обхода.
procedure printк(u : typecircle);
var x : typecircle;
begin
x := u;
repeat
write(x^.data,' ');
x := x^.next;
until x=u;
end;
114
Задания для самостоятельного решения
А. В файле находится текст программы на Паскале. Используя стек, проверить
правильность вложений операторных скобок (begin - end) в этой программе.
В. Создать текстовые файлы, содержащие один текстовую, а другой числовую
информацию (количество слов и чисел может быть неодинаковым). Используя стек,
создать другой текстовый файл, в котором числа и слова чередовались и были бы
записаны в обратном порядке ("лишние" числа или слова были бы записаны в конец
файла).
Практикум
ДИНАМИЧЕСКИЕ СТРУКТУРЫ
Пример 10-4. Написать программу, проверяющую своевременность закрытия скобок в
строке символов.
Для решения задачи определим стек, элементами которого являются символы:
type exst = ^st;
st=record
data : char;
next : exst;
end;
Будем двигаться по строке до ее конца. Если в процессе просмотра встретится одна из
закрывающихся скобок ({, (, [ ), занесем ее в стек. При обнаружении закрывающейся скобки,
соответствующей скобке, находящейся в вершине стека, последняя удаляется. При
несоответствии скобок выдается сообщение об ошибке.
Пусть факт наличия ошибки хранится в переменной логического типа. Тогда условие
работы цикла будет выглядеть так: while (i<>Length(a)) and f do ...
Осталось выяснить, как определить, соответствует ли очередная закрывающаяся скобка
скобке, находящейся в вершине стека. Можно заметить, что коды соответствующих друг
другу скобок отличаются не более чем на 2, что можно проверить с помощью функции
Ord(x)):
{ } 123–125
[ ] 91–93
( ) 40–41
Причем код открывающейся скобки меньше. То есть можно записать следующее
условие соответствия: if (Ord(a[i]–Ord(stack^.Data))<=2 then . . .
type exst = ^st;
st = record
data : char; next : exst;
end;
var a : string; f : boolean; i : integer;
procedure writestack(var x1 : exst; c : integer);
var u : exst;
begin
new(u); {создание нового элемента стека}
u^,data := c; u^.next := x1;
x1 := u; {созданный элемент определить как вершину стека}
end;
procedure delstack(var x1 : exst);
{процедура удаления верхнего элемента стека}
var u:exst;
115
begin
u := x1; x1 := x1^.next; dispose(u);
end.
procedure solve(a : string); {процедура правильности расстановки скобок}
var stack : exst;
begin
stack := nil; i := 1;
while (i<=length(a)) and f do begin
if (a[i]='(') or (a[i]='{') or (a[i]='[') then
writestack(stack , a[i])
else
if (a[i]=')') or (a[i]='}') or (a[i]=']') then
if ord(stack ^.data)–ord(a[i])<=2 then delstack(stack)
else f := false;
inc(i);
end;
end.
begin
writeln('введите строку');
readln(a);
f := true;
if a<>' ' then begin solve(a);
if f then writeln('все скобки расставлены верно')
else writeln('скобка ',a[i-1],' закрыта преждевременно');
end
else writeln('строка пуста');
end.
Пример 10-5. Проверить есть ли и сколько раз встречается список М1 в списке М2.
type exs = ^ s;
s = record data : integer; next : exs;
end;
var u, x, m1, m2 : exs;
i, kol : integer;
procedure poisk(var x1, x2 : exs);
var m3, m4 : exs;
begin
kol := 0;
m3 := m1;
m4 := m2;
while m4 <> nil do begin
if m4^.data = m3^.data then begin
m3 := m3^.next;
m4 := m4^.next;
if m3 = nil then begin
kol := kol+1;
m3 := m1;
end;
end;
else begin
m3 := m1;
m4 := m4^.next;
end;
end;
end;
procedure init (var u : exs);
var y : exs;
digit : integer;
begin
writeln('введите список. конец ввода – 0');
u := nil;
read(digit);
while digit <> 0 do begin
new(y);
116
y^.next := nil;
y^.data := digit;
if u = nil then u := y else x^.next := y;
x := y;
read(digit);
end;
writeln;
end;
procedure print(x : exs);
begin
while x <> nil do begin
write(x^.data : 5);
x := x^.next;
end;
readln;
writeln;
end;
begin
init(m1);
init(m2);
writeln('***список 1***');
print(m1);
writeln('***список 2***');
print(m2);
poisk(m1, m2);
writeln('список 1 встречается в списке 2 ', kol, ' раз(а)');
readln;
end.
Пример 10-6. Из текстового файла, состоящего из строк, сформировать список,
запросить слово и удалить это слово из списка.
uses crt;
type exs = ^ spisok;
spisok = record data : string; next : exs; end;
var
golova_spiska, golova_spiska_udalen_:exs;
f : text;
s, st : string;
procedure smotr(x : exs);
begin
textcolor(lightred);
write('ваш список...');
while x <> nil do begin
writeln (x^.data,' ');
x := x^.next;
end;
end;
procedure reading;
begin
reset (f);
writeln('ваш файл...');
while not eof(f) do begin
readln (f, st);
writeln (st);
end;
close (f);
end;
procedure createfile;
begin
117
writeln('создание файла');
write('введите имя файла...');
readln(s);
assign (f, s);
rewrite('вводите текст в файл (окончание ввода - <enter>');
repeat
readln(st);
writeln (f, st);
until st = '';
write('файл создан');
close (f);
reading;
end;
procedure proverka;
var x, y, u : exs;
i : integer;
begin
reset (f);
while not eof (f) do begin
readln (f, st[i]);
while i < length (st) do begin
new(x);
x^.next := nil;
if (st[i] <> '') or (st[i] <> st[length(st)])then
x^.data := x^.data + st[i];
if u = nil then u := x else y^.next := x;
y := x;
end;
end;
close (f);
smotr (u);
end;
begin
clrscr;
textcolor (white);
createfile;
proverka;
end.
Пример 10-7. N ребят располагаются по кругу. Начав отсчет от первого, удаляют
каждого k-го, смыкая при этом круг. Определить порядок удаления ребят из круга. Для
хранения данных об участниках игры используется список.
type
children = ^child;
child = record
data : integer;
next : children;
end;
var circl, p, temp : children;
i, j, numname : integer;
text : string;
function numslov(var s : string) : integer;
var i, d : integer;
begin
d := 0; i := 1;
while i < length(s) do begin
118
while s[i] = ' ' do inc(i);
while s[i] <> ' ' do inc(i);
d := d+1;
end;
if s[length(s)] = '' then d := d-1;
numslov := d;
end;
procedure addname(var old, young : children);
begin
young^.next := old;
young^.prev := old^.prev;
old^.prev^.next := young;
old^.prev := young;
end;
procedure deletename(var old : children);
begin
old^.next^.prev := old^.prev;
old^.prev^.next := old^.next;
end;
begin
new(circl);
circl^.next := circl;
circl^.prev := circl;
circl^.name := '';
writeln('считалка');
writeln('введите текст считалки >');
readln(text);
writeln('сколько человек в кругу? >');
readln(numname);
if numname>0 then begin
write('введите ',i,'-е имя: '); new(p); readln(p^.name);
temp := head^.next;
while temp <> head do
temp := temp^.next;
addname(temp, p);
end;
for i := 1 to numname-1 do begin
temp := head;
for j := 1 to numslov(text) do begin
temp := temp^.next;
if temp^.name = '' then temp :=temp^.next;
end;
writeln(temp^.name, '- вышел');
deletename(temp);
end;
writeln(head^.next^.name, '- остался');
end.
Пример 10-8. Вывести на экран работающий светофор.
uses crt, graph;
type typecircle = ^k; k = record data : char; next : typecircle; end;
const xx = 80; r = 50;
var svetofor, x : typecircle;
gd, gm, y : integer;
procedure picture;
begin
setviewport(240, 1, 400, 477, clipoff);
line(0, 1, 0, 477); line(160, 1, 160, 477); line(0, 1, 160, 1);
line(0, 477, 160, 477); line(0, 150, 156, 150); line(0, 330, 156, 330);
line(-240, 480, 0, 100); line(400, 480, 160,100); line(380,460,160, 460);
line(160, 440, 368, 440);line(368, 440,380, 460);line(-220,460,-208, 440);
setfillstyle(1,white);floodfill(375,455,white);floodfill(-215,455, white);
setfillstyle(7, 6);floodfill(-230, 200, white);
setcolor(4);
line(-240, 150, -120, -1);line(400, 150, 240, -1);
setcolor(15);
119
setfillstyle(9, 4); floodfill(-240, 0, 4); floodfill(390, 10, 4);
setfillstyle(1, 8); floodfill(-100, 470, white);
y := 74; circle(xx, y, r);
y := 240; circle(xx, y, r);
y := 405; circle(xx, y, r);
setfillstyle(9, 6); floodfill(5, 5, white);
end;
procedure yellow(y : integer);
begin
picture;
y := 240; setfillstyle(1, 14); floodfill(xx, y, 15);
delay(850); clearviewport;
end;
procedure green(y : integer);
begin
picture;
y := 405; setfillstyle(1, 2); floodfill(xx, y, 15);
delay(1500); clearviewport;
end;
procedure red_yellow(y : integer);
begin
picture;
y := 240; setfillstyle(1, 14); floodfill(xx, y, 15);
delay(1500); clearviewport;
end;
procedure red(y : integer);
begin
picture;
y := 74; setfillstyle(1, 4); floodfill(xx, y, 15);
delay(2000); clearviewport;
end;
procedure vibor;
begin
case x^.data of
'r' : red(y);
'2' : red_yellow(y);
'g' : green(y);
'y' : yellow(y);
end;
begin
gd:= detect; gm:=0;
initgraph(gd, gm, '');
new(x);
u := x;
x^.data := 'r';
new(x^.next);
x := x^.next;
x^.data := '2';
new(x^.next);
x := x^.next;
x^.data := 'g';
new(x^.next);
x := x^.next;
x^.data := 'y';
x^.next := u;
x := u;
while not keypressed do
begin
vibor;
x := x^.next;
end;
end.
120
ИТОГОВЫЙ ПРАКТИКУМ
2-1-1 Обработка деталей
Имеется некоторое количество деталей, каждая из которых проходит обработку
сначала на токарном, а затем на шлифовальном станке. Известно время обработки детали
на каждом станке. Упорядочить детали так, чтобы суммарное время обработки заданной
партии деталей было минимально.
2-1-2. Салют
Реализовать картину праздничного салюта:
пиротехнических ракет и их осколков разного цвета.
взлет,
разрывы,
падение
2-1-3. 12 коней
Найти расстановку 12 коней на шахматной доске, при которой каждое поле будет
находиться под ударом одного из них.
2-1-4. Путь в таблице
Двумерная таблица заполнена случайными числами. Необходимо найти путь из
левого верхнего угла в правый нижний, такой что, сумма чисел в клетках таблицы через
которые проходит путь наибольшая из возможных. Таблицу и путь представить
графически.
2-1-5. Математические стихи
Одна из известных математических забав - математические стихи. Например,
38, 45,
46, 12
19, 25,
20,20,20!
Составить программу, которая печатает на экране математическое
стихотворение.
Уровень "А". Программа работает с заранее определенным (или вводящимся с
клавиатуры) набором чисел, из которых потом складывается стихотворение.
Уровень "В". Программа работает со случайными двузначными числами, т.е.
генерируется набор случайных чисел, из которых затем складывается математическое
стихотворение.
Уровень "С". Программа работает со случайными трехзначными числами.
Уровень "Д". На экран выводится как само стихотворение (в числах), так и его
русскоязычный текст.
2-1-6. Хитрые фигуры
Составить программы, которые выводят на экран фигуры (см. рисунки),
вычерчиваемые одним росчерком.
2-1-7. Кубик
Дан кубик, только одна грань которого окрашена в красный цвет. Поставьте кубик в
заданный угол доски размером n*n так, чтобы его красная грань была обращена вверх.
Перекатывая кубик с одного поля доски на другое, обойдите все клетки доски, побывав на
каждой лишь один раз, так, чтобы закончить путешествие в указанном углу доски и чтобы
красная грань опять оказалась сверху. На протяжении всего путешествия красная грань ни
разу не должна быть обращена вниз. Составьте программу, демонстрирующую путь
кубика или указать, что такого пути не существует.
Примечание: ребро кубика равно стороне клетки доски.
121
2-1-8. Колония бактерий
Дана колония бактерий, каждая бактерия занимает 1 клетку на экране. Размер
колонии 50*50. Случайным образом одна из бактерий заражается. Рассмотреть динамику
развития болезней бактерий, если заразная бактерия в течение определенного периода
может заражать только ближайших восемь соседей, с определенной вероятностью
(вероятность заражения отдельной клетки за 1 контакт). После данного периода
бактерия выздоравливает и становится незаразной. Изобразить процесс графически.
Начертить графики: числа здоровых, больных и выздоровевших бактерий в зависимости от
времени в течение всей эпидемии. Характер развития эпидемии зависит от вероятности
заражения и периода, в течении которого бактерия болела для всех клеток период болезней
один и тот же.
2-1-9. Остановка
На остановке останавливаются автобусы одного или нескольких маршрутов.
Человек пришел на автобусную остановку в k-часов m-минут и находился на ней до k-часов
m1-минут (k принимает значения от 0 до 23, m и m1 от 0 до 59). За это время он записал
время прибытия всех автобусов. Эта информация образует исходные данные задачи.
Автобусы маршрута с одним номером прибывают с равномерным интервалом (через
одинаковые промежутки времени) с k-часов m-минут до k-часов m1-минут. В указанный
период останавливались по крайне мере два автобуса каждого маршрута. Несколько
автобусных маршрутов могут иметь одинаковое время прибытия и/или одинаковые
интервалы. Составьте программу, которая определяет наименьшее количество
автобусных маршрутов, проходящих через данную остановку, и график движения
автобусов по маршрутам.
2-1-10. Осколки
На столе расположено несколько треугольных осколков стекла. Были выдвинуты
следующие предположения:

все эти осколки принадлежали одному прямоугольному стеклу, которое исходно
лежало так, что его стороны были параллельны краям стола;

осколки получены в результате удара в некоторую точку стекла, не лежащую
на его границе;

в момент удара одна из вершин каждого осколка находилась в точке удара;

некоторые осколки, возможно, были сдвинуты;

стекло может быть восстановлено параллельным переносом осколков, то есть
ни один из осколков не был повернут.
Напишите программу, помогающую при этих предположениях полностью
восстановить прямоугольное стекло из всех имеющихся осколков или определяющую, что
это сделать невозможно. Процесс изобразить графически.
122
НЕКОТОРЫЕ ЗАНИМАТЕЛЬНЫЕ ЗАДАЧИ ПРОГРАММИРОВАНИЯ
КАК СЖАТЬ ИНФОРМАЦИЮ
При оцифровке графической, аудио-, видео- и другой информации, а также в
некоторых других задачах образуются массивы большой размерности, содержащие большие
фрагменты из одинаковых элементов, т.е. память используется неэффективно. В качестве
примера, можно привести следующую ситуацию. Пусть экран монитора представлен
массивом 640х480 элементов и содержит битовое представление черно-белого изображения
(1-точка "горит", 0- точка "погашена"). Пусть на экране у нас изображена некоторая фигура
из 100 точек. Легко увидеть, что из 307200 бит (38400 байт или 37,5 Кбайт!) отведенных под
хранение этого изображения в оперативной памяти, эффективно используются только 100
бит (12,5 байт!). Соответственно, если мы хотим сохранить изображение в файле на диске, то
у нас есть выбор: либо сохранить 37,5 Кбайт в формате "как есть", либо использовать
некоторый алгоритм, который позволит уменьшить объем хранимой информации более чем
в 3000 раз. На сегодняшний день разработано множество алгоритмов сжатия информации
различного рода, например, самый известный алгоритм Хаффмана.
Обычно используют для хранения информации массивы (матрицы). Для хранения
матриц, содержащих много нулевых элементов (разреженных матриц), используются
различные способы упаковки, при которой хранятся только ненулевые элементы. Так,
диагональная матрица D(n,n) в упакованном вид хранится в одномерном массиве C(n),
содержащем только ненулевые диагональные элементы. Верхнетреугольная или
нижнетреугольная матрица упаковывается в одномерный массив, в котором последовательно
записываются ненулевые части строк матрицы.
Сильно разреженная матрица (содержащая много нулей, расположенных
беспорядочно) может храниться в трех одномерных массивах I(k), J(k), A(k), где первые два
массива хранят координаты расположения соответствующего элемента А. В принципе,
любая матрица A(m,n) может храниться по строкам или по столбцам в одномерном массиве
длиной mxn с соответствующим пересчетом индексов. Тогда элемент aij такой матрицы в
одномерном массиве при построчном хранении стоит под номером k=(i-1)*n+j. Число k
называют приведенным индексом (кодом) этого элемента.
Двоичным массивом называется массив, состоящий из нулей и единиц. Такие
массивы используются для хранения двухтоновой графической информации. Один из
способов сжатия двоичных массивов - представление их в виде двоичных кодов, где под
каждый элемент отводится только 1 бит памяти. При другом способе сжатия таких массивов
хранятся только длины цепочек, целиком состоящих из нулей либо единиц. Так, например,
последовательность 11110001100000111 представляется пятью числами (кодами): 4,3,2,5,3.
Компьютер использует двоичное кодирование всей информации. Соответственно, любую
информацию любого типа можно представить в виде двоичной последовательности и,
используя приведенный алгоритм, сжать. Примерно по такому принципу (алгоритм RLE)
работают все существующие на сегодняшний день архиваторы.
В качестве же практического примера рассмотрим упомянутый выше алгоритм
Хаффмана.
Проще всего рассмотреть алгоритм Хаффмана на простейшем примере, представленном
на рисунке.
Предположим,
что
нам
надо
заархивировать
следующую
символьную
последовательность: "AAABCCD". Без архивации эта последовательность занимает 7 байт. С
архивацией по методу RLE она бы выглядела бы так:
3,"A",1,"B",2,"C",1,"D"
123
то есть возросла бы до 8-ми байтов. А алгоритм Хаффмана может сократить ее почти до двух
байт, и вот как это происходит.
Прежде всего, отметим, что разные символы
встречаются в нашем тексте по-разному. Чаще
всего присутствует буква "A". Можно составить
таблицу частот:
Символ
Количество повторений
A
3
B
1
C
2
D
1
Затем эта таблица используется для построения так называемого двоичного дерева (см.
рисунок). Именно это дерево используется для генерации нового сжатого кода. Левые ветви
дерева помечены кодом 0, а правые-1. Имея такое дерево, легко найти код любого символа,
если идти от вершины. В нашем случае алгоритм выглядит так:
Если символ равен "A" то ему присваивается двоичный ноль, в противном случае единица и рассматривается следующий бит, если символ - "C", то он получит код 10, в
противном случае 11. Если символ "D", то его код - 110, в противном случае-111 ("В").
Обратите внимание на то, что в алгоритме Хаффмана разные символы будут иметь
разную битовую длину, и не надо иметь ни какого разделителя между символами. Например,
если вы попробуете декодировать с помощью рисунка последовательность:
0001111111010110
то получите текст:
"AAABBCCD"
0
0
0
111 111 10
10
110
A
A
A
B
B
C
C
D
а, рассмотренный нами выше текст "AAABCCD" займет всего 13 бит (а это меньше двух
байтов).
A
A
A
B
C
C
D
0
0
0
111 10
10
110
Как видно, результат довольно впечатляющий, но не все проблемы еще исчерпаны.
Замечание 1.
Первая проблема состоит в том, что на разных данных метод может генерировать
различные двоичные деревья. И действительно, например, в русских текстах чаще всего
встречается буква "А" и она будет стоять у вершины дерева и ей будет присвоен код равный
двоичному нулю. А вот в англоязычных текстах, например самая частая буква - это "E" и
этот код будет присвоен ей. А если ваш файл - не текст, а какая-нибудь арифметическая
таблица, то там чаще встречается цифра "0", а в файлах графики чаще встречаются коды "0"
и "255". Представляете, что будет если программа -декомпрессор ничего не будет знать об
исходном двоичном дереве? Естественно, она ваш файл не разархивирует, так как не знает,
какие коды сопоставляются последовательностям 0, 10, 110, 1110 и т. д.
Первое решение приходит сразу, в самом начале архивированного файла надо
записывать само дерево, с помощью которого проходила архивация. Но тут вот где "собака
порылась": ведь если мы архивировали файл длиной 8 байтов и получили 2 байта, а теперь к
нему приложим таблицу длиной 8-10 байтов, то ценность нашей архивации будет
отрицательной. Таким образом, на коротких файлах метод Хаффмана ничего не даст и чем
длиннее файл, тем лучше будет эффект.
Второе решение может быть, например, следующим. Пусть у нас имеется несколько
"стандартных" деревьев. Первое для текста на русском языке, второе для текста на
английском языке, третье для графических файлов, четвертое для блоков машинного кода и
т. д. Если эти деревья (таблицы соответствия) достаточно стандартны, то можно переводную
124
таблицу к файлу не прикладывать, а перед сжатым файлом давать один байт, в котором
записан номер стандартной таблицы.
В этом случае компрессирующая программа может проверить на вашем файле
несколько разных методов, посмотреть, какой будет эффективнее, припишет к выходному
файлу префиксный байт и потом осуществит саму архивацию. А декомпрессирующая
программа по первому байту определит, каким методом была произведена компрессия, и
поскольку таблицы стандартны произведет декодирование.
Замечание 2
В описанном алгоритме очень большая проблема связана с определением конца
файла. Как декомпрессирующая программа поймет, что файл закончен, какой маркер
поставить в конце?
Первый вариант связан опять же с возможностью создания специального заголовка,
который записывается перед файлом и в котором указано количество байт в файле.
Декомпрессирующая программа работает только с этим числом и не одним битом больше.
Второй вариант изящнее, в качестве маркера используется символ, не использующийся
в исходном файле, поэтому любой такой символ будет считаться маркером конца файла. Но,
к сожалению, очень редко можно заранее знать точно, что таких-то или таких-то символов не
может быть в файле. Например, если вы делаете компрессор общего назначения, то он
должен работать с чем угодно. В этом случае вводят дополнительный фальшсимвол 256-ой.
Он будет самым редко встречающимся в файле, и может быть встречен в нем только один
раз, и как самый редко встречающийся символ, он будет самым длинным, и для его записи
будет использована довольно длинная битовая последовательность, но поскольку это
происходит только один раз, в этом нет ничего страшного. Хотя старый принцип остается в
действии: на коротких файлах алгоритм теряет эффективность.
Замечание 3.
Давайте опять рассмотрим дерево на рисунке. В соответствии с ним, мы можем
составить следующую таблицу соответствия:
A
0
B
10
C
110
..................
252 символ
1111…10
253 символ
1111…110
254 символ
1111…1110
255 символ
1111…11110
Не трудно посчитать, что 255 символ занимал бы 256 бит, а это 32 байта, что свело бы
на нет все преимущества компрессии.
С этой проблемой нужно справляться применением какой-либо иной системой
двоичного кодирования.
Вариант 1 (простой)
Договоримся, что мы как бы разобьем все символы нашего файла на группы по числу
битов в номере символа. И будем строить новое представление двоичного числа из двух
половинок. Левая половинка указывает на номер группы вашего числа сколько единичек
слева, таков и номер группы. Правая половинка указывает на номер числа в группе.
Обратимся к конкретным примерам:
Пример 1: Символ «5». В двоичной форме 5=101. Длина - 3 бита. Это число из третьей
группы, в которую входят числа 4..7
125
Порядковый номер в группе - 001 (номер 000 у числа 4) В итоге мы имеем следующее
новое представление:
5
=
111 001
“номер группы”
=“
номер в группе”
Пример 2: Символ «10». В двоичной форме 10=1010. Длина четыре бита. Это число из
четвертой группы, в которую входят числа 8.. 15. Порядковый номер в группе - 0010. В итоге
мы имеем следующее представление:
10
=
1111 0010
Пример 3: Символ «44». В двоичной форме 44=101100. Это число из шестой группы, в
которую входят числа 32.. 64. Порядковый номер в группе - 001100. В итоге мы имеем
следующее представление:
44
=
111111 001100
На запись ушло 12 битов, это и есть расплата за то, что самый часто встречающийся
символ заменили одним битом.
Теперь можно написать алгоритм перекодировки из обычной системы двоичного
кодирования в рассмотренную выше.
1. Берется двоичное число.
2. Первая единица в нем заменяется на "0"
3. Слева к числу приписывается столько единиц, сколько бит в исходном числе.
Теперь посмотрим, как работает декомпрессирующая программа. Пусть на нее
поступила произвольная последовательность бит, например:
11010101000111001111101010101010
Всего 30 бит. Количество ведущих единиц указывает на длину двоичного кода. Режем
текст по ведущим единицам:
1101,0,10,10,0,0,111001,11110101,10,10
А теперь вместо двоичных значений поставим порядковые номера символов:
3,0,1,1,0,0,5,13,1,1
Всего 10 символов
Как можно заметить декодирование происходит вполне однозначно и несложно. Можно
оценить эффективность компрессии 10 символов у нас хранилась в 30 битах (примерно в
четырех байтах). Неплохо!
Во-первых, можно сразу отметить, что для записи 255-го символа нам потребуется
вместо обычных восьми битов нам потребуется 16, и остается уповать на то, что такой
символ в файле будет редок.
Во-вторых, можно отметить еще одну интересную деталь. Мы теперь можем иметь дело
и с 256-ым и с 500-ым символом. Коды не ограничены стандартной длиной одного байта и
поэтому мы можем иметь в нашем символьном наборе хоть миллион символов. Поскольку
один миллион это два в двадцатой степени то для его записи нам потребуется 2*20=40 битов,
то есть всего пять байтов. Может это и расточительство, но ведь на этот один "символ"
можно подвешивать не один символ. Так, например, можно считать, что слово
"RECTANGLE" это 256-ой символ, а слово "REPEAT"- это 257-ой символ. Неплохо, когда
архивируешь тексты Паскаля.
126
Вариант 2 (Рекуррентная система)
Этот вариант совершенствования двоичной системы несколько сложнее
предыдущего, но у него есть свои преимущества. Так, на больших символьных наборах (от
512 и выше) этот вариант наиболее эффективен.
0
1
2
3
4
5
6
7
0
10
1100
1101
1110000
1110001
1110010
1110011
В левой графе - номер символа, в правой графе - его представление в данной системе
двоичного кодирования.
Рассмотрим, например как в этой системе образуется двоичное представление числа 5.
Все начинается с обычной двоичной формы 510=1012. Далее берется первый бит (1), а
последние два бита (01) «откладываются» в остаток r[5]. Измеряется длина этого остатка
l(r[5]). Она равна двум битам. Между первой единицей и остатком записывается
рекуррентное представление числа 2-p(2).
p(5)=1+p(l(r[5]))+r[5]=1+p(2)+01
p(2)=1+p(l(r[1]+0=1+p(1)+0
p(1)=10
Итого: p(5)=1 1 10 0 01 = 1110001
Рассмотрим еще один пример для числа 17:
1710 = 100012
p(17) = 1+p(4)+0001
p(04) = 1+p(2)+00
p(02) = 1+p(1)+0
p(01) = 10
Итого: p(17)=111100000001
Подведем итоги:
Столбец 1 - номер символа по мере убывания частоты появления
Столбец 2 - Количество бит на символ при варианте 1
Столбец 3 - Количество бит на символ при варианте 2
1
2
3
0
01
01
1
02
1
2
3
8-15
08
08
02
16-31
12
10
2,3 04
04
64-127
14
14
4-7 07
06
128-255
15
16
Как видно на конкретных примерах, при малом наборе символов более эффективен
первый из рассмотренных вариантов. Для наборов 128-512 символов эффективность двух
вариантов примерно одинакова. Но для очень больших наборов, в которых тысячи
кодируемых элементов, по-видимому, нет более эффективных систем, чем предложенная
рекуррентная система.
Конечный выбор как всегда остается за программистом.
127
АЛГОРИТМИЧЕСКИЕ «ФОКУСЫ»
При программировании иногда попадаются задачи, которые трудно "втиснуть" в
стандартные конструкции языка. А решение лежит совсем рядом - в теории конечных
автоматов. Не пугайтесь – это только название страшное, а на самом деле все очень просто.
Из курса школьной алгебры мы знаем о существовании формальных преобразований.
Самым простым примером является разложение скобки (a+b)2.
Давным-давно, когда люди еще не придумали объектно-ориентированное
программирование, модным направлением было программирование структурное. Шутки
шутками, но в результате именно структурного подхода мы сейчас имеем Pascal и Delphi.
Так вот, в те давние времена возникла следующая ситуация:
 "Сочинение" алгоритмов решения различных задач - процесс творческий, а
творчество очень не любит каких-либо ограничений. Cтало быть алгоритм может
быть любым, сколь угодно запутанным, образующим петли и прочие нелинейности.
Особенно этим грешат процедуры, занимающиеся разного рода синтаксическим
разбором.
 Стандартный Паскаль имеет очень ограниченное количество структурных инструкций
(if-then-else, while-do и т.д.)
А нельзя ли как-нибудь "втиснуть" этот наш премудрый алгоритм в куцый набор
инструкций? Можно! Причем используя вполне формальное преобразование. Вот этим
мы сейчас и займемся.
Итак, структурное программирование учит нас, что есть 5 основных конструкций, из
которых как из кубиков строится любая процедура:
SEQUENCE
IF-THENELSE
WHILEDO
REPEATUNTIL
CASE
В нашем запутанном алгоритме наверняка не все так ужасно, как кажется. Скорее всего,
там можно найти несколько фрагментов, подходящих под определение чисто структурных
конструкций. Вопрос лишь в том, как эти конструкции соединить между собой.
А вот в этом как раз может помочь наша рабочая лошадка - непотопляемая конструкция
REPEAT-CASE. При умелом применении эта пара команд может "переварить" алгоритм
любой сложности и запутанности.
Предположим, у нас есть алгоритм следующего вида:
128
Если приглядеться, то он легко разбивается на 3 вложенные стандартные структуры:
Так что мы с легкой душой можем воплотить его в программе вроде такой:
repeat
while C1 do B1;
if C2 then B2
else B3;
until C3;
И все! Очень красиво и компактно.
Как было бы хорошо, если бы в жизни нам попадались только такие алгоритмы.
А что вы скажете на это?
Выглядит вроде просто, но в стандартный Паскаль явно не укладывается. Можно,
конечно, попытаться "расшить" процедурные блоки B1 и B3 или применить GOTO или EXIT
из цикла. Но все это, согласитесь, выглядит как-то жалко и самодеятельно. Опять же надо
каждый раз думать где разомкнуть цикл...
И вот теперь мы можем выполнить несколько чисто формальных шагов:
 Выделяем в нашем алгоритме фрагменты, которые хорошо укладываются в
структурную модель (если такие есть). В нашем случае такой фрагмент только один:
B2 + C2, т.е. последовательность из блока и условия.
 Вне этих фрагментов ставим жирные точки в следующих местах:
o на входе в модуль (обозначим ее 1)
o на выходе модуля (обозначим 0)
o на входах и выходах всех фрагментов, что мы нашли
o во всех местах, где есть пересечение линий на блок-схеме
 Скорее всего, многие точки просто сольются - пусть, мы будем считать их за одну.
Например, у нас точка 1 на входе модуля совпадает с точкой пересечения линий
входящей и от B3.
 Пронумеруем оставшиеся точки произвольно. В нашем примере получается 4 точки
от 0 до 3.
129
Теперь мы готовы перейти к модели конечного автомата и написать-таки нашу
программу.
Представьте, что есть некий блок, который может находиться в одном из четырех
состояний. И есть набор действий, в результате которых блок переходит из одного состояния
в другое.
Для отображения этого самого состояния, заведем в программе некоторую
переменную, скажем, State. А внутри веток CASE будем изменять ее состояние.
Пишем нашу программу:
var State:integer;
begin
State:=1; {для любого алгоритма}
repeat
case State of
...
end;
until State=0; {тоже для любого алгоритма}
end;
Теперь пропишем ветки CASE. Не забудьте в конце каждой ветки уточнить состояние:
case State of
1: begin B1; if C1 then State:=2 else State:=3 end;
2: begin B2; if C2 then State:=0 else State:=3 end;
3: begin B3; State:=1 end;
end;
Все! Программа готова. И она работает. И с точки зрения логики Паскаля все
безупречно - никаких GOTO и прочих неприятностей.
Что мы сделали?
Мы изобразили наш алгоритм как блок-схему или, другими словами, направленный
граф
 Затем провели преобразование этого графа с выделением нескольких стационарных
состояний программы - конечного автомата
 В результате получили новый граф, который легко укладывается в структурные
конструкции Паскаля

130
Проводя указанные действия несколько раз для разных алгоритмов, можно заметить,
что на самом деле наши произвольно расставленные точки-состояния не такие уж
случайные и произвольные. Как правило, при более глубоком рассмотрении вашего
конкретного алгоритма можно найти каждому из этих состояний свое название. Это название
может быть гораздо более выразительным, чем просто 1-2-3, поскольку это действительно
состояния вашей программы.
Пусть ваш алгоритм занимается, скажем, синтаксическим разбором HTML-файла. Тогда
одно из состояний может звучать как "Обнаружен тэг BODY" или "Найден конец
документа".
Паскаль предлагает нам замечательное средство для работы с такими обозначениями в
символическом виде и об этом средстве сейчас часто забывают. Программа из нашего
примера может выглядеть так:
var State:(START, EOF_found, Line_Added, DONE);
begin
State:=START; {для любого алгоритма}
repeat
case State of
START:
begin B1; if C1 then State:=EOF_Found else
State:=Line_Added end;
EOF_Found: begin B2; if C2 then State:=DONE else
State:=Line_Added end;
Line_Added: begin B3; State:=START end;
end;
until State=DONE; {тоже для любого алгоритма}
end;
Возможно, проделав подряд несколько таких преобразований и войдя во вкус, вы
заметите, что стали мыслить при программировании чуть-чуть иначе. Иногда, особенно
когда задача несколько запутана, хочется сразу выделить несколько важных состояний и
строить обработчик уже вокруг них.
Кстати, сейчас тема конечных автоматов вновь стала актуальной и то и дело мелькает на
страницах компьютерных журналов.
Крайние случаи
Как сказал один мудрый человек, "Идея, доведенная до абсурда, часто превращается в
свою противоположность". Давайте попробуем довести наш метод до крайней степени.
В нашем случае это означает добавление еще двух состояний - 4 и 5. Тогда программа
примет вид:
case State of
131
1: begin
2: begin
3: begin
4: if C1
5: if C2
end;
B1; State:=4 end;
B2; State:=5 end;
B3; State:=1 end;
then State:=2 else State:=3;
then State:=0 else State:=3;
Хорошо это или плохо?
Хорошо, в том смысле, что даже при таком издевательстве программа не перестает
работать правильно. С другой стороны, посмотрите на исходный код: где прозрачность, где
легкость и ясность? Суть алгоритма растворена в сплошных переходах состояний и из-за
этого теряется.
А что, если пойти в другую сторону и уменьшить число выделенных состояний? В
нашем примере реально только исключить состояние 2.
После "приведения подобных" программа будет иметь следующий вид:
case State of
1: begin
B1; State:=3;
if C1 then begin
B2; if C2 then State:=0
end
end;
3: begin B3; State:=1 end;
end;
Здесь формально получаются две ветки ELSE, ведущие обе к третьему состоянию. Если
состояние вынести вверх, до условия, то программа получается короче.
Возможны возражения такого толка, что при подобном подходе программы будут иметь
повышенную склонность к зацикливанию. И да и нет. Циклы вообще склонны к
зацикливанию, особенно если написать что-нибудь вроде repeat until false;. А если серьезно,
то устойчивость работы преобразованных таким образом программ прямо и недвусмысленно
показывает, насколько удачно вы проработали исходную блок-схему и насколько аккуратно
ее преобразовали. Поскольку на то оно и инвариантное преобразование, чтобы ничего не
менять в смысле и логике программы, а затрагивать лишь ее внешнее представление.
Все проблемы и решения, изложенные в этой статье, известны уже довольно давно.
Цель лекции была просто напомнить об одном красивом, но, забытом подходе к
программированию на Паскале. А если учесть, что и современный Бейсик поддерживает
структуры, то и к программированию вообще.
132
ЭТА ЗАГАДОЧНАЯ КОМБИНАТОРИКА…
Во многих случаях постановка задачи сводится к нахождению тех или иных
комбинаций, составленных из букв, цифр или иных объектов. Область математики, в
которой изучаются вопросы о том, сколько различных комбинаций, подчиненных тем или
иным условиям, можно составить из заданных объектов, называется комбинаторикой.
Однако, математические вычисления при этом становятся довольно громоздкими.
Практически в любой формуле комбинаторике присутствует факториал, который как мы
знаем растет в геометрической прогрессии. (напомним, что n! = 1*2*3*…*n, и уже 10! не
может быть представлено целым типом переменных).
Основными величинами
комбинаторики являются сочетания, размещения и
перестановки. Прямое вычисление этих величин не представляет труда.
Пример 1. Имеется n различных предметов. Сколько из них можно составить kрасстановок? Например, в футбольной группе участвуют 17 команд. Сколькими вариантами
могут быть распределены золотые, серебряные и бронзовые медали в группе?
Решение: По формуле размещений Ank=n*(n-1)*…(n-k+1) получаем 17*16*15=4080
вариантов распределения наград между командами.
Пример 2. Имеется n различных предметов. Сколькими способами можно их
расположить так, чтобы в каждом случае их порядок был различен? Например, сколько
анаграмм можно получить из слова "март"?
Решение. Поскольку в слове "март" у нас 4 буквы, то общее количество перестановок
букв будет равно Pn=Ann=n!, т.е. 1*2*3*4=24 анаграммы.
Пример 3. Имеются предметы k различных типов. Сколько перестановок можно
сделать из n1 элементов первого типа, n2 элементов второго типа,…, nk элементов k-го типа?
Например, сколько перестановок можно сделать из букв слова "Миссисипи"?
n!
Решение. По формуле перестановок с повторениями P(n1 ,..., n k ) 
, получим
n1 ! *n 2! *... * n k !
Р(4,3,1,1)=2520.
Пример 4. Найти все k-сочетания из n элементов. Например, сколькими способами
можно расставить на шахматной доске (64 клетки) 8 ладей?
n!
Решение. По формуле сочетаний C nk 
получаем C 648  64!  4 328 284 968
k! (n  k )!
8!*56!
вариантов.
Тем не менее, вычисления комбинаторных величин по прямым формулам не
представляют большого труда. Рассмотрим порождения комбинаторных объектов,
применительно к информатике и ее задачам.
Размещения с повторениями.
Пример 5. Напечатать все последовательности длины k из чисел 1..n.
Решение. Будем печатать их в лексикографическом порядке (последовательность a
предшествует последовательности b, если для некоторого s их начальные отрезки длины s
равны, а (s+1)-ый член последовательности a меньше). Первой будет последовательность
<1, 1, ..., 1>, последней - последовательность <n, n, ..., n>. Будем хранить последнюю
напечатанную последовательность в массиве x(1)...x(k). Алгоритм будет выглядеть
следующим образом:
...x(1)...x(k) положить равным 1
...напечатать x
...last(1)...last(k) положить равным n
while x <> last
...x = следующая за x последовательность
...напечатать x
wend
133
Опишем, как можно перейти от x к следующей последовательности. Согласно
определению, у следующей последовательности первые s членов должны быть такими же, а
(s+1)-ый - больше. Это возможно, если x(s+1) было меньше n. Среди таких s нужно выбрать
наибольшее (иначе полученная последовательность не будет непосредственно следующей).
Соответствующее x(s+1) нужно увеличить на 1. Итак, надо, двигаясь с конца
последовательности, найти самый правый член, меньший n (он найдется, так как по
предположению x<>last), увеличить его на 1, а идущие за ним члены положить равными
единице.
P=K
WHILE NOT (X(P) < N)
P=P-1
WEND
X(P) = X(P) + 1
FOR I=P+1 TO K
X(I)=1
NEXT
Замечание. Если членами последовательности считать числа не от 1 до n, а от 0 до n-1,
то переход к следующему соответствует прибавлению 1 в n-ичной системе счисления.
Разбиения.
Пример 6. Перечислить все разбиения целого положительного числа n на целые
положительные слагаемые (разбиения, отличающиеся лишь порядком слагаемых, считаются
за одно). (Пример: n=4, разбиения 1+1+1+1, 2+1+1, 2+2, 3+1, 4.)
Решение. Договоримся, что в разбиениях слагаемые идут в невозрастающем порядке и
сами разбиения мы перечисляем в лексикографическом порядке. Разбиение храним в
начале массива x(1)...x(n), при этом количество входящих в него чисел обозначим k. В
начале x(1)=...=x(n)=1, k=n, в конце x(1)=n, k=1. В каком случае x(s) можно увеличить не
меняя предыдущих?
Во-первых, должно быть x(s-1)>x(s) или s=1. Во-вторых, s должно быть не последним
элементом (увеличение s надо компенсировать уменьшением следующих). Увеличив s, все
следующие элементы надо взять минимально возможными.
S = K - 1
WHILE NOT ((S=1) OR (X(S-1) > X(S)))
S = S-1
WEND
'S - ПОДЛЕЖАЩЕЕ УВЕЛИЧЕНИЮ СЛАГАЕМОЕ
X(S) = X(S) + 1
SUM = 0
FOR I = S+1 TO K
SUM = SUM + X(I)
NEXT
'SUM - СУММА ЧЛЕНОВ, СТОЯВШИХ ПОСЛЕ X(S)
FOR I = 1 TO SUM-1
X(S+I) = 1
NEXT
K = S+SUM-1
Коды Грея и аналогичные задачи
Иногда бывает полезно перечислять объекты в таком порядке, чтобы каждый
последующий минимально отличался от предыдущего. Рассмотрим несколько задач такого
рода.
Пример 7. Перечислить все последовательности длины n из чисел 1..k в таком порядке,
чтобы каждая следующая отличалась от предыдущей в единственной цифре, причем не более,
чем на 1.
134
Решение. Рассмотрим прямоугольную доску ширины n и высоты k. На каждой
вертикали будет стоять шашка. Таким образом, положения шашек соответствуют
последовательностям из чисел 1..k длины n (s-ый член последовательности соответствует
высоте шашки на s-ой горизонтали). На каждой шашке нарисуем стрелочку, которая может
быть направлена вверх или вниз. Вначале все шашки поставим на нижнюю горизонталь
стрелочкой вверх. Далее двигаем шашки по такому правилу: найдя самую правую шашку,
которую можно подвинуть в направлении (нарисованной на ней) стрелки, двигаем ее на
одну клетку в этом направлении, а все стоящие правее ее шашки (они уперлись в край)
разворачиваем кругом.
Ясно, что на каждом шаге только одна шашка сдвигается, т.е. один член
последовательности меняется на 1. Докажем индукцией по n, что проходятся все
последовательности из чисел 1...k. Случай n = 1 очевиден. Пусть n > 1. Все ходы поделим на
те, где двигается последняя шашка, и те, где двигается не последняя. Во втором случае
последняя шашка стоит у стены, и мы ее поворачиваем, так что за каждым ходом второго
типа следует k-1 ходов первого типа, за время которых последняя шашка побывает во всех
клетках. Если мы теперь забудем о последней шашке, то движения первых n-1 по
предположению индукции пробегают все последовательности длины n-1 по одному разу;
движения же последней шашки из каждой последовательности длины n-1 делают k
последовательностей длины n.
В программе, помимо последовательности x(1)...x(n), будем хранить массив d(1)...d(n)
из чисел +1 и -1 (+1 соответствует стрелке вверх, -1 -стрелке вниз).
Начальное состояние: x(1) =...= x(n) = 1; d(1) =...= d(n) = 1.
Приведем алгоритм перехода к следующей последовательности (одновременно
выясняется, возможен ли он - ответ становится значением булевской переменной p).
'если можно, сделать шаг и положить p=1, если нет, положить p=0
I = N
WHILE (I > 1) AND
(((D(I)=1) AND (X(I)=N)) OR ((D(I)=-1) AND (X(I)=1)))
I=I-1
WEND
IF (D(I)=1 AND X(I)=N) OR (D(I)=-1 AND X(I)=1) THEN
P=0
ELSE
P=1
X(I)= X(I) + D(I)
FOR J= I+1 TO N
D(J)= - D(J)
NEXT
END IF
Для последовательностей нулей и единиц возможно другое решение, использующее
двоичную систему. Именно оно связывается обычно с названием "коды Грея".
Запишем подряд все числа от 0 до (2 в степени n) - 1 в двоичной системе. Например, для
n = 3 напишем:
000 001 010 011 100 101 110 111
Затем каждое из чисел подвергнем преобразованию, заменив каждую цифру, кроме
первой, на ее сумму с предыдущей цифрой (по модулю 2). Иными словами, число a(1),
a(2),...,a(n) преобразуем в a(1), a(1) + a(2), a(2) + a(3),...,a(n-1) + a(n) (сумма по модулю 2).
Для n=3 получим:
000 001 011 010 110 111 101 100.
Легко проверить, что описанное преобразование чисел обратимо (и тем самым дает все
последовательности по одному разу). Кроме того, двоичные записи соседних чисел
отличаются заменой конца 011...1 на конец 100...0, что - после преобразования - приводит
к изменению единственной цифры.
135
Применение кода Грея. Пусть есть вращающаяся ось, и мы хотим поставить датчик
угла поворота этой оси. Насадим на ось барабан, выкрасим половину барабана в черный
цвет, половину в белый и установим фотоэлемент. На его выходе будет в половине случаев
0, а в половине 1 (т. е. мы измеряем угол "с точностью до 180").
Развертка барабана:
0
1
|_|_|_|_|*|*|*|*|
(склеить бока).
Сделав рядом другую дорожку из двух черных и белых частей и поставив второй
фотоэлемент, получаем возможность измерить угол с точностью до 90 градусов:
0 0 1 1
0 1 0 1
____
|_|_|_|_|*|*|*|*|
|_|_|*|*|_|_|*|*|
Сделав третью,
00001111
00110011
01010101
____
|_|_|_|_|*|*|*|*|
|_|_|*|*|_|_|*|*|
|_|*|_|*|_|*|_|*|
мы измерим угол с точностью до 45 градусов и т.д. Эта идея имеет, однако, недостаток: в
момент пересечения границ сразу несколько фотоэлементов меняют сигнал, и если эти
изменения произойдут не одновременно, на какое-то время показания фотоэлементов будут
бессмысленными. Коды Грея позволяют избежать этой опасности. Сделаем так, чтобы на
каждом шаге менялось показание лишь одного фотоэлемента (в том числе и на последнем,
после целого оборота).
00001111
00111100
01100110
____
|_|_|_|_|*|*|*|*|
|_|_|*|*|*|*|_|_|
|_|*|*|_|_|*|*|_|
Написанная нами формула позволяет легко преобразовать данные от фотоэлементов в
двоичный код угла поворота.
Пример 8. Напечатать все перестановки чисел 1..n так, чтобы каждая следующая
получалась
из
предыдущей перестановкой (транспозицией) двух соседних чисел.
Например, при n=3 допустим такой порядок (между переставляемыми числами вставлены
точки):
3.2 1 -> 2 3.1 -> 2.1 3 -> 1 2.3 -> 1.3 2 -> 3 1 2
Решение. Наряду с множеством перестановок
рассмотрим множество
последовательностей y(1)..y(n) целых неотрицательных чисел, у которых y(1)0,...,y(n)n-1.
В нем столько же элементов, сколько в множестве всех перестановок, и мы сейчас установим
между ними взаимно однозначное соответствие. Именно, каждой перестановке поставим в
соответствие последовательность y(1)..y(n), где y(i) - количество чисел, меньших i и
136
стоящих левее i в этой перестановке. Взаимная однозначность вытекает из такого
замечания. Перестановка чисел 1...n получается из перестановки чисел 1..n-1 добавлением
числа n, которое можно вставить на любое из n мест. При этом к сопоставляемой с ней
последовательности добавляется еще один член, принимающий значения от 0 до n-1, а
предыдущие члены не меняются. При этом оказывается, что изменение на единицу одного
из членов последовательности y соответствует перестановке двух соседних чисел, если все
следующие
числа последовательности y принимают максимально или минимально
возможные для них значения. Именно, увеличение y(i) на 1 соответствует перестановке
числа i с его правым соседом, а уменьшение - с левым.
Теперь вспомним решение задачи о перечислении всех последовательностей, на каждом
шаге которого один член меняется на единицу. Заменив прямоугольную доску доской в
форме лестницы (высота i-ой вертикали равна i) и двигая шашки по тем же правилам, мы
перечислим все последовательности y, причем i-ый член будет меняться, лишь если все
следующие шашки стоят у края. Надо еще уметь параллельно с изменением
y
корректировать перестановку. Очевидный способ требует отыскания в ней числа i; это
можно облегчить, если помимо самой перестановки хранить функцию i как позицию числа i
в перестановке (обратное к перестановке отображение), и соответствующим образом ее
корректировать. Получаемая по этому алгоритму программа такова:
n=...
DIM x(n): 'перестановка
DIM inv_x(n): 'обратная перестановка
DIM y(n) : 'Y[i] < i
DIM d(n) : 'направления (-1 0 1)
'первая перестановка: y(i)=0 при всех i
for i= 1 to n
x(i) = n + 1 – i: inv_x(i) = n + 1 - i
y(i)=0: d(i)=1
next
for i=1 to n
print x(i);
next
print
b = 1
'напечатаны все перестановки до текущей включительно
'если b=0, то текущая - последняя
while b=1
i=n
while (i > 1) and (((d(i)=1) and (y(i)=(i-1))) or
((y(i)=-1) and (y(i)=0)))
i=i-1
wend
if i>1 then b=1 else b=0
if b=1 then
y(i)=y(i)+d(i)
for j=i+1 to n
d(j) = -d(j)
next
pos1 = inv_x(i): val1 = i: pos2 = pos1 + d(i): val2 = x(pos2)
'pos1, pos2 - номера переставляемых элементов;
'val1, val2 - их значения}
tmp = x(pos1): x(pos1) = x(pos2): x(pos2) = tmp: tmp = inv_x(val1)
inv_x(val1)=inv_x(val2)
inv_x(val2) = tmp
end if
if b=1 then
for i=1 to n : print x(i);:
next
print
end if
wend
end
137
Несколько замечаний.
Посмотрим еще раз на использованные нами приемы. Вначале удавалось решить
задачу по такой схеме: определяем порядок на подлежащих перечислению объектах и явно
описываем процедуру перехода от данного объекта к следующему (в смысле этого порядка).
В задаче о кодах Грея потребовалось хранить, помимо текущего объекта, и некоторую
дополнительную информацию (направления стрелок). Наконец, в задаче о перечислении
перестановок (на каждом шаге допустима одна транспозиция) мы применили такой прием:
установили взаимно однозначное соответствие между перечисляемым множеством и
другим, более просто устроенным. Таких соответствий в комбинаторике известно много.
Например, "числа Каталана".
Пример 8. Перечислить все последовательности длины 2n, составленные из n единиц и
n минус единиц, у которых сумма любого начального отрезка положительна (т.е. число
минус единиц в нем не превосходит числа единиц).
Решение. Изображая единицу вектором (1,1), а минус единицу вектором (1,-1), можно
сказать, что мы ищем пути из точки (0,0) в точку (n,0), не опускающиеся ниже оси абсцисс.
Будем перечислять последовательности в лексикографическом порядке, считая, что -1
предшествует 1. Первой последовательностью будет "пила"
1, -1, 1, -1, ...
а последней - "горка"
1, 1, 1, ..., 1, -1, -1, ..., -1.
Как перейти от последовательности к следующей? До некоторого места они должны
совпадать, а затем надо заменить -1 на 1. Место замены должно быть расположено как
можно правее. Но заменять -1 на 1 можно только в том случае, если справа от нее есть
единица (которую можно заменить на -1). Заменив -1 на 1, мы приходим к такой задаче:
фиксирован начальный кусок последовательности, надо найти минимальное продолжение.
Ее решение: надо приписывать -1, если это не нарушит условия неотрицательности, а иначе
приписывать 1. Текст получаемой программы:
...
DIM a(2*n)
...
'в a помещается следующая последовательность, если
'она есть (при этом переменная last=0 (false), иначе last=1(true)
k=2*n
while a(k)=-1
k=k-1
wend
'k - максимальное среди тех, для которых a(k)=1
while (k>0) and (a[k] = 1)
k=k-1
wend
'a[k] - самая правая -1, за которой есть 1 если таких нет, то k=0
if k = 0 then
last = 1
else
last=0: i=0:sum=0
'sum = a(1)+...+a(i)
while i<>k
i=i+1: sum=sum+a[i]
wend
'sum=a(1)+...+a(k)
a(k)=1: sum=sum+2
'вплоть до a(k) все изменено, sum=a(1)+...+a(k)
while k <> 2*n
k=k+1
if sum > 0 then a(k)=-1 else a(k)=1
sum= sum+a(k)
wend
'k=n, sum=a(1)+...a(2n)=0
end if
138
АЛГОРИТМЫ ПОИСКА В ТЕКСТЕ
Рассмотрим следующую задачу.
Пример 1. Имеется некоторая последовательность из n символов. Определить,
имеются ли в ней идущие друг за другом символы "abcd".
Решение. Имеется примерно n-3 позиций, на которых могут находиться искомые
символы в исходном слове. Для каждой из позиций можно проверить, действительно ли там
оно находится, сравнив поочередно четыре символа. Однако есть более эффективный
способ. Читая исходное слово слева направо, мы «ожидаем» появления буквы 'a'. Как
только она появилась, мы «ждем» за ней букву 'b', затем 'c', и, наконец, 'd'. Если наши
«ожидания» оправдываются, то слово "abcd" обнаружено. Если же какая-то из нужных букв
не появляется, мы начинаем все сначала.
Этот простой алгоритм можно описать в разных терминах. Используя терминологию
конечных автоматов, которые мы упоминали в лекции 3, можно сказать, что при чтении
слова слева направо мы в каждый момент находимся в одном из следующих состояний:
"начальное" (0), "сразу после a" (1), "сразу после ab" (2), "сразу после abc" (3) и "сразу после
abcd" (4). «Читая» очередной символ, мы переходим в следующее состояние по правилу
Текущее
состояние
0
0
1
1
1
2
2
2
3
3
3
Очередной
символ
а
«не» а
b
a
«не» а и «не» b
c
a
«не» а и «не» c
d
a
«не» а и «не» d
Новое
состояние
1
0
2
1
0
3
1
0
4
1
0
Как только мы попадем в состояние 4, работа заканчивается.
Иными
словами, мы в каждый момент храним информацию о том, какое
максимальное начало нашего образца "abcd" является концом прочитанной части. Его
длина и есть то "состояние", о котором шла речь.
Используем следующую терминологию. Слово - это любая последовательность
символов из некоторого фиксированного конечного множества. Это множество называется
алфавитом, его элементы - буквами. Если отбросить несколько букв с конца слова, останется
другое слово, называемое началом первого. Любое слово также считается своим началом.
Конец слова - то, что останется, если отбросить несколько первых букв. Любое слово
считается своим концом. Подслово - то, что останется, если отбросить буквы и с начала, и с
конца.
Можно ли в предыдущем примере заменить слово "abcd" на произвольное слово? Нет,
и проблемы связаны с тем, что в образце могут быть повторяющиеся буквы. Пусть,
например, мы ищем вхождения слова "ababc". Вот появилась буква "a", за ней идет "b", за
ней идет "a", затем снова "b". В этот момент мы с нетерпением ждем буквы "c". Однако
вместо нее появляется другая буква, и наш образец "ababc" не обнаружен.
В принципе, не составляет труда для любого конкретного образца написать
программу, осуществляющую поиск этого образца описанным способом. Однако хотелось
139
бы написать программу, которая ищет произвольный образец в произвольном слове. Это
можно делать в два этапа: сначала по образцу строится таблица переходов конечного
автомата, а затем читается входное слово и состояние преобразуется в соответствии с этой
таблицей. Подобный метод часто используется для более сложных задач поиска, но для
поиска подслова существует более простой и эффективный алгоритм, называемый
алгоритмом Кнута - Морриса - Пратта.
На основе его созданы и работают функции MID$ в Бейсике, Copy и Pos в Паскале и
аналогичные им в других языках.
Этот алгоритм является классическим, он описан во многих учебниках и мы не будем
останавливаться на нем, отправив любознательного читателя к первоисточникам.
Нас интересуют более интересные с позиций логической организации алгоритмы.
Например, алгоритм Бойера-Мура. Этот алгоритм делает то, что на первый взгляд
кажется невозможным: в типичной ситуации он читает лишь небольшую часть всех букв
слова, в котором ищется заданный образец. Как так может быть? Идея проста. Пусть,
например, мы ищем образец "abcd". Посмотрим на четвертую букву слова: если, к примеру,
это буква "e", то нет никакой необходимости читать первые три буквы. В самом деле, в
образце буквы "e" нет, поэтому он может начаться
не раньше пятой буквы.
Мы приведем самый простой вариант этого алгоритма. Пусть x[1]..x[n] - образец,
который надо искать. Для каждого символа s найдем самое правое его вхождение в слово X,
то есть наибольшее k, при котором x[k]=s. Эти сведения будем хранить в массиве pos[s];
если символ s вовсе не встречается, то нам будет удобно положить pos[s] = 0.
for i:=1 to n do
pos[x[i]]:=i;
В процессе поиска мы будем хранить в переменной last номер буквы в слове, против
которой последняя буква образца. В начале last = m (т.е. длине образца), затем постепенно
увеличивается. Смотрим:
last:=m;
{все предыдущие положения образца уже проверены}
while last <= m do begin {слово не кончилось}
if x[m] <> y[last] then begin {последние буквы разные}
last := last + (m - pos[y[last]]);
{m - pos[y[last]] - это минимальный сдвиг образца,
при котором напротив y[last] встанет такая же
буква в образце. Если такой буквы нет вообще,
то сдвигаем на всю длину образца}
end else begin
{если нынешнее положение подходит, т.е. если
x[1]..x[m] = y[last-m+1]..y[last],
то сообщить о совпадении;}
last := last+1;
end;
end;
Еще более простым является алгоритм Рабина.
Этот алгоритм основан на простой идее. Представим себе, что в слове длины m мы
ищем образем длины n. Вырежем окошечко размера n и будем двигать его по входному
слову. Нас интересует, не совпадает ли слово в окошечке с заданным образцом. Сравнивать
по буквам долго. Вместо этого фиксируем некоторую функцию на словах длины n. Если
значения этой функции на слове в окошечке и на образце различны, то совпадения нет.
Только если значения одинаковы, нужно проверять совпадение по буквам.
Что мы выигрываем при таком подходе? Казалось бы, ничего - ведь чтобы
вычислить значение функции на слове в окошечке, все равно нужно прочесть все буквы
этого слова. Так уж лучше их сразу сравнить с образцом. Тем не менее выигрыш возможен, и
140
вот за счет чего. При сдвиге окошечка слово не меняется полностью, а лишь добавляется
буква в конце и убирается в начале. Хорошо бы, чтобы по этим данным можно было бы
легко рассчитать, как меняется функция.
Заменим все буквы в слове и образце их номерами, представляющими собой целые
числа. Тогда удобной функцией является сумма цифр. При сдвиге окошечка нужно добавить
новое число и вычесть пропавшее.
Для каждой функции существуют слова, к которым она плохо применима. Зато другая
функция в этом случае может работать хорошо. Возникает идея: надо запасти много
функций и в начале работы алгоритма выбирать из них случайную.
Выберем некоторое число p (желательно простое) и некоторый вычет x по модулю
p. Каждое слово длины n будем рассматривать как последовательность целых чисел (заменив
буквы их кодами). Эти числа будем рассматривать как коэффициенты многочлена степени n1 и вычислим значение этого многочлена по модулю p в точке x. Это и будет одна из
функций семейства (для каждой пары p и x получается, таким образом, своя функция).
Сдвиг окошка на 1 соответствует вычитанию старшего члена, умножению на x и
добавлению свободного члена.
Следующее соображение говорит в пользу того, что совпадения не слишком вероятны.
Пусть число p фиксировано и к тому же простое, а X и Y - два различных слова длины n.
Тогда им соответствуют различные многочлены (мы предполагаем, что коды всех букв
различны - это возможно при p, большем числа букв алфавита). Совпадение значений
функции означает, что в точке x эти два различных многочлена совпадают, то есть их
разность обращается в 0. Разность есть многочлен степени n-1 и имеет не более n-1 корней.
Таким образом, если n много меньше p, то случайному x мало шансов попасть в неудачную
точку.
На основании этого алгоритма можно искать не конкретно слово, а подслова
заданного вида. Например, можно искать слова вида a@b, где вместо @ может стоять любая
буква (иными словами, нас интересует буква b на расстоянии 2 после буквы a). Еще один
вид поиска - это поиск любого из слово некоторого списка.
Для более полного понимания описанных алгоритмов, правда с использованием
некоторых стандартных функций работы со строками языка программирования, приведем
примеры решения некоторых задач.
Пример 2. Широко известна игра "Города". Называется какой-нибудь город,
допустим, "Саратов". Кончается на "в", значит требуется назвать другой город, у которого в
названии первая буква "в". Это может быть "Воронеж". Следующий город должен
начинаться на "ж" и т.д. Запрещено повторять названия городов. Надо написать программу,
которая из набора названий городов (все названия разные) строит цепочку максимальной
длины.
Например, из списка
НОВОСИБИРСК АСТРАХАНЬ САМАРА ВЛАДИМИР
КИРОВ
максимально длинным будет
САМАРА
АСТРАХАНЬ НОВОСИБИРСК КИРОВ ВЛАДИМИР
const mnt = 20; {максимальное количество слов на входе}
var list,chain,store: array [1..mnt] of string;
{для списка и цепочек}
numin:integer; {реальное количество слов на входе}
pc :integer;
{Указатель на хвост цепочки}
ml:integer;
{Длина наибольшей цепочки}
sym:char;
{Первичная буква для перебора}
procedure read_data; {Начальные установки и чтение данных}
var i : integer;
begin
pc:=0; ml:=0; numin:=0;
assign(input,'TOWN.IN'); reset(input);
141
fillchar(chain,sizeof(chain),0);
readln(numin); if (numin>mnt) then numin:=mnt;
for i:=1 to numin do readln(list[i]); close(input);
end;
procedure write_results; { Запись результатов в файл }
var i : integer;
begin
assign(output,'TOWN.OUT'); rewrite(output);
writeln(ml); if (ml>0) then begin
for i:=1 to ml do writeln(store[i]);
end; close(output);
end;
procedure store_chain; {Запоминаем только более длинную цепочку}
var i:integer;
begin if (pc>ml) then begin store:=chain; ml:=pc; end; end;
{Возвращает указатель по 1-й букве, 0-такого элемента нет }
function find_next_item( c:char; n:integer ):integer;
var i:integer;
begin
i:=1; find_next_item:=0;
while (i<=numin) and (n>0) do begin
if (list[i][1]=c) then i:=i-1; i:=i+1; end;
if (n=0) then find_next_item:=pred(i);
end;
{ Алгоритм построения цепочек. } {Метод: перебор с возвратом.}
procedure build_chain( c:char; n:integer );
var i:integer;
begin
i:=find_next_item(c,n); if (i>0) then begin
pc:=pc+1; chain[pc]:=list[i]; list[i][1]:='X'; {вычеркиваем }
build_chain(list[i][length(list[i])], 1);
pc:=pc-1; list[i][1]:=c; {возвращаем}
build_chain(c, n+1);
end else store_chain;
end;
begin
read_data; for sym:='А' to 'Я' do build_chain(sym,1);
write_results;
end.
Пример 3. Выделить слова из данного текста. Т.е. на входе - текст, на выходе список слов
const Alpha:set of char=['A'..'Z','А'..'Я','a'..'z','а'..'я'];
var s,t:string;i:integer;
begin
writeln('Введите текст'); readln(s); i:=1;
Repeat while NOT(s[i] in Alpha) and (i<=length(s)) do i:=i+1;
t:='';
while (s[i] in Alpha) and (i<=length(s)) do begin
t:=t+s[i]; i:=i+1; end;
if length(t)<>0 then writeln(t);
Until (i>length(s));
end.
Как можно увидеть, даже внешне эти программы похожи на описанные нами алгоритмы.
Читателю предлагается самостоятельно найти фрагменты в программах, основанные на
рассмотренных алгоритмах.
142
РЕКУРСИЯ В ГРАФИКЕ
Рекурсия – один из самых замечательных приемов программирования. Детальное
описание рекурсии и методов ее использования при решении задач широко описаны в
литературе, нас же на данный момент интересует использование рекурсии в графических
программах для построения некоторых изображений и орнаментов.
Построем простейший рисунок, основанный на рекурсивном построении отрезков –
лабиринт.
За основу алгоритма примем следующее положение: отрезок длиной L строится под
углом ugol градусов из текущего положения курсора: это называют рекурсией с
построением на прямом проходе последовательности рекурсивных вызовов
du
2*dL
uses crt,graph;
var gd,gm,dl,du: integer;
procedure vector( l,ugol: integer);
var dx,dy: integer;
begin {составляющие вектора по осям }
dx:=round( l*cos( ugol*pi/180));
dy:=round( l*sin( ugol*pi/180));
linerel(dx,dy); delay(5000);
{условие продолжения рекурсии }
if (l>abs(dl))and(l<500) then
{меняем длину отрезка на dl и направление на du}
vector(l+dl,ugol+du); {рекурсивный вызов}
end;
begin
gd:=detect;
initgraph(gd,gm,'');
moveto(getmaxx div 2,getmaxy div 2); {стартовая точка }
dl:=-20; du:=90; { изменение длины и угла вектора }
vector(240,0);
readln;
closegraph
end.
Поскольку внутри процедуры VECTOR происходит вызов этой же процедуры с новыми
фактическими параметрами (x, y), то последующий вектор начнется с конца предыдущего.
Варьируя dL и du, можно строить различные спиралевидные узоры. Если рекурсивный
вызов перенести до операторов расчета очередного смещения (dx, dy) с выводом LineRel
(dx,dy), то построение пройдет на обратном проходе последовательности рекурсивных
вызовов.
Следующий пример показывает использование рекурсии при построении узоров,
напоминающих кружева. Задается размер "стежка" - короткой линии длиной dl, а также
функция варьирования угла ugol, под которым этот стежок строится, в зависимости от
номера шага n.
143
uses graph,crt;
var gd,gm: integer;
l,ugol,base,a,b: double;
c: char; s1,s2: string;
stop,draw: boolean;
procedure step(x,y:double; n,nmax: integer);
begin
{ n – счетчик стежков узора }
base:=2*pi*n/nmax; {угол,определяющий базовую линию узора}
{на базовую линию (здесь это окружность диаметром n*l/pi)
накладываем периодическое отклонение с амплитудой a и частотой b}
ugol:=base+a*sin(b*base);
{переход к стартовой точке }
if n=0 then moveto(round(x),round(y));
x:=x+l*cos(ugol);
y:=y+l*sin(ugol);
lineto(round(x),round(y)); {прорисовка стежка}
if n<nmax then step(x,y, n+1,nmax)
end;
begin
gd:=detect;
initgraph(gd,gm,'');
l:=3;
{размер "стежка"}
a:=1; b:=2;
{начальные значения коэффициентов}
step(200,170,0,400);{вывод узора}
stop:=false;
repeat
{модификация узора подбором величин a,b }
c:=readkey;
{считывание с клавиатуры}
if c=#0 then
c:=readkey; {для курсорных клавиш}
draw:=true;
{признак перерисовки}
case c of
{анализируем код нажатой клавиши}
#72: a:=a+0.1; {вверх}
#80: a:=a-0.1; {вниз}
#77: b:=b+1;
{вправо}
#75: b:=b-1;
{влево}
#27: stop:=true; {при нажатии esc}
else draw:=false;
end;
if stop then break;
if draw then begin
cleardevice;
str(a:5:1, s1); str(b:5:1, s2);
{вывод текущих коэффициентов}
outtextxy(460,390,'a='+s1+' вверх/вниз');
outtextxy(460,410,'b='+s2+' <-/->');
step(200,170,0,400) {вывод узора}
end
until stop;
closegraph
end.
Приведенная программа позволяет строить весьма разнообразные кружевные узоры
даже при взятой сравнительно простой зависимости варьирования направления "вышивания"
ugol:=base+a*sin(b*base). При усложнении зависимости, например, наложением на базовое
направление двух пульсаций
ugol:=base+a1*sin(b1*base)+a2*sin(b2*base) разнообразие
картин, как и их изящество существенно возрастает – нужно лишь удачно подобрать
соотношение коэффициентов a1,b1,a2,b2. Полезно также ввести варьирование размера
стежка и/или количества стежков – иногда размер узора получается слишком большим или
слишком маленьким. Рост количества стежков при уменьшении их размера позволяет
уменьшить угловатость узора.
В качестве базового направления необязательно брать окружность – можно любую
линию, например, при base=const – прямую. Из отрезков прямых можно делать "заготовки"
для кружевных рамок. Можно варьировать и размер стежка в зависимости от его номера
(например, циклически).
144
Если в процедуре проводить несколько рекурсивных вызовов, то можно создавать
"древовидные структуры" – количество "отростков" в развилках будет равно количеству
вызовов.
uses graph,crt;
var gd,gm: integer;
procedure vetka(x,y,l: integer; a: double);
{рекурсивное рисование "веток" - последовательно расположенных отрезков
из точки (x,y), постепенно меняющих размер l и угол ориентации a}
const b=pi/4; {угол между " ветками"}
m=0.8;
{коэффициент пошагового изменения размера "ветки"}
var
x0,y0: integer;
begin
{ограничение размеров "ветки" является условием прекращения рекурсии}
if(l<9) or (l>100) then exit;
{установка стилей для разных элементов рисунка}
if l>40 then setcolor(6) else setcolor(10);
if l<30 then setlinestyle(0,0,1) else setlinestyle(0,0,3);
moveto(x,y); {переход к стартовой точке рисования}
x0:=x; y0:=y; {запоминаем "начало ветки"}
x:=x+round(l*cos(a)); {координаты "конца ветки"}
y:=y+round(l*sin(a));
lineto(x,y); {рисование "ветки" в виде отрезка}
vetka(x,y,round(l*m),a-b/2); {первый "отросток" - отклонение на -b/2}
vetka(x,y,round(l*m),a+b/2); {второй "отросток" - отклонение на +b/2}
{возврат к предшествующим координатам перед началом новой ломаной}
moveto(x0,y0)
end;
begin
gd:=detect;
initgraph(gd,gm,'');
vetka(300,450,90,-pi/2);
{в процедуру передаем параметры "базовой ветки"}
readln;
closegraph
end.
Приведенный алгоритм нетрудно разнообразить, например, добавлением количества
рекурсивных вызовов увеличить количество отростков, а постановкой ограничительных
условий перед рекурсивными вызовами и варьированием коэффициента пошагового
изменения размеров менять стиль получаемых образов.
Не секрет, что наиболее красивые орнаменты получаются при использовании так
называемых фрактальных множеств точек, из которых самым известным является множество
Мандельброта.
Однако красивые линии с повторяющимся рисунком можно получить и с помощью
простых рекурсивных алгоритмов. Первый пример такой линии — кривая дракона:
145
Кривая дракона впервые была описана в популярной литературе в журнале Scientific
American в 1967 году. Заметка о ней появилась в колонке “Математические игры”, которую
вел Мартин Гарднер.
Рассмотрим горизонтальный отрезок как кривую дракона нулевого порядка. Разделим
отрезок пополам и построим на нем прямой угол, как показано на рисунке. Получим кривую
дракона первого порядка. На сторонах прямого угла снова построим прямые углы.
При этом вершина первого угла всегда находится справа, если смотреть из точки A
(начала кривой) вдоль первого отрезка кривой, а направления, в которых строятся вершины
остальных углов, чередуются. Далее показаны кривые дракона третьего и четвертого
порядков соответственно
Приступим к разработке программы построения кривой дракона. Начнем с того, что
будем наблюдать ход ломаных линий, начиная с отрезка 1, и на каждом углу следить,
поворачивается отрезок на 900 вправо (по часовой стрелке) или влево (против часовой
стрелки). Присвоим код 1 повороту влево и код 3 повороту вправо и обозначим код для
отрезка с номером i через K(i).
Если рассмотреть ломаные, но состоящие из 16, 32 и т.д. отрезков, и проанализировать
зависимость направления поворота от номера отрезка, то можно установить, что значение
K(i) определяется следующим образом:
K(i)=K(i div 2), если i четное;
K(i)=i mod 4, если i нечетное,
Определение значений K(i) может быть проведено с помощью рекурсивной функции:
алг цел K(арг цел i)
нач
если i mod 2 = 0 то
К:=K(i div 2) | рекурсивный вызов функции
иначе
К:= i mod 4
все
кон
Построение очередного отрезка ломаной удобно выполнять с использованием
команды, которая на школьном алгоритмическом языке называется вектор. Эта команда
проводит линию из текущей позиции в точку, заданную приращением ее координат.
В процедуре Step, выполняющей построение, рассматриваются 4 варианта направления
перемещения (2 направления по горизонтали и 2 по вертикали). Направление задается
величиной angle. При перемещении вертикально вверх значение этой величины равно 0,
горизонтально влево –90, вертикально вниз –180 и горизонтально вправо –270 (т.е. отсчет
производится против часовой стрелки от направления вертикально вверх). Длина отрезка
ломаной обозначена len.
146
алг Step(арг цел angle)
нач
выбор
при angle=0 : вектор(0, -len)
при angle=180 : вектор(0, len)
при angle=270 : вектор(len, 0)
при angle=90 : вектор(-len, 0)
все
кон
Определим закономерности изменения значения угла angle в ходе построения ломаной.
Можно утверждать, что в конце каждого отрезка с номером i мы должны повернуть на
K(i)*900 влево, поскольку поворот на 900 по часовой стрелке эквивалентен повороту на 2700
влево против часовой стрелки. Тогда с учетом принятой системы отсчета угла angle его
очередное (после поворота) значение связано с предыдущим значением зависимостью:
angle= (angle+K(i)*90) mod 360
где K(i) — код направления поворота.
Следовательно, основная часть программы может быть оформлена в виде:
алг Lom
нач цел n, angle, i
поз(190, 276) |начальная точка ломаной
angle:=270 |угол, под которым рисуется первый отрезок
len:=20 |длина отрезков ломаной
вектор(len, 0) |рисуем первый отрезок
n:=418 |количество отрезков
нц для i от 1 до n-1
angle:= (angle+K(i)*90) mod 360
Step(angle) |рисуем остальные отрезки линии
кц
кон
Немного уточним приведенную программу. Основные изменения должны быть
внесены в процедуру Step. Включим в нее рисование “закругления”, предшествующего
очередному отрезку. Очевидно, что для вычерчивания этого “закругления” необходимо знать
предшествующее направление перемещения. Информацию о нем будем хранить в
переменной old_angle. Естественно, что длина вычерчиваемого отрезка в данном случае
уменьшается до len-2*a, где a - длина катета “закругления”. С учетом этого процедура Step
оформляется следующим образом:
алг Step(арг цел angle, арг рез цел old_angle)
нач
выбор
при angle=0:
если old_angle=90 то вектор(-a, -a)
иначе вектор(a, -a)
все
вектор(0, -(len-2*a))
при angle=180:
если old_angle=90 то вектор(-a, a)
иначе вектор(a, a)
все
вектор(0, len-2*a)
при angle=270:
если old_angle=0 то вектор(a, -a)
иначе вектор(a, a)
все
вектор(len-2*a, 0)
при angle=90:
если old_angle=0 то вектор(-a, -a)
147
иначе вектор(-a, a)
все
вектор(-(len-2*a), 0)
все
old_angle:=angle
кон
Основная часть программы меняется незначительно:
алг Lom
нач цел n, angle, old_angle, I
поз(190+a, 276)
len:=20
a:=div(len, 5)
angle:=270
вектор(len-a, 0)
old_angle:=270
n:=418
нц для i от 1 до n-1
angle:= (angle+K(i)*90) mod 360
Step(angle,old_angle)
кц
кон
Кроме кривой дракона, широко известны кривая Гильберта и кривая Серпинского.
Кривая Гильберта первого порядка, обозначаемая H1, похожа на изображение буквы
П, вычерченной в виде трех сторон квадрата, как показано на следующем рисунке (поз. а).
На поз. б изображена кривая Гильберта второго порядка H2. Видно, что кривая H2 состоит из
кривых H1, ориентированных в разные стороны (вправо, вверх и влево). Кривые H1,
составляющие кривую H2, соединены тремя отрезками прямых, называемых связками (они
вычерчены утолщенными линиями). В действительности эти отрезки должны иметь
одинаковую толщину с другими линиями, утолщенными они показаны единственно с целью
демонстрации способа получения H2 из Н1.
Аналогично фигуру H3 (поз. в) можно рассматривать как состоящую из четырех
кривых H2 (ориентированных в разные стороны) и трех связок.
148
Заметим, что отрезки, образующие линию H1, можно рассматривать как связки,
соединяющие 4 точки — кривые Гильберта нулевых порядков.
Таким образом, кривую Гильберта i-го порядка Hi можно получить из четырех кривых
Hi–1, ориентированных в разные стороны, и трех связок. Если процедуры рисования кривых
Hi, ориентированных вверх, вниз, влево и вправо, обозначить соответственно GU(i), GD(i),
GL(i) и GR(i), то можно составить следующие рекурсивные схемы построения этих кривых:
GU(i): GR(i—1)
GU(i—1)
GU(i—1)
GL(i—1)
GR(i): GU(i—1)
GR(i—1)
GR(i—1)
GD(i—1)
GD(i): GL(i—1)
GD(i—1)¬ GD(i—1)
GR(i—1)
GL(i): GD(i—1)
GL(i—1)
GL(i—1)
GU(i—1)
Обозначим через h длину элементарного отрезка прямых в кривых Hi. Тогда, эти
процедуры могут быть оформлены следующим образом:
алг GU(арг цел i)
нач
если i>0
то
GR(i-1)
вектор(0, -d)
GU(i-1)
вектор(d, 0)
GU(i-1)
вектор(0, d)
GL(i-1)
все
кон
алг GD(арг цел i)
нач
если i>0
то
GL(i-1)
вектор(0, d)
GD(i-1)
вектор(-d, 0)
GD(i-1)
вектор(0, -d)
GR(i-1)
все
кон
алг GL(арг цел i)
нач
если i>0
то
GD(i-1)
вектор(-d, 0)
GL(i-1)
вектор(0, d)
GL(i-1)
вектор(d, 0)
GU(i-1)
все
кон
алг GR(арг цел i)
нач
если i>0
то
GU(i-1)
вектор(d, 0)
GR(i-1)
вектор(0, -d)
GR(i-1)
вектор(-d, 0)
GD(i-1)
все
кон
Обратим внимание на то, что в приведенных процедурах рисования кривых
Гильберта используется так называемая косвенная рекурсия - ситуация, когда процедура
вызывает себя как вспомогательную не только непосредственно, а также и через другую
процедуру.
Квадрат, в который вписывается кривая Гильберта, будем называть опорным, длину его
стороны (в пикселях) обозначим через S. Обсудим теперь вопрос определения значения
величины h в зависимости от порядка кривой n. При n=2 длина элементарного отрезка линии
в три раза меньше стороны опорного квадрата, при n=3 — в семь раз. Отсюда получаем, что
коэффициенты уменьшения для этих элементарных отрезков в фигурах H1, H2 , H3, ...
образуют ряд чисел 1, 3, 7, ..., то есть в общем случае коэффициент уменьшения для фигуры
Hn может быть вычислен по формуле 2n—1.
Расположим изображаемую кривую Гильберта по центру экрана. Для этого надо найти
координаты x0, y0 начальной точки кривой. Проанализировав приведенные выше процедуры,
149
можно убедиться, что при ориентации кривой вверх и влево она начинается с левой нижней
точки опорного квадрата, т.е.
x0=Xc - S/2;
y0 =Yc+S/2,
а в остальных случаях — с правой верхней точки опорного квадрата, т.е. в этих случаях
x0=Xc + S/2;
y0 =Yc - S/2,
где Xc, Yc — координаты центра экрана.
Кроме того, удобно задавать размер опорного квадрата в процентах от высоты экрана,
поскольку она всегда меньше ширины. Эту величину обозначим PrS. В программе
построения кривой Гильберта используем, помимо указанных обозначений, еще переменную
orient - число, определяющее ориентацию кривой (вверх - 1, вниз -2, вправо - 3, влево - 4).
Получим следующий алгоритм
алг Gilbert
нач цел n, x0, y0, s, orient, Hscr, Wscr
вещ PrS
Hscr:=480 |Высота экрана
Wscr:=640 |Ширина экрана
ввод PrS
ввод n
ввод orient
S:=Int(PrS/100*Hscr) |Сторона опорного квадрата
h:= (S div 2* n *n-1) | Длина связок
|Находим координаты начальной точки кривой
если (orient=1) или (orient=3) то
x0:=Wscr Div 2- S Div 2
y0:=Hscr Div 2+ S Div 2
иначе
x0:=Wscr Div 2+ S Div 2
y0:=Hscr Div 2- S Div 2
все
поз(x0, y0) |Начальная точка кривой
|Рисуем
соответствующий
вариант
кривой
выбор
при orient=1: GU(n)
при orient=2: GD(n)
при orient=3: GR(n)
иначе GL(n)
все
кон
Гильберта
В результате получим вот такой симпатичный орнамент.
В заключение темы рассмотрим еще одну рекурсивную кривую кривую
Серпинского
На следующем рисунке представлены две кривые Серпинского: первого (а) и второго
(б) порядков. Обратим внимание на важную особенность кривых Серпинского: длина
150
горизонтальных и вертикальных отрезков кривых в два раза больше длины горизонтальных и
вертикальных проекций наклонных отрезков:
Кривая Серпинского состоит из четырех звеньев, каждое из которых строится
рекурсивно, соединенных четырьмя отрезками. На рисунке эти отрезки обозначены BC, DE,
FG и HA. С учетом этого можно увидеть, что рекурсивно строятся звенья AB, CD, EF и GH.
Если процедуры рисования четырех звеньев кривой обозначить соответственно LineAB,
LineCD, LineEF и LineGH, а отрезков BC, DE, FG и HA соответственно SegmBC, SegmDE,
SegmFG и SegmAH, то фрагмент, относящийся к построению кривой Серпинского (по
часовой стрелке), имеет вид:
LineAB
SegmBC
LineCD
SegmDE
LineEF
SegmFG
LineGH
SegmHA
Напомним, что звенья AB, CD, EF и GH строятся рекурсивно. Чтобы получить схемы их
построения, проанализируем структуру кривой A2B2. Можно увидеть, что она состоит из
линий, подобных кривым A1B1, C1D1, G1H1 и A1B1, соединенных отрезками, аналогичными
отрезкам B2C2 и H2A2, а также горизонтальным отрезком двойной длины, т.е. рекурсивная
схема построения кривой AB i-го порядка следующая:
AB(i): AB(i–1); BC;
CD(i–1);; GH(i–1); HA; AB(i–1)
Соответствующая рекурсивная процедура имеет вид:
алг LineAB(арг цел i)
нач
если i>0
то
LineAB(i-1)
SegmBC
LineCD(i-1)
SegmE
LineGH(i-1)
SegmHA
LineAB(i-1)
все
кон
Здесь SegmBC, SegmHA и SegmE - процедуры рисования отрезков BC, HA и отрезка,
изображенного на схеме в виде символа .
Аналогично можно получить схемы построения кривых CD, EF и GH:
151
Рекурсивные процедуры их построения:
алг LineCD(арг цел i)
нач
если i>0
то
LineCD(i-1)
SegmDE
LineEF(i-1)
SegmS
LineAB(i-1)
SegmBC
LineCD(i-1)
все
кон
алг LineEF(арг цел i)
нач
если i>0
то
LineEF(i-1)
SegmFG
LineGH(i-1)
SegmW
LineCD(i-1)
SegmDE
LineEF(i-1)
все
кон
алг LineGH(арг цел i)
нач
если i>0
то
LineGH(i-1)
SegmHA
LineAB(i-1)
SegmN
LineEF(i-1)
SegmFG
LineGH(i-1)
все
кон
Длину горизонтальной (и вертикальной) проекции наклонных отрезков кривой
обозначим h и учтем, что горизонтальные и вертикальные отрезки имеют длину 2h. Тогда
процедуры рисования отрезков SegmE, SegmW, SegmN, SegmS можно записать как:
SegmE
SegmW
вектор(2*h, 0)
вектор(-2*h, 0)
SegmS
SegmN
вектор(0, 2*h)
вектор(0, -2*h)
Процедуры рисования наклонных отрезков SegmBC, SegmDE, SegmFG, SegmHA имеют
вид:
SegmBC
вектор(h, h)
SegmDE
вектор(-h, h)
SegmFG
вектор(-h, -h)
SegmHA
вектор(h, -h)
Выразим теперь параметр h кривой Серпинского через длину стороны опорного
квадрата, которую обозначим как A. Кривая Серпинского порядка i состоит из центрального
квадрата со срезанными углами, а к каждому срезу примыкает кривая Серпинского порядка i
–1. Проведем главную диагональ опорного квадрата, соединяющую левую верхнюю
вершину Tlu с правой нижней Trd. Она пересечет кривую порядка i в точках Сlu и Сrd, а линии
среза центрального квадрата – в точках Klu и Krd. Назовем отрезок, соединяющий точки Сlu и
Сrd диагональю кривой Серпинского, его длину обозначим  i, кроме того, введем
относительную длину диагонали кривой Серпинского Si=i/h. Расстояние между точками Klu
152
и Krd обозначим через p. Выполнив несложные геометрические выкладки, найдем, что
p=3 2 h. Поскольку отрезки [Сlu, Klu] и [Сrd, Krd] являются диагоналями кривых Серпинского
порядка i –1, то i=2i–1+p или в относительных величинах
Si =2Si–1+ 3 2 h
Из рассмотрения кривой первого порядка следует, что S0 = 2 . Нам понадобится не
относительная длина диагонали кривой Серпинского Si, а величина Zi = Si/ 2 , которую
назовем коэффициентом диагонали кривой Серпинского. Разделив полученное уравнение
на 2 , получим
Zi =2 Zi–1+3 2
причем Z0 = 1.
Отсюда следует, что коэффициенты Zi – натуральные числа. Это уравнение позволяет
найти с использованием рекурсии Zi для любого i. Диагональ опорного квадрата Dsq (как
известно, Dsq = A 2 ) выражается через диагональ кривой Серпинского соотношением: Dsq
=n + 2 h. Выражая n через Sn, а эту величину через Zn, получаем: Dsq = h (Zn +1) 2 . С
другой стороны, как известно, Dsq=A 2 . Приравнивая эти два выражения для Dsq, находим
величину h:
A
h
Zn 1
Теперь легко найти положение начальной точки кривой Серпинского T0: она находится
правее точки Tlu на величину h. В свою очередь координаты этой точки находятся, если
учесть, что опорный квадрат расположен по центру экрана:
Xtlu=Xc — A/2; Ytlu=Yc — A/2
153
Напишем рекурсивную фукцию calcZ, вычисляющую коэффициент длины диагонали
кривой Серпинского порядка i:
алг цел calcZ(арг цел i)
нач
если i=0
то знач:=1
иначе знач:=2*calcS(i-1)+3
все
кон
Целиком алгоритм построения кривой Серпинского данного порядка выглядит
следующим образом .
алг Serpen
нач цел n, x0, y0,Xlu,Ylu,Hscr,Wscr,A,Z
вещ PrA
Hscr:=480 |Высота экрана
Wscr:=640 |Ширина экрана
ввод PrA
ввод n
A:=Int(PrA/100*Hscr)
Z:=calcZ(n)
h:=Int(A/(Z+1))
Xlu:= Wscr Div 2 – A Div 2
Ylu:= Hscr Div 2 – A Div 2
y0:=Ylu
x0:=Xlu+h
поз(x0,y0)
LineAB(n)
SegmBC
LineCD(n)
SegmDE
LineEF(n)
SegmFG
LineGH(n)
SegmHA
кон
При выполнении данного алгоритма на экране отображается следующий узор.
Рассмотренные нами примеры рекурсивных кривых могут дать только начальное
представление об этой области математики, уже настолько связанных с информатикой, что
их раздельное осмысление и тем более использование уже не предоставляется вероятным.
154
РЕТРОСПЕКТИВНЫЙ АНАЛИЗ ИЛИ ШАХМАТНАЯ ТАКТИКА
Есть задачи, в которых перебор оказывается безнадежно долгим, а анализ ситуаций,
начиная с заключительных, быстро приводит к цели. Самой известной задачей такого рода
является следующая.
Два француза
решили
выяснить, не являются ли они прямыми потомками по
мужской линии короля Карла Великого. Были у них все метрические архивы. Первый
француз начал с Карла Великого. У короля было 11 сыновей. У сыновей снова были
сыновья..., и к концу дня первый француз выяснил, что не сможет закончить анализ за всю
свою жизнь. А второй француз начал с себя, нашел в записях своего отца, потом его отца... и
в тот же день закончил работу.
Вот более трудная задача. Она из шахмат. У белых король и ферзь, у черных один король. Могут ли белые выиграть, не делая хода своим королем, стоящим на поле сЗ?
Эта задача была известна еще в прошлом веке, но явилась первой шахматной задачей,
решенной машиной раньше, чем людьми. Впрочем, зная, что решение есть, человек находит
его за 1-2 часа.
Попытаемся решить задачу перебором. У белых, как правило, больше 20 вариантов
хода, у черных - примерно 5.
Вариантов
ход-ответ
более
100.
А всего вариантов
просмотра на глубину в 20 ходов-ответов получается более 100 =10 . Если машина будет
20
40
просматривать миллиард (109) позиций в секунду (что уже нереально), то анализ займет
миллиарды миллиардов лет (напомним, что возраст галактики менее 100 миллиардов лет).
Попытка явно не удалась.
Можно, однако, заметить, что всего позиций не так уж много. У белого ферзя
менее 64 положений, у черного короля — тоже. Всего положений (считая и невозможные)
4096, а с учетом очереди хода 8192. Значит, сведения о них можно поместить в память
машины.
Введем понятие о ранге позиции. Ранг позиции — это число ходов, которые
должны сделать белые, чтобы дать мат.
Заведем два четырехиндексных массива: BR, CR [1:8, 1:8, 1:8, 1:8]. Индексы F, E, К, R
элементов BR[F, E, К, R] и CR[F, E, К, R] будут обозначать: F и Е - номера вертикали и
горизонтали, где стоит белый ферзь, К и R - то же для черного короля. В самих элементах
этих массивов будут записываться: BR — ранг позиции, если ход белых, CR - то же, если ход
черных.
Теперь решение состоит в заполнении массивов. Сначала отмечаются невозможные
позиции, маты, паты и другие ничьи (король съел ферзя). Для матовых позиций в CR,
естественно, заносится 0. Далее, для каждого i=0,1,... делается следующее.
155
1) Просматриваются все позиции (F, E, К, R), еще не имеющие ранга BR. Если из
такой позиции можно пойти ферзем в позицию (F, E, К, R), где CR равно i, то в
BR[F, E, K, R] заносится i+1.
2) Просматриваются все позиции (F, Е, K, R), еще не имеющие ранга CR. Если из
такой позиции все ходы королем ведут в позиции, уже имеющие ранги BR, то в
CR[F, Е, К, R] также заносится число i+1.
Фактически
это
можно
сделать
экономнее,
но сейчас важно только
принципиальное решение.
Работа заканчивается, когда при очередном значении i не появится новых значений в
элементах BR.
Если все позиции получили ранги BR, то мат всегда возможен, если не все - то не
всегда. Так, было выяснено, что при белом короле на сЗ мат дается не позже 23-го хода.
После того как массивы заполнены, можно напирать программу игры человека с
машиной. Если машина играет белыми, то делает очередной ход ферзем так, чтобы ранг
CR новой позиции был на единицу ниже ранга BR исходной позиции. Если же машина
играет черными, то делает
ход
королем
в
позицию с
максимальным рангом BR.
Любопытно, что эта тактика черных создает человеку, играющему белыми фигурами,
наибольшие трудности.
Чтобы не отыскивать каждый раз нужные ходы, для них удобно завести два
четырехиндексных массива ВН и СН для хода белых и черных соотвественно. Если в
позиции (F, Е, К, R) ферзь должен пойти на (F1, E1), то в BH[F, Е, К, R] удобно записать
число 10*F1+E1. Если в этой позиции черный король должен пойти на поле (К1, R1), то в
CH[F, Е, K, R] записывается 10*K1+R1. Массивы ВН и СН удобно заполнять одновременно с
заполнением массивов BR и CR.
Для тех, кто захочет написать эти программы, приведем числа, которые удобно
предварительно занести в массивы и которыми удобно отметить особые позиции:
Позиция
Предварительно
Шах
Съел ферзя
Ем ферзя
Недопустимо
Мат
Пат
BR
60
00
50
00
00
00
ВН
90
90
90
90
90
90
СR
60
СH
90
50
50
00
00
50
90
10*F+Е
90
90
90
Вместо заключения. Недавно с помощью ретроспективного анализа
установлено, что король с двумя слонами всегда выигрывает у короля с конем.
156
было
СЛУЧАЙНЫЕ ЧИСЛА И ЭЛЕКТРОННАЯ ГАДАЛКА
В этой лекции мы рассмотрим две задачи программирования: получение случайных
чисел и угадывание задуманного числа.
Случайные числа бывают нужны при решении многих прикладных задач. С их
помощью исследуют поведение .регуляторов в ответ на случайные отклонения регулируемой
величины. Они употребляются для приближенного решения задач вычислительного анализа.
Бывают они полезны для проверки правильности работы программы в неожиданных
ситуациях. Нужны они в теории игр и других вопросах.
Для работы ЭВМ со случайными числами вначале пытались вводить эти числа извне.
Вводили в память готовые таблицы случайных чисел. Строили приборы, использующие
случайные физические процессы, например, радиоактивный распад, и вводящие полученные
числа в машину. Все это было недостаточно хорошо. Таблицу случайных чисел ЭВМ быстро
исчерпывала, а случайное физическое явление нельзя было повторить, чтобы проверить
вычисления. Таким образом, возникла парадоксальная задача - вырабатывать в самой ЭВМ
числа случайные, но такие, чтобы их можно было повторить и чтобы последующее число
вычислялось по предыдущим, но не зависело от них. Задача, разумеется, неразрешимая. Но
Дж. Нейман придумал алгоритм, последовательно вычисляющий числа очень похожие на
случайные, равномерно распределенные от 0 до 1. Их называют псевдослучайными, или
просто случайными. Ниже изложен этот алгоритм, получивший название метода середины
квадрата.
Будем строить четырехзначные псевдослучайные числа. Возьмем произвольное целое
k1 из диапазона 0<k1<104. Это будет наше первое число. Если нам уже известно ki, то
возведем его в квадрат и возьмем 4 средних разряда. Если, например, ki=2251, то возведя его
в квадрат, получим ki2 =05067001, и поэтому ki+1=0670.
Чтобы получить из нашей последовательности k1, k2,… последовательность
действительных чисел х1, x2, … равномерно распределенных между 0 и 1, надо положить
xi = ki/104
Несмотря на очевидные возражения, вроде того, что эта последовательность
непременно начнет повторяться или что она может выродиться в сплошные нули, числа
x1, x2,... похожи на случайные. В среднем в половине случаев х i<хi+1, а в половине - наоборот.
Среди первой тысячи чисел x1, x2,... примерно половина будет меньше 1/2, а половина
больше, и т. п.
Разработаны
и
более
сложные
способы
получения
псевдослучайных
последовательностей, препятствующие обращению членов последовательности в нули и
удлиняющие период ее повторения. Но принцип они используют тот же, и для понимания
существа дела достаточно изложенного.
Напишем подпрограмму, доставляющую по k=ki следующее значение k=ki+1
четырехзначных случайных чисел.
m: = k;
m: = m + 4321;
m: = m * m;
m: = m - round(m/lE6)*lE6;
k:= round(m/l00);
157
Здесь k - целая переменная, m - вещественная. Для борьбы с тенденцией обнуления
мы ввели преобразование m = m + 4321.
Наши четырехзначные псевдослучайные числа слишком быстро начинают
повторяться и склонны к обнулению. Обычно работают с десятизначными числами, причем
представляют десятизначное число парой пятизначных.
Можно показать еще несколько методов получения псевдослучайных чисел.
Например, метод, который строит ki+2 no ki+1 и ki. Рассмотрите такой метод (r=1010):
ki+2=7*ki+1+3*ki+123456789;
ki+2=ki+2-(ki+2/r)*r
В нем надо начинать с двух десятизначных чисел, и он будет давать числа от 0 до 1010.
Для алгоритма, подающего случайным образом числа 1, 2, 3, 4, 5, 6, взамен бросания
игрального кубика можно рассмотреть наши случайные четырехзначные числа и
вычислять значение выражения 6*ki/104+1
Электронную гадалку, которую мы сейчас опишем, придумал создатель теории
информации Клод Шеннон. Работает она так. Человек пишет на бумаге число 0 или 1.
Машина этого числа не знает, но печатает 0, 1 или 2. Двойка означает, что машина не
берется угадать написанное число, а 0 или 1 - ее предположение о написанном числе. После
этого человеку сообщают предположение машины, а в машину вводят число, написанное человеком. Вначале машина играет неважно, но после двух-трех десятков проб начинает
угадывать в 90% случаев, сколько бы человек ни пытался ее запутать. Это производит
впечатление.
Устроена программа так. В ней имеется 5-индексный массив А[0:1, 0:2, 0:1, 0:2, 0:1]
из 72 элементов. Вначале массив заполнен нулями, и машина первые три раза печатает
двойки. В дальнейшем машина помнит несколько последних ходов своих и человека. Если
человек последними написал числа а1, а2, а3 и машина на это отвечала b1, b2, b3, то в ячейку
А[а1, b1, a2, b2, a3] добавляется единица, то есть машина запоминает, что после комбинации
а1, b1, a2, b2 человек выбрал число а3. Чтобы предсказать, что теперь напишет человек,
машина сравнивает числа А[а2, b2, а3, b3, 0] и A[а2, b2, а3, b3, 1]. Если первое сильно
превосходит второе, то машина предсказывает число 0, если наоборот, то - число 1, а если
они отличаются мало, то печатает число 2, то есть отказывается угадывать. Можно
усовершенствовать программу, добавляя на ходе i в нужную ячейку не единицу, а число
(1.1)i, и тем самым уменьшая вес старых событий, которые человек успевает забыть.
Задание для практики.
Запрограммируйте «гадалку» так, чтобы цифры, написанные человеком, и цифры,
предсказанные машиной, располагались на экране парами и чтобы человек видел последние
10-20 пар. Показывайте все время на экране текущий процент верных угадываний:
Испытайте вариант гадалки, не учитывающей своих предсказаний, но зато
руководствующейся более длинными сериями чисел человека.
Если бы человек определял свои числа бросанием монеты или с помощью случайных
чисел, то программа не смогла бы угадать заметно более 50% чисел. Но человек не умеет
задавать числа случайно, и электронная гадалка расшифровывает его тактику или
психологию.
158
УКАЗАНИЯ К РЕШЕНИЮ ЗАДАЧ
МОДУЛЬ 1
Указания к решению задач лекции
Записать указанные выражения по правилам языка программирования можно так:
A)
B)
C)
D)
E)
F)
a:=
b:=
a:=
b:=
a:=
b:=
(sqrt (abs (x-1))- sqrt (y)) / (1+ sqr(y)+ sqr(х))
1+abs (x-y) + sqr (y-x)/2+ (y-x)/3
(1+cos (y-2)/(sqr(sqr(x)) + sin (z));
y+ x/ (sqr (y) + abs (sqr (x) / (y+x*sqr(x)))))
(1+sqr (sin (x+y)) / (2+ abs (x-2) +sqrt(sqr(x*y)+1))
x-x /sqrt (x) + y/sqrt (y)
А. Рассчитываем первое повышение квартплаты и суммируем его с исходным:
f1:=k+k*a*100; далее выполняем аналогичный расчет, но уже исходя из нового значения
квартплаты: f2:=f1+f1*b/100;
В. Для получения результата достаточно взять целую часть от равного разделения
объема продукции между предприятиями: v1:=trunc(v/n);
С. Расчет выполняется по формулам школьного курса: v:=sqr(a)*a; s: = 6*sqr(a);
D. Т.к. 15 минут составляют ¼ часа, то формулой расчета будет : x:=(4*t)/l;
1-1-1. Временной интервал.
Для решения достаточно реализовать «перевод» стрелок по циферблату с
учетом накопления секунд и минут:
{начало промежутка c1, m1, s1}
{конец промежутка c2, m2, s2}
{продолжительность промежутка: c, m, s}
s: = (s2 - s1 + 60) mod 60;
p: = (s2 - s1 + 60) div 60;
m: = (m2-m1-1+60+ p) mod 60; p: = (m2 - m1 - 1 + 60 + p) div 60;
c: = c2 - c1 - 1 + p;
1-1-2. Округленное время.
Для решения задачи проводим округление секунд, а затем и минут по модулю
числа 60:
cm:= m+round(s/60);
ch:=h+round(cm/60);
writeln(h,’:’,cm);
writeln(ch);
1-1-3. Угловое время
Аналогичными рассуждениями в тексте Практикума приходим к следующим
формулам расчета (r – заданный угол):
r:=r mod 360; r1:=(r mod 30)*12;
l:=((r1-r)+360)mod 360; t:=((360-l)*((l+359) div 360))/5.5;
c:=trunc(t*100); m:=c div 100; s:=c mod 100; s:=(s*60) div 100;
writeln('Стрелки совпадут через ',m,':',s);
t:=(90+(((l div 91)-l div 181 )*180)-l)/5.5;
c:=trunc(t*100); m:=c div 100; s:=c mod 100; s:=(s*60) div 100;
writeln('Стрелки будут перпендикулярны через ',m,':',s);
t:=(180+((l div 181)*360)-l)/5.5;
c:=trunc(t*100); m:=c div 100; s:=c mod 100; s:=(s*60) div 100;
writeln('Стрелки окажутся на одной прямой через ',m,':',s);
159
Графическая иллюстрация задачи
{Математические часы}
uses graph;
var gd,gm: integer;
alfa,beta,gamma,teta: real;
x,y: integer; xc,yc: integer;
i,j: integer;
s,s1: string;
begin
gd:=detect; gm:=0; initgraph(gd,gm,'');
write('Введите угол alfa: '); readln(alfa);
xc:=getmaxx div 2; yc:=getmaxy div 2;
circle(xc,yc,100); circle(xc,yc,3);
for i:=1 to 12 do begin
line(xc+round(95*sin(pi*i*30/180)),yc+round(-95*cos(pi*i*30/180)),
xc+round(105*sin(pi*i*30/180)),yc+round(-105*cos(pi*i*30/180)));
for j:=1 to 4 do
line(xc+round(98*sin(pi*(i*30+j*6)/180)),
yc+round(-98*cos(pi*(i*30+j*6)/180)),
xc+round(102*sin(pi*(i*30+j*6)/180)),
yc+round(-102*cos(pi*(i*30+j*6)/180)));
str(i,s);
outtextxy(xc-5+round(120*sin(pi*i*30/180)),
yc+round(-115*cos(pi*i*30/180))-3,s);
end;
x:=round(60*sin(pi*alfa/180));
y:=round(-60*cos(pi*alfa/180));line(xc,yc,xc+x,yc+y);
{Угол между лучом и минутной стрелкой: alfa%30*12}
beta:=(round(2*alfa) mod 30)*12/2;
{Угол между минутной стрелкой и положением совпадения
(alfa-beta+360)%360/(1-1/12)}
gamma:=(round(alfa-beta+360) mod 360)/(11/12);
{Угол между минутной стрелкой и положением минутной стрелки при
перпендикулярности ((alfa-beta+360)%360+270)%180/(11/12)}
teta:=(round((round(alfa-beta+360) mod 360)+270) mod 180)/(11/12);
x:=round(90*sin(pi*beta/180)); y:=round(-90*cos(pi*beta/180));
line(xc,yc,xc+x,yc+y);
str(round(alfa)div 30,s); {alfa} str(round(beta)div 6,s1);
s:='Время: '+s+':'+s1; outtextxy(0,20,s);
str(round(gamma) div 6,s1); s:='Время до совпадения стрелок: '+'0:'+s1;
outtextxy(0,40,s); str(round(teta)div 6,s1);
s:='Время до взаймной перпендикулярности:'+'0:'+s1;
outtextxy(0,60,s);
readln; closegraph; end.
1-1-4. Русские единицы длины.
var p,w1,w,s,s1,v,a:integer;u:real;
begin
writeln('Введите длину отрезка в метрах'); readln(p);
u:=(1000/44.45)*p;
v:=round(u);
w:=v div 24000;
w1:=v mod 24000; s:=w1 div 48;
s1:=w1 mod 48;
a:=s1 div 16;
v:=s1 mod 16;
writeln('Длина равна ',w,' вёрст ',s,' саженей ',a,'
',v,' вершков');
end.
1-1-5. Хитрая степень
Формула основана на математическом законе ab=eb*lna : y:=exp(n*ln(x))
160
аршин
1-1-6. Число наоборот
Выделим из заданного числа поразрядно значащие цифры и либо выведем их в
обратном порядке, либо получим число, цифры которого обратно расположены по
отношению к исходному:
{t,s,d,e – тысячи, сотни, десятки и единицы исходного числа х}
t:=x div 1000;
s:=(x-t*1000) div 100;
d:=(x-t*1000-s*100) div 10;
e:= x-t*1000-s*100- d*10;
writeln(e,d,s,t); { или } writeln(e*1000+d*100+s*10+t);
1-1-7. Сравните числа
На основе свойств модуля математически верно:
min:=(a+b-abs(a-b))/2; max:=(a+b+abs(a-b))/2;
1-1-8. Деньги, деньги…
Количество копеек равно остатку от деления, а количество рублей – целой
части деления на 100:
kop:=s mod 100;
rub:=s div 100;
МОДУЛЬ 2
Указания к решению задач лекции
А. Задача линейного алгоритма: расстояние между машинами определяется по
формуле abs(r-(v1+v2)). Условие задачи выполняется автоматически.
В. Вычленяем составные части числа, как в примере 1-1-6 «Число наоборот» и
сравниваем между собой 1 и 4, 2 и 3 цифры.
С. Алгоритм решения изложен в условии, поэтому для решения достаточно
реализовать описанные закономерности:
var a,b,god,m,d,y,c:integer;
begin
write('введите число '); readln(a);
write('введите месяц '); readln(b);
write('введите год '); readln(c);
d:=a; m:=b;
y:=c mod 100;
c:=c div 100;
case (trunc(2.6*m-0.2)+d+y+trunc(y/4)+ trunc(c/4)-2*c) mod 7 of
0:writeln('воскресение');
1:writeln('понедельник');
2:writeln('вторник');
3:writeln('среда');
4:writeln('четверг');
5:writeln('пятница');
6:writeln('суббота');
end;
end.
1-2-1. Угроза коня
Условие проверки:
(abs(m-k)=2) and (abs(n-l)=1) or (abs(m-k)=1) and (abs(n-l)=2)
161
1-2-2. Шахматный этюд.
Задача является «сводной» для всех шахматных фигур, за исключением ферзя. Хотя
при подробном рассмотрении могут возникнуть вопросы частных случаев, например: на
пути фигуры гарантирующей мат или шах стоит другая фигура, или фигуры, гарантирующие
мат или шах, могут быть взяты королем (стоят в соседних клетках), условие задачи является
только оценка текущей ситуации, а не ее развитие. Проверяем взаимное положение всех
фигур и короля с учетом возможностей каждой фигуры (можно через логическое
умножение). Ладья контролирует горизонтали и вертикали, слон - диагонали, конь должен
отстоять от короля на разность координат по модулю либо +-|1,2| либо +-|2,1|
(см.предыдущую задачу). Если у короля есть возможность хода (окружающие его клетки не
под боем других фигур), тогда это другая позиция. Если ему некуда пойти, но само поле, на
котором он стоит, не под боем, получаем пат. Если поле, на котором стоит король под боем,
получаем шах, если есть королю есть куда уйти, и мат, в противном случае.
1-2-3. Головоломка жестянщика
Рассуждаем для предельного случая следующим образом: если две прямоугольные
пластины образуют квадрат со стороной k (a+c=b+d=k или a+d=b+c=k), то решение
k 2
зависит от формулы отношения квадрата, вписанного в окружность радиуса r: r 
. Для
2
всех остальных случаев верно утверждение: если две пластины умещаются в квадрате со
стороной K, то решение положительно.
Значит в общем виде формула «проверки» будет следующей: a+c<=k и b+d<=k или
2r
a+d<=k и b+c<=k где k 
.
2
1-2-4. Считаем ворон
Одним из вариантов является «перебор» возможных окончаний и компоновка
нужного текста. Естественно, что оператор выбора может быть заменен условным
оператором со сложными условиями.
var k,a,b: integer;
begin
writeln ('введите число ворон'); readln (k);
a:=k div 10;
b:=k mod 10;
if (a=1) and (b=0) then write ('десять ');
if (a=1) and (b<>0) then begin
case b of
1:write ('один');
2:write ('две');
3:write ('три');
4:write ('четыр');
5:write ('пят');
6:write ('шест');
7:write ('сем');
8:write ('восем');
9:write ('девят');
end;
write ('надцать ');
end
else begin
Case a of
2:write ('двадцать ');
3:write ('тридцать ');
4:write ('сорок ');
5:write ('пятьдесят ');
6:write ('шестьдесят ');
162
7:write ('семьдесят ');
8:write ('восемьдесят ');
9:write ('девяносто ');
end;
Case b of
1:write ('одна ');
2:write ('две ');
3:write ('три ');
4:write ('четыре ');
5:write ('пять ');
6:write ('шесть ');
7:write ('семь ');
8:write ('восемь ');
9:write ('девять ');
end;
end;
write ('ворон');
if a<>1 then
case b of
1:write ('а');
2:write ('ы');
3:write ('ы');
4:write ('ы');
end;
end.
1-2-5. Анализ числа
Проверка знака проводится обычным сравнением – больше или меньше нуля. Для
анализа разрядности можно использовать ряд операторов сравнения для оценки результата
деления нацело от 10 до 10000 (целое число не превышает по модулю 32000).
1-2-6. Точка графика
См. указание к сравнению вещественных чисел в лекции.
1-2-10. Счастливый билет
Нужно сравнить сумму первых трех цифр с суммой последних трех. Задача
аналогична задаче В, с отличием в количестве разрядов.
МОДУЛЬ 3
Указания к решению задач лекции
А. Вводим исходные данные, в том числе вид перемен, и последовательно в цикле
наращиваем общее время с учетом вида перемены. Преобразуем время с учетом перехода
через 60 мин.
var n1,n2,h1,h2,h3,h4,h5,h6,a,b,c,a1,c1,s,m,v,n,z:integer;
begin
writeln('Введите начало учебного дня ');
readln(n1,n2);
writeln('Введите продолжительность малой перемены');
readln(a);
writeln('Введите продолжительность обычной перемены'); readln(b);
writeln('Введите продолжительность большой перемены'); readln(c);
writeln('Введите место малой перемены в расписании (номер
урока,
после которого идёт малая перемена)');
readln(a1);
writeln('Введите место большой перемены в расписании (номер
урока,
после которого идёт большая перемена)'); readln(c1);
writeln('Введите кол-во уроков'); readln(v);
writeln('Введите продолжительность урока'); readln(z);
s:=0;
writeln; writeln;
163
writeln('Расписание уроков');
writeln;
write(s+1:2,'. ',n1:2,':',n2 div 10,n2 mod 10,'-');
m:=n1*60+n2;
h1:=0;
h2:=m;
repeat
s:=s+1;
h1:=h2+z;
h3:=h1 div 60;
h4:=h1 mod 60;
writeln(h3:2,':',h4 div 10,h4 mod 10);
if s=a1 then h2:=h1+a
else if s=c1 then h2:=h1+c
else h2:=h1+b;
h5:=h2 div 60;
h6:=h2 mod 60;
if s<>v then write(s+1:2,'. ',h5:2,':',h6 div 10,h6 mod 10,'-');
until s=v;
end.
В. i:=100; while i<999 do begin s:=s+i; i:=i+2; end;
С.
readln(a);
s:=0; i:=0;
repeat
s:=a mod 10; a:=a div 10;
i:=i+s;
until a=0; writeln('сумма цифр этого числа равна ',i);
1-3-1. Парикмахер
var code,t,hour,min,kol,h,m,i,j,n:integer;
s:string;
begin
writeln('Введите продолжительность рабочего дня в минутах.');
readln(t);
writeln('Введите кол-о клиентов.'); readln(n);
kol:=0;
for i:=1 to n do begin
writeln('Введите время прихода ',i,'-ого клиента.');
readln(s);
writeln('Введите время обслуживания ',i,'-ого клиента.');
readln(m);
j:=1;
while (j<=length(s))and(s[j]<>'.') do inc(j);
val(copy(s,1,j-1),hour,min);
val(copy(s,j+1,length(s)-j),min,code);
if i=1 then t:=t+hour*60+min;
if (hour*60+min+m<t)and(h<hour*60+min) then begin
h:=hour*60+min+m;
inc(kol);
end;
end;
writeln(kol);
end.
1-3-2. Гуси и кролики
for i:=0 to 64 div 4 do writeln(i,' кроликов ', (n-i*4) div 2,' гусей');
1-3-3. Площади прямоугольников
Считаем габаритами координаты угла и длины двух сторон. Стороны прямоугольника
параллельны осям. Вводим параметры одного прямоугольника. В
цикле вводим
последовательно данные других прямоугольников, находим точки пересечения, выясняя
сравнением внутренние точки, т.е общую область.
164
var x1,x2,x,y1,y2,y,a1,b1,a2,b2,a,b:real;
i,k:integer;
ans,p,f:boolean;
begin
readln(x1,y1,a1,b1); readln(k);
ans:=true;
for i:=1 to k do begin readln(x2,y2,a2,b2);
p:=false; f:=false;
if (x1<x2)and(x2<x1+a1) then begin
x:=x2;a:=a1-x2;
if x1+a1<x2+a2 then a:=a1-x2 else a:=a2;p:=true;end;
if (x2<x1)and(x1<x2+a2) then begin
x:=x1;
if x2+a2<x1+a1 then a:=a2-x1 else a:=a1;p:=true;end;
if x1=x2 then begin x:=x1;p:=true;
if a1<a2 then a:=a1 else a:=a2;end;
if (y1<=y2)and(y1>y2-b2) then begin
y:=y1;
if y1-b1<=y2-b2 then b:=b2-(y2-y1) else b:=b1;f:=true;end;
if (y2<=y1)and(y2>y1-b1) then begin
y:=y2;if y2-b2<=y1-b1 then b:=b1-(y1-y2) else b:=b2;f:=true;end;
if (p=false)or(f=false) then ans:=false;
x1:=x; y1:=y; a1:=a; b1:=b;
end;
if ans=false then writeln('0') else writeln(a*b:5:3);
end.
Задачи 1-3-4 – 1-3-7
В этих задачах вычленение цифр числа и проверка их свойств по условию задач
выполняется любым удобным способом (см.например задачу 3С или задачу 1-1-6). Вывод же
чисел в колонки можно организовать таким способом:
uses crt;
var ...
begin
k:=1; {счетчик колонок}
{Цикл для перебора заданных чисел}
{Вычленение цифр числа и проверка на выполнение условия}
if {условие = true} then begin
gotoxy(k,wherey); write(i);
k:=k+7; {7 – количество позиций под число}
if k>70 then begin k:=1;writeln; end;
end;
end.
1-3-8. Числа –5
var a,b,c,d:integer;
begin
for a:=10 to 99 do
for b:=10 to 99 do begin c:=a*100+b; d:=b*100+a;
if (c mod 99 = 0) and (d mod 49 = 0) then
writeln(a,' ',b);
end;
end.
1-3-9. Проблема первоклассника
km:=0; repeat m:=m-k; km:=km+1; until m<k;
165
МОДУЛЬ 4
Указания к решению задач лекции
Задачи А, E, G, I, J, L, N решаются «в лоб», без использования каких – либо
алгоритмических решений.
B. Сортируем массив точек А. Далее вводим значение точки Х и выполняем
следующую проверку:
if x<s[1] then writeln ('Не входит в отрезки') else
if x>s[n] then writeln ('Не входит в отрезки') else begin
for i:=1 to n-1 do
if (x>=s[i]) and (x<=s[i+1]) then break;
writeln ('[A',i,';A',i+1,']');
end;
C.
for i:=1 to n do
for j:=1 to n do begin
if (i+j)=(n+1) then m[i,j]:=1;
if (i+j)<(n+1) then m[i,j]:=i+j;
end;
D.
n:=0;
for i:=2 to m+1 do
if i mod 2=1 then begin n:=n+1; a[i-n]:=a[i]; a[i]:=0;end;
for i:=1 to m-n do write(a[i],' ');
F.
for i:=1 to l do begin
if i mod 2 =0 then a[2,j]:=s[i] else begin
j:=j+1; a[1,j]:=s[i]; end;
end;
for m:=1 to 2 do begin
for i:=1 to j do begin
if (i=j) and (l mod 2<>0)and (m=2) then write ('-') else
write(a[m,i],' '); end;
writeln;
end;
K.
writeln ('Введите длинну массива'); readln (n);
writeln('Введите 1 элемент массива'); readln (m[1]);
for i:=2 to n do begin
readln (m[i]);
if (m[i]=m[i-1]) and (k=1) then f:=f+1;
if m[i]=m[i-1] then begin if k=0 then begin
f:=2; k:=1; end; end else
if k=1 then
if f>r then begin r:=f; c:=m[i-1]; end;
if m[i]<>m[i-1] then begin
f:=0; k:=0;
end; end;
if f>r then begin r:=f; c:=m[i]; end;
if r=0 then writeln ('Подряд повторяющихся элементов нет')
else
writeln ('Число ',c,' встречается ',r,' раз(а)');
end.
166
M. Сортируем массив по признаку равенства нулю, затем находим номер первого
ненулевого элемента. Отняв от него единицу, получим искомое количество
O.
writeln ('Задайте число сдвига'); readln (v);
if v>20 then v:=v mod 20; j:=v;
for i:=1 to 20 do begin
j:=j+1;
if j>20 then j:=j-20;
b[i]:=a[j];
end;
P.
for i:=1 to n do begin
writeln ('Введите время работы ',i,' работника');
readln (j);
m[i]:=1/j; s:=s+m[i];
end;
s:=1/s;
writeln ('Если никто из работников не сачкует, t=',s:0:2);
«Сачкование» рабочего выражается через бесконечно большое время его работы.
1-4-1. Лотерея
begin
...
{Заполнение массивов К и L различными числами от 0 до 25}
...
{Заполнение массива S числами от 2 до 2n}
s[i]:=random(n*2)+2;
...
for i:=1 to m do for j:=1 to n do
if L[i]=k[j] then vyigrych:=vyigrych+s[j];
{Вывод результатов}
end.
1-4-2. Подматрица
{Задается номер левой верхней вершины квадрата}
for i:=1 to n-m+1 do begin
for j:=1 to n-m+1 do begin
kol:=0;
{Просматривается квадрат от вершины - влево и вниз}
for i_i:=i to i+m-1 do
for j_j:=j to j+m-1 do
if a[i_i,j_j]=0 then inc(kol);
{Если количество нулей равно m*m, то квадрат найден}
if kol=m*m then writeln(i:2,j:2);
end;
end;
1-4-3. Латинский квадрат
for i:=1 to n do b[i]:=i;
for i:=1 to n do begin
for j:=1 to n do a[i,j]:=b[j];
ob:=b[1];
for j:=1 to n-1 do b[j]:=b[j+1];
b[n]:=ob;
end;
167
1-4-4. Суммы по косой.
{Сумма элементов по косой до главной диагонали}
if n mod 2=0 then c:=1 else c:=2;
i_n:=1; j_n:=2*n-1;
for k:=1 to n div 2+c do begin
s:=0;
for i:=1 to i_n do s:=s+a[i,n-i_n+i];
kos_sum[j_n]:=s;
inc(i_n);dec(j_n);
end;
{Сумма элементов главной диагонали}
s:=0;
for i:=1 to n do s:=s+a[i,n-i_n+i];
kos_sum[j_n]:=s;
dec(j_n);
{Сумма элементов по косой ниже главной диагонали}
i_n:=2;
for k:=1 to n div 2 +c do begin
s:=0;
for i:=i_n to n do s:=s+a[i,i-k];
kos_sum[j_n]:=s;
inc(i_n);dec(j_n);
end;
writeln('Сумма по косой начиная с {1,',n,']');
for i:=2*n-1 downto 1 do write(kos_sum[i]:3);
writeln;
1-4-5. Замочная скважина.
for i:=1 to m1 do
for j:=1 to n1 do k[i,j]:=random(2);
for i:=1 to m2 do
for j:=1 to n2 do begin
L[i,j]:=random(2);
if l[i,j]=1 then inc(kol_1);
end;
for i:=1 to m1-m2+1 do
for j:=1 to n1-n2+1 do
begin
kol_0_1:=0;
for i_i:=i to i+m2-1 do
for j_j:=j to j+n2-1 do begin
if (k[i_i,j_j]=0) and (l[i_i-i+1,j_j-j+1]=1)
then inc(kol_0_1);
end;
if kol_1=kol_0_1 then writeln('i=',i:2,',j=',j:2,'
');
end;
1-4-6. Задачка для Штирлица
type tbp=0..1;
var rez: array[1..10,1..10] of char;
buk: array[1..100] of char;
kl,b: text;
kluch,vspom: array[1..10,1..10] of tbp;
m:integer ;
i,j,k,kol,p,p1: word;
{k-кол-во поворотов ключа,kol-счетчик массива buk,
p-тип операции,p1-наравление поворота ключа}
begin
{ввод из текстового файла}
assign(kl,'k.txt'); reset(kl);
for i:=1 to 10 do begin
for j:=1 to 10 do begin
168
read(kl,kluch[i,j]);
readln(kl);
end;
end;
for i:=1 to 100 do begin
read(kl,buk[i]);
end;
close(kl);
{ввод с клавиатуры}
write('Введите матрицу-ключ:');
for i:=1 to 10 do
for j:=1 to 10 do
begin
write('kluch[',i,',',j,']: '); read(kluch[i,j]);
end;
write('Введите последовательность из 100 букв через пробел:');
for i:=1 to 100 do read(buk[i]);
write('Направление поворота ключа: 1-по часовой стрелке, 0-против.');
write('->'); readln(p1);
write('Операция: 1-кодирование, 0-расшифровка.');
write('->'); readln(p);
if p=1 then begin
kol:=1;
for k:=1 to 4 do begin
{заполнение текста}
for i:=1 to 10 do
for j:=1 to 10 do
if kluch[i,j]=0 then begin
rez[i,j]:=buk[kol]; kol:=kol+1; end;
{поворот ключа}
if k<>4 then
if p1=1 then begin
for i:=1 to 10 do begin
m:=-9;
for j:=1 to 10 do begin
vspom[i,j]:=kluch[j-m,i];
m:=m+2;
end;
end;
for i:=1 to 10 do
for j:=1 to 10 do kluch[i,j]:=vspom[i,j];
end
else begin
m:=1;
for i:=10 downto 1 do begin
for j:=1 to 10 do
vspom[m,j]:=kluch[j,i];
m:=m+1;
end;
for i:=1 to 10 do
for j:=1 to 10 do kluch[i,j]:=vspom[i,j];
end;
end;
{печать рез-та}
for i:=1 to 10 do
begin
for j:=1 to 10 do write(rez[i,j]);
writeln;
end;
end
else begin
169
{заполнение массива из buk в rez}
for i:=1 to 10 do
for j:=1 to 10 do rez[i,j]:=buk[(i-1)*10+j];
kol:=1;
for k:=1 to 4 do begin
for i:=1 to 10 do
for j:=1 to 10 do
if kluch[i,j]=0 then begin buk[kol]:=rez[i,j];
kol:=kol+1; end;
{поворот ключа}
if k<>4 then
if p1=1 then begin
for i:=1 to 10 do begin
m:=-9;
for j:=1 to 10 do begin
vspom[i,j]:=kluch[j-m,i];
m:=m+2;
end;
end;
for i:=1 to 10 do
for j:=1 to 10 do kluch[i,j]:=vspom[i,j];
end
else begin
m:=1;
for i:=10 downto 1 do begin
for j:=1 to 10 do
vspom[m,j]:=kluch[j,i];
m:=m+1;
end;
for i:=1 to 10 do
for j:=1 to 10 do kluch[i,j]:=vspom[i,j];
end;
end;
{печать рез-та}
for i:=1 to 100 do write(buk[i]);
end;
end.
1-4-7. Идем в школу
Задача решается через формулу расстояния между двумя точками:
for i:=1 to n do
begin
writeln(sqrt(sqr(a-x[i])+sqr(b-y[i])):2:1);
sred:=sred+sqrt(sqr(a-x[i])+sqr(b-y[i]))
end;
1-4-8. Оценка судей
Упорядочиваем массив оценок и находим среднее арифметическое значение
элементов без первого и последнего из них.
170
МОДУЛЬ 5
Указания к решению задач лекции
Сердце
Ellipse(195,240,40,210,25,20);
Ellipse(235,240,335,140,25,20);
line(174,250,215,290);
line(256,250,215,290);
line(310,260,300,255);
line(300,255,310,270);
line(310,270,315,280);
line(315,280,310,280);
SetFillStyle(1,0);
FloodFill(320,256,0);
FloodFill(332,270,0);
FloodFill(307,270,0);
FloodFill(310,256,0);
FloodFill(330,256,0);
Молния
line(265,235,300,220);
line(300,220,320,245);
line(320,245,315,247);
line(315,247,335,270);
line(335,270,330,273);
line(330,273,360,300);
line(360,300,310,280);
line(310,280,320,275);
line(320,275,290,260);
line(290,260,300,255);
line(300,255,265,235);
Нота
FloodFill(100,100,15);
i:=0;
while i<=20 do begin
SetColor(8);
SetFillStyle(1,8);
FillEllipse(195+i,390+i,75,50);
FillEllipse(445+i,390+i,75,50);
Bar(250+i,90+i,265+i,390+i);
Bar(500+i,90+i,515+i,390+i);
Bar(265+i,90+i,510+i,190+i);
i:=i+20;
end;
SetFillStyle(1,4);
FillEllipse(445,390,73,48);
FillEllipse(195,390,73,48);
Bar(252,92,263,390);
Bar(502,92,513,390);
Bar(263,92,510,188);
Полумесяц
arc(320,240,90,270,40);
arc(350,240,128,233,50);
Лампочка
Ellipse(352,288,140,180,13,13);
Ellipse(352,288,140,180,8,8);
Ellipse(320,240,300,240,50,50);
Ellipse(320,240,300,240,45,45);
Ellipse(352,288,140,180,13,13);
Ellipse(352,288,140,180,8,8);
Ellipse(288,288,0,40,13,13);
Ellipse(288,288,0,40,8,8);
line(301,288,339,288);
line(344,288,344,308);
line(296,288,296,308);
Ellipse(320,308,180,360,24,24);
PieSlice(320,312,180,360,15);
SetFillStyle(1,15);
FloodFill(352,288,15);
FloodFill(320,240,15);
SetColor(0);
line(310,280,305,270);
line(305,270,290,250);
line(290,250,310,255);
line(310,255,315,250);
line(315,250,320,255);
line(320,255,325,250);
line(325,250,330,255);
line(330,255,350,250);
line(350,250,335,270);
line(335,270,330,280);
line(330,280,325,280);
line(325,280,330,270);
line(330,270,340,255);
line(340,255,330,260);
line(330,260,325,255);
line(325,255,320,260);
line(320,260,315,255);
line(315,255,310,260);
Звезда
SetColor(8);
SetFillStyle(1,15);
FloodFill(100,100,8);
line(245,330,265,245);
line(265,245,195,190);
line(195,190,285,190);
line(285,190,320,100);
line(320,100,355,190);
line(355,190,445,190);
line(445,190,375,245);
line(375,245,395,330);
line(395,330,320,270);
line(320,270,245,330);
line(320,225,320,100);
line(320,225,445,190);
line(320,225,195,190);
line(320,225,245,330);
line(320,225,395,330);
SetFillStyle(1,6);
FloodFill(325,195,8);
SetFillStyle(1,14);
FloodFill(310,195,8);
SetFillStyle(1,8);
FloodFill(310,240,8);
SetFillStyle(1,7);
FloodFill(300,250,8);
FloodFill(340,250,8);
171
Компас
FloodFill(100,100,15);
SetColor(8);
line(300,260,310,240);
line(310,240,300,220);
line(300,220,320,230);
line(320,230,340,220);
line(340,220,330,240);
line(330,240,340,260);
line(340,260,320,250);
line(320,250,300,260);
SetFillStyle(1,7);
FloodFill(320,240,8);
SetColor(0);
line(320,300,310,250);
line(310,250,260,240);
line(260,240,310,230);
line(310,230,320,180);
line(320,180,330,230);
line(330,230,380,240);
line(380,240,330,250);
line(330,250,320,300);
SetFillStyle(1,15);
FloodFill(320,230,0);
line(320,180,320,300);
line(260,240,380,240);
line(320,240,310,230);
line(320,240,310,250);
line(320,240,330,230);
line(320,240,330,250);
SetFillStyle(1,7);
FloodFill(325,230,0);
SetFillStyle(1,7);
FloodFill(340,245,0);
SetFillStyle(1,7);
FloodFill(310,235,0);
SetFillStyle(1,7);
FloodFill(315,250,0);
line(250,385,250,375);
line(250,375,230,375);
SetFillStyle(1,8);
FloodFill(240,376,8);
FillEllipse(250,200,6,10);
FillEllipse(245,190,10,12);
FillEllipse(245,270,14,50);
FillEllipse(245,335,10,20);
FillEllipse(245,360,8,12);
FillEllipse(245,375,5,8);
line(420,340,440,340);
line(440,340,440,185);
line(440,185,420,185);
line(420,175,440,175);
Ellipse(440,185,0,90,10,10);
line(450,185,450,340);
Ellipse(440,340,270,360,10,10);
line(440,350,420,350);
SetFillStyle(1,4);
FloodFill(445,340,8);
Апельсин
FloodFill(100,100,15);
SetColor(4);
SetFillStyle(1,4);
FillEllipse(320,240,140,140);
SetFillStyle(1,6);
FillEllipse(320,240,130,130);
SetFillStyle(1,15);
SetColor(15);
FillEllipse(320,240,80,80);
i:=0;
while i<=5 do begin
PieSlice(320,240-i,65,115,110-2*i);
PieSlice(320,240-i,60,120,98-2*i);
FillEllipse(280+i,148+i,10,10);
FillEllipse(360-i,148+i,10,10);
PieSlice(320+i,240-i,5,55,110-2*i);
PieSlice(320+i,240-i,0,60,98-2*i);
FillEllipse(420-i,230-i,10,10);
FillEllipse(378,158+i,10,10);
PieSlice(320-i,240-i,125,175,110-2*i);
PieSlice(320-i,240-i,120,180,100-2*i);
FillEllipse(262,158+i,10,10);
FillEllipse(220+i,230-i,10,10);
PieSlice(320-i,240+i,185,235,110-2*i);
PieSlice(320-i,240+i,180,240,100-2*i);
FillEllipse(262,322-i,10,10);
FillEllipse(220+i,250+i,10,10);
PieSlice(320+i,240+i,305,355,110-2*i);
PieSlice(320+i,240+i,300,360,98-2*i);
FillEllipse(420-i,250+i,10,10);
FillEllipse(378,322-i,10,10);
PieSlice(320,240+i,245,295,110-2*i);
PieSlice(320,240+i,240,300,100-2*i);
FillEllipse(280+i,332-i,10,10);
FillEllipse(360-i,332-i,10,10);
i:=i+5;
SetColor(4);
SetFillStyle(1,4);
end;
Кружка
FloodFill(100,100,15);
SetColor(8);
Ellipse(320,375,180,360,100,25);
line(220,375,220,150);
Ellipse(320,150,0,360,100,25);
line(420,375,420,150);
SetFillStyle(1,8);
FloodFill(320,150,8);
SetFillStyle(1,4);
FloodFill(320,250,8);
SetColor(15);
SetFillStyle(1,15);
Bar(408,175,410,375);
SetColor(8);
SetFillStyle(1,8);
Bar(230,180,250,375);
line(230,180,230,170);
line(230,170,250,180);
line(250,180,230,180);
SetFillStyle(1,8);
FloodFill(235,175,8);
line(230,375,250,385);
56
1-5-1. Гистограмма
uses graph;
var l,d,r,e,rad,err,i,c,f,f1:integer;
s,max:real; w,w1:string;
m:array[1..100] of real;
x:array[1..100] of string;
k:word;
begin
writeln ('Введите количество значений'); readln (c);
for i:=1 to c do begin
writeln ('Введите значение ',i);
readln (m[i]);
if max<m[i] then max:=m[i];
f:=trunc(m[i]);
f1:=round((m[i]-f)*100);
str(f,w);
str(f1,w1);
x[i]:='-'+w+'.'+w1; end;
max:=max; d:=detect;
initgraph(d,r,'');
setlinestyle(0,0,3); line(20,10,20,353); line(20,352,630,352);
s:=(565)/c;
for i:=1 to c do begin
setlinestyle(0,0,1);
if i mod 15 <>0 then setfillstyle(1,(i mod 15))
else setfillstyle(1,15);
bar(35+round(((i-1)*s)),350-round(330*((m[i])/max)),
35+round((i-1)*s+s*3/4),350);
bar(10+60*((i-1) div 10),360+((i-1) mod 10)*12,
10+60*((i-1) div 10)+13,360+((i-1) mod 10)*12+8);
outtextxy(10+60*((i-1)div 10)+15,360+((i-1) mod 10)*12+1,x[i]);
end;
readln;
closegraph;
end.
1-5-2. Диаграмма
uses graph;
var l,d,r,e,rad,err,i,c:integer; s:real;
m:array[1..7] of real; m1,m2,m3:array[1..7] of string;
k:word;
begin
randomize; d:=detect;
for i:=1 to 7 do begin
writeln ('Введите ',i,' значение'); readln (m[i]);
s:=s+m[i]; c:=trunc(m[i]); str(c,m1[i]);
c:=round((m[i]-c)*1000); str(c,m2[i]);
m3[i]:=m1[i]+'.'+m2[i];
if length(m2[i])=1 then m3[i]:=m3[i]+'00';
if length(m2[i])=2 then m3[i]:=m3[i]+'0'; end;
s:=360/s;
for i:=1 to 7 do m[i]:=m[i]*s;
initgraph(d,r,'');
l:=0; setlinestyle(0,0,2); setcolor(white);
for i:=1 to 7 do begin
setfillstyle(1,i);
if l<>360 then
if i<>7 then
sector(320,200,l,l+round(m[i]),250,160)
else sector(320,200,l,360,250,160);
l:=l+round(m[i]);
bar(25,350+i*15,60,358+i*15);
outtextxy(72,352+i*15,'-'); outtextxy(85,352+i*15,m3[i]);
end; readln; closegraph;
end.
56
1-5-3. Часы
uses graph, dos, crt;
const
SA: array[1..4] of PointType = ((X:3;Y:0),(X:107;Y:0),(X:87;Y:20),(X:23;Y:20));
SB: array[1..4] of PointType = ((X:0;Y:3),(X:20;Y:23),(X:20;Y:96),(X:0;Y:107));
SC:array[1..4] of PointType = ((X:110;Y:3),(X:90;Y:23),(X:90;Y:96),(X:110;Y:107));
SD: array[1..6] of PointType = ((X:3;Y:110),(X:23;Y:99),(X:87;Y:99),(X:107;Y:110),
(X:87;Y:121),(X:22;Y:121));
SE:array[1..4] of PointType = ((X:0;Y:113),(X:20;Y:125),(X:20;Y:197),(X:0;Y:217));
SF:array[1..4]ofPointType= ((X:110;Y:113),(X:90;Y:125),(X:90;Y:197),(X:110;Y:217));
SG: array[1..4] of PointType = ((X:3;Y:220),(X:107;Y:220),(X:87;Y:200),(X:23;Y:200));
SA1: array[1..4] of PointType = ((X:2;Y:0),(X:53;Y:0),(X:43;Y:10),(X:12;Y:10));
SB1: array[1..4] of PointType = ((X:0;Y:2),(X:10;Y:12),(X:10;Y:48),(X:0;Y:53));
SC1: array[1..4] of PointType = ((X:55;Y:2),(X:45;Y:12),(X:45;Y:48),(X:55;Y:53));
SD1: array[1..6] of PointType = ((X:2;Y:55),(X:12;Y:50),(X:44;Y:50),(X:54;Y:55),
(X:44;Y:61),(X:11;Y:61));
SE1: array[1..4] of PointType = ((X:0;Y:57),(X:10;Y:64),(X:10;Y:98),(X:0;Y:108));
SF1:array[1..4] of PointType = ((X:55;Y:58),(X:45;Y:64),(X:45;Y:98),(X:55;Y:108));
SG1:array[1..4] of PointType = ((X:2;Y:110),(X:53;Y:110),(X:43;Y:100),(X:12;Y:100));
var
gd,gm:integer; a,b,c,d,e: word;
chas:array[1..6] of byte;
procedure znak(cifra:byte);
begin
case cifra of
0:begin
setfillstyle(1,2); fillpoly(4,sa); fillpoly(4,sc); fillpoly(4,sf);
fillpoly(4,se); fillpoly(4,sg); fillpoly(4,sb);
setfillstyle(1,0); fillpoly(6,sd); end;
1: begin setfillstyle(1,2); fillpoly(4,sc); fillpoly(4,sf);
setfillstyle(1,0); fillpoly(4,sa);
fillpoly(6,sd); fillpoly(4,sg); fillpoly(4,sb);
fillpoly(4,se); end;
2:begin
setfillstyle(1,2); fillpoly(4,sa); fillpoly(4,sc); fillpoly(6,sd);
fillpoly(4,se); fillpoly(4,sg);
setfillstyle(1,0); fillpoly(4,sf); fillpoly(4,sb); end;
3:begin
setfillstyle(1,2); fillpoly(4,sa); fillpoly(4,sc); fillpoly(4,sf);
fillpoly(6,sd); fillpoly(4,sg);
setfillstyle(1,0); fillpoly(4,se); fillpoly(4,sb); end;
4:begin
setfillstyle(1,2); ; fillpoly(4,sc); fillpoly(4,sf);
fillpoly(6,sd); fillpoly(4,sb); setfillstyle(1,0);
fillpoly(4,se); fillpoly(4,sa); fillpoly(4,sg);end;
5:begin setfillstyle(1,2); fillpoly(4,sa); fillpoly(4,sf);
fillpoly(6,sd); fillpoly(4,sg); fillpoly(4,sb);
setfillstyle(1,0); fillpoly(4,se); fillpoly(4,sc); end;
6:begin
setfillstyle(1,2); fillpoly(4,sa); fillpoly(4,se); fillpoly(4,sf);
fillpoly(6,sd); fillpoly(4,sg); fillpoly(4,sb);
setfillstyle(1,0); fillpoly(4,sc); end;
7:begin
setfillstyle(1,2); fillpoly(4,sa); fillpoly(4,sc); fillpoly(4,sf);
setfillstyle(1,0); fillpoly(6,sd); fillpoly(4,sg); fillpoly(4,sb);
fillpoly(4,se); end;
8:begin
setfillstyle(1,2); fillpoly(4,sa); fillpoly(4,sc); fillpoly(4,sf);
fillpoly(6,sd); fillpoly(4,sg); fillpoly(4,sb); fillpoly(4,se); end;
9:begin
setfillstyle(1,2); fillpoly(4,sa); fillpoly(4,sc); fillpoly(4,sf);
fillpoly(6,sd); fillpoly(4,sg); fillpoly(4,sb);
setfillstyle(1,0); fillpoly(4,se); end;
end;
end;
57
procedure znak1(cifra1:byte);
begin
case cifra1 of
0:begin
setfillstyle(1,2); fillpoly(4,sa1); fillpoly(4,sc1);
fillpoly(4,sf1); fillpoly(4,se1); fillpoly(4,sg1); fillpoly(4,sb1);
setfillstyle(1,0); fillpoly(6,sd1); end;
1: begin setfillstyle(1,2); fillpoly(4,sc1); fillpoly(4,sf1);
setfillstyle(1,0); fillpoly(4,sa1);
fillpoly(6,sd1); fillpoly(4,sg1); fillpoly(4,sb1);
fillpoly(4,se1); end;
2:begin
setfillstyle(1,2); fillpoly(4,sa1); fillpoly(4,sc1);
fillpoly(6,sd1); fillpoly(4,se1); fillpoly(4,sg1);
setfillstyle(1,0); fillpoly(4,sf1); fillpoly(4,sb1); end;
3:begin
setfillstyle(1,2); fillpoly(4,sa1); fillpoly(4,sc1);
fillpoly(4,sf1); fillpoly(6,sd1); fillpoly(4,sg1);
setfillstyle(1,0); fillpoly(4,se1); fillpoly(4,sb1); end;
4:begin
setfillstyle(1,2); ; fillpoly(4,sc1); fillpoly(4,sf1);
fillpoly(6,sd1); fillpoly(4,sb1); setfillstyle(1,0);
fillpoly(4,se1); fillpoly(4,sa1); fillpoly(4,sg1);end;
5:begin setfillstyle(1,2); fillpoly(4,sa1); fillpoly(4,sf1);
fillpoly(6,sd1); fillpoly(4,sg1); fillpoly(4,sb1);
setfillstyle(1,0); fillpoly(4,se1); fillpoly(4,sc1); end;
6:begin
setfillstyle(1,2); fillpoly(4,sa1); fillpoly(4,se1);
fillpoly(4,sf1); fillpoly(6,sd1); fillpoly(4,sg1); fillpoly(4,sb1);
setfillstyle(1,0); fillpoly(4,sc1); end;
7:begin
setfillstyle(1,2); fillpoly(4,sa1); fillpoly(4,sc1);
fillpoly(4,sf1); setfillstyle(1,0); fillpoly(6,sd1);
fillpoly(4,sg1); fillpoly(4,sb1); fillpoly(4,se1); end;
8:begin
setfillstyle(1,2); fillpoly(4,sa1); fillpoly(4,sc1);
fillpoly(4,sf1); fillpoly(6,sd1); fillpoly(4,sg1); fillpoly(4,sb1);
fillpoly(4,se1); end;
9:begin
setfillstyle(1,2); fillpoly(4,sa1); fillpoly(4,sc1);
fillpoly(4,sf1); fillpoly(6,sd1); fillpoly(4,sg1); fillpoly(4,sb1);
setfillstyle(1,0); fillpoly(4,se1); end;
end; end;
begin
gd:=detect; gm:=0;
initgraph(gd,gm,'');
setbkcolor(0); setcolor(0);
setfillstyle(1,7);
gettime(a,b,c,d);
chas[1]:=a div 10; chas[2]:=a mod 10;
chas[3]:=b div 10; chas[4]:=b mod 10;
chas[5]:=c div 10; chas[6]:=c mod 10;
setviewport(5,130,115,350,true); znak(chas[1]);
setviewport(130,130,240,350,true); znak(chas[2]);
setviewport(240,130,270,350,true);
setfillstyle(1,2); bar(10,70,20,80); bar(10,140,20,150);
setviewport(270,130,380,350,true); znak(chas[3]);
setviewport(395,130,505,350,true); znak(chas[4]);
setviewport(520,240,575,350,true); znak1(chas[5]);
setviewport(584,240,639,350,true); znak1(chas[6]);
58
repeat
gettime(a,b,c,d);
if chas[1] <> a div 10 then begin
chas[1]:= a div 10; setviewport(5,130,115,350,true);
znak(chas[1]); end;
if chas[2] <> a mod 10 then begin
chas[2]:= a mod 10; setviewport(130,130,240,350,true);
znak(chas[2]); end;
if chas[3] <> b div 10 then begin
chas[3]:=b div 10; setviewport(270,130,380,350,true);
znak(chas[3]); end;
if chas[4] <> b mod 10 then begin
chas[4]:=b mod 10; setviewport(395,130,505,350,true);
znak(chas[4]); end;
if chas[5] <> c div 10 then begin
chas[5]:=c div 10; setviewport(520,240,575,350,true);
znak1(chas[5]); end;
if chas[6] <> c mod 10 then begin
chas[6]:=c mod 10; setviewport(584,240,639,350,true);
znak1(chas[6]); end;
until keypressed;
closegraph;
end.
1-5-4. Кодированное изображение
for i:=1 to n do begin
for j:=1 to n do begin
read(l); putpixel (j,i,l);
end;
1-5-5. Кодированное изображение-1
writeln ('Введите размерность матриц'); readln (n);
writeln ('Если пересечение множеств - введите 1');
writeln ('Если объединение множеств - введите 0');
readln (f);
grDriver:=Detect;
InitGraph(grDriver, grMode, '');
for i:=1 to n do begin
for j:=1 to n do begin
read (x); read (y);
if f=0 then if (x=1) or (y=1) then putpixel (j,i,1);
if f=1 then if ((x=1) and (y=1)) then putpixel(j,i,1);
end; end;
1-5-6. Калейдоскоп
uses graph,crt;
procedure flodfil(x,y,t:integer);
var s,i,k,k1,linp,linl,sxp,sxl,sx :integer;
begin
k1:=y; setcolor(t);
while getpixel(x,y)=0 do begin
k:=0;
while getpixel(x,y)=0 do begin
putpixel(x,y,t); k:=k+1; y:=y+1; end;
for s:=k1 to k1+k-1 do begin
sxp:=x; sxl:=x; sx:=x;
linp:=0; linl:=0;
while getpixel(sxp+1,s)=0 do begin sxp:=sxp+1; linp:=linp+1; end;
while getpixel(sxl-1,s)=0 do begin sxl:=sxl-1; linl:=linl-1; end;
line (linl+sx,s,linp+sx,s);
end;
59
y:=s;
sx:=round((linl+linp+2*sx)/2); sxl:=sx; sxp:=sx;
while (getpixel(sxl,y+1)=0) and (getpixel(sxl-1,y+1)<>0) do
sxl:=sxl-1;
while (getpixel(sxp,y+1)=0) and (getpixel(sxl+1,y+1)<>0) do
sxp:=sxp+1;
x:=round((sxl+sxp)/2);
y:=y+1; k1:=y;
end;
end;
var x,y,q,wp,d1,cu,su:real;
i,d,e,rad,err,c,q1,i1,j1,z,j,f,as,a,b,a1,b1:integer;
m:array[1..100,1..6] of real;
begin
randomize;
d:=detect;
initgraph(d,q1,'');
repeat
m[1,1]:=320; m[1,2]:=240; m[2,1]:=120; m[2,2]:=240;
m[3,2]:=240-200*sin(pi/3); m[3,1]:=120+200*cos(pi/3);
m[1,3]:=m[2,1]; m[1,4]:=m[2,2];
m[2,3]:=m[3,1]; m[2,4]:=m[3,2];
m[3,3]:=m[1,1]; m[3,4]:=m[1,2];
for i:=1 to 3 do begin
m[i,5]:=(m[i,2]-m[i,4])/(m[i,1]-m[i,3]);
m[i,6]:=m[i,2]-m[i,5]*m[i,1]; end;
for i:=1 to 3 do
if i<3 then line(round(m[i,1]),round(m[i,2]),
round(m[i+1,1]),round(m[i+1,2])) else
line(round(m[3,1]),round(m[3,2]),
round(m[1,1]),round(m[1,2]));
c:=random(5)+5; {здесь задается количество разбиений}
for i:=1 to c do begin i1:=random (3)+1; j1:=0;
while (i1=j1) or (j1=0) do j1:=random(3)+1;
m[i+3,1]:=random(round(abs(m[i1,1]m[i1,3])))+round((m[i1,1]+m[i1,3]-abs(m[i1,1]-m[i1,3]))/2);
m[i+3,2]:=m[i1,5]*m[i+3,1]+m[i1,6];
m[i+3,3]:=random(round(abs(m[j1,1]m[j1,3])))+round((m[j1,1]+m[j1,3]-abs(m[j1,1]-m[j1,3]))/2);
m[i+3,4]:=m[j1,5]*m[i+3,3]+m[j1,6];
line(round(m[i+3,1]),round(m[i+3,2]),round(m[i+3,3]),round(m[i+3,4]));
end;
for i:=round(m[3,2]) to round(m[2,2]) do begin
for j:=round(m[2,1]) to round(m[1,1]) do begin
if
(i>(m[2,5]*j+m[2,6]))
and
(i>(m[3,5]*j+m[3,6]))
and
(getpixel(j,i)=0) then begin as:=as+1; as:=as mod 15; if as=0
then as:=1; flodfil(j,i,as); end; end; end;
for j:=round(m[3,2]) to round(m[2,2]) do begin
for i:=round(m[2,1]) to round(m[1,1]) do begin
if (j>(m[2,5]*i+m[2,6]))and (j>(m[3,5]*i+m[3,6])) then begin
d1:=sqrt(abs(sqr(abs(320-i))+sqr(240-j)));
if d1 <>0 then begin cu:=(320-i)/d1; su:=(240-j)/d1;
a:=320+round(d1*(cu*cos(pi/3)-su*sin(pi/3)));
b:=240-round(d1*(su*cos(pi/3)+cu*sin(pi/3)));
putpixel(a,b,getpixel(i,j));
a1:=320+abs(round(d1*(cu*cos(2*pi/3)-su*sin(pi*2/3))));
b1:=240-round(d1*(su*cos(2*pi/3)+cu*sin(pi*2/3)));
putpixel(a1,b1,getpixel(i,j)); end;
end; end; end;
for j:=round(m[3,2]) to round(m[2,2]) do begin
for i:=round(m[2,1]) to round(m[1,1])+200 do begin
putpixel(i,240+(240-j),getpixel(i,j)); end; end;
delay(5000);
60
for j:=round(m[3,2]) to round(m[2,2]) do
for i:=round(m[2,1]) to round(m[1,1]) do
if
(j>=(m[2,5]*i+m[2,6]))and
(j>=(m[3,5]*i+m[3,6]))
putpixel(i,j,0);
setcolor(15);
until keypressed;
closegraph;
end.
then
1-5-7. Спирограф
uses crt, graph;
function nod(a,b:Integer):Integer;
var c : integer;
begin
if a<b then begin c:=a; a:=b; b:=c; end;
while b<>0 do begin
if b=0 then c:=a else begin c:=a mod b; a:=b; b:=c end;
end;
nod:=a;
end;
procedure spireline(a,b,d,dt:real; x0,y0:integer);
var t,fi:real; x,y,x1,y1:integer;
begin
setlinestyle(0,0,1); t:=0;
x1:=x0+round((a-b)*cos(0)+d*cos(0));
y1:=y0+round((a-b)*sin(0)-d*sin(0));
repeat
fi:=(a/b)*t;
x:=x0+round((a-b)*cos(t)+d*cos(fi));
y:=y0+round((a-b)*sin(t)-d*sin(fi));
setcolor(13); line(x,y,x1,y1);
t:=t+0.1; x1:=x; y1:=y;
until t>dt;
end;
var i,j,xc,yc,x1,y1,x,y,x2,y2,ar,ar1,grDriver,grMode: integer;
a,b,d,fi,t: real; klav: char;
begin
repeat
clrscr;
writeln('введите радиус колеса a'); readln(a);
writeln('введите радиус диска b'); readln(b);
writeln('введите расстояние от центра диска до отверстия с
карандашом'); readln(d);
if (a>b)and(b>d) then begin
grdriver := detect;
initgraph(grdriver, grmode,'');
xc := getmaxx div 2; yc := getmaxy div 2;
setcolor(15); setlinestyle(0,0,3);
circle(xc,yc,round(a)); setbkcolor(1);
t:=0; ar1:=0;
61
repeat
setlinestyle(0,0,3); setcolor(15);
circle(xc,yc,round(a));
fi:=(a/b)*t;
x:=xc+round((a-b)*cos(t)+d*cos(fi));
y:=yc+round((a-b)*sin(t)-d*sin(fi));
x1:=xc+round((a-b-5)*cos(t));
y1:=yc+round((a-b-5)*sin(t));
circle(x1,y1,round(b));
ar1:=ar1+1;
for ar:=ar1 to ar1+120 do
if ar mod 2 = 0 then
arc (x1,y1,ar*3, (ar+1)*3, round(b+3));
setcolor(13); circle(x,y,3);
spireline(a,b,d,t,xc,yc);
setlinestyle(0,0,3); setcolor(getbkcolor);
circle(x1,y1,round(b));
for ar:=ar1 to ar1+120 do
if ar mod 2 = 0 then
arc (x1,y1,ar*3, (ar+1)*3, round(b+3));
circle(x,y,3); t:=t+0.1;
until t>2*pi*(b/nod(round(a),round(b)));
spireline(a,b,d,2*pi*(b/nod(round(a),round(b))),xc,yc);
setlinestyle(0,0,3); setcolor(white);
circle(x1,y1,round(b));
for ar:=ar1 to ar1+120 do
if ar mod 2 = 0 then
arc (x1,y1,ar*3, (ar+1)*3, round(b+3));
setcolor(13); circle(x,y,3);
setcolor(10);
outtextxy(20,435,'хотите продолжить - "enter"');
outtextxy(20,450,'хотите выйти - "esc"');
repeat klav:=readkey until (klav=#27)or(klav=#13);
closegraph; end
else begin
writeln ('вы ввели некорректные данные');
writeln ('хотите продолжить - "enter"');
writeln ('хотите выйти - "esc"');
repeat klav:=readkey until (klav=#27)or(klav=#13)
end;
until klav = #27;
end.
62
МОДУЛЬ 6
1-6-1. Римский счет
Const
a:array[1..13] of string=
('I','IV','V','IX','X','XL','L','XC','C','CD','D','CM','M');
a1:array[1..13] of integer=
(1,4,5,9,10,40,50,90,100,400,500,900,1000);
var i,j,ch:longint;
begin
writeln('Введите целое число'); read(ch);
i:=13;
while i>=1 do begin
if ch>=a1[i] then begin ch:=ch-a1[i]; write(a[i]); i:=i+1; end;
i:=i-1;
end;
end.
1-6-2. Факториалы
const n=100; k=100;
var a:array[1..n] of integer;
i,l:integer; flag:boolean;
begin
a[n]:=1;
for i:=1 to k do begin
for l:=n downto 2 do a[l]:=a[l]*i;
for l:=n downto 2 do begin
if a[l]>10 then begin
a[l-1]:=a[l-1] + a[l] div 100;
a[l]:=a[l] mod 100;
end;
end;
write(i,' - ');
flag:=false;
for l:=1 to n do begin
if flag then
if a[l]>9 then write(a[l]) else write('0',a[l])
else if a[l]>0 then begin write(a[l]); flag:=true; end;
end;
writeln;
end;
readln;
end.
1-6-3. Цифры и числа
var i,j,l,m,k:longint;
s:string;
begin
writeln('Введите натуральное число'); readln(k);
for i:=1 to k do begin
str(i,s); m:=m+length(s);
if m>=k then break; end;
writeln;
writeln(k,'-я цифра с начала последовательности - ',s[length(s)-(m-k)]);
m:=0;
for i:=k downto 1 do begin
str(i,s);
m:=m+length(s);
if m>=k then break; end;
writeln(k,'-я цифра с конца последовательности - ',s[(m-k)+1]);
end.
63
1-6-4. Два треугольника
uses graph;
var
grdriver : integer; grmode : integer;
s,s1:real;
i,j,l,x,y,f,a,maxx,minx,maxy,miny,q1,q2,r:integer;
m,m1:array[1..3,1..4] of real;
begin
for i:=1 to 3 do begin
writeln ('введите координаты ',i,' точки 1 треугольника');
readln(m[i,1],m[i,2]);
end;
for i:=1 to 3 do begin
writeln ('введите координаты ',i,' точки 2 треугольника');
readln(m1[i,1],m1[i,2]);
end;
grdriver:=detect; initgraph(grdriver, grmode, '');
m[1,3]:=m[2,1]; m[1,4]:=m[2,2]; m[2,3]:=m[3,1]; m[2,4]:=m[3,2];
m[3,3]:=m[1,1]; m[3,4]:=m[1,2]; m1[1,3]:=m1[2,1]; m1[1,4]:=m1[2,2];
m1[2,3]:=m1[3,1]; m1[2,4]:=m1[3,2]; m1[3,3]:=m1[1,1]; m1[3,4]:=m1[1,2];
for i:=1 to 3 do begin
l:=i+2;
if l>3 then l:=l-3;
s1:=((m[i,3]-m[i,1])*(m[l,2]-m[i,2])-(m[i,4]-m[i,2])*(m[l,1]-m[i,1]));
for j:=1 to 3 do begin
s:=0;
s:=((m[i,3]-m[i,1])*(m1[j,2]-m[i,2])-(m[i,4]-m[i,2])*(m1[j,1]-m[i,1]));
if ((s<=0)and(s1>=0))or((s>=0)and(s1<=0)) then f:=1;
if f=1 then break;
end;
if f=1 then break; end;
if f=0 then a:=1 else begin f:=0;
for i:=1 to 3 do begin for j:=1 to 3 do begin
s:=((m1[i,3]-m1[i,1])*(m[j,2]-m1[i,2])-(m1[i,4]-m1[i,2])*(m[j,1]-m1[i,1]));
l:=i+2;
if l>3 then l:=l-3;
s1:=((m1[i,3]-m1[i,1])*(m1[l,2]-m1[i,2])-(m1[i,4]-m1[i,2])*(m1[l,1]-m1[i,1]));
if ((s<=0)and(s1>=0))or((s>=0)and(s1<=0))then f:=1;
if f=1 then break; end;
if f=1 then break; end;
if f=0 then a:=-1; end;
i:=1; setbkcolor(1);
if a=0 then begin setcolor(5);
for i:=1 to 3 do
line(round(m[i,1]),round(m[i,2]),round(m[i,3]),round(m[i,4]));
setcolor(9);
for i:=1 to 3 do
line(round(m1[i,1]),round(m1[i,2]),round(m1[i,3]),round(m1[i,4]));
end;
if a=1 then begin
setcolor(5); for i:=1 to 3 do
line(round(m[i,1]),round(m[i,2]),round(m[i,3]),round(m[i,4]));
setfillstyle(1,5);
floodfill(round(m1[1,1]),round(m1[1,2]),5);
setcolor(1);
minx:=round(m1[1,1]); miny:=round(m1[1,2]);
for i:=1 to 3 do begin
line(round(m1[i,1]),round(m1[i,2]),round(m1[i,3]),round(m1[i,4]));
if maxx<m1[i,1] then maxx:=round(m1[i,1]);
if minx>m1[i,1] then minx:=round(m1[i,1]);
if maxy<m1[i,2] then maxy:=round(m1[i,2]);
if miny>m1[i,2] then miny:=round(m1[i,2]);
end;
setfillstyle(1,1);
f:=0; r:=0; j:=round((miny+maxy)/2);
for l:=minx to maxx do begin
if (r=0) and (getpixel(l,j)=1) then begin f:=0;r:=1; end;
if (getpixel(l,j)=5) and(f=1)and (r=0) then break;
if (getpixel(l,j)=1) then begin f:=1; r:=0; end;
end;
64
q1:=l; q2:=j; floodfill(l,j,1); end;
if a=-1 then begin setcolor(5); for i:=1 to 3 do
line(round(m1[i,1]),round(m1[i,2]),round(m1[i,3]),round(m1[i,4]));
setfillstyle(1,5); floodfill(round(m[1,1]),round(m[1,2]),5);
setcolor(1); minx:=round(m1[1,1]); miny:=round(m1[1,2]);
for i:=1 to 3 do begin
line(round(m[i,1]),round(m[i,2]),round(m[i,3]),round(m[i,4]));
if maxx<m[i,1] then maxx:=round(m[i,1]);
if minx>m[i,1] then minx:=round(m[i,1]);
if maxy<m[i,2] then maxy:=round(m[i,2]);
if miny>m[i,2] then miny:=round(m[i,2]);
end;
f:=0; setfillstyle(1,1); f:=0;r:=0; j:=round((miny+maxy)/2);
for l:=minx to maxx do begin
if (r=0) and (getpixel(l,j)=1) then begin f:=0;r:=1; end;
if (getpixel(l,j)=5) and(f=1)and (r=0) then break;
if (getpixel(l,j)=1) then begin f:=1; r:=0; end;
end; q1:=l; q2:=j; floodfill(l,j,1);
end; readln; closegraph; end.
1-6-5. Охота на зайца
var
a:array[1..100,1..3] of real;
i,j,l,m,n,f,c,d,q,k,aas:integer;
max,p,x,y,z:real;
gr,s:real;
begin
writeln('Введите количество прыжков сделанных зайцем'); readln(n);
for i:=2 to n+1 do begin
writeln('Введите длинну ',i-1,' прыжка и угол под которым он был
сделан по отношению к северу (в градусах)');
read(l,gr);
gr:=gr*pi/180;
a[i,1]:=a[i-1,1]+l*sin(gr);
a[i,2]:=a[i-1,2]+l*cos(gr);
end;
for i:=1 to n+1 do
if max<a[i,1] then begin max:=a[i,1]; m:=i;aas:=i; end;
a[m,3]:=1; c:=1;
for d:=1 to n+1 do begin
for j:=1 to n+1 do begin
if m<>j then begin f:=0;
for i:=1 to n+1 do begin
if m<>i then begin
s:=((a[j,1]-a[m,1])*(a[i,2]-a[m,2])-(a[j,2]-a[m,2])*(a[i,1]-a[m,1]));
if s-(4e-11)>0 then f:=1; end;
if f=1 then break;
end; end;
if f=0 then break; end;
if a[j,3]=1 then break;
c:=c+1; a[j,3]:=c; m:=j; end;
i:=1; s:=0;
while(i<=c) do begin
f:=0; p:=0;
if i>c then begin q:=1; i:=i-c; end;
for l:=1 to n+1 do begin
if a[l,3]=i then f:=1;
if f=1 then break; end;
f:=0; i:=i+1;
if i>c then begin q:=1; i:=i-c; end;
for k:=1 to n+1 do begin if a[k,3]=i then f:=1;
if f=1 then break; end;
x:=sqrt(sqr(a[aas,1]-a[l,1])+sqr(a[aas,2]-a[l,2]));
y:=sqrt(sqr(a[l,1]-a[k,1])+sqr(a[l,2]-a[k,2]));
z:=sqrt(sqr(a[k,1]-a[aas,1])+sqr(a[k,2]-a[aas,2]));
p:=(x+y+z)/2;
s:=s+sqrt(p*(p-x)*(p-y)*(p-z));
if q=1 then break; end;
writeln(s:0:2); end.
65
МОДУЛЬ 7
Решения задач лекции
А. var j,k,b:integer;
m: set of byte;
i, x: longint;
begin
writeln('Введите число'); readln(x);
i:=x;
{Формируем множество цифр числа}
repeat
b:=x mod 10;
m:=m+[b];
x:= x div 10;
until x=0;
{Организуем цикл по цифрам от 0 до 9 и если цифра входит
в множество цифр чила - увеличиваем счетчик на 1}
for j:=0 to 9 do
if j in m then k:=k+1;
writeln('В числе ', i,' ',k, ' различных цифр');
end.
В. const m=0; n=9;
var u:set of m..n;
a,x:longint; i,j:integer;
begin
writeln(''Введите число '); readln(a);
x:=a;
{Формируем множество цифр числа}
repeat
i:=a mod 10;
u:=u+[i];
a:=a div 10;
until a=0;
{Организуем цикл по цифрам от n до m9 и если цифра не входит
в множество цифр чиcла - выводим на экран число}
writeln('В числе ',x, ' нет цифр');
for i:=m to n do begin
if not(i in u) then write(i,' ');
end;
end.
Решения задач практикума
А. var a,b,c,k,k1,I : integer;
s1,s2,s3:set of 0..20;
begin
{Случайным образом формируем первое множество}
randomize; s1:=[];s2:=[];
writeln('первое множество');
repeat
b:=random(20);
if not (b in s1) then begin
s1:=s1+[b]; write(b,' '); inc(k); end;
until k=10;
{Случайным образом формируем второе множество}
writeln; writeln('второе множество');
repeat
c:=random(20);
if not (c in s2) then begin
66
s2:=s2+[c]; write(c,' ');
inc(k1);
end;
until k1=10;
{Находим самый первый элемент входящий в первое множество и не входящий
во второе}
writeln; writeln('Наименьший элемент, входящий в s1, но не входящий в
s2');
s3:=s1*s2;
for i:=0 to 20 do
if (i in s1) and not (i in s2) then begin write(i,' ') ;
exit;
end;
end.
В-1. procedure pchelka;
var a,b,c,d,e,f,a1,a2,a3,a4,a5,a6:0..9;
n1,n2,n,n3: longint;
s1,s2:set of 0..9;
begin
s1:=[];s2:=[]; a:=1;
writeln('пчелка*7=жжжжжж');
for a:=1 to 2 do begin
s1:=s1+[a];
for b:=0 to 9 do
if not (b in s1) then begin
s1:=s1+[b];
for c:=0 to 9 do
if not (c in s1) then begin
s1:=s1+[c];
for d:=0 to 9 do
if not (d in s1) then begin
s1:=s1+[d];
for e:=0 to 9 do
if not (e in s1) then begin
s1:=s1+[e];
for f:=0 to 9 do
if not (f in s1) then begin
s1:=s1+[f];
n:=100000; n3:=10000;
n1:=a*n+b*n3+c*1000+d*100+e*10+f;
n2:=n1*7;
a1:=n2 div 100000;
a2:=n2 div 10000 mod 10;
a3:=n2 div 1000 mod 10;
a4:=n2 div 100 mod 10;
a5:=n2 div 10 mod 10;
a6:=n2 mod 10;
s2:=[a1,a2,a3,a4,a5,a6];
if (s1*s2=[]) and (a1=a2) and (a2=a3) and (a3=a4)
and (a4=a5) and (a5=a6) and (a6=a1) then writeln (n1, '* ',n1,'=',n2);
s1:=s1-[f];
end;
s1:=s1-[e];
end;
s1:=s1-[d];
end;
s1:=s1-[c];
end;
s1:=s1-[b];
end;
s1:=s1-[a];
end;
end;
67
В-2 procedure kaply;
var k,a,p,l,y,o,z,e,r,k1,o1:0..9;
n1,n2,n,n3: longint;
s1,s2:set of 0..9;
begin
s1:=[];s2:=[];
writeln('капля+капля+капля=озерко');
for k:=1 to 9 do begin
s1:=s1+[k];
for a:=0 to 9 do
if not (a in s1) then begin s1:=s1+[a];
for p:=0 to 9 do
if not (p in s1) then begin s1:=s1+[p];
for l:=0 to 9 do
if not (l in s1) then begin s1:=s1+[l];
for y:=1 to 9 do
if not (y in s1) then begin s1:=s1+[y];
n:=10000; n3:=100000;
n1:=k*n+a*1000+p*100+l*10+y;
n2:=n1*3;
o:=n2 div n3;
z:=n2 div n mod 10;
e:=n2 div 1000 mod 10;
r:=n2 div 100 mod 10;
k1:=n2 div 10 mod 10;
o1:=n2 mod 10;
s2:=[o,z,e,r,k1,o1];
if ([o]=[o1]) and (s1*s2=[k1,k]) and ([k]=[k1])
and ([o]<>[k1]) and ([r]<>[o]) and ([e]<>[o]) and ([z]<>[o]) and ([e]<>[r])
and ([z]<>[r]) and ([e]<>[k])and([z]<>[k1]) then
writeln (n1, '+ ',n1,'+',n1,'=',n2);
s1:=s1-[y]; end;
s1:=s1-[l]; end;
s1:=s1-[p]; end;
s1:=s1-[a]; end;
s1:=s1-[k]; end;
end;
В-3 procedure vetka;
TYPE MN=SET OF 0..9;
var v,e,t,k,a,d,e1,r,e2,v1,o:0..9;
n,n2,n1: longint;
s1,s2:MN;
begin
s1:=[];s2:=[];
writeln('ветка+ветка=дерево');
for v:=1 to 9 do begin
s1:=s1+[v];
for e:=0 to 9 do
if not (e in s1) then begin s1:=s1+[e];
for t:=0 to 9 do
if not (t in s1) then begin s1:=s1+[t];
for k:=0 to 9 do
if not (k in s1) then begin s1:=s1+[k];
for a:=0 to 9 do
if not (a in s1) then begin s1:=s1+[a];
n1:=10000;
n:=a+k*10+t*100+e*1000+v*n1;
n2:=n*2;
d:=n2 div 100000;
e1:=n2 div 10000 mod 10;
r:=n2 div 1000 mod 10;
e2:=n2 div 100 mod 10;
68
v1:=n2 div 10 mod 10;
o:=n2 mod 10;
s2:=[d,e1,e2,r,v1,o];
if
(d<>0)and([e]=[e1])
and
([e2]=[e])
and
([v]=[v1]) and (s1*s2=[e,v]) and ([r]<>[o]) then writeln (n, '+ ',n,'=',n2);
s1:=s1-[a]; end;
s1:=s1-[k]; end;
s1:=s1-[t]; end;
s1:=s1-[e]; end;
s1:=s1-[v]; end;
end;
С. uses graph,crt;
var x,y,z,t: set of byte;
s1,s:longint;
k,a,b,gd,gm,n,m,i,j,x1,y1: integer;
begin
writeln('Задайте количество точек'); readln(n);
writeln('во сколько раз уменьшить расстояние'); readln(m);
gm:=detect; initgraph(gd,gm,'');
{Случайным образом формируем множество координат х}
i:=1;
repeat
x1:=random(250);
if x1 in x then i:=i-1 else begin x:=x+[x1]; s:=s+x1; end;
i:=i+1;
until i=n;
{Случайным образом формируем множество координат у}
i:=1;
repeat
y1:=random(250);
if y1 in y then i:=i-1 else begin y:=y+[y1]; s1:=s1+y1; end;
i:=i+1;
until i=n;
z:=x; t:=y;
{Находим центр тфжести точек}
a:=s div n; b:=s1 div n;
setcolor(12); {Выводим точки на экран}
for i:=1 to 250 do
for j:=1 to 250 do begin
if (i in z) and(j in t) then begin putpixel(i*2,j*2,14); z:=z[i]; t:=t-[j]; end;
end;
circle(a*2,b*2,2);
readln;
{Сжимаем в M раз и выводим точки на экран}
for i:=1 to 250 do
for j:=1 to 250 do begin
if (i in x) and(j in y) then begin
putpixel(i*2,j*2,0);
for k:=1 to m do begin
x1:=round((i*2+k*a*2)/(k+1));
y1:=round((j*2+k*b*2)/(k+1));
putpixel(x1,y1,11);
delay(1000);
if k<>m then putpixel(x1,y1,00);
end;
x:=x-[i]; y:=y-[j];
end; end; readln; end.
69
МОДУЛЬ 9
Решения заданий лекции
А.
uses crt;
type stud=record
ba,mat,inf,eng:word;
fam:string[15]; end;
var i,a,b,c,n,k:integer;
m:array [1..100] of stud;
f:text;
procedure poisk; {Процедура поиска отличников}
begin
for I:=1 to n do
if (m[i].mat>=5)and(m[i].inf>=5)and(m[i].eng>=5) then
with m[i] do
writeln(fam:15);
end;
procedure poisk1; {Процедура поиска по проходному баллу}
begin
for I:=1 to n do
if m[i].mat+m[i].inf+m[i].eng>=k then
with m[i] do
writeln(fam:15);
end;
begin
assign(f,'stud.txt'); reset(f);
{Ввод данных}
while not eof(f) do begin
inc(i); readln(f,m[i].fam); readln(f,m[i].mat);
readln(f,m[i].inf); readln(f,m[i].eng);
write(m[i].fam,' '); write(m[i].mat,' ');
write(m[i].inf,' '); writeln(m[i].eng); end;
n:=i;
Write('Введите проходной балл'); readln(k);
writeln('Отличники');
writeln('----------------------');
poisk;
writeln('Набравшие проходной балл');
writeln('----------------------');
poisk1;
readkey;
end.
В.
uses crt;
type dom=record
kv:word;
fam,ii,gr:string[15]; end;
var i,n,k,l:integer;
m:array [1..100] of dom;
f:text;
s,a,b,c: string;
begin
writeln('В доме проживают');
writeln('__________________________');
assign(f,'dom.txt'); reset(f);
while not eof(f) do begin
inc(i); readln(f,m[i].kv); readln(f,s);
m[i].fam:=copy(s,1,length(s)-10);
m[i].ii:=copy(s,length(s)-8,4);
70
m[i].gr:=copy(s,length(s)-3,4);
{Вывод таблицы жильцов}
write(m[i].fam,' ');
write(m[i].ii,' ');
writeln(m[i].gr);
end;
writeln('__________________________');
n:=i;
{Начало поиска по фамилии}
write('Введите фамилию '); readln(a);
for I:=1 to n do if m[i].fam=a then begin
k:=k+1; l:=i; end;
if k=0 then begin writeln('Такого жильца нет');
readln; exit; end;
if k=1 then
writeln(m[l].fam,' живет в ',m[l].kv,' квартире')
else begin
{Поиск по фамилии и имени}
write('Введите инициалы '); readln(b);
k:=0;
for I:=1 to n do
if (m[i].fam=a)and(m[i].ii=b) then begin
k:=k+1; l:=i; end;
if k=0 then begin
writeln('Такого жильца нет');
readln;
exit;
end;
if k=1 then
writeln(m[l].fam,'
',m[l].ii
,'живет
в
',m[l].kv,'
квартире')
else begin
{Поиск по фамилии, имени и году рождения}
write('Введите год рождения '); readln(c);
k:=0;
for I:=1 to n do
if (m[i].fam=a)and(m[i].ii=b)and(m[i].gr=c) then
begin k:=k+1; l:=i; end;
if k=1 then
writeln(m[l].fam,'
',m[l].ii
,'
живет
в
',m[l].kv,'
квартире');
end;
end;
if k=0 then writeln('Такого жильца нет'); readkey;
end.
С.
uses crt;
type sam=record
k,po,pn,r,s:string[15];
kol: integer;
vr: array[1..10] of string;
m1,m2: integer;
st: integer;
end;
var i,n,k,l,p2:integer;
m:array [1..10] of sam;
f:text;
p,p1: string;
begin
writeln('Рейсы');
writeln('__________________________');
assign(f,'sam.txt'); reset(f);
while not eof(f) do begin
71
inc(i); readln(f,m[i].k); readln(f,m[i].po);
readln(f,m[i].pn); readln(f,m[i].r);
readln(f,m[i].s); readln(f,m[i].kol);
for n:=1 to m[i].kol do
readln(f,m[i].vr[n]);
readln(f,m[i].m1);
readln(f,m[i].m2);
readln(f,m[i].st);
{Вывод таблицы данных об авиакомпании}
write(m[i].k
,'
',m[i].po,'
',m[i].pn,'
',m[i].r,'
',m[i].s,' ');
for l:=1 to m[i].kol do write(m[i].vr[l], ' ');
writeln(m[i].m1,' ',m[i].m2,' ',m[i].st);
end;
writeln('__________________________');
n:=i; close(f);
writeln('пункт назначения'); Readln(p);
{По запросу выводим необходимую информацию о рейсе}
for i:= 1 to n do Begin
if m[i].pn=p then begin
writeln(m[i].k
,'
',m[i].po,'
',m[i].pn,'
','рейс
',m[i].r,' ',m[i].s,' ');
writeln('Время отпправления');
for l:=1 to m[i].kol do
writeln(m[i].vr[l], ' ');
writeln(m[i].m1,' - в первом классе ',m[i].m2,'- во втором
классе ','цена билета - ',m[i].st,' рублей ');
k:=i;
end; end;
writeln('Будете ли брать билет: да\нет'); Readln(p1);
if p1='да' then begin
writeln('В какой салон 1/2'); Readln(p2);
if p2=1 then m[i].m1:= m[i].m1-1
else m[i].m2:= m[i].m2-1 ;
{Если билет куплен, то записываем данные в файл}
assign(f,'sam.txt'); rewrite(f);
for i:=1 to n do begin
writeln(f,m[i].k); writeln(f,m[i].po);
writeln(f,m[i].pn); writeln(f,m[i].r);
writeln(f,m[i].s); writeln(f,m[i].kol);
for n:=1 to m[i].kol do
writeln(f,m[i].vr[n]);
writeln(f,m[i].m1);writeln(f,m[i].m2); writeln(f,m[i].st);
end;
writeln('__________________________');
n:=i; close(f); end; readln; end.
«Генеалогическое древо»
uses crt,graph;
const s=[3,8];
type sem=record
fam,mam,pap:string[35]; end;
var gd,gm,i,j,b,c,n,k:integer;
m,a:array [1..100] of sem;
f:text;
procedure poisk; {Процедура поиска родителей}
begin
for I:=1 to n do
For j:=i to n do
if
((m[i].mam=m[j].fam)or(m[i].pap=m[j].fam))
then begin
k:=k+1;
a[k].fam:=m[j].fam; a[k].mam:=m[j].mam;
72
and
(i<>J)
a[k].pap:=m[j].pap; end;
end;
begin
assign(f,'rod.txt'); reset(f);
while not eof(f) do begin
inc(i);
readln(f,m[i].fam); readln(f,m[i].mam);
readln(f,m[i].pap); end;
n:=i;
a[1].fam:=m[1].fam; a[1].mam:=m[1].mam;
a[1].pap:=m[1].pap;
k:=1;
poisk;
i:=1;
gd:=detect; initgraph(gd,gm,'');
settextstyle(2,0,6); setcolor(14);
outtextxy (250,10,a[1].fam);
setcolor(11); outtextxy (70,30,a[1].mam);
outtextxy (350,30,a[1].pap); settextstyle(2,1,5);
setcolor(12);
outtextxy (100,50,a[2].mam); outtextxy (230,50,a[2].pap);
outtextxy (450,50,a[3].mam); outtextxy (570,50,a[3].pap);
setcolor(13);
outtextxy (70,250,a[4].mam); outtextxy (130,250,a[4].pap);
outtextxy (200,250,a[5].mam);outtextxy (260,250,a[5].pap);
outtextxy (410,250,a[6].mam);outtextxy (470,250,a[6].pap);
outtextxy (540,250,a[7].mam);outtextxy (600,250,a[7].pap);
readln;
end.
«Ежедневник»
uses crt,graph;
label l,l1;
type zap=record
s,d,v,dl,ms:string[35];
end;
var gd,gm,i,i1,j,b,c,n,k,x:integer;
dat: string[35];
m,a:array [1..100] of zap;
f:text;
begin
clrscr; assign(f,'ed.txt'); reset(f);
while not eof(f) do begin
inc(i);
readln(f,m[i].s); readln(f,m[i].d);
readln(f,m[i].v); readln(f,m[i].dl);
readln(f,m[i].ms);
writeln(m[i].s,'
',m[i].d,'
',m[i].v,'
',m[i].dl,'
',m[i].ms);
end;
k:=i; close(f); readln;
gd:=detect;
initgraph(gd,gm,'');
l1: cleardevice;
settextstyle(2,0,6);
setcolor(14);
outtextxy (200,10,'Выберете режим работы');
outtextxy (150,30,'1 - Просмотр дел на сегодня');
outtextxy (150,50,'2 - Просмотр дел на завтра');
outtextxy (150,70,'3 - Запись новых дел');
outtextxy (150,90,'4 - Удаление вчерашних дел');
outtextxy (150,110,'5 - Ближайшее событие');
outtextxy (150,130,'6 - Конец работы');
gotoxy(60,2); readln(x);
73
case x of
1: begin {Просмотр дел на сегодня}
cleardevice;
outtextxy(100,100,'Введите дату в фомате ДД.ММ.ГГ');
gotoxy(20,10); readln(dat);
for i:=1 to k do if m[i].d=dat then begin
outtextxy(50,150+i*20,m[i].s);
outtextxy(200,150+i*20,m[i].d);
outtextxy(300,150+i*20,m[i].v);
outtextxy(400,150+i*20,m[i].dl);
outtextxy(500,150+i*20,m[i].ms);
readln; end; goto l1;
end;
2: begin
{Просмотр дел на завтра}
cleardevice;
outtextxy(100,100,'Введите
завтрашнюю
дату
в
фомате
ДД.ММ.ГГ');
gotoxy(20,10); readln(dat);
for i:=1 to k do if m[i].d=dat then begin
outtextxy(50,150+i*20,m[i].s);
outtextxy(200,150+i*20,m[i].d);
outtextxy(300,150+i*20,m[i].v);
outtextxy(400,150+i*20,m[i].dl);
outtextxy(500,150+i*20,m[i].ms);
readln; end; goto l1;
end;
3: begin
{Запись новых дел}
cleardevice;
assign(f,'ed.txt'); rewrite(f);
for i:=1 to k do begin
writeln(f,m[i].s); writeln(f,m[i].d);
writeln(f,m[i].v); writeln(f,m[i].dl);
writeln(f,m[i].ms); end;
outtextxy(100,100,'Событие'); gotoxy(20,9);
i1:=i+1;
readln(m[i1].s);
outtextxy(100,150,'Дата в фомате ДД.ММ.ГГ');
gotoxy(20,12); readln(m[i1].d);
outtextxy(100,200,'Время в фомате ЧЧ:ММ');
gotoxy(20,15); readln(m[i1].v);
outtextxy(100,250,'Длительность событие в фомате ЧЧ:ММ ');
gotoxy(20,18); readln(m[i1].dl);
outtextxy(100,300,'Место'); gotoxy(20,21);
readln(m[i1].ms);
j:=0; for i:=1 to k do
if (m[i].v=m[i1].v) and (m[i].d=m[i1].d) then begin
j:=1; outtextxy(100,400,'Время занято!!!'); end;
if j=0 then begin i:=i1; writeln(f,m[i].s);
writeln(f,m[i].d); writeln(f,m[i].v);
writeln(f,m[i].dl); writeln(f,m[i].ms);
end;
readln; close(f);
goto l1;
end;
4: begin
{Удаление дел}
cleardevice;
outtextxy(100,100,'Введите дату в фомате ДД.ММ.ГГ');
gotoxy(20,10); readln(dat);
assign(f,'ed.txt');
rewrite(f);
for i:=1 to k do if m[i].d<>dat then begin
writeln(f,m[i].s); writeln(f,m[i].d);
writeln(f,m[i].v); writeln(f,m[i].dl);
writeln(f,m[i].ms); end;
74
close(f); readln;
goto l1;
end;
5: begin
{Ближайшее событие}
cleardevice;
outtextxy(100,100,'Введите дату ближайшего события в фомате
ДД.ММ.ГГ');
gotoxy(20,10); readln(dat);
for i:=1 to k do if m[i].d=dat then begin
outtextxy(50,150+i*20,m[i].s);
outtextxy(200,150+i*20,m[i].d);
outtextxy(300,150+i*20,m[i].v);
outtextxy(400,150+i*20,m[i].dl);
outtextxy(500,150+i*20,m[i].ms);
readln;
goto l1;
end;
end;
6: goto l;
{Выход}
end;
l: cleardevice;
outtextxy(150,200,'Работа с ежедневником закончена');
readln;
end.
МОДУЛЬ 10
Решения задач для самостоятельного решения
А.
type
exst=^st;
st=record
data: string;
next:exst; end;
var
a:string;
f,f1:boolean;
i,k: integer; u:exst;g: text;
procedure writestack(var u:exst;c:string;f1:boolean);
var x1: exst;
begin
new(u); u^.data:=c; u^.next:=x1; x1:=u; f1:=true; end;
procedure delstack(var x1:exst);
var u: exst;
c:string;
begin
c:=u^.data ; u:=x1; x1:=x1^.next; dispose(u); end;
procedure solve (var a:string; var f:boolean);
var stack:exst;
begin
stack:=nil; if a=' begin' then begin
writestack(stack,a,f1); f:=false;
end;
if ((a=' end;') or (a=' end.')or(a=' end'))and(f=false) then
begin
if f1=true then delstack(stack);
f:=true;
f1:=false;
end;
75
end;
begin
аssign(g,'file.pas'); reset(g);
f:=true; f1:=false;
while not eof(g) do begin
readln(g,a); inc(k); solve(a,f);
end;
if f=true then writeLn('Вeрно вложены операторные скобки')
else Writeln('Неверно вложены операторные скобки');
readln;
end.
В.
type exst=^st;
st=record
data: string;
next:exst;
end;
var a:string;
i,k,j,l: integer; v:exst;g,f,h,t: text;
procedure writestack(var u:exst ;c:string);
var x: exst;
begin
new(x); x^.data:=c; x^.next:=u; u:=x; end;
procedure delstack(var u:exst;var c:string);
var x: exst;
begin
c:=u^.data ; x:=u; u:=u^.next; dispose(x); end;
begin
assign(g,'in2.txt'); reset(g);
assign(h,'in3.txt'); reset(h);
readln(g,i); readln(h,j);
assign(f,'out2.txt'); rewrite(f);
v:=nil;
if i<j then l:=i else l:=j;
k:=abs(i-j);
for k:=1 to l do begin
readln(g,a); writestack(v,a);
readln(h,a); writestack(v,a);
end;
writeln(k);
for i:=1 to l*2 do begin
delstack(v ,a); writeln(f,a);
end;
for i:=l+1 to k+l do begin
if i=l then readln(g,a) else readln(h,a);
writeln(f,a);
end;
close(f); close(g); close(h);
readln;
end.
76
РЕШЕНИЯ ЗАДАЧ САМОСТОЯТЕЛЬНОЙ РАБОТЫ
«Детали»
type
ukazatel=^x;
x= record
data:integer;
next:ukazatel;
end;
var i,k,a,b,d: integer;
c:array [1..100] of string;
d1: array [1..100] of integer;
f:text;h,px:ukazatel;
procedure insinto(d:integer;var head: ukazatel);
var dx,px,x: ukazatel;
begin
new(x); x^.data:=d; x^.next:=nil;
if head = nil then head:=x else begin
dx:=head; px:=head;
while(px<>nil) and(px^.data<=d) do begin
dx:=px; px:=px^.next;
end;
if px= nil then dx^.next:=x else begin
x^.next:=px;
if px=head then head:=x else dx^.next:=x;
end;
end;
end;
begin
assign(f,'det.txt'); reset(f);
while not eof(f) do begin
i:=i+1;
readln(f,c[i]); readln(f,a); readln(f,b);
d1[i]:=a+b; d:=d1[i]; insinto(d,h); end;
while h<>nil do begin
for k:=1 to i do
if d1[k]=h^.data then writeln (c[k],' ',h^.data,' ');
h:=h^.next;
end; readln;
end.
«Салют»
uses crt, graph;
type typecircle=^k;
k=record
data:char;
next:typecircle;
end;
var u,x:typecircle;
xx,yy ,gd,gm,j,i,m,n: integer;
procedure Yellow(var xx,yy: integer );
begin
setcolor(14);
circle(xx,yy,3);
setfillstyle(1,14);
floodfill(xx,yy,14);
setfillstyle(1,0);
floodfill(xx,yy,14);
77
setcolor(0);
for n:=3 to 8 do
circle(xx,yy,n);
end;
procedure Blue(var xx,yy: integer );
begin
setcolor(1);
circle(xx,yy,3);
setfillstyle(1,1);
floodfill(xx,yy,1);
setfillstyle(1,0);
floodfill(xx,yy,1);
setcolor(0);
for n:=3 to 8 do
circle(xx,yy,n);
end;
procedure green(var xx,yy: integer );
begin
setcolor(2);
circle(xx,yy,3);
setfillstyle(1,2);
floodfill(xx,yy,2);
setfillstyle(1,0);
floodfill(xx,yy,2);
setcolor(0);
for n:=3 to 8 do
circle(xx,yy,n);
end;
procedure red(var xx,yy: integer );
begin
setcolor(4);
circle(xx,yy,3);
setfillstyle(1,4);
floodfill(xx,yy,4);
setfillstyle(1,0);
floodfill(xx,yy,4);
setcolor(0);
for n:=3 to 7 do
circle(xx,yy,n);
end;
procedure vibor(var xx,yy: integer );
begin
case x^.data of
'r':red(xx,yy);
'y':yellow(xx,yy);
'b':blue(xx,yy);
'g':green(xx,yy);
end;
end;
begin
gd:=detect;
initgraph(gd,gm,'');
new(x);
u:=x;
x^.data:='r';
new(x^.next);
x:=x^.next;
78
x^.data:='g';
new(x^.next);
x:=x^.next;
x^.data:='b';
new(x^.next);
x:=x^.next;
x^.data:='y';
x^.next:=u;
x:=u;
while not keypressed do
begin
i:=320;
j:=240;
for m:=480 downto 240 do
begin
setcolor(14);
circle(320,m,13);
setfillstyle(1,14);
floodfill(320,m,14);
setfillstyle(1,0);
delay(200);
floodfill(320,m,14);
setcolor(0);
circle(320,m,13);
circle(320,m,14);
circle(320,m,15);
circle(320,m,16);
end;
for m:=1 to 120 do
begin
xx:=i-m-10;
yy:=j-m;
vibor(xx,yy);
xx:=i+m+10;
yy:=j+m;
vibor(xx,yy);
xx:=i+m+10;
yy:=j-m;
vibor(xx,yy);
xx:=i-m-10;
yy:=j+m;
vibor(xx,yy);
xx:=i-m;
yy:=j-m;
vibor(xx,yy);
xx:=i+m;
yy:=j+m;
vibor(xx,yy);
xx:=i+m;
yy:=j-m;
vibor(xx,yy);
xx:=i-m;
yy:=j+m;
vibor(xx,yy);
xx:=i-m;
yy:=j-m-20;
vibor(xx,yy);
xx:=i+m;
yy:=j+m+20;
vibor(xx,yy);
xx:=i+m;
yy:=j-m-20;
79
vibor(xx,yy);
xx:=i-m;
yy:=j+m+20;
vibor(xx,yy);
xx:=i;
yy:=j+m+30;
vibor(xx,yy);
xx:=i;
yy:=j-m-30;
vibor(xx,yy);
xx:=i+m+30;
yy:=j;
vibor(xx,yy);
xx:=i-m-30;
yy:=j;
vibor(xx,yy);
end;
cleardevice;
x:=x^.next;
end;
readln;
end..
В разборе задач наравне с авторскими решениями использованы решения участников проектов
ДООИ-2004, ОСО-2005, ОСО-2006.
СПИСОК ЛИТЕРАТУРЫ
1.
Перминов О.Н. Программирование на языке Паскаль. -М.:Радио и связь, 1988
2.
Прайс Д. Программирование на языке Паскаль: Практическое руководство. - М.: Мир. 1987.
3.
Офицеров Д.В. Программирование в интегрированной среде Турбо-Паскаль:.-Мн.: Беларусь, 1992
4.
Роджерс Д. Алгоритмические основы машинной графики.- М.: Мир, 1989
5.
Роджерс Д., Адамс А. Математические основы машинной графики. - М.: Машиностроение, 1980.
6.
Котов И.И. Алгоритмы машинной графики. - М.: Машиностроение, 1977.
7.
Павлидис Т. Алгоритмы машинной графики и обработки изображений. - М.: Радиосвязь, 1986.
8.
Энджел И. Практическое введение в машинную графику. - М.: Радио и связь, 1984.
9.
Фокс Ф., Пратт М. Вычислительная геометрия. - М.: Мир, 1982
10. Эгрон Ж. Синтез изображений. Базовые алгоритмы.-М.:Радио и связь, 1993.
11. Романов В.Ю. Форматы файлов для хранения изображений на IBM PC. - М. : Унитех, 1992
12. Шикин Е.В. и др. Начала компьютерной графики. - М.:ДИАЛОГ-МИФИ, 1993.
13. Гранпер Ж., Коттэ Р. Трехмерная графика на Турбо-Паскале
14. Фаронов В.В. Турбо-Паскаль (в 3 книгах). - М.: "МВТУ-ФЕСТО ДИДАКТИК", 1992-1993.
15. Кассера Винфрид И Фолькер Turbo Pascal 7.0 – К.: "Диасофт". 2003.
16. Немнюгин С. А. Turbo Pascal. Практикум (2-е изд.) изд. "Питер". 2003.
17. О. Ускова Программирование на языке Паскаль: задачник СПб.: "Питер". 2003
18. Рапаков Г. Программирование на языке Pascal – СПб.: "БХВ - Санкт-Петербург". 2003·
19. Дональд Е. Кнут Искусство программирования. в 3-х т. 2000.
20. Юркин А. Задачник по программированию. – СПб.: Питер, 2002.
80