Консультация № 177587
01.04.2010, 03:16
0.00 руб.
0 12 1
Доброй ночи,уважаемые эксперты,помогите пожалуйста вот с такой задачей:
Задание:
Определите запись для хранения информации об адресе проживания: название улицы, номер дома, номер квартиры, этаж.
Напишите
– процедуру вывода одной записи print,
– процедуру вывода массива записей print1,
– процедуру ввода массива записей enter,
– процедуру, определяющую запись с наибольшим номером квартиры среди всех адресов населённого пункта (соответствующая запись должна быть выходным параметром процедуры),
– процедуру формирования по заданному массиву записей нового массива, содержащего адреса с названием заданной улицы,
– функцию, определяющую количество жителей первого этажа,
– процедуру сортировки массива записей по каждому полю записи.
Напишите клиентскую программу, содержащую вызов всех процедур и функций

Обсуждение

Неизвестный
01.04.2010, 10:59
общий
А все данные как хранить? В виде массива заданного размера, массива с размером, который можно менять (это будет массив, размещенный в динамически подключаемой памяти), список (их тоже есть несколько видов)?
Неизвестный
01.04.2010, 22:36
общий
Boriss:
Boriss, добрый вечер!Я немного не пойму вашего вопроса....(просто меня на этой теме не было...)
Неизвестный
01.04.2010, 23:00
общий
Как Вам велено сохранять информацию? В виде чего?
Неизвестный
02.04.2010, 13:03
общий
Например:
Код:
Type
OneInfo = record
Street: String[10];
House : String[5]; {Могут быть а, б ...}
Room : Integer;
Level : Integer;
end;

Unlimit = Array[1..1] of OneInfo;
PUnlimit = ^Unlimit;

CONST
max_Infos = 100;

VAR
Info: Array[1..max_Infos] of OneInfo; {Массив фиксированной длины}

Unlim: PUnlimit; {Массив, длину которой можно задать во время
выполнения программы}

Использование структур здесь не показываю, по-видимому, рано еще
давно
Мастер-Эксперт
319965
1463
03.04.2010, 21:35
общий
angel.nero:
Я немного не пойму вашего вопроса....(просто меня на этой теме не было...)


Мысль интересная. Именно поэтому желания что-то сделать не возникает (вам представят программу и окажется что это совсем не то, что нужно). Неужели нельзя спросить у преподавателя или у одногрупников?
Неизвестный
04.04.2010, 00:16
общий
star9491:
Просто он имеет в виду, что ранее задавал вопросы в других рассылках (видел его с элементарными задачами по физике), но с Вашим замечанием согласен на 100%
Неизвестный
05.04.2010, 17:05
общий
это ответ
Здравствуйте, angel.nero.
Вот в приложении код программы, которая решает Ваше задание. Плохо, что Вы не отвечали на мои уточняющие вопросы. Поэтому сделал так, как понял.
Что непонятно или не так сделано - пишите. Покумекаем и исправим
А также исходный код, доступный для скачивания: исходный код

И самое главное: программа написана в Borland Pascal в д..рацком ABCpascal работать не будет - там не поддерживаются типизированные файлы. По крайней мере, в той версии, которая есть у меня

Приложение:
uses CRT;
const
len_street = 10;
len_house = 5;
Type
OneInfo = record
Street: String[len_street];
House : String[len_house]; {Может быть кроме номера еще и корпус: а, б ...}
Room : Integer;
Level : Integer;
end;

CONST
max_Infos = 100;
dat_fileName = '177587.dat'; {Файл для хранения записей}

VAR
{Для хранения используем массив фиксированной длины в 100 записей}
Info: Array[1..max_Infos] of OneInfo;
Streets: Array[1..max_Infos] of OneInfo;
count: Integer; {Число записей в базе данных}
count_streetS: Integer; {Число улиц}
changed: Boolean; {были ли изменения списка}

function UpRuss(s: String): String;
{Преобразование строки в состоящую из заглавных букв.
Нужна для правильного сравнения}
var i, len: Integer;
begin
len := length(s);
for i:=1 to len do
Case s[i] of
'a'..'z': s[i] := UpCase(s[i]);
'а'..'п': s[i] := chr(ord(s[i]) - 32);
'р'..'я': s[i] := chr(ord(s[i]) - 80);
end;
UpRuss := s
end;

