Geum.ru

Прогон и отладка программы Справочная служба Турбо Паскаля

Вид материалаДокументы
Interval = 30
Подобный материал:
1   2   3   4   5   6   7
{ShowField} 

for i := 1 to nrow do begin

GotoXY(X0,i+4);

Write(i); {Номер ряда}

GotoXY(X1,i+4);

Write(col[i]:2); {Количество фишек в ряду}

for j := 1 to ncol[i] do {Вывод ряда фишек:}

begin

GotoXY(X+2*j,i+4); if j[i] then

Write(FISH) 

else

Write('.') 

end 

end 

end; {ShowField}

Символы FISH (квадратики) выводятся через одну позицию, чтобы не сливались на экране. В те позиции, в которых ранее стояли уже снятые с поля фишки, выводится точка.

Теперь вернемся к процедуре GETPLAYERMOVE. При вводе любого очередного хода игрок должен задать два целых числа X1 и Х2. Первое из них указывает номер ряда, а второе - количество фишек, которые игрок хочет забрать из этого ряда. Программа должна проконтролировать правильность задания этих чисел: X1 должно указывать непустой ряд, Х2 не может превышать количество фишек в этом ряду. Кроме того, мы должны условиться о двух особых случаях:
  • пользователь больше не хочет играть и дает команду завершить работу программы;
  • пользователь хочет изменить условия игры.

Пусть ввод числа X1 =0 означает команду выхода из программы, а X1 = -1 - команду изменения условий игры. Тогда можно написать такой начальный вариант процедуры:

Procedure GetPlayerMove;

{Получает, контролирует и отображает ход игрока}

var

correctly : Boolean; {Признак правильности сделанного хода} 

xl,x2 : Integer; {Вводимый ход} 

begin {GetPlayerMove}

{Показываем начальное состояние игрового поля}

ShowField;

{Сообщаем, игроку правила ввода хода}

repeat

{Приглашаем игрока ввести ход}

ReadLn(xl,x2); {Вводим очередной ход} 

exit := xl=0; {Контроль команды выхода} 

change := xl=-l; {Контроль команды изменения} 

if not (exit or change) then

{Проверить правильность хода и установить нужное значение переменной CORRECTLY. Если ход правильный, сделать нужные изменения в раскладке фишек и показать поле.}  

else

correctly := true {Случай EXIT или CHANGE} 

until correctly; if change then

{ Изменить условия игры }  

end; {GetPlayerMove}

В этом варианте в процедуре GetPlayerMove нет описания процедуры SHOWFIELD. Сделано это не случайно: процедура ShowField может понадобиться также и при реализации процедуры SetOwnerMove, поэтому она должна быть глобальной по отношению и к GetPlayerMove, и к SetOwnerMove, т.е. ее описание должно в тексте программы предшествовать описаниям двух использующих ее процедур.

Действия

{ Сообщить игроку правила ввода хода } ,

{ Пригласить игрока ввести ход } 

и

{Проверить правильность хода и установить нужное значение переменной Correctly. Если ход правильный, сделать нужные изменения в раскладке фишек и показать поле.}

не очень сложны в реализации, поэтому их можно осуществить непосредственно в теле процедуры GETPLAYERMOVE. Иное дело - изменение условий игры. Это действие полезно реализовать в отдельной процедуре GETCHANGE. С учетом этого второй вариант процедуры GETPLAYERMOVE примет такой вид:

Procedure GetPlayerMove;

{Получает, контролирует и отображает ход игрока}  

const

ТЕХТ1 = 'Введите Ваш ход в формате РЯД КОЛИЧ ';

ТЕХТ01= ' (например, 2 3- взять из 2 ряда 3 фишки) ' ;

ТЕХТ2 = 'или введите 0 0 для выхода из игры; ' ; . 

ТЕХТ02= '-1 0 для настройки игры';

ТЕХТЗ = 'Ваш ход:                            ';

Y = 20; {Номер строки для вывода сообщений} 

var

correctly : Boolean; {Признак правильности сделанного хода}

