program bn6;
var
c:char;
i:word;
a:array[1..6] of string[15];
begin
writeln('Vvedit familii studentiv:');
for i:=1 to 6 do read(a);
readln;
writeln('Familii studentiv do sortuvannja:');
for i:=1 to 6 do write(a);
writeln;
for c:= 'a' to 'z' do
for i:=1 to 6 do
if a[i,1] = c then begin
writeln('Familii studentiv pislja sortuvannja:');
write(a);
end;
readln
end.
Запись строк с клавы в массив и сортировка
Задача:
Фамилии 6-ти студентов вводяться с клав. Максимальная длинна символов в фамилии - 15. Задание: упорядочить фамилии по алфавиту.
вообщем у меня тут где то ошибка, не записываються строки в массив, паскаль я зная пару дней ^^, подскажите где ошибка и может алгоритм сортировки другой (покруче)
Спасибо.
Фамилии 6-ти студентов вводяться с клав. Максимальная длинна символов в фамилии - 15. Задание: упорядочить фамилии по алфавиту.
вообщем у меня тут где то ошибка, не записываються строки в массив, паскаль я зная пару дней ^^, подскажите где ошибка и может алгоритм сортировки другой (покруче)
Код:
Спасибо.
Когда вводишь строчечку, писать надо Readln. Или можно считать все фамилии одной строкой (тоже Readln) и разбить по пробелам.
wanja спасибо! вчера ночью два часа ковырялся так и не понял что я не так делаю =)
вот готовый вариант:
вот готовый вариант:
Код:
program bn6;
var
c:char;
i:word;
a:array[1..6] of string[15];
begin
writeln('Vvedit familii studentiv:');
for i:=1 to 6 do readln(a);
writeln('Familii studentiv do sortuvannja:');
for i:=1 to 6 do writeln(a);
writeln('Familii studentiv pislja sortuvannja:');
for c:= 'a' to 'z' do
for i:=1 to 6 do
if a[i,1] = c then writeln(a);
readln
end.
var
c:char;
i:word;
a:array[1..6] of string[15];
begin
writeln('Vvedit familii studentiv:');
for i:=1 to 6 do readln(a);
writeln('Familii studentiv do sortuvannja:');
for i:=1 to 6 do writeln(a);
writeln('Familii studentiv pislja sortuvannja:');
for c:= 'a' to 'z' do
for i:=1 to 6 do
if a[i,1] = c then writeln(a);
readln
end.
только тут вы их не упорядочиваете по алфавиту
nilbog это почему ?) вроде работает
ну хотя бы посмотрите фамилии скажем Иванов , Ибрагимов :)
в каком порядке они должны идти? и в каком будут у вас
а во вторых сортировка обычно подразумевает запись в память в отсортированном варианте
в каком порядке они должны идти? и в каком будут у вас
а во вторых сортировка обычно подразумевает запись в память в отсортированном варианте
да точно =) ну наверно надо создать массив для каждой фамилии и перебирать по букве или чето такое .. завтра попробую
нет - все гораздо проще
я думаю скорость не важна - вот вам пузырек :)
я думаю скорость не важна - вот вам пузырек :)
Код:
type M=array[1..6] of string[15];
procedure sort(var x:M);
var i,k:integer; per:boolean;
begin
per:=true;
for k:=6 downto 1 do
begin
for i:=1 to k-1 do
if x[i+1]<x then
begin c:=x; x:=x[i+1]; x[i+1]:=c ;per:=false end;
if per then exit;{не было ни одной перестановки - все упорядочено}
per:=true
end
end;
procedure sort(var x:M);
var i,k:integer; per:boolean;
begin
per:=true;
for k:=6 downto 1 do
begin
for i:=1 to k-1 do
if x[i+1]<x then
begin c:=x; x:=x[i+1]; x[i+1]:=c ;per:=false end;
if per then exit;{не было ни одной перестановки - все упорядочено}
per:=true
end
end;
та не я хотел сам зделать, а так на случай если я не успею есть уже спертый вариант из http://sources.ru
Код:
program SortStudent;
const N = 6;
type
TInfo = record
Name: string [15];
end;
List = array [1..N] of TInfo;
var Data: List;
function Compare (T1,T2: TInfo): integer;
begin
if T1.Name > T2.Name then
Compare := 1
else
if T1.Name = T2.Name then
Compare := 0
else
Compare := -1
end;
procedure Sort;
var
i, j: integer;
temp: TInfo;
begin
For I := 1 To Pred (N) Do
For J := Succ (I) To N Do
if Compare (Data, Data[j]) > 0 then
Begin
temp := Data;
Data := Data[j];
Data[j] := temp;
End;
end;
procedure InputData;
var
I: Integer;
begin
for I := 1 to N do
with Data do
begin
writeln;
write ('Vvedit familiju studenta ',I,':'); readln (Name);
end;
end;
procedure OuputData;
var
I: Integer;
begin
writeln;
writeln ('Familija' : 10);
for I := 1 to 40 do write ('-');
writeln;
for I := 1 to N do
with Data do
begin
write ( I : 2 );
writeln ( ' ' : 4, Name);
end;
readln;
end;
begin
InputData;
Sort;
OuputData;
end.
const N = 6;
type
TInfo = record
Name: string [15];
end;
List = array [1..N] of TInfo;
var Data: List;
function Compare (T1,T2: TInfo): integer;
begin
if T1.Name > T2.Name then
Compare := 1
else
if T1.Name = T2.Name then
Compare := 0
else
Compare := -1
end;
procedure Sort;
var
i, j: integer;
temp: TInfo;
begin
For I := 1 To Pred (N) Do
For J := Succ (I) To N Do
if Compare (Data, Data[j]) > 0 then
Begin
temp := Data;
Data := Data[j];
Data[j] := temp;
End;
end;
procedure InputData;
var
I: Integer;
begin
for I := 1 to N do
with Data do
begin
writeln;
write ('Vvedit familiju studenta ',I,':'); readln (Name);
end;
end;
procedure OuputData;
var
I: Integer;
begin
writeln;
writeln ('Familija' : 10);
for I := 1 to 40 do write ('-');
writeln;
for I := 1 to N do
with Data do
begin
write ( I : 2 );
writeln ( ' ' : 4, Name);
end;
readln;
end;
begin
InputData;
Sort;
OuputData;
end.