procedure ReadFromFile;
var
f : file of OneInfo;
c : Integer;
o : OneInfo;
begin
Assign(f, dat_fileName);
{$I-} Reset(f); {$I+}
if IOResult <> 0 then begin
WriteLn('Считывание информации невозможно: файл ',dat_fileName,' не найден');
WriteLn(' Нажмите любую клавишу');
ReadKey;
Exit; {Немедленный вывход из подпрограммы}
end;
WriteLn('Добавление информации из файла ', dat_fileName);
if count = max_Infos then
WriteLn('Список полон - нельзя добавить информацию')
else
begin
c:= 0;
while (c + count + 1< max_Infos) and (NOT EOF(f)) do
begin
Read(f, Info[c + count + 1]);
inc(c);
end;
WriteLn('Добавлено записей: ',c);
if count <> 0 then changed := True;
count := count + c;
end;
WriteLn(' Нажмите любую клавишу');
ReadKey;
Close(f);
end;

procedure SaveToFile;
{сохранение списка в файл}
var
f: file of OneInfo;
i: Integer;
begin
if count = 0 then
WriteLn('Списк пуст, нечего сохранять')
else
begin
WriteLn('Сохранение информации в файл');
Assign(f, dat_fileName);
{Сначала проверим, есть ли такой}
{$I-} Reset(f); {$I+}
if IOResult = 0 then
begin
Close(f);
WriteLn('Файл с именем ',dat_fileName,' уже имеется');
WriteLn('Если не хотите изменить файл, нажмите 1');
WriteLn(' После нажатия любой друго клавиши старая информаиця дудет удалена');
if ReadKey = '1' then
Exit; {Немедленный выход ничего не делая}
{В принципе, можно и дописать в конец, но тут возможна
ситация, когда запишешь больше чем сможешь прочиитать
(количество считываемого ограничено)}
end;
Rewrite(f);
for i:=1 to count do
Write(f, Info[i]);
Close(f);
WriteLn('Добавлено записей: ', count)
end;
changed := false;
WriteLn(' Для продолжения работы нажмите любую клавишу');
ReadKey
end;

procedure Print(no: Integer);
{Вывод одной записи с заданным номером}
begin
if (no > 0) and (no <= count) then {элементарная проверка}
WriteLn(no:4,') ', Info[no].Street:len_street,' ',
Info[no].House:len_house,' ',
Info[no].Room:5,' ',Info[no].Level:5);
end;

procedure Print1;
{Вывод всего списка}
var i: integer;
begin
if count =0 then
WriteLn('Список пуст')
else
begin
WriteLn('номер Улица дом квартира этаж');
for i:=1 to count do Print(i);
end;
WriteLn(' Для продолжения работы нажмите любую клавишу');
ReadKey
end;

procedure Enter;
{Заполнение массива}
var c: Integer;
s: String;
begin
ClrScr;
c := 0;
WriteLn('Заполнение массива. Для завершения введите пустое название улицы');
while ( c + count < 100) do begin
Write('Введите название улицы: '); ReadLn(s);
if s = '' then Break; {Немедленный выход из цикла}
inc(c);
Info[count + c].Street := Copy(s, 1, len_street);
{Не более len_street букв в названии}
Write('Введите номер дома: '); ReadLn(s);
Info[count + c].House := Copy(s, 1, len_house);
Write('Введите номер квартиры: ');
ReadLn(Info[count+ c].Room);
Write('Введите этаж: ');
ReadLn(Info[count + c].Level);
WriteLn;
end;
count := count + c;
WriteLn('Добавлено новых записей: ',c,'. Всего в списке записей: ', count);
changed := true;

WriteLn(' Для продолжения работы нажмите любую клавишу');
ReadKey
end;

procedure MaxRoomNumber;
{Поиск квартиры с наибольшим номером}
var
i, max_no, max_no_count: Integer;
begin
if count = 0 then
WriteLn('Список пуст')
else
begin
max_no := 1;
max_no_count := 1; {число квартир с наибольшим. По крайней мере одна есть}
for i:= 2 to count do
if Info[i].Room > Info[max_no].Room then
begin
max_no_count := 1;
max_no := i
end
else
if Info[i].Room = Info[max_no].Room then
inc(max_no_count);
end;
WriteLn('Максимальный номер квартиры: ',Info[max_no].Room,
' Количество квартир с таким номером: ', max_no_count);

WriteLn(' Для продолжения работы нажмите любую клавишу');
ReadKey
end;

procedure FirstLevelPopulation;
var
i, population: Word;
begin
if count = 0 then
WriteLn('Список пуст')
else
begin
population := 0;
for i:=1 to count do
if Info[i].Level = 1 then inc(population);
if population = 0 then
WriteLn('На первом этаже никто не живет')
else
WriteLn('Количество квартир на первом этаже: ', population);
end;

WriteLn(' Для продолжения работы нажмите любую клавишу');
ReadKey
end;

