Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ Динамические структуры (Очередь)

Автор: Ametist 9.05.2008 11:41

Задание таково. Даны детские сады (наименовани, номер, кол-во детей, район, плата). Нужно последовательно сделать такие операции (насколько я понял для каждой нужна своя процедурка).
1) Записать данные в файл. (Написано, работает)
2) Считать из этого файла в очередь. (Написано, но не знаю правильно или нет, так как не знаю как проверить)
3) Из очереди считать в массив. (Не соображу как подскажите?)
4) Отсортировать массив в зависимости от ключа сортировки. (Готово, работает)
5) Записать отсортированные данные в отдельный файл. (Готово, работает)


Program Lab1;
uses crt;
type
det_ptr=^tdetsad;
Tdetsad = record
name: string;
number: integer;
child: integer;
rayon: string;
plata: integer;
next:det_ptr;
End;
TArDetsad = array [1..100] of Tdetsad;
Var
cur:det_ptr; i:integer;
f,ff:text;
Detsad: TArDetsad;
Kol: integer;


procedure vvod (var A:TArDetsad);
Var
i:byte;
Begin
Assign(f,'C:\lab.txt');
Rewrite(f);
For i:=1 to kol do
Begin
Writeln('vvedite nazvanie', i ,':'); Readln(A[i].name); Writeln(f,A[i].name);
Writeln('vvedite nomer sada', i ,':'); Readln(A[i].number);Writeln(f,A[i].number);
Writeln('vvedite kolichestvo detey', i ,':'); Readln(A[i].child); Writeln(f,A[i].child);
Writeln('vvedite rayon', i ,':'); Readln(A[i].rayon); Writeln(f,A[i].rayon);
Writeln('vvedite platu', i ,':'); Readln(A[i].plata); Writeln(f,A[i].plata);
End;
Close(f);
End;

procedure add_to_och (var b:det_ptr);
var
run:det_ptr;
Begin
For i:=1 to kol do
Begin
If cur=nil then cur:=b else
Begin
run:=cur;
while run^.next<>nil do
run:=run^.next;
run^.next:=b;
End;
New(b);
With b^do
Begin
Reset(f);
Readln(f,name);
Readln(f,number);
Readln(f,child);
Readln(f,rayon);
Readln(f,plata);
End;
Close(f);
b^.next:=nil;
End;
End;

procedure obmen( var c2:tardetsad; i:byte; j:byte);
Var
t:tdetsad;
Begin
T:=c2[j+1];
c2[j+1]:=c2[j];
c2[j]:=t;
End;


procedure sort(var C:TArDetsad);
var
d,i,j:byte;
Begin
Writeln('vvedite pole po kotoromu nuzhno sortirovat');
Writeln('1:nazvanie 2:nomer 3:kolicestvo detey 4:rayon 5:plata');

Readln(d);
For i:=1 to kol-1 do
For j:=1 to kol-1 do
Case d of
1: If c[j].name> c[j+1].name then obmen(c,i,j);
2: If c[j].number> c[j+1].number then obmen(c,i,j);
3: If c[j].child> c[j+1].child then obmen(c,i,j);
4: If c[j].rayon> c[j+1].rayon then obmen(c,i,j);
5: If c[j].plata> c[j+1].plata then obmen(c,i,j);
End;
End;
procedure vivod(var B:TArDetsad);
var
i:byte;
Begin
Assign(ff,'C:\vvivod.txt');
Rewrite(ff);
For i:=1 to kol do
Begin
Writeln( ff, B[i].name);
Writeln(ff,B[i].number);
Writeln(ff,B[i].child);
Writeln(ff,B[i].rayon);
Writeln(ff,B[i].plata);
End;
Close(ff);
End;


Begin
clrscr;
Writeln('vvedite kolichestvo detskih sadov');
Readln(kol);
vvod(detsad);
add_to_och(detsad[i].next);
sort(detsad);
vivod(detsad);
Readln;
End.


