База Данных, pascal Опции

[Анна]

Создать компонентный файл реализующий базу данных "записная книжка", которая состоит из след. полей: имя, фамилия, отчество, дата рождения, город, улица, дом, квартира, телефон.
Программа должна обеспечивать вввод записи с клавиатуры, а также сортировки записи по полю (отсортированную базу сохранить в другом файле)
Сортировка по фамилии.

Вот что получилось:

Program Lab11;
uses	crt;
type
	base = record
		name, family, otchestvo, DofBr, city, street: string;
		dom, kvartira, telefon: integer;
	end;
var
	mas:array[1..20] of string;
	temp: string;
	mass: array[1..20] of base;
	filename: string;
	f: file of base;
	rf: file of base;
	i, j, k, g:integer;
	key: char;
	proverka:boolean;
begin
clrscr;
write('Введите имя исх файла: ');
readln(filename);
assign(f, filename);
write('Введите имя рез файла: ');
readln(filename);
assign(rf, filename);
rewrite(f);
g := 0;
repeat
g := g + 1;
write('Имя:');
readln(mass[g].name);
write('Фамилия:');
readln(mass[g].family);
write('Отчество:');
readln(mass[g].otchestvo);
write('Дата рождения:');
readln(mass[g].DofBr);
write('Город:');
readln(mass[g].city);
write('Улица:');
readln(mass[g].street);
write('Дом:');
readln(mass[g].dom);
write('Квартира:');
readln(mass[g].kvartira);
write('Телефон:');
readln(mass[g].telefon);
write(f, mass[g]);
writeln('Выход ESC');
writeln('Для продолжения нажмите любую клавишу');
key:=readkey;
if key=#27 then break;
until false;
close(f);

reset(f);
i:=0;
while not eof(f) do
begin
i:=i+1;
read(f, mass[i]);
mas[g]:=mass[i].family;
end;


{сортировка ...}


reset(rf);
g:=0;
clrscr;
while not eof(rf) do
begin
g:=g+1;
read(rf, mass[g]);
writeln(g,' элемент списка: ');
writeln('Имя:' ,mass[g].name);
writeln('Фамилия: ',mass[g].family);
writeln('Отчество: ',mass[g].otchestvo);
writeln('Дата рождения: ', mass[g].DofBr);
writeln('Город: ',mass[g].city);
writeln('Улица: ',mass[g].street);
writeln('Дом: ',mass[g].dom);
writeln('Квартира: ',mass[g].kvartira);
writeln('Телефон: ',mass[g].telefon);
writeln('Нажмите любую кнопку!');
readln;

end;
close(f);
end.

Не получается отсортировать, да и мне кажется, что моя программа слишком громоздкая .

[volvo]

Не получается отсортировать

Здесь была?
FAQ: Как упорядочить данные по возрастанию?

[volvo]

Анна, смотри аттач

[Анна]

To: volvo
Спасибо!
Просто у самой пока времени не было, не успела зайти по твоей ссылке на FAQ.

[Анна]

To: volvo
Выдаёт ошибку при открытии результирующего файла.

Исправила

begin
  clrscr;
  write('Введите имя исх файла: '); readln(filename);
  assign(f, filename); rewrite(f);
  write('Введите имя рез файла: '); readln(filename);
  assign(rf, filename); rewrite(rf);

Вместо rewrite(rf) было просто rewrite(f) ...


Ещё такой вопрос. В файле кириллица не отображается. Это исправить можно?
И можно ли дублировать вывод данных на экран? пробовала просто write (mass[g]) - ругается.

[volvo]

Анна, это - типизированный файл, а не текстовый... Чтобы его отобразить - надо прочитать его содержимое... Блокнот и ему подобные программы будут показывать неправильную информацию...

И можно ли дублировать вывод данных на экран?

Ну, для этого же специально я написал:

  for g := 1 to i do begin

    WriteInfo(mass[g]); { Это - на экран }
    write(rf, mass[g]);   { Это - в файл... }

  end;

[Анна]

Я имела ввиду уже отсортированные данные .

Сообщение отредактировано: Анна - 9.12.2005 15:34

[volvo]

Я тоже... Этот фрагмент идет после

QuickSort(mass, 1, i);

, значит данные уже отсортированы...

[Анна]

Всё, разобралась!

значит данные уже отсортированы...

Необязательно. Просто нужно было убрать

clrscr;

после

 QuickSort(mass, 1, i);

Он просто стирал с экрана отсортированные данные, я так поняла.

[volvo]

Анна, не путай... ClrScr стоит ПЕРЕД выводом на экран и в файл, т.е. ничего затирать физически не может (если, конечно, ты не подправляла программу... А уж если ты ее исправила, то извините, этот разговор вообще лишен смысла.)

[Анна]

To: volvo
Абсолютно ничего не исправляла. Попробуй сам убрать clrscr и проверить ...

[Анна]

Небольшие изменения:
Немного запуталась в программе...