procedure DoStreet;
var
newStreet: String;
i: Integer;
begin
if count = 0 then
WriteLn('Список пуст')
else
begin
Write('Введите название улицы: '); ReadLn(newStreet);
newStreet := Copy(newStreet, 1, len_street);
count_streets := 0;
for i:=1 to count do
if UpRuss(Info[i].Street) = UpRuss(newStreet) then
begin
inc(count_streets);
Streets[count_streets] := Info[i];
end;
if count_streets = 0 then
WriteLn('Такой улицы ',newStreet,' нет в списке')
else
begin
WriteLn('Список адресов на улице ', newStreet);
for i:=1 to count_streets do
WriteLn(i:3,') ', Streets[i].Street:len_Street,' ',
Streets[i].House:len_house,' ',
Streets[i].Room:5,' ', Streets[i].Level:5);
end;
end;
WriteLn(' Для продолжения работы нажмите любую клавишу');
ReadKey
end;

procedure Sort;
var
temp: OneInfo;
i, j, min_no: Integer;
{термин "одна процедура сортировки по каждому" понимаю как сортировка
сначала по первому,
потом при равных первых полях по второму полю и т.д.
По четвертому полю сортировать бесполезно - просто глупость одна квартира на
нескольких этажах. Бывают многоэтажные, но адрес у них один - я так думаю.
Если не так нужно, напишите}
begin
if count = 0 then WriteLn('Список пуст')
else
begin
WriteLn('Сортировка массива');
Write('По первому полю');
{Сначала все по первому полю}
for i:=1 to count-1 do
for j := i+1 to count do
if UpRuss(Info[i].Street) > UpRuss(Info[j].Street) then
{UpRuss, чтоб сортировать без учета регистра
Сотрировка - пузырьковая}
begin
temp := Info[i];
Info[i]:= Info[j];
Info[j]:= temp
end;
WriteLn(' закончена');
Write('По второму полю ');
{Теперь по второму полю - сортировка вставкой}
i:=1;
while i < count do
begin
if UpRuss(Info[i].Street) = UpRuss(Info[i+1].Street) then
{если ли вообще равные по первому}
begin
{ищем среди равных по первому полю минимальный
по второму полю}
j:=i+1;
min_no := i;
while UpRuss(Info[i].Street) = UpRuss(Info[j].Street) do
begin
if UpRuss(Info[j].House) < UpRuss(Info[min_no].House) then
min_no := j;
inc(j)
end;
{Нашли минимальный вставили}
if min_no <> i then
begin
temp := Info[i];
Info[i] := Info[min_no];
Info[min_no] := temp
end;
end;
inc(i) {здесь можно немного оптимизировать - если надо, то помогу}
end;
WriteLn(' закончена');

{Проход по третьему полю}
Write('Сортировка по третьему полю');
i :=1;
while i < count do
begin
if (UpRuss(Info[i].Street) = UpRuss(Info[i+1].Street))
and (UpRuss(Info[i].House) = UpRuss(Info[i+1].House)) then
{если ли вообще равные по первому, второму?}
begin
{Опять метод вставки}
j:=i+1;
min_no := i;
while (UpRuss(Info[i].Street) = UpRuss(Info[j].Street))
and (UpRuss(Info[i].House) = UpRuss(Info[i+1].House)) do
begin
if Info[j].Room < Info[min_no].Room then
min_no := j;
inc(j)
end;
if min_no <> i then
begin
temp := Info[i];
Info[i] := Info[min_no];
Info[min_no] := temp
end;
end;
inc(i)
end;
WriteLn(' закончена');

end;
WriteLn(' Для продолжения работы нажмите любую клавишу');
ReadKey
end;

procedure Menu;
var selection: Char;
begin
repeat
ClrScr;
WriteLn('Выберите действие:');
WriteLn(' 1 - Вывод всего списка');
WriteLn(' 2 - Ввод (добавление) инфомации');
WriteLn(' 3 - Очистка базы');
WriteLn(' 4 - Поиск наибольшего номера квартиры');
WriteLn(' 5 - Количество жителей первого этажа');
WriteLn(' 6 - Сформировать список для улицы');
WriteLn(' 7 - Сортировать список');
WriteLn(' 8 - Сохранить список в файл');
WriteLn(' 9 - Ввести информацию из файла');
WriteLn(' 0 - Выход (окончание работы)');
WriteLn;
WriteLn('Информация: в списке ',count,' записей');

selection:=ReadKey;
case selection of
'1': Print1;
'2': Enter;
'3': count := 0;
'4': MaxRoomNumber;
'5': FirstLevelPopulation;
'6': DoStreet;
'7': Sort;
'8': SaveToFile;
'9': ReadFromFile;
'0', #27: Exit; {Дополнительное прекращение работы по нажатию Esc}
end
until selection = '0';
end;

BEGIN
count := 0;
count_streetS := 0;
changed := False;