xl,x2 : Integer; {Вводимый ход}

{-----------------}

Procedure GetChange;

{Устанавливает новую настройку игры (количество рядов и количество фишек в каждом ряду}  

begin {GetChange} 

end; {GetChange}

{-----------------}

begin {GetPlayerMove}

ShowField; {Показываем начальное состояние поля}

{Сообщить игроку правила ввода хода:}

GotoXY((80-Length(TEXT1+TEXT01)) div2,Y);

Write(TEXT1+TEXT01);

GotoXY((80-Length(TEXT2+TEXT02)) div2,Y+l);

Write(TEXT2+TEXT02);

repeat

{Пригласить игрока ввести ход:}

GotoXY(l,Y+2);

Write(TEXTS); {Выводим приглашение и стираем предыдущий ход}

GotoXY(WhereX-16,Y+2); {Курсор влево на 16 позиций}

ReadLn(xl,x2); {Вводим очередной ход} 

exit := xl=0; {Контроль команды выхода} 

change := xl=-l; {Контроль команды изменения}

 if not (exit or change) then 

begin

correctly := (xl > 0) and (xl <= nrow) and (x2 <= col[xl]) and (x2 > 0) ; 

if correctly then

begin {Ход правильный:}

col[xl] := col[xl]-x2; {Изменяем раскладку фишек} 

ShowField {Показываем поле} 

end 

else

Write(#7) {Ход неправильный: дать звуковой сигнал} 

end 

else

correctly := true {Случай EXIT или CHANGE} 

until correctly; 

if change then

GetChange end; {GetPlayerMove}

Обратите внимание: константа

ТЕХТЗ = 'Ваш ход:

имеет длинный «хвост» из пробелов (их 17), поэтому после вывода этого приглашения курсор возвращается влево на 16 позиций оператором

GotoXY(WhereX-16,Y+2); {курсор влево на 16 позиций}

(функция WHEREX возвращает текущую горизонтальную координату курсора, а функция WHEREY - его вертикальную координату). Сделано это для того, чтобы в случае, если игрок ввел неверный ход и программа повторяет вывод приглашения, пробелы в константе ТЕХТЗ затерли бы строку предыдущего ввода.

Чтобы завершить создание процедуры GETPLAYERMOVE, нужно спроектировать процедуру GETCHANGE, в которой осуществляется изменение условий игры. Я привожу текст этой процедуры без пояснений и приглашаю Вас самостоятельно разобраться в том, как она работает:

Procedure GetChange;

{Устанавливает новую настройку игры (количество рядов и количество фишек в каждом ряду} 

const

tl='HACTPOЙKA ИГРЫ';

t2 ='(ввод количества рядов и количества '+'фишек в каждом ряду)'; 

var

correctly : Boolean;

i : Integer; begin {GetChange}

ClrScr;

GotoXY( (80 -Length (tl) ) div2,l);

Write(tl) ;

GotoXY( (80 -Length (t2) ) div2,2);

Write (t2);

repeat

GotoXYd, 3) ;

Write ( 'Введите количество рядов (максимум ', MAXROW, '):'); 

GotoXY(WhereX-6,WhereY) ; 

ReadLn (nrow) ;

correctly := (nrow <= MAXROW) and (nrow > 1) ; 

if not correctly then

Write (#7) 

until correctly; 

for i := 1 to nrow do 

repeat

GotoXY(l,i+3) ;

Write (' ряд ',i,', количество фишек (максимум ', MAXCOL , ' ) : ' ) ; 

GotoXY (WhereX - 6 , WhereY) ; 

ReadLn (ncol [i] ) ;

correctly := (ncol [i] <= MAXCOL) and (ncol[i] > 0) ; 

if not correctly then

Write (#7) 

until correctly 

end; {GetChange}

Переходим к конструированию процедуры SETOWNERMOVE, в которой программа должна проконтролировать текущую ситуацию на игровом поле и выбрать собственный ход. Работа процедуры начинается с подсчета числа непустых рядов. В зависимости от этого подсчета реализуются следующие действия:
  • если все ряды пусты, значит предыдущим ходом игрок забрал последнюю фишку и он победил; нужно поздравить его с победой, усложнить игру и предложить сыграть еще раз;
  • если есть только один непустой ряд, то очередной ход программы очевиден -забрать все фишки, что означает победу машины: сообщить об этом и предложить сыграть еще раз;
  • если осталось два или более непустых ряда, выбрать собственный ход на основе оптимальной стратегии. Начальный вариант процедуры:

Procedure SetOwnerMove;

{Находит и отображает очередной ход программы}

{-----------------}

Function CheckField : Integer;

{Проверяет состояния игры. Возвращает 0, если нет ни одной фишки (победа игрока) , 1 - есть один ряд (победа машины) и - количество непустых рядов в остальных случаях}

begin {CheckField} 

end; {CheckField}

{-----------------}

Procedure PlayerVictory;

{Поздравить игрока с победой и усложнить игру}

begin {PlayerVictory} 

end; {PlayerVictory}

{-----------------}

Procedure OwnVictory; 

{Победа машины} 

begin {OwnVictory} 

end; {OwnVictory}

{-----------------}

Procedure ChooseMove;

{Выбор очередного хода}  

begin {ChooseMove} 

end; {ChooseMove}

{-----------------}

begin {SetOwnerMove} 

case CheckField of {Проверяем количество непустых рядов} 

0 : PlayerVictory; {Все ряды пусты - победа игрока} 

1 : OwnVictory; {Один непустой ряд - победа машины} 

else

ChooseMove; {Выбираем очередной ход} 

end; {case}

end; {SetOwnerMove}

Функция CHECKFIELD и процедуры PLAYERVICTORY и OWNVICTORY достаточно просты и их текст помещается без каких-либо пояснений в окончательный вариант программы (см. прил.5.3). Отмечу лишь, что в случае победы игрока нет смысла повторять партию заново с той же самой раскладкой фишек. Поэтому игра усложняется: в исходную раскладку добавляется еще по одной фишке в каждый ряд.

В процедуре CHOOSEMOVE анализируется позиция и выбирается очередной ход программы. Описание оптимальной стратегии уже приводилось выше. Действия программы заключаются в поиске первого слева (старшего) двоичного разряда, для которого сумма чисел нечетная. Если такой разряд не обнаружен, то текущая позиция безопасна для игрока, а значит любой ход программы сделает ее опасной. В этом случае для программы не существует оптимального выбора и она лишь убирает одну фишку из любого непустого ряда. Такая тактика означает пассивное ожидание ошибки игрока.

Если обнаружен разряд i с нечетной суммой, программа приступает к реализации оптимальной стратегии и тогда игрок обречен на поражение. Для выбора ряда, из которого следует взять фишки, программа просматривает последовательно все ряды и отыскивает тот ряд j, количество фишек в котором (в двоичном представлении) дает единицу в разряде i. Значение этого разряда для количества фишек в ряду j заменяется нулем. Затем программа продолжает подсчет суммы для оставшихся младших разрядов. Если в каком-либо из них вновь обнаружена нечетность, значение этого разряда для количества фишек в рядуj инвертируется, т.е. 0 заменяется на 1, а 1 на 0. Например, если двоичные представления числа фишек и четности сумм таковы:

число фишек в ряду j: 01001 

четность сумм: 01011

(единицей указаны разряды с нечетными суммами), то в результате этой операции получим:

число фишек в ряду j: 00010 

четность сумм: 00000

Таким образом, в исходном состоянии в ряду j было 1001 =9 фишек, безопасная позиция требует, чтобы в ряду осталось 0010 = 2 фишки, следовательно, из него нужно забрать 9-2 = 7 фишек.

Окончательный вариант программы представлен в прил.5.3. Попробуйте разобраться в ее деталях самостоятельно.

В программной реализации алгоритма широко используется то обстоятельство, что Ваш компьютер, как и все остальные вычислительные машины, работает с числами, представленными в двоичной системе счисления. Поэтому для получения двоичного представления числа в процедуре BITFORM оно проверяется на четность с помощью стандартной функции ODD, затем сдвигается вправо на один двоичный разряд (операция SHR), вновь осуществляется проверка на четность и т.д. до тех пор, пока не будут проверены все разряды. Максимальное число двоичных разрядов, достаточное для двоичного представления количества фишек в ряду MAXCOL=63, задается константой ВIТ=6.

Для получения суммы двоичных разрядов в процедуре CHOOSEMOVE используется суммирование разрядов по модулю 2 с помощью операции XOR. Такое суммирование дает 0, если количество единиц четное или равно нулю, и 1 - если нечетное. В этой же процедуре для инверсии двоичного разряда применяется оператор

if nbit[i] = 1 then

ncbit[j,i] := ord(ncbit[j,i]=0); {Инверсия разрядов},

в котором используется соглашение о внутреннем представлении логических величин в Турбо Паскале: 0 соответствует FALSE, а 1 - TRUE.

 

Тнексты программ
  • Программа определения дня недели
  • Определение биоритмов
  • Игра НИМ
  • Программа NOTEBOOK

 

Программа определения дня недели

{Эта программа вводит дату в формате ДЦ ММ ГГГГ к выводит на экран соответствующий этой дате день недели. Описание программы см. п. 2. 7.1.} 

var

IsCorrectDate: Boolean; {Признак правильной даты}

d,m,y : Integer; {Вводимая дата - день, месяц и год}

{---------------}

Procedure InputDate (var d,m,y : Integer; var correctly : Boolean); 

{Вводит в переменные d, m и у очередную дату и проверяет ее. Если дата правильная, устанавливает correctly=true, иначе correctly= false } 

begin {InputDate}

Write ( 'Введите дату в формате ДД ММ ГГГГ: ');

ReadLn(d,m,y) ;

correctly := (d>=l) and (d<=31) and (m>=l)

and (m<=12) and (y>=1582) and (y<=4903) 

end; {InputDate}

{----------------}

Procedure WriteDay (d,m,y : Integer) ; 

const

Days_of_week : array [0..6] of String [11] =

( ' воскресенье ' , ' понедельник ' , ' вторник ' ,

' среда ' , ' четверг ' , ' пятница ' , ' суббота ' ) ; 

var

с, w : Integer; 

begin

if m < 3 then

begin {Месяц январь или февраль} 

m := m + 10; 

у := у - 1 

end 

else

m := m - 2; {Остальные месяцы} 

с := у div 100; {Вычисляем столетие} 

y := y mod 100; {Находим год в столетии} 

w := abs(trunc(2.6*m-0.2)+d+y div 4+y+c div 4-2*c) mod 7; 

WriteLn (Days_of_week [w] ) 

end;

{------------}

begin 

repeat

InputDate (d,m,y, IsCorrectDate) ; 

if IsCorrectDate then 

WriteDay (d,m, у ) 

until not IsCorrectDate 

end.

 

Определение биоритмов

{Программа для определения физической, эмоциональной и интеллектуальной активности человека. Вводится дата рождения и текущая дата. Программа вычисляет и выводит на экран общее количество дней, часов, минут и секунд, разделяющих обе даты, а также прогнозирует на месяц вперед даты, соответствующие максимуму и минимуму биоритмов. Описание программы см. п. 2. 7. 2.} 

const

Size_of_Month: array [1..12] of Byte =

(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);

var

d0, d,{Дни рождения и текущий}

m0, m,{Месяцы рождения и текущий}

y0, y,{Годы рождения и текущий}

dmin,{Наименее благоприятный день}

dmax,{Наиболее благоприятный день}

days: Integer;{Количество дней от рождения}

{--------------------------}

Procedure InputDates(var d0,m0,y0,d,m,y : Integer);

{Вводит дату рождения и текущую дату. Контролирует правильность дат и их непротиворечивость(текущая дата должна быть позже даты рождения)}

var

correctly: Boolean; {Признак правильного ввода}

{-------------------}

Procedure InpDate(text: String; var d,m,y: Integer);

{Выводит приглашение TEXT, вводит дату в формате ДД ММ ГГГГ и проверяет ее правильность}

const

YMIN =1800; {Минимальный правильный год} 

YMAX =2000; {Максимальный правильный год} 

begin {InpDate} 

repeat

Write(text);

ReadLn(d,m,y);

correctly := (y >= YMIN) and (Y <= YMAX) and (m >= 1)

and (m <= 12) and (d > 0); 

if correctly then

if (m = 2) and (d = 29) and (y mod 4=0) 

then

{Ничего не делать: это 29 февраля високосного года!} 

else

correctly := d <= Size_of_Month[m]; 

if not correctly then

WriteLn('Ошибка в дате!') 

until correctly 

end; {InpDate}

{----------------}

begin {InputDates} 

repeat

InpDate('Введите дату рождения в формате ДД ММ ГГГГ:',d0,m0,y0); 

InpDate(' Введите текущую дату: ', d, m, у); 

{Проверяем непротиворечивость дат:}

correctly := у > у0; 

if not correctly and (y = y0) then 

begin

correctly := m > m0;

if not correctly and (m = m0) then

correctly := d >= d0 

end

until correctly 

end; {InputDates}

{-----------------} 

Procedure Get_number s_of_days (d0,m0, y0,d,m, у : Integer; var days: Integer); 

{Определение полного количества дней, прошедших от одной даты до другой }

{-------------------}

Procedure Variant2 ; 

{Подсчет количества дней в месяцах, разделяющих обе даты } 

var

mm : Integer; 

begin {Variant2}

mm : = m0 ;

while mm < m do

begin

days := days + Size_of_Month[mm] ; 

if (mm = 2) and (y0 mod 4=0) then

inc(days) ; 

inc (mm) 

end 

end; {Variant2}

{---------------}

Procedure Variant3 ;

{Подсчет количества дней в месяцах и годах, разделяющих обе даты} 

var

mm, yy : Integer; 

begin {variant3} 

mm := m0 + 1;

while mm <= 12 do {Учитываем остаток года рождения:} 

begin

days := days+Size_of_Month[mm] ;

if (mm = 2) and (yO mod 4=0) then

inc (days) ; 

inc (mm)

end;

yy := y0 + 1;

while yy < у do {Прибавляем разницу лет:} 

begin

days := days + 365; 

if yy mod 4=0 then

inc (days) ; 

inc (yy) 

end;

mm : = 1 ;

while mm < m do {Прибавляем начало текущего года:} 

begin

days := days + Size_of_Month[mm] ; 

if (y mod 4=0) and (mm = 2) then

inc (days) ; 

inc (mm) 

end 

end; {Variant3}

{--------------------}

begin {Get_numbers_of_days}

if (y = y0) and (m = m0) then {Даты отличаются только днями:} 

days := d - d0

else {Даты отличаются не только днями: } 

begin

days := d + Size_of_Month[m0] - d0;

{Учитываем количество дней в текущем месяце и количество дней до конца месяца рождения} 

if (y0 mod 4=0) and (m0 = 2) then

inc (days) ; {Учитываем високосный год} 

if у = y0 then

Variant2 {Разница в месяцах одного и того же года} 

else

Variant3 {Даты отличаются годами} 

end 

end; {Get_numbers_of_days}

{-------------------}

Procedure FindMaxMin(var dmin, dmax: Integer; days: Integer) ;

{Поиск критических дней} 

const

TF = 2*3.1416/23.6884; {Период физической активности} 

ТЕ = 2*3.1416/28.4261; {Период эмоциональной активности} 

TI = 2*3.1416/33.1638; {Период интеллектуальной активности}

INTERVAL = 30;{Интервал прогноза}

var

min,{Накапливает минимум биоритмов}

max,{Накапливает максимум биоритмов}

x : Real;{Текущее значение биоритмов} 

i : Integer; 

begin {FindMaxMin}

max := sin(days*TF)+sin(days*TE)+sin(days*TI);

min := max;