Код

Program Lab11;
uses    crt;

const
  max = 30;
type
  base = record
    name, family, otchestvo, data, city, street: string[50];
    dom, kv, tel: integer;
  end;
  List = array[1 .. max] of base;


procedure ReadInfo(var r: base);
begin

    write('Имя:');           readln(r.name);
    write('Фамилия:');       readln(r.family);
    write('Отчество:');      readln(r.otchestvo);
    write('Дата рождения:'); readln(r.data);
    write('Город:');         readln(r.city);
    write('Улица:');         readln(r.street);
    write('Дом:');           readln(r.dom);
    write('Квартира:');      readln(r.kv);
    write('Телефон:');       readln(r.tel);
end;

procedure WriteInfo(r: base);
begin
    writeln('Имя: ' ,           r.name);
    writeln('Фамилия: ',       r.family);
    writeln('Отчество: ',      r.otchestvo);
    writeln('Дата рождения: ', r.data);
    writeln('Город: ',         r.city);
    writeln('Улица: ',         r.street);
    writeln('Дом: ',           r.dom);
    writeln('Квартира: ',      r.kv);
    writeln('Телефон: ',       r.tel);
end;



{Если длина строки 1 больше длины 2 строки, то сдвигаем 1 строку вперёд на 1 ? и т.п.}
function Compare (T1, T2: base): integer;
begin
    if length (T1.family) > length (T2.family) then Compare := 1
    else if length (T1.family) = length (T2.family) then Compare := 0
    else Compare := -1
end;


{А дальше я совсем запуталась ...}
procedure QuickSort (var A: List; Lo, Hi: Integer);
var
i,j: integer;
x, y: base;

procedure Sort (l, r: Integer);
begin
  repeat
    x := A[(l+r) shr 1];
    i := l; j := r;
    repeat
      while Compare( A[i], x ) < 0 do inc(i);
      while Compare( A[j], x ) > 0 do dec(j);
      if i <= j then begin

        y := A[i]; A[i] := A[j]; A[j] := y;
        inc(i); dec(j);

      end;
    until i > j;

    if l < j then Sort (l, j);
    l := i;
  until l >= r;
end;

begin
  Sort (Lo,Hi);
end;


var
  mass: List;
  filename: string;
  f, rf: file of base;
  i, j, k, g:integer;
  key: char;
  proverka:boolean;

begin
  clrscr;
  write('Введите имя исх файла: '); readln(filename);
  assign(f, filename); rewrite(f);
  write('Введите имя рез файла: '); readln(filename);
  assign(rf, filename); rewrite(rf);

  g := 0;
  repeat

    inc(g);
    ReadInfo(mass[g]);
    write(f, mass[g]);

    writeln('Выход ESC');
    writeln('Для продолжения нажмите любую клавишу');
    writeln;
    key := readkey;

  until key = #27;

  reset(f);
  i := 0;
  while not eof(f) do begin
    inc(i);
    read(f, mass[i]);
  end;


  {сортировка ...}
  QuickSort(mass, 1, i);


{  clrscr;}
writeln('Отcортированные данные: ');
  for g := 1 to i do begin

    writeln;
    WriteInfo(mass[g]);
    write(rf, mass[g]);

  end;
  writeln;
  writeln('Нажмите любую кнопку!');
  readln;

  close(rf);
  close(f);
end.

Сообщение отредактировано: Анна - 11.12.2005 15:45

[volvo]

Анна,
погоди, а почему ты делаешь так:

{ Если длина строки 1 больше длины 2 строки,
  то сдвигаем 1 строку вперёд на 1 ? и т.п. }
function Compare (T1, T2: base): integer;
begin
    if length (T1.family) > length (T2.family) then Compare := 1
    else if length (T1.family) = length (T2.family) then Compare := 0
    else Compare := -1
end;

?
Ты не длины строк должна сравнивать, чтобы отсортировать базу по фамилиям (по алфавиту), а сами строки... Или задание поменялось? Если функцию Compare оставить в таком виде, то например при фамилиях
Иванова, Петров, Сидорова
они будут отсортированы так:
Петров, Иванова, Сидорова
хотя правильно было бы (по алфавиту) - так, как они перечислены в начале...

[Анна]

volvo, ага, всё поняла ..

Вот мой метод сортировки (пузырьком):

Program Lab11;
uses
	crt;
type
	base = record
		name, family, otchestvo, DofBr, city, street: string[20];
		dom, kvartira, telefon: integer;
	end;
var
	temp: base;
	mass: array[1..20] of base;
	filename: string;
	f: file of base;
	rf: file of base;
	i, j, g:integer;
	key: char;
begin
 clrscr;
 write('Введите имя исх файла: '); readln(filename); assign(f, filename);
 write('Введите имя рез файла: '); readln(filename); assign(rf, filename);
 rewrite(f);
 g := 0;
repeat
 inc(g);