Menu;
if changed then begin
WriteLn('Список изменен. Сохранить в файл? (Y/N)');
Case ReadKey of
'Y','y','Н','н', #13: SaveToFile;
{и Enter}
end;
end;
END.
Неизвестный
19.04.2010, 03:01
общий
Boriss:
Доброй ночи,уважаемый Boriss!!!!
Вы простите меня пожалуйста что раньше не отвечал на ваши вопросы и не уточнял(были проблемки...)
узнал у одногруппников,вот в таком стиле или типа этого требует препод:


Определите запись для хранения информации о дереве: название, возраст (в годах), высота в метрах и сантиметрах.
Напишите
– процедуру вывода одной записи print,
– процедуру вывода массива записей print1,
– процедуру ввода массива записей enter,
– функцию нахождения среднего возраста деревьев,
–процедуру формирования по заданному массиву записей нового массива, содержащего сведения о тех деревьях парка, высота которых больше заданного значения,
–процедуру, определяющую запись с наибольшим возрастом (соответствующая запись должна быть выходным параметром процедуры),
– процедуру сортировки массива записей по каждому полю записи.
Напишите клиентскую программу, содержащую вызов всех процедур и функций.

const
nm = 100;

type
derevo = record
name: string[20];
age: integer;
dlina: real;
end;
tkey = (kname, kage, kdlina);
base = array [1..nm] of derevo;

var
b, a: base;
y, m, k, n: integer;
key: tkey;
ssmax: derevo;

procedure enter(var n: integer; var a: base);//Процедура ввода
var
i, age, dlina: integer;
name: string;
begin
writeln('Ввод бвзы данных');
writeln('№', 1);
writeln('Название дерева:');
readln(a[1].name);
n := 1;
while a[n].name <> '*' do
begin

writeln('Возраст');
readln(a[n].age);
writeln('Высота');
readln(a[n].dlina);
writeln;
n := n + 1;
writeln('Название дерева:');
readln(a[n].name);
end;
n := n - 1;
end;


procedure print(const z: derevo);
var
i: integer;
begin
write(z.name);
for i := length(z.name) + 1 to 20 do
write(' ');
with a do
writeln('Название - ', z.name, ';', 'Возраст - ', z.age, ';', 'Высота - ', z.dlina);
end;


procedure print1(n: integer; const a: base);//Процедура вовода всех записей
var
i: integer;
begin
for i := 1 to n do
print(a[i]);
end;

procedure maxi(n: integer; y: integer; const a: base; var b: base; var m: integer);//Процедура формирования массива из деревьев возраст которых больше У
var
i: integer;
begin
m := 0;
for i := 1 to n do
if a[i].dlina > y then
begin
m := m + 1;
b[m] := a[i];
end;
end;

procedure samax(n: integer; a: base; var k: integer; var smax: derevo) ;//Процедура нахождения самого старого дерева
var
i: integer;
begin
smax := a[1];
for i := 2 to n do
if a[i].age > smax.age then
begin
smax := a[i];
end;
end;

function sred(const a: base; n: integer): real;// Функция нахождения ыреднего возраста деревьев
var
i: integer;
s: real;
begin
s := 0;
for i := 1 to n do
s := s + a[i].age;
sred := s / n;
end;

procedure sort(var a: base; n: integer; key: tkey);//Процедура сртироки массива записей по каждому полю
var
i, j: integer;
t: boolean;
x: derevo;
begin
for i := n downto 2 do
for j := 1 to i - 1 do
begin
case key of
kname: t := a[j].name > a[j + 1].name;
kage: t := a[j].age > a[j + 1].age;
kdlina: t := a[j].dlina > a[j + 1].dlina;
end;
if t then
begin
x := a[j];
a[j] := a[j + 1];
a[j + 1] := x;
end;
end;
end;

begin//основная программа
enter(n, a);
writeln('Информация по всем деревьям:');
print1(n, a);
writeln('Ведите высоту дерева');
readln(y);
writeln('Информация о деревьях парка, высота которых больше - ', y);
writeln;
maxi(n, y, a, b, m);
print1(m, b);
writeln;
writeln('Cамое старое дерево');
writeln;
samax(n, a, k, ssmax);
print(ssmax);
writeln('----------------------------------------------------------');
writeln;
writeln('Cортировка массива записей по каждому полю записей');
writeln;
for key := kname to kdlina do
begin
sort(a, n, key);
writeln('Сортировка по - ', key );
print1(n, a);
end;
writeln;
writeln('Средний возраст деревьев = ', sred(a, n), 'лет');
end.
Неизвестный
19.04.2010, 03:02
общий
Boriss:
Помогите пожалуйста!
Неизвестный
19.04.2010, 07:40
общий
И что надо сделать? Что не так в приведенном Вами коде?
Неизвестный
19.04.2010, 07:40
общий
То есть, и "ту" программу так переделать?
Неизвестный
19.04.2010, 13:33
общий
Boriss:
ага,если можно

простите, что отнимаю ваше драгоценное время!
Форма ответа