Автор: Ametist 9.05.2008 13:56

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


Program Lab1;
uses crt;
type
det_ptr=^tdetsad;
Tdetsad = record
name: string;
number: integer;
child: integer;
rayon: string;
plata: integer;
next:det_ptr;
End;
TArDetsad = array [1..10] of Tdetsad;
Var
cur:det_ptr; i:integer;
f,ff:text;
Detsad,Detsad2: TArDetsad;
Kol: integer;
procedure add_to_och ;
var
b:det_ptr;
run:det_ptr;
Begin
New(b);
With b^do
Begin
Reset(f);
Readln(f,name);
Readln(f,number);
Readln(f,child);
Readln(f,rayon);
Readln(f,plata);
Close(f);
End;
If cur=nil then cur:=b else
Begin
run:=cur;
while run^.next<>nil do
run:=run^.next;
run^.next:=b;
End;
b^.next:=nil;
End;
procedure schitivanie(var A:TARDetsad);
var
j:integer;
Begin
j:=1;
Repeat
With A[j] do
Begin
name:=cur^.name;
number:=cur^.number;
child:=cur^.child;
rayon:=cur^.rayon;
plata:=cur^.plata;
End;
j:=j+1;
cur:=cur^.next;
Until cur<>nil;
End;
procedure vvod (var A:TArDetsad);
Var
i:byte;
Begin
Assign(f,'C:\lab.txt');
Rewrite(f);
For i:=1 to kol do
Begin
Writeln('vvedite nazvanie', i ,':'); Readln(A[i].name); Writeln(f,A[i].name);
Writeln('vvedite nomer sada', i ,':'); Readln(A[i].number);Writeln(f,A[i].number);
Writeln('vvedite kolichestvo detey', i ,':'); Readln(A[i].child); Writeln(f,A[i].child);
Writeln('vvedite rayon', i ,':'); Readln(A[i].rayon); Writeln(f,A[i].rayon);
Writeln('vvedite platu', i ,':'); Readln(A[i].plata); Writeln(f,A[i].plata);
End;
Close(f);
End;

procedure vivod(var B:TArDetsad);
var
i:byte;
Begin
Assign(ff,'C:\vivod.txt');
Rewrite(ff);
For i:=1 to kol do
Begin
Writeln(ff,B[i].name);
Writeln(ff,B[i].number);
Writeln(ff,B[i].child);
Writeln(ff,B[i].rayon);
Writeln(ff,B[i].plata);
End;
Close(ff);
End;

procedure obmen( var c2:tardetsad; i:byte; j:byte);
Var
t:tdetsad;
Begin
T:=c2[j+1];
c2[j+1]:=c2[j];
c2[j]:=t;
End;


procedure sort(var C:TArDetsad);
var
d,i,j:byte;
Begin
Writeln('vvedite pole po kotoromu nuzhno sortirovat');
Writeln('1:nazvanie 2:nomer 3:kolicestvo detey 4:rayon 5:plata');

Readln(d);
For i:=1 to kol-1 do
For j:=1 to kol-1 do
Case d of
1: If c[j].name> c[j+1].name then obmen(c,i,j);
2: If c[j].number> c[j+1].number then obmen(c,i,j);
3: If c[j].child> c[j+1].child then obmen(c,i,j);
4: If c[j].rayon> c[j+1].rayon then obmen(c,i,j);
5: If c[j].plata> c[j+1].plata then obmen(c,i,j);
End;
End;
Begin
clrscr;
Writeln('vvedite kolichestvo detskih sadov');
Readln(kol);
vvod(detsad);
For i:=1 to kol do
add_to_och;
schitivanie(detsad2);
sort(detsad2);
vivod(detsad2);
Readln;
End.


Автор: Ametist 9.05.2008 14:34

Все, уже ничего не надо, я сам во всем разобрался=) Тему можно удалить, дабы не засорять форум=)