bài tập _ nghĩ hoài hok ra

[thiennu274]

[TẶNG BẠN] TRỌN BỘ Bí kíp học tốt 08 môn
Chắc suất Đại học top - Giữ chỗ ngay!!

ĐĂNG BÀI NGAY để cùng trao đổi với các thành viên siêu nhiệt tình & dễ thương trên diễn đàn.

Hi, ai giúp mình giùm nhá.

VCT, nhập vào nhanh sách họ tên, sắp sếp danh sách ý theo thứ tự A,B,C. Nếu tên trùng thì sắp xếp họ đệm

 

[ochuotqb]

Code đây, khuya nên mình không làm chuẩn hoá, bạn có thể bổ sung

var a: array [1..100] of string;
    n,i,j,t:byte;demo:string;
      function find2(st:string):byte; { tìm vị trí từ đầu của tên, để so sánh}
          var i:byte;
              begin
                 for i:=length(st) downto 1 do
                     if st[i]=#32 then
                      begin
                        find2:=i+1;
                      break;
                     end;
                  end;
  begin
       write('Nhap do dai danh sach: ');
       readln(n);
  for i:=1 to n do
     begin
        write('Stt[',i,']= ');
        readln(a[i]);
     end;
{Sử dụng thuật toán sắp xếp }  
for i:=1 to n-1 do
   for j:=i+1 to n do
       if a[i][find2(a[i])]>a[j][find2(a[j])] then
          begin
            demo:=a[i];
            a[i]:=a[j];
            a[j]:=demo;
          end
            else
     if a[i][find2(a[i])]=a[j][find2(a[j])] then { nếu a[i]=a[j] thì thực hiện kiểm tra tên, nếu tên giống nhau thì kiểm tra họ đệm}
              begin
               if copy(a[i],find2(a[i]),length(a[i]))=copy(a[j],find2(a[j]),length(a[j])) then  {Kiểm tra 2 tên giống nhau, nếu hai tên giống nhau thì so sánh chữ cái của họ đệm }
                 begin
                      t:=1;
                      while a[i][pos(#32,a[i])+t]=a[j][pos(#32,a[j])+t]  do  
                         t:=t+1;
               if a[i][pos(#32,a[i])+t]>a[j][pos(#32,a[j])+t] then {khi các chữ có khác nhau thì sắp xếp}
                 begin
                    demo:=a[i];
                    a[i]:=a[j];
                    a[j]:=demo;
               end;
                 end
              else
                  begin
                    t:=1;
                       while a[i][find2(a[i])+t]=a[j][find2(a[j])+t] do { Nếu hai tên bằng nhau thì kiểm tra từng chữ cái trong tên}
                           t:=t+1;
                      if a[i][find2(a[i])+t]>a[j][find2(a[j])+t] then
                        begin
                         demo:=a[i];
                         a[i]:=a[j];
                         a[j]:=demo;
                      end;
                  end;
          end;
 for i:=1 to n do
   writeln(a[i]);

  readln
end.

p/s: sắp xếp mình dùng là bublesort bạn có thể thay bằng quick sort để giảm thời gian .
Code đã edit một số chỗ để hoàn thiện hơn
Ở một số code đổi chỗ thì mình không giải thích lắm, nhìn vào chắc các bạn cũng hiểu

 

[p_trk]

starlove: chào bạn ochuotqb, mình rất cảm ơn bạn đã giúp trả lời câu hỏi , nhưng khi trả lời câu hỏi bạn code kèm theo { giải thích } để mọi người cùng hiểu .
mà mình cũng chưa hiểu cách của bạn !!!

 

[memberdota]

p_trk oi!!! ban co the ep nick Yahoo vs mình hok??? mình cần ban chỉ vài cái về phần pascan mà hỏi ở đây thì hok dc tiên cho lắm...
Nick mình là : memberdota

 

[p_trk]

Starlove chào bạn !! tạm thời bạn add nick lvtpro_96 .
Thân

 

[p_trk]

Starlove giúp bạn theo chương trình con và hàm ;

var
  n,m,p: word;
  a:array[1..100] of string;
  t:string;
procedure nhap;
 var
 i: word;
 begin
   write('n= '); readln(n);
   for i:=1 to n do
    begin
    write( 'S = '); readln(a[i]);
    end;
    end;
function he1(s:string):word;
 begin
   for m:=length(s) downto 1 do
    if s[m]=' ' then break; he1:=ord(s[m+1]);
 end;
 function he2(s:string):word;
 begin
   for p:=m-1 downto 1 do
    if s[p]=' ' then break; he2:=ord(s[p+1]);
 end;
procedure xuli2;
 var
   i,j:word;
 begin
     for j:=n  downto 2 do
     for i:=1 to j-1 do
        if he2(a[i]) > he2(a[i+1]) then
          begin
           t:=a[i];
           a[i]:=a[i+1];
           a[i+1]:=t;
          end;
 end;
procedure xuli1;
 var
  i,j: word;
 begin
    for j:=n  downto 2 do
     for i:=1 to j-1 do
      begin
        if he1(a[i])>he1(a[i+1]) then
          begin
           t:=a[i];
           a[i]:=a[i+1];
           a[i+1]:=t;
          end;
        if he1(a[i])=he1(a[i+1]) then xuli2;
      end;
 end;
procedure print;
 var
  i: word;
 begin
  for i:=1 to n do
  writeln(a[i]);
  readln;
 end;
BEGIN
 nhap;
 xuli1;
 print;
END.