with mass[g] do begin

 write('Имя:');
 readln(name);
 write('Фамилия:');
 readln(family);
 write('Отчество:');
 readln(otchestvo);
 write('Дата рождения:');
 readln(DofBr);
 write('Город:');
 readln(city);
 write('Улица:');
 readln(street);
 write('Дом:');
 readln(dom);
 write('Квартира:');
 readln(kvartira);
 write('Телефон:');
 readln(telefon);
 write(f, mass[g]);
 writeln('Выход ESC');
 writeln('Для продолжения нажмите любую клавишу');
 key:=readkey;
end;
if key=#27 then break;
until false;
 close(f);

for i:=2 to g do
for j:=g downto i do
if ord(mass[j-1].family[1])>ord(mass[j].family[1]) then begin
 temp:=mass[j-1];
 mass[j-1]:=mass[j];
 mass[j]:=temp;
end;

 rewrite(rf);
 i:=0;
repeat
 inc(i);
 write(rf, mass[i]);
until i=(g+1);
 close(rf);


 reset(rf);

 clrscr;
for i:=1 to g do begin
 read(rf,mass[g]);
 writeln(i,' элемент списка: ');

with mass[g] do begin

 writeln('Имя:' ,name);
 writeln('Фамилия: ',family);
 writeln('Отчество: ',otchestvo);
 writeln('Дата рождения: ',DofBr);
 writeln('Город: ',city);
 writeln('Улица: ',street);
 writeln('Дом: ',dom);
 writeln('Квартира: ',kvartira);
 writeln('Телефон: ',telefon);
 readln;
end;

end;
 close(rf);
end.

Можете мне как бы попонятней объяснить вот этот кусок программы (просто смотрела по учебнику, поняла неочень ):

for i:=2 to g do
for j:=g downto i do
if ord(mass[j-1].family[1])>ord(mass[j].family[1]) then begin
 temp:=mass[j-1];
 mass[j-1]:=mass[j];
 mass[j]:=temp;
end;

 rewrite(rf); {создаём вх. файл}
 i:=0; {обнул. счётчик}
repeat {запуск цикла ..}
 inc(i); {увел. на 1 .. , двигаемся ..}
 write(rf, mass[i]); {запись в файл данных}
until i=(g+1); {пока .. как этло сказать правильно?}
 close(rf);{закр. файл}

[volvo]

{
  Ну, это и есть реализация метода пузырька -
  посимвольное сравнение строк, и при нахождении символа, стоЯщего
  "не на своем месте", обмен записей местами
}
for i:=2 to g do
  for j:=g downto i do
    { сравнение очередных букв фамилии }
    if ord(mass[j-1].family[1])>ord(mass[j].family[1]) then begin
      { Сам обмен записей }
      temp:=mass[j-1]; mass[j-1]:=mass[j]; mass[j]:=temp;
    end;

rewrite(rf); { создаём _выходной_ файл}

i:=0; { обнул. счётчик }

repeat { запуск цикла .. }
  inc(i); { нахождение следующего индекса для записи в файл }
  write(rf, mass[ i ]); { запись в файл данных }
until i = (g+1); 
{ 
  пока очередной индекс не превысит количество записей,
  т.е. все записи уже записаны в файл - пора заканчивать цикл
}
close(rf); { закр. файл }

P.S. Пузырек - ОЧЕНЬ медленный способ сортировки...

Кстати, опять же вопрос - что будет, если заданы такие данные:
Соколов, Смирнов, Семенов
?
Что будет после того, как отработает твой алгоритм?

[Анна]

volvo, поставил в тупик. Но нам сказали делать пузырьком или другими методами, которые мы проходили, сортировка вставками, выбором элементов, раздления ... а такой сортировки, какую представил ты, мы не проходили
Сейчас ещё попробуй другими методами сделать ..

[volvo]

for i:=2 to g do
  for j:=g downto i do
    { сравнение фамилий }
    if mass[j-1].family > mass[j].family then begin
      { Сам обмен записей }
      temp:=mass[j-1]; mass[j-1]:=mass[j]; mass[j]:=temp;
    end;

А вот это какой метод по-твоему? Не пузырек? Но это будет нормально сортировать, т.к. сравниваются не только первые, но и все остальные символы

[Анна]

volvo, не поверишь, сама сейчас до этого догадалась .. думаю, зачем эта единица нужна ...
PS Всё-таки, ещё хочу попробовать сделать другими методами ...

[Анна]

ну что я могу сказать ...
да вот:

for i:=1 to g-1 do begin
R:=I;

for j:=i+1 to g do

if mass[R].family > mass[j].family then begin
 temp:=mass[R];
 mass[R]:=mass[j];
 mass[j]:=temp;
end;   end;

Метод простого выбора, аднака

[Анна]

end;
reset(vf);
.......

 close(rf);

end.

Как сделать, чтоб после сортировки, на экран выводилось определённое поле записи, к примеру отчество из второй записи ..