Tin học Tây Sơn

Đua ngựa (4 điểm)

Go down

Đua ngựa (4 điểm)

Bài gửi by Admin on Thu Dec 13, 2018 1:55 pm

 Trước trận chung kết AFF cup 2018 giữa hai đội tuyển Việt Nam và Malaysia, cổ động viên hai đội quyết định tổ chức giải đua ngựa để lấy may mắn cho đội nhà. Mỗi đội sẽ chuận bị N con ngựa, mỗi con ngựa có hệ số riêng. Thể thức đua như sau: đua ngựa theo từng cặp; trong khi đua, con ngựa nào có hệ số cao hơn sẽ thắng, nếu có hệ số ngang nhau thì sẽ về đích cùng lúc. Đội nào có tổng số điểm cao hơn sẽ thắng chung cuộc. Số trận đấu          ≤ 1000 trận. Em hãy giúp Việt Nam sắp xếp các lượt đấu để có thể đạt được số trận thắng cao nhất.
            Cho biết: trận thắng sẽ được 2 điểm, trận hòa được 1 điểm, trận thua được 0 điểm.
Dữ liệu vào: file DUANGUA.INP bao gồm:- Dòng đầu là số lượng ngựa: N.
            - Dòng thứ hai có N số, số thứ i là hệ số của con ngựa thứ i của Việt Nam.
            - Dòng thứ ba có N số, số thứ i là hệ số của con ngựa thứ i của Malaysia.
Kết quả: ghi vào file DUANGUA.OUT gồm N+1  dòng, trong đó:
            - Dòng 1: ghi tổng số điểm chung cuộc Việt Nam đạt được.
            - Dòng 2 trở đi, mỗi dòng ghi 2 số: số thứ i là chỉ số ngựa Việt Nam đem đấu với ngựa chỉ số j của Malaysia.
Ví dụ:
DUANGUA.INP
DUANGUA.OUT
4
4 7 2 8
9 3 8 6
5
3 1
1 2
2 4
4 3
avatar
Admin
Admin
Admin

Posts : 687
Reputation : -10042
Join date : 16/11/2015
Age : 29

Xem lý lịch thành viên http://tinhocts.forumvi.com

Về Đầu Trang Go down

Re: Đua ngựa (4 điểm)

Bài gửi by tonguyengiahan237 on Fri Dec 14, 2018 10:09 pm

Code:
Program Dua_ngua;
Uses    crt;
Type    Mang2c=array[1..50,1..50] of integer;
        Mang1c=array[1..50] of integer;
Var     A:mang2c;
        B,C:mang1c;
        n:integer;
        fi,fo:text;

Procedure Docdl;
Var i,j,k,h:integer;
Begin
k:=1;h:=1;
Assign(fi,'DUANGUA.INP');
Reset(fi);
Readln(fi,n);
        For i:=1 to 2 do
        For j:=1 to n do
                Begin
                Read(fi,A[i,j]);
                If i=1 then
                        begin
                        B[k]:=A[i,j];
                        inc(k);
                        end;
                If i=2 then
                        begin
                        C[h]:=A[i,j];
                        inc(h);
                        end;
                If j=N then Readln(fi);
                End;
Close(fi);
End;

Procedure Sx_tang;
Var i,k,j,tam:integer;
Begin
For i:=1 to 2 do
 For j:=1 to n-1 do
  For k:=j to n do
  If A[i,k]<A[i,j] then
        begin
        tam:=A[i,k];
        A[i,k]:=A[i,j];
        A[i,j]:=tam;
        end;
End;

Procedure Xuli;
Var D,tam,j,T,k:integer;
Begin
Assign(fo,'DUANGUA.OUT');
Rewrite(fo);
D:=0;
T:=0;
For j:=1 downto n do
While A[2,n]<A[1,j] do
begin
inc(D);
end;
If D=0 then
        begin
        If A[2,n]=A[1,1] then T:=T+1;
        For j:=2 to n do
                begin
                If A[1,j]>A[2,j-1] then T:=T+2;
                If A[1,j]=A[2,j-1] then T:=T+1;
                end;
        end
Else
        begin
        For j:=1 to n do
                begin
                If A[1,j]>A[2,j] then T:=T+2;
                If A[1,j]=A[2,j] then T:=T+1;
                end;
        end;
Writeln(fo,T);
If D=0 then
        begin
        For k:=1 to n do
                begin
                If A[1,1]=B[k] then Write(fo,' ',k,' ');
                If A[2,n]=C[k] then Write(fo,' ',k,' ');
                end;
                Writeln(fo);
        For j:=2 to n do
        For k:=1 to n do
                begin
                If A[1,j]=B[k] then Write(fo,' ',k,' ');
                If A[2,j-1]=C[k] then Write(fo,' ',k,' ');
                If (k mod 2=0) and (j mod 2=0) then Writeln(fo);
                end;
          end
Else
        begin
        For j:=1 to n do
        For k:=1 to n do
                begin
                If A[1,j]=B[k] then Write(fo,' ',k,' ');
                If A[2,j]=C[k] then Write(fo,' ',k,' ');
                If (k mod 2=0) and (j mod 2=0) then Writeln(fo);
                end;
        end;



Close(fo);
End;

BEGIN
CLRSCR;
Docdl;
Sx_tang;
Xuli;
READLN;
END.
avatar
tonguyengiahan237
Nhiệt tình
Nhiệt tình

Posts : 42
Reputation : -1
Join date : 06/11/2018
Age : 14
Location : TT Phú Phong Huyện Tây Sơn Tỉnh Bình Định

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Đua ngựa (4 điểm)

Bài gửi by Admin on Fri Dec 14, 2018 10:14 pm

tonguyengiahan237 đã viết:
Code:
Program Dua_ngua;
Uses    crt;
Type    Mang2c=array[1..50,1..50] of integer;
        Mang1c=array[1..50] of integer;
Var     A:mang2c;
        B,C:mang1c;
        n:integer;
        fi,fo:text;

Procedure Docdl;
Var i,j,k,h:integer;
Begin
k:=1;h:=1;
Assign(fi,'DUANGUA.INP');
Reset(fi);
Readln(fi,n);
        For i:=1 to 2 do
        For j:=1 to n do
                Begin
                Read(fi,A[i,j]);
                If i=1 then
                        begin
                        B[k]:=A[i,j];
                        inc(k);
                        end;
                If i=2 then
                        begin
                        C[h]:=A[i,j];
                        inc(h);
                        end;
                If j=N then Readln(fi);
                End;
Close(fi);
End;

Procedure Sx_tang;
Var i,k,j,tam:integer;
Begin
For i:=1 to 2 do
 For j:=1 to n-1 do
  For k:=j to n do
  If A[i,k]<A[i,j] then
        begin
        tam:=A[i,k];
        A[i,k]:=A[i,j];
        A[i,j]:=tam;
        end;
End;

Procedure Xuli;
Var D,tam,j,T,k:integer;
Begin
Assign(fo,'DUANGUA.OUT');
Rewrite(fo);
D:=0;
T:=0;
For j:=1 downto n do
While A[2,n]<A[1,j] do
begin
inc(D);
end;
If D=0 then
        begin
        If A[2,n]=A[1,1] then T:=T+1;
        For j:=2 to n do
                begin
                If A[1,j]>A[2,j-1] then T:=T+2;
                If A[1,j]=A[2,j-1] then T:=T+1;
                end;
        end
Else
        begin
        For j:=1 to n do
                begin
                If A[1,j]>A[2,j] then T:=T+2;
                If A[1,j]=A[2,j] then T:=T+1;
                end;
        end;
Writeln(fo,T);
If D=0 then
        begin
        For k:=1 to n do
                begin
                If A[1,1]=B[k] then Write(fo,' ',k,' ');
                If A[2,n]=C[k] then Write(fo,' ',k,' ');
                end;
                Writeln(fo);
        For j:=2 to n do
        For k:=1 to n do
                begin
                If A[1,j]=B[k] then Write(fo,' ',k,' ');
                If A[2,j-1]=C[k] then Write(fo,' ',k,' ');
                If (k mod 2=0) and (j mod 2=0) then Writeln(fo);
                end;
          end
Else
        begin
        For j:=1 to n do
        For k:=1 to n do
                begin
                If A[1,j]=B[k] then Write(fo,' ',k,' ');
                If A[2,j]=C[k] then Write(fo,' ',k,' ');
                If (k mod 2=0) and (j mod 2=0) then Writeln(fo);
                end;
        end;



Close(fo);
End;

BEGIN
CLRSCR;
Docdl;
Sx_tang;
Xuli;
READLN;
END.
code rất dài và rối confused
avatar
Admin
Admin
Admin

Posts : 687
Reputation : -10042
Join date : 16/11/2015
Age : 29

Xem lý lịch thành viên http://tinhocts.forumvi.com

Về Đầu Trang Go down

Re: Đua ngựa (4 điểm)

Bài gửi by tonguyengiahan237 on Fri Dec 14, 2018 10:29 pm

Admin đã viết:
tonguyengiahan237 đã viết:
Code:
Program Dua_ngua;
Uses    crt;
Type    Mang2c=array[1..50,1..50] of integer;
        Mang1c=array[1..50] of integer;
Var     A:mang2c;
        B,C:mang1c;
        n:integer;
        fi,fo:text;

Procedure Docdl;
Var i,j,k,h:integer;
Begin
k:=1;h:=1;
Assign(fi,'DUANGUA.INP');
Reset(fi);
Readln(fi,n);
        For i:=1 to 2 do
        For j:=1 to n do
                Begin
                Read(fi,A[i,j]);
                If i=1 then
                        begin
                        B[k]:=A[i,j];
                        inc(k);
                        end;
                If i=2 then
                        begin
                        C[h]:=A[i,j];
                        inc(h);
                        end;
                If j=N then Readln(fi);
                End;
Close(fi);
End;

Procedure Sx_tang;
Var i,k,j,tam:integer;
Begin
For i:=1 to 2 do
 For j:=1 to n-1 do
  For k:=j to n do
  If A[i,k]<A[i,j] then
        begin
        tam:=A[i,k];
        A[i,k]:=A[i,j];
        A[i,j]:=tam;
        end;
End;

Procedure Xuli;
Var D,tam,j,T,k:integer;
Begin
Assign(fo,'DUANGUA.OUT');
Rewrite(fo);
D:=0;
T:=0;
For j:=1 downto n do
While A[2,n]<A[1,j] do
begin
inc(D);
end;
If D=0 then
        begin
        If A[2,n]=A[1,1] then T:=T+1;
        For j:=2 to n do
                begin
                If A[1,j]>A[2,j-1] then T:=T+2;
                If A[1,j]=A[2,j-1] then T:=T+1;
                end;
        end
Else
        begin
        For j:=1 to n do
                begin
                If A[1,j]>A[2,j] then T:=T+2;
                If A[1,j]=A[2,j] then T:=T+1;
                end;
        end;
Writeln(fo,T);
If D=0 then
        begin
        For k:=1 to n do
                begin
                If A[1,1]=B[k] then Write(fo,' ',k,' ');
                If A[2,n]=C[k] then Write(fo,' ',k,' ');
                end;
                Writeln(fo);
        For j:=2 to n do
        For k:=1 to n do
                begin
                If A[1,j]=B[k] then Write(fo,' ',k,' ');
                If A[2,j-1]=C[k] then Write(fo,' ',k,' ');
                If (k mod 2=0) and (j mod 2=0) then Writeln(fo);
                end;
          end
Else
        begin
        For j:=1 to n do
        For k:=1 to n do
                begin
                If A[1,j]=B[k] then Write(fo,' ',k,' ');
                If A[2,j]=C[k] then Write(fo,' ',k,' ');
                If (k mod 2=0) and (j mod 2=0) then Writeln(fo);
                end;
        end;



Close(fo);
End;

BEGIN
CLRSCR;
Docdl;
Sx_tang;
Xuli;
READLN;
END.
code rất dài và rối confused
Em không nghĩ ra được cách khác ạ bounce
avatar
tonguyengiahan237
Nhiệt tình
Nhiệt tình

Posts : 42
Reputation : -1
Join date : 06/11/2018
Age : 14
Location : TT Phú Phong Huyện Tây Sơn Tỉnh Bình Định

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Đua ngựa (4 điểm)

Bài gửi by Admin on Fri Dec 14, 2018 10:36 pm

tonguyengiahan237 đã viết:
Admin đã viết:
tonguyengiahan237 đã viết:
Code:
Program Dua_ngua;
Uses    crt;
Type    Mang2c=array[1..50,1..50] of integer;
        Mang1c=array[1..50] of integer;
Var     A:mang2c;
        B,C:mang1c;
        n:integer;
        fi,fo:text;

Procedure Docdl;
Var i,j,k,h:integer;
Begin
k:=1;h:=1;
Assign(fi,'DUANGUA.INP');
Reset(fi);
Readln(fi,n);
        For i:=1 to 2 do
        For j:=1 to n do
                Begin
                Read(fi,A[i,j]);
                If i=1 then
                        begin
                        B[k]:=A[i,j];
                        inc(k);
                        end;
                If i=2 then
                        begin
                        C[h]:=A[i,j];
                        inc(h);
                        end;
                If j=N then Readln(fi);
                End;
Close(fi);
End;

Procedure Sx_tang;
Var i,k,j,tam:integer;
Begin
For i:=1 to 2 do
 For j:=1 to n-1 do
  For k:=j to n do
  If A[i,k]<A[i,j] then
        begin
        tam:=A[i,k];
        A[i,k]:=A[i,j];
        A[i,j]:=tam;
        end;
End;

Procedure Xuli;
Var D,tam,j,T,k:integer;
Begin
Assign(fo,'DUANGUA.OUT');
Rewrite(fo);
D:=0;
T:=0;
For j:=1 downto n do
While A[2,n]<A[1,j] do
begin
inc(D);
end;
If D=0 then
        begin
        If A[2,n]=A[1,1] then T:=T+1;
        For j:=2 to n do
                begin
                If A[1,j]>A[2,j-1] then T:=T+2;
                If A[1,j]=A[2,j-1] then T:=T+1;
                end;
        end
Else
        begin
        For j:=1 to n do
                begin
                If A[1,j]>A[2,j] then T:=T+2;
                If A[1,j]=A[2,j] then T:=T+1;
                end;
        end;
Writeln(fo,T);
If D=0 then
        begin
        For k:=1 to n do
                begin
                If A[1,1]=B[k] then Write(fo,' ',k,' ');
                If A[2,n]=C[k] then Write(fo,' ',k,' ');
                end;
                Writeln(fo);
        For j:=2 to n do
        For k:=1 to n do
                begin
                If A[1,j]=B[k] then Write(fo,' ',k,' ');
                If A[2,j-1]=C[k] then Write(fo,' ',k,' ');
                If (k mod 2=0) and (j mod 2=0) then Writeln(fo);
                end;
          end
Else
        begin
        For j:=1 to n do
        For k:=1 to n do
                begin
                If A[1,j]=B[k] then Write(fo,' ',k,' ');
                If A[2,j]=C[k] then Write(fo,' ',k,' ');
                If (k mod 2=0) and (j mod 2=0) then Writeln(fo);
                end;
        end;



Close(fo);
End;

BEGIN
CLRSCR;
Docdl;
Sx_tang;
Xuli;
READLN;
END.
code rất dài và rối confused
Em không nghĩ ra được cách khác ạ bounce
code thế cũng tốt rồi Idea E ngủ sớm đi, khuya rồi đó
avatar
Admin
Admin
Admin

Posts : 687
Reputation : -10042
Join date : 16/11/2015
Age : 29

Xem lý lịch thành viên http://tinhocts.forumvi.com

Về Đầu Trang Go down

Re: Đua ngựa (4 điểm)

Bài gửi by tonguyengiahan237 on Fri Dec 14, 2018 10:37 pm

Admin đã viết:
tonguyengiahan237 đã viết:
Admin đã viết:
tonguyengiahan237 đã viết:
Code:
Program Dua_ngua;
Uses    crt;
Type    Mang2c=array[1..50,1..50] of integer;
        Mang1c=array[1..50] of integer;
Var     A:mang2c;
        B,C:mang1c;
        n:integer;
        fi,fo:text;

Procedure Docdl;
Var i,j,k,h:integer;
Begin
k:=1;h:=1;
Assign(fi,'DUANGUA.INP');
Reset(fi);
Readln(fi,n);
        For i:=1 to 2 do
        For j:=1 to n do
                Begin
                Read(fi,A[i,j]);
                If i=1 then
                        begin
                        B[k]:=A[i,j];
                        inc(k);
                        end;
                If i=2 then
                        begin
                        C[h]:=A[i,j];
                        inc(h);
                        end;
                If j=N then Readln(fi);
                End;
Close(fi);
End;

Procedure Sx_tang;
Var i,k,j,tam:integer;
Begin
For i:=1 to 2 do
 For j:=1 to n-1 do
  For k:=j to n do
  If A[i,k]<A[i,j] then
        begin
        tam:=A[i,k];
        A[i,k]:=A[i,j];
        A[i,j]:=tam;
        end;
End;

Procedure Xuli;
Var D,tam,j,T,k:integer;
Begin
Assign(fo,'DUANGUA.OUT');
Rewrite(fo);
D:=0;
T:=0;
For j:=1 downto n do
While A[2,n]<A[1,j] do
begin
inc(D);
end;
If D=0 then
        begin
        If A[2,n]=A[1,1] then T:=T+1;
        For j:=2 to n do
                begin
                If A[1,j]>A[2,j-1] then T:=T+2;
                If A[1,j]=A[2,j-1] then T:=T+1;
                end;
        end
Else
        begin
        For j:=1 to n do
                begin
                If A[1,j]>A[2,j] then T:=T+2;
                If A[1,j]=A[2,j] then T:=T+1;
                end;
        end;
Writeln(fo,T);
If D=0 then
        begin
        For k:=1 to n do
                begin
                If A[1,1]=B[k] then Write(fo,' ',k,' ');
                If A[2,n]=C[k] then Write(fo,' ',k,' ');
                end;
                Writeln(fo);
        For j:=2 to n do
        For k:=1 to n do
                begin
                If A[1,j]=B[k] then Write(fo,' ',k,' ');
                If A[2,j-1]=C[k] then Write(fo,' ',k,' ');
                If (k mod 2=0) and (j mod 2=0) then Writeln(fo);
                end;
          end
Else
        begin
        For j:=1 to n do
        For k:=1 to n do
                begin
                If A[1,j]=B[k] then Write(fo,' ',k,' ');
                If A[2,j]=C[k] then Write(fo,' ',k,' ');
                If (k mod 2=0) and (j mod 2=0) then Writeln(fo);
                end;
        end;



Close(fo);
End;

BEGIN
CLRSCR;
Docdl;
Sx_tang;
Xuli;
READLN;
END.
code rất dài và rối confused
Em không nghĩ ra được cách khác ạ bounce
code thế cũng tốt rồi Idea  E ngủ sớm đi, khuya rồi đó
Dạ Thầy
avatar
tonguyengiahan237
Nhiệt tình
Nhiệt tình

Posts : 42
Reputation : -1
Join date : 06/11/2018
Age : 14
Location : TT Phú Phong Huyện Tây Sơn Tỉnh Bình Định

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Đua ngựa (4 điểm)

Bài gửi by Đinh Ngọc Mạnh on Tue Dec 18, 2018 3:46 pm

tonguyengiahan237 đã viết:
Admin đã viết:
tonguyengiahan237 đã viết:
Admin đã viết:
tonguyengiahan237 đã viết:
Code:
Program Dua_ngua;
Uses    crt;
Type    Mang2c=array[1..50,1..50] of integer;
        Mang1c=array[1..50] of integer;
Var     A:mang2c;
        B,C:mang1c;
        n:integer;
        fi,fo:text;

Procedure Docdl;
Var i,j,k,h:integer;
Begin
k:=1;h:=1;
Assign(fi,'DUANGUA.INP');
Reset(fi);
Readln(fi,n);
        For i:=1 to 2 do
        For j:=1 to n do
                Begin
                Read(fi,A[i,j]);
                If i=1 then
                        begin
                        B[k]:=A[i,j];
                        inc(k);
                        end;
                If i=2 then
                        begin
                        C[h]:=A[i,j];
                        inc(h);
                        end;
                If j=N then Readln(fi);
                End;
Close(fi);
End;

Procedure Sx_tang;
Var i,k,j,tam:integer;
Begin
For i:=1 to 2 do
 For j:=1 to n-1 do
  For k:=j to n do
  If A[i,k]<A[i,j] then
        begin
        tam:=A[i,k];
        A[i,k]:=A[i,j];
        A[i,j]:=tam;
        end;
End;

Procedure Xuli;
Var D,tam,j,T,k:integer;
Begin
Assign(fo,'DUANGUA.OUT');
Rewrite(fo);
D:=0;
T:=0;
For j:=1 downto n do
While A[2,n]<A[1,j] do
begin
inc(D);
end;
If D=0 then
        begin
        If A[2,n]=A[1,1] then T:=T+1;
        For j:=2 to n do
                begin
                If A[1,j]>A[2,j-1] then T:=T+2;
                If A[1,j]=A[2,j-1] then T:=T+1;
                end;
        end
Else
        begin
        For j:=1 to n do
                begin
                If A[1,j]>A[2,j] then T:=T+2;
                If A[1,j]=A[2,j] then T:=T+1;
                end;
        end;
Writeln(fo,T);
If D=0 then
        begin
        For k:=1 to n do
                begin
                If A[1,1]=B[k] then Write(fo,' ',k,' ');
                If A[2,n]=C[k] then Write(fo,' ',k,' ');
                end;
                Writeln(fo);
        For j:=2 to n do
        For k:=1 to n do
                begin
                If A[1,j]=B[k] then Write(fo,' ',k,' ');
                If A[2,j-1]=C[k] then Write(fo,' ',k,' ');
                If (k mod 2=0) and (j mod 2=0) then Writeln(fo);
                end;
          end
Else
        begin
        For j:=1 to n do
        For k:=1 to n do
                begin
                If A[1,j]=B[k] then Write(fo,' ',k,' ');
                If A[2,j]=C[k] then Write(fo,' ',k,' ');
                If (k mod 2=0) and (j mod 2=0) then Writeln(fo);
                end;
        end;



Close(fo);
End;

BEGIN
CLRSCR;
Docdl;
Sx_tang;
Xuli;
READLN;
END.
code rất dài và rối confused
Em không nghĩ ra được cách khác ạ bounce
code thế cũng tốt rồi Idea  E ngủ sớm đi, khuya rồi đó
Dạ Thầy
Dui thế nhỉ?? Laughing bounce
avatar
Đinh Ngọc Mạnh
Năng động
Năng động

Posts : 73
Reputation : -300002
Join date : 18/06/2018
Age : -7981
Location : Ở nhà

Xem lý lịch thành viên http://firtsblogspot.blogspot.com

Về Đầu Trang Go down

Re: Đua ngựa (4 điểm)

Bài gửi by tonguyengiahan237 on Tue Dec 18, 2018 4:55 pm

Đinh Ngọc Mạnh đã viết:
tonguyengiahan237 đã viết:
Admin đã viết:
tonguyengiahan237 đã viết:
Admin đã viết:
tonguyengiahan237 đã viết:
Code:
Program Dua_ngua;
Uses    crt;
Type    Mang2c=array[1..50,1..50] of integer;
        Mang1c=array[1..50] of integer;
Var     A:mang2c;
        B,C:mang1c;
        n:integer;
        fi,fo:text;

Procedure Docdl;
Var i,j,k,h:integer;
Begin
k:=1;h:=1;
Assign(fi,'DUANGUA.INP');
Reset(fi);
Readln(fi,n);
        For i:=1 to 2 do
        For j:=1 to n do
                Begin
                Read(fi,A[i,j]);
                If i=1 then
                        begin
                        B[k]:=A[i,j];
                        inc(k);
                        end;
                If i=2 then
                        begin
                        C[h]:=A[i,j];
                        inc(h);
                        end;
                If j=N then Readln(fi);
                End;
Close(fi);
End;

Procedure Sx_tang;
Var i,k,j,tam:integer;
Begin
For i:=1 to 2 do
 For j:=1 to n-1 do
  For k:=j to n do
  If A[i,k]<A[i,j] then
        begin
        tam:=A[i,k];
        A[i,k]:=A[i,j];
        A[i,j]:=tam;
        end;
End;

Procedure Xuli;
Var D,tam,j,T,k:integer;
Begin
Assign(fo,'DUANGUA.OUT');
Rewrite(fo);
D:=0;
T:=0;
For j:=1 downto n do
While A[2,n]<A[1,j] do
begin
inc(D);
end;
If D=0 then
        begin
        If A[2,n]=A[1,1] then T:=T+1;
        For j:=2 to n do
                begin
                If A[1,j]>A[2,j-1] then T:=T+2;
                If A[1,j]=A[2,j-1] then T:=T+1;
                end;
        end
Else
        begin
        For j:=1 to n do
                begin
                If A[1,j]>A[2,j] then T:=T+2;
                If A[1,j]=A[2,j] then T:=T+1;
                end;
        end;
Writeln(fo,T);
If D=0 then
        begin
        For k:=1 to n do
                begin
                If A[1,1]=B[k] then Write(fo,' ',k,' ');
                If A[2,n]=C[k] then Write(fo,' ',k,' ');
                end;
                Writeln(fo);
        For j:=2 to n do
        For k:=1 to n do
                begin
                If A[1,j]=B[k] then Write(fo,' ',k,' ');
                If A[2,j-1]=C[k] then Write(fo,' ',k,' ');
                If (k mod 2=0) and (j mod 2=0) then Writeln(fo);
                end;
          end
Else
        begin
        For j:=1 to n do
        For k:=1 to n do
                begin
                If A[1,j]=B[k] then Write(fo,' ',k,' ');
                If A[2,j]=C[k] then Write(fo,' ',k,' ');
                If (k mod 2=0) and (j mod 2=0) then Writeln(fo);
                end;
        end;



Close(fo);
End;

BEGIN
CLRSCR;
Docdl;
Sx_tang;
Xuli;
READLN;
END.
code rất dài và rối confused
Em không nghĩ ra được cách khác ạ bounce
code thế cũng tốt rồi Idea  E ngủ sớm đi, khuya rồi đó
Dạ Thầy
Dui thế nhỉ?? Laughing bounce
Sao vui??? confused
avatar
tonguyengiahan237
Nhiệt tình
Nhiệt tình

Posts : 42
Reputation : -1
Join date : 06/11/2018
Age : 14
Location : TT Phú Phong Huyện Tây Sơn Tỉnh Bình Định

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Đua ngựa (4 điểm)

Bài gửi by Đinh Ngọc Mạnh on Tue Dec 18, 2018 4:56 pm

tonguyengiahan237 đã viết:
Đinh Ngọc Mạnh đã viết:
tonguyengiahan237 đã viết:
Admin đã viết:
tonguyengiahan237 đã viết:
Admin đã viết:
tonguyengiahan237 đã viết:
Code:
Program Dua_ngua;
Uses    crt;
Type    Mang2c=array[1..50,1..50] of integer;
        Mang1c=array[1..50] of integer;
Var     A:mang2c;
        B,C:mang1c;
        n:integer;
        fi,fo:text;

Procedure Docdl;
Var i,j,k,h:integer;
Begin
k:=1;h:=1;
Assign(fi,'DUANGUA.INP');
Reset(fi);
Readln(fi,n);
        For i:=1 to 2 do
        For j:=1 to n do
                Begin
                Read(fi,A[i,j]);
                If i=1 then
                        begin
                        B[k]:=A[i,j];
                        inc(k);
                        end;
                If i=2 then
                        begin
                        C[h]:=A[i,j];
                        inc(h);
                        end;
                If j=N then Readln(fi);
                End;
Close(fi);
End;

Procedure Sx_tang;
Var i,k,j,tam:integer;
Begin
For i:=1 to 2 do
 For j:=1 to n-1 do
  For k:=j to n do
  If A[i,k]<A[i,j] then
        begin
        tam:=A[i,k];
        A[i,k]:=A[i,j];
        A[i,j]:=tam;
        end;
End;

Procedure Xuli;
Var D,tam,j,T,k:integer;
Begin
Assign(fo,'DUANGUA.OUT');
Rewrite(fo);
D:=0;
T:=0;
For j:=1 downto n do
While A[2,n]<A[1,j] do
begin
inc(D);
end;
If D=0 then
        begin
        If A[2,n]=A[1,1] then T:=T+1;
        For j:=2 to n do
                begin
                If A[1,j]>A[2,j-1] then T:=T+2;
                If A[1,j]=A[2,j-1] then T:=T+1;
                end;
        end
Else
        begin
        For j:=1 to n do
                begin
                If A[1,j]>A[2,j] then T:=T+2;
                If A[1,j]=A[2,j] then T:=T+1;
                end;
        end;
Writeln(fo,T);
If D=0 then
        begin
        For k:=1 to n do
                begin
                If A[1,1]=B[k] then Write(fo,' ',k,' ');
                If A[2,n]=C[k] then Write(fo,' ',k,' ');
                end;
                Writeln(fo);
        For j:=2 to n do
        For k:=1 to n do
                begin
                If A[1,j]=B[k] then Write(fo,' ',k,' ');
                If A[2,j-1]=C[k] then Write(fo,' ',k,' ');
                If (k mod 2=0) and (j mod 2=0) then Writeln(fo);
                end;
          end
Else
        begin
        For j:=1 to n do
        For k:=1 to n do
                begin
                If A[1,j]=B[k] then Write(fo,' ',k,' ');
                If A[2,j]=C[k] then Write(fo,' ',k,' ');
                If (k mod 2=0) and (j mod 2=0) then Writeln(fo);
                end;
        end;



Close(fo);
End;

BEGIN
CLRSCR;
Docdl;
Sx_tang;
Xuli;
READLN;
END.
code rất dài và rối confused
Em không nghĩ ra được cách khác ạ bounce
code thế cũng tốt rồi Idea  E ngủ sớm đi, khuya rồi đó
Dạ Thầy
Dui thế nhỉ?? Laughing bounce
Sao vui??? confused
Thâu bỏ qua Laughing clown
avatar
Đinh Ngọc Mạnh
Năng động
Năng động

Posts : 73
Reputation : -300002
Join date : 18/06/2018
Age : -7981
Location : Ở nhà

Xem lý lịch thành viên http://firtsblogspot.blogspot.com

Về Đầu Trang Go down

Re: Đua ngựa (4 điểm)

Bài gửi by mainhatthong2004 on Thu Dec 20, 2018 5:05 pm

thong:
program bai4;
uses crt;
type mang=array[1..100] of integer;
var aa,b,c,d,p,z,a,bb,h,g:mang;
i,n,tg,j,s,l,m,t,k,s1:integer;
fi,fo:text;
//-------------------------------------------
procedure doi(var x,y:integer);
begin
tg:=x;
x:=y;
y:=tg;
end;
//---------------------------------------
procedure doc;
begin
assign(fi,'DUANGUA.inp');
reset(fi);
readln(fi,n);
for i:=1 to n do
read(fi,a[i]);
readln(fi);
for i:=1 to n do
read(fi,b[i]);
close(fi);
end;
//---------------------------------------
procedure xl;
begin
assign(fo,'DUANGUA.out');
rewrite(fo);
k:=1;
for i:=1 to n do
begin
c[i]:=k;
d[i]:=k;
h[i]:=b[i];
g[i]:=a[i];
inc(k);
end;
for i:=1 to n-1 do
for j:=i+1 to n do
begin
if a[i]>a[j] then
begin
doi(a[i],a[j]);
doi(c[i],c[j]);
end;
if b[i]>b[j] then
begin
doi(b[i],b[j]);
doi(d[i],d[j]);
end;
end;
i:=1;
t:=1;
while i<=n do
begin
m:=i;
for j:=1 to n do
if (b[j]<a[i]) and (b[j]>=0) then
begin
aa[t]:=d[j];
s1:=s1+2;
inc(t);
b[j]:=-1;
inc(i);
break;
end;
if m=i then
for j:=1 to n do
if (b[j]=a[i]) and (b[j]>=0) then
begin
aa[t]:=d[j];
s1:=s1+1;
inc(i);
inc(t);
b[j]:=-1;
break;
end;
if m=i then
begin
aa[t]:=d[j];
inc(i);
b[j]:=-1;
inc(t);
end;
end;
//---------------------------------------------------------------------------
k:=1;
for i:=1 to n do
begin
p[i]:=k;
z[i]:=k;
inc(k);
end;
for i:=1 to n-1 do
for j:=i+1 to n do
begin
if g[i]<g[j] then
begin
doi(g[i],g[j]);
doi(p[i],p[j]);
end;
if h[i]<h[j] then
begin
doi(h[i],h[j]);
doi(z[i],z[j]);
end;
end;
i:=1;
t:=1;
while i<=n do
begin
m:=i;
for j:=1 to n do
if (h[j]<g[i]) and (h[j]>=0) then
begin
bb[t]:=z[j];
s:=s+2;
inc(t);
h[j]:=-1;
inc(i);
break;
end;
if m=i then
for j:=1 to n do
if (h[j]=g[i]) and (h[j]>=0) then
begin
bb[t]:=z[j];
s:=s+1;
inc(i);
inc(t);
h[j]:=-1;
break;
end;
if m=i then
begin
bb[t]:=z[j];
inc(i);
h[j]:=-1;
inc(t);
end;
end;
//--------------------------------------------------------------------
if s>s1 then
begin
writeln(fo,s);
for i:=1 to n do
writeln(fo,p[i],' ',bb[i]);
end else
begin
writeln(fo,s1);
for i:=1 to n do
writeln(fo,c[i],' ',aa[i]);
end;
close(fo);
end;
//-------------------------------------------
begin
clrscr;
doc;
xl;
readln;
end.



avatar
mainhatthong2004
Teen cá tính
Teen cá tính

Posts : 85
Reputation : -369988
Join date : 18/06/2018

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Đua ngựa (4 điểm)

Bài gửi by tonguyengiahan237 on Sat Dec 22, 2018 2:11 pm

Code:
Program Dua_ngua;
Uses crt;
Type Mang2c=array[1..50,1..50]of integer;
Var n,T1,T2,g,h,e:integer;
    fi,fo:text;
    A,B,X,Y:Mang2c;
    C,D:array[1..100]of integer;

Procedure Docdl1;
Var i,j:integer;
Begin
Assign(fi,'DUANGUA.INP');
Reset(fi);
Read(fi,N);
Readln(fi);
        For i:=1 to 2 do
        For j:=1 to n do
                begin
                Read(fi,A[i,j]);
                B[i,j]:=j;
                If j=n then readln(fi);
                end;
Close(fi);
End;

Procedure Sx_tang;
Var i,j,k,Tam:integer;
Begin
For i:=1 to 2 do
For j:=1 to n-1 do
For k:=j+1 to n do
        If A[i,k]<A[i,j] then
                Begin
                begin
                Tam:=A[i,k];
                A[i,k]:=A[i,j];
                A[i,j]:=Tam;
                end;
                begin
                Tam:=B[i,k];
                B[i,k]:=B[i,j];
                B[i,j]:=Tam;
                end;
                End;
End;

Procedure Xuli1;
Var j,k,D,f:integer;
Begin
Sx_tang;
T1:=0;
g:=1;
For j:=1 to n do
Begin
For k:=1 to n do
        begin
        f:=0;
        If (A[2,k]<A[1,j]) and (A[2,k]<>-1) then
                begin
                T1:=T1+2;
                C[g]:=B[1,j];
                inc(g);
                C[g]:=B[2,k];
                inc(g);
                inc(f);
                A[2,k]:=-1;
                break;
                end;
        End;
If f=0 then
        For k:=1 to n do
        Begin
        If (A[2,k]=A[1,j]) and (A[2,k]<>-1)then
                begin
                T1:=T1+1;
                C[g]:=B[1,j];
                inc(g);
                C[g]:=B[2,k];
                inc(g);
                A[2,k]:=-1;
                break;
                end;
        If (A[2,k]>A[1,j]) and (A[2,k]<>-1) then
                begin
                C[g]:=B[1,j];
                inc(g);
                C[g]:=B[2,n];
                inc(g);
                A[2,n]:=-1;
                end;
        End;
        End;
End;

Procedure Docdl2;
Var i,j:integer;
Begin
Assign(fi,'DUANGUA.INP');
Reset(fi);
Read(fi,N);
Readln(fi);
        For i:=1 to 2 do
        For j:=1 to n do
                begin
                Read(fi,X[i,j]);
                Y[i,j]:=j;
                If j=n then readln(fi);
                end;
Close(fi);
End;

Procedure Sx_giam;
Var i,j,k,Tam:integer;
Begin
For i:=1 to 2 do
For j:=1 to n-1 do
For k:=j+1 to n do
        If X[i,k]>X[i,j] then
                Begin
                begin
                Tam:=X[i,k];
                X[i,k]:=X[i,j];
                X[i,j]:=Tam;
                end;
                begin
                Tam:=Y[i,k];
                Y[i,k]:=Y[i,j];
                Y[i,j]:=Tam;
                end;
                End;
End;
Procedure Xuli2;
Var j,k,f,l:integer;
Begin
Sx_giam;
T2:=0;
h:=1;
l:=1;
For j:=1 to n do
Begin
For k:=1 to n do
        begin
        f:=0;
        If (X[2,k]<X[1,j]) and (X[2,k]<>-1) then
                begin
                T2:=T2+2;
                D[h]:=Y[1,j];
                inc(h);
                D[h]:=Y[2,k];
                inc(h);
                inc(f);
                X[2,k]:=-1;
                break;
                end;
        End;
If f=0 then
        For k:=1 to n do
        Begin
        If (X[2,k]=X[1,j]) and (X[2,k]<>-1)then
                begin
                T2:=T2+1;
                D[h]:=Y[1,j];
                inc(h);
                D[h]:=Y[2,k];
                inc(h);
                X[2,k]:=-1;
                break;
                end;
        If (X[2,k]>X[1,j]) and (X[2,k]<>-1) then
                begin
                D[h]:=Y[1,j];
                inc(h);
                D[h]:=Y[2,l];
                inc(h);
                X[2,l]:=-1;
                inc(l);
                end;
        End;
        End;
End;

BEGIN
CLRSCR;
Docdl1;
Xuli1;
Docdl2;
Xuli2;
Assign(fo,'DUANGUA.OUT');
Rewrite(fo);
If T1>T2 then
        begin
        Writeln(fo,T1);
        For e:=1 to g-1 do
                begin
                Write(fo,C[e],' ');
                If e mod 2=0 then writeln(fo);
                end;
        End
Else    begin
        Writeln(fo,T2);
        For e:=1 to h-1 do
                begin
                Write(fo,D[e],' ');
                If e mod 2=0 then writeln(fo);
                end;
        End;
Close(fo);
READLN;
END.
avatar
tonguyengiahan237
Nhiệt tình
Nhiệt tình

Posts : 42
Reputation : -1
Join date : 06/11/2018
Age : 14
Location : TT Phú Phong Huyện Tây Sơn Tỉnh Bình Định

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Đua ngựa (4 điểm)

Bài gửi by mainhatthong2004 on Sat Dec 22, 2018 2:45 pm

thong:
program bai4;
uses crt;
type mang=array[1..100] of integer;
var aa,b,c,d,p,z,a,bb,h,g:mang;
i,n,tg,j,s,l,m,t,k,s1:integer;
fi,fo:text;
//-------------------------------------------
procedure doi(var x,y:integer);
begin
tg:=x;
x:=y;
y:=tg;
end;
//---------------------------------------
procedure doc;
begin
assign(fi,'DUANGUA.inp');
reset(fi);
readln(fi,n);
for i:=1 to n do
read(fi,a[i]);
readln(fi);
for i:=1 to n do
read(fi,b[i]);
close(fi);
end;
//---------------------------------------
procedure xl;
begin
assign(fo,'DUANGUA.out');
rewrite(fo);
k:=1;
for i:=1 to n do
begin
c[i]:=k;
d[i]:=k;
h[i]:=b[i];
g[i]:=a[i];
inc(k);
end;
for i:=1 to n-1 do
for j:=i+1 to n do
begin
if a[i]>a[j] then
begin
doi(a[i],a[j]);
doi(c[i],c[j]);
end;
if b[i]>b[j] then
begin
doi(b[i],b[j]);
doi(d[i],d[j]);
end;
end;
i:=1;
t:=1;
while i<=n do
begin
m:=i;
for j:=1 to n do
if (b[j]<a[i]) and (b[j]>=0) then
begin
aa[t]:=d[j];
s1:=s1+2;
inc(t);
b[j]:=-1;
inc(i);
break;
end;
if m=i then
for j:=1 to n do
if (b[j]=a[i]) and (b[j]>=0) then
begin
aa[t]:=d[j];
s1:=s1+1;
inc(i);
inc(t);
b[j]:=-1;
break;
end;
if m=i then
begin
aa[t]:=d[j];
inc(i);
b[j]:=-1;
inc(t);
end;
end;
//---------------------------------------------------------------------------
k:=1;
for i:=1 to n do
begin
p[i]:=k;
z[i]:=k;
inc(k);
end;
for i:=1 to n-1 do
for j:=i+1 to n do
begin
if g[i]<g[j] then
begin
doi(g[i],g[j]);
doi(p[i],p[j]);
end;
if h[i]<h[j] then
begin
doi(h[i],h[j]);
doi(z[i],z[j]);
end;
end;
i:=1;
t:=1;
while i<=n do
begin
m:=i;
for j:=1 to n do
if (h[j]<g[i]) and (h[j]>=0) then
begin
bb[t]:=z[j];
s:=s+2;
inc(t);
h[j]:=-1;
inc(i);
break;
end;
if m=i then
for j:=1 to n do
if (h[j]=g[i]) and (h[j]>=0) then
begin
bb[t]:=z[j];
s:=s+1;
inc(i);
inc(t);
h[j]:=-1;
break;
end;
if m=i then
for j:=n downto 1 do
if h[j]>-1 then
begin
bb[t]:=z[j];
inc(i);
h[j]:=-1;
inc(t);
break;
end;
end;
//--------------------------------------------------------------------
if s>s1 then
begin
writeln(fo,s);
for i:=1 to n do
writeln(fo,p[i],' ',bb[i]);
end else
begin
writeln(fo,s1);
for i:=1 to n do
writeln(fo,c[i],' ',aa[i]);
end;
close(fo);
end;
//-------------------------------------------
begin
clrscr;
doc;
xl;
readln;
end.
avatar
mainhatthong2004
Teen cá tính
Teen cá tính

Posts : 85
Reputation : -369988
Join date : 18/06/2018

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Đua ngựa (4 điểm)

Bài gửi by nganvonhat123 on Sat Dec 22, 2018 2:57 pm

Code:
program duangua;

uses crt;
        type mang=array[1..100]of integer;
        var fi,fo:text;
            n,i,j,x,xx,t1,t2,dem:integer;
            a,b,c,d,e,ee:mang;
            kt:boolean;

        procedure nhap;
        begin
                assign(fi,'duangua.inp');
                reset(fi);
                readln(fi,n);
                for i:=1 to n do begin read(fi,a[i]);c[i]:=i;end;
                writeln;
                for j:=1 to n do begin read(fi,b[j]);d[j]:=j;end;
                close(fi);
        end;

        procedure doi(var a,b:integer);
                var tg:integer;
        begin
                tg:=a;
                a:=b;
                b:=tg;
        end;

        procedure sxga(var a:mang;b:integer);
                var i,j:integer;
        begin
                for i:=1 to n-1 do
                        for j:=i+1 to n do
                        if a[i]<a[j] then
                        begin
                                doi(a[i],a[j]);
                                doi(c[i],c[j]);
                        end;
        end;

        procedure sxgb(var a:mang;b:integer);
                var i,j:integer;
        begin
                for i:=1 to n-1 do
                        for j:=i+1 to n do
                        if a[i]<a[j] then
                        begin
                                doi(a[i],a[j]);
                                doi(d[i],d[j]);
                        end;
        end;




        procedure ty(a,b:mang);
        begin
                sxga(a,n);
                sxgb(b,n);
                t1:=0;
                for i:=n downto 1do
                begin
                        kt:=false;
                        for j:=1 to n do
                        if (a[i]>b[j]) and (b[j]<>-1) then
                                begin
                                        inc(x);
                                        e[x]:=c[i];
                                        inc(x);
                                        e[x]:=d[j];

                                        b[j]:=-1;

                                        t1:=t1+2;
                                        kt:=true;
                                        break;
                                end;
                        if not kt then
                        begin
                          for j:=1 to n do
                        if (a[i]=b[j]) and (b[j]<>-1) then
                                begin
                                        inc(x);
                                        e[x]:=c[i];
                                        inc(x);
                                        e[x]:=d[j];

                                        b[j]:=-1;

                                        t1:=t1+1;
                                        kt:=true;
                                        break;
                                end;
                        end;
                        if not kt then
                        begin
                        for j:=1 to n do
                        if (a[i]<b[j]) and (b[j]<>-1) then
                                begin
                                      inc(x);
                                      e[x]:=c[i];
                                      inc(x);
                                      e[x]:=d[j];

                                      b[j]:=-1;

                                      break;

                                end;
                        end;
        end;
        end;

        procedure tm(a:mang;b:mang);
        begin
                t2:=0;
                sxga(a,n);
                sxgb(b,n);

                for i:=1 to n do
                begin
                        kt:=false;
                        for j:=1 to n do
                        if (a[i]>b[j]) and (b[j]<>-1) then
                                begin
                                        inc(xx);
                                        ee[xx]:=c[i];
                                        inc(xx);
                                        ee[xx]:=d[j];
                                        t2:=t2+2;

                                        b[j]:=-1;

                                        kt:=true;
                                        break;
                                end;
                        if not kt then
                        begin
                          for j:=1 to n do
                        if (a[i]=b[j]) and (b[j]<>-1) then
                                begin
                                        inc(xx);
                                        ee[xx]:=c[i];
                                        inc(xx);
                                        ee[xx]:=d[j];
                                        t2:=t2+1;
                                        kt:=true;

                                        b[j]:=-1;
                                        break;
                                end;
                        end;
                        if not kt then
                        begin
                        for j:=1 to n do
                        if (a[i]<b[j]) and (b[j]<>-1) then
                                begin
                                        inc(xx);
                                        ee[xx]:=c[i];
                                        inc(xx);
                                        ee[xx]:=d[j];

                                        b[j]:=-1;

                                        break;
                                end;
                        end;
        end;

        end;





      procedure tim;
      begin
                assign(fo,'duangua.out');
                rewrite(fo);
                ty(a,b);
                tm(a,b);
                if t1>=t2 then
                        begin
                        writeln(fo,t1);
                                for i:=1 to x do
                                begin
                                        write(fo,e[i]);
                                        if i mod 2=0 then writeln(fo);
                                end
                        end
                        else
                        begin
                        writeln(fo,t2);
                                for i:=1 to xx do
                                begin
                                        write(fo,ee[i]);
                                        if i mod 2=0 then writeln(fo);
                                end;

                end;
                close(fo);
      end;

BEGIN
clrscr;
nhap;

tim;
readln;
END.

avatar
nganvonhat123
Teen Chính hiệu
Teen Chính hiệu

Posts : 12
Reputation : -109991
Join date : 24/11/2018
Age : 14

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Đua ngựa (4 điểm)

Bài gửi by Nguyễn Hoàng Nam on Sat Dec 22, 2018 2:59 pm

CODE HEHE:
program bt;
uses crt;
var n,t1,t2,g,h,dem1,i,j:longint;
fi,fo:text;
a,b,c,d:array[1..100,1..100]of longint;
aa,bb:array[1..100]of longint;

//--------------------------------------

procedure xstang;
var i,j,k,Tg:longint;
begin
for i:=1 to 2 do
for j:=1 to n-1 do
for k:=j+1 to n do
if A[i,k]<A[i,j] then
begin
begin
tg:=a[i,k];
a[i,k]:=a[i,j];
a[i,j]:=tg;
end;

begin
tg:=b[i,k];
b[i,k]:=b[i,j];
b[i,j]:=tg;
end;
end;
end;

//---------------------------------------

Procedure yeu;
var j,k,d,dem:integer;
begin
xstang;
t1:=0;
g:=1;
for j:=1 to n do
begin
for k:=1 to n do
begin
dem:=0;
if (a[2,k]<a[1,j]) and (a[2,k]<>-1) then
begin
t1:=t1+2;
aa[g]:=b[1,j];
inc(g);
aa[g]:=b[2,k];
inc(g);
inc(dem);
a[2,k]:=-1;
break;
end;
End;
if dem=0 then
For k:=1 to n do
Begin
If (a[2,k]=a[1,j]) and (a[2,k]<>-1)then
begin
t1:=t1+1;
aa[g]:=b[1,j];
inc(g);
aa[g]:=b[2,k];
inc(g);
A[2,k]:=-1;
break;
end;
if (a[2,k]>a[1,j]) and (a[2,k]<>-1) then
begin
aa[g]:=B[1,j];
inc(g);
aa[g]:=B[2,n];
inc(g);
a[2,n]:=-1;
end;
end;
end;
end;

//-----------------------------------------------------

procedure xsgiam;
var i,j,k,Tg:integer;
begin
for i:=1 to 2 do
for j:=1 to n-1 do
for k:=j+1 to n do
if c[i,k]>c[i,j] then
begin
begin
tg:=c[i,k];
c[i,k]:=c[i,j];
c[i,j]:=tg;
end;
begin
tg:=d[i,k];
d[i,k]:=d[i,j];
d[i,j]:=tg;
end;
end;
end;

//---------------------------------------

procedure manh;
var j,k,dem,l:integer;
begin
xsgiam;
t2:=0;
h:=1;
l:=1;
For j:=1 to n do
Begin
For k:=1 to n do
begin
dem:=0;
if (c[2,k]<c[1,j]) and (c[2,k]<>-1) then
begin
T2:=T2+2;
bb[h]:=d[1,j];
inc(h);
bb[h]:=d[2,k];
inc(h);
inc(dem);
c[2,k]:=-1;
break;
end;
end;
If dem=0 then
for k:=1 to n do
begin
if (c[2,k]=c[1,j]) and (c[2,k]<>-1)then
begin
t2:=T2+1;
bb[h]:=d[1,j];
inc(h);
bb[h]:=d[2,k];
inc(h);
c[2,k]:=-1;
end;
if (c[2,k]>c[1,j]) and (c[2,k]<>-1) then
begin
bb[h]:=d[1,j];
inc(h);
bb[h]:=d[2,l];
inc(h);
c[2,l]:=-1;
inc(l);
end;
end;
end;
end;

//---------------------------------------------

begin
clrscr;
assign(fi,'duangua.inp');
reset(fi);
read(fi,N);
readln(fi);
for i:=1 to 2 do
for j:=1 to n do
begin
read(fi,A[i,j]);
b[i,j]:=j;
if j=n then readln(fi);
end;
close(fi);
manh;
assign(fi,'duangua.inp');
reset(fi);
read(fi,n);
readln(fi);
For i:=1 to 2 do
for j:=1 to n do
begin
read(fi,c[i,j]);
d[i,j]:=j;
if j=n then readln(fi);
end;
close(fi);
yeu;
assign(fo,'duangua.out');
rewrite(fo);
if t1>t2 then
begin
writeln(fo,t1);
for dem1:=5 to g-1 do
begin
write(fo,aa[dem1],' ');
if dem1 mod 2=0 then writeln(fo);
end;
end
else
begin
Writeln(fo,T2);
for dem1:=5 to h-1 do
begin
write(fo,bb[dem1],' ');
if dem1 mod 2=0 then
writeln(fo);
end;
End;
Close(fo);
readln;
end.
avatar
Nguyễn Hoàng Nam
Teen Chính hiệu
Teen Chính hiệu

Posts : 17
Reputation : -159986
Join date : 06/11/2018
Age : 14

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Đua ngựa (4 điểm)

Bài gửi by Nguyễn Văn Biên on Sat Dec 22, 2018 3:20 pm

Spoiler:
Code:
program DUANGUA;
var f:text;
    A:array[1..10,1..1000] of integer;
    i,j,k,m,n,s,s1,t:integer;

procedure doi(var a,b:integer);
var c:integer;
begin c:=a; a:=b; b:=c end;

begin
        assign(f,'DUANGUA.INP'); reset(f);
        readln(f,n);
        for i:=1 to n do read(f,A[1,i]);
        for i:=1 to n do read(f,A[2,i]);
        close(f);
        k:=1;
        for i:=1 to n do
        begin A[3,i]:=k; A[4,i]:=k; A[5,i]:=A[2,i]; A[6,i]:=A[1,i]; inc(k) end;
        for i:=1 to n-1 do
        for j:=i+1 to n do
        begin
                if A[1,i]>A[1,j] then
                begin doi(A[1,i],A[1,j]); doi(A[3,i],A[3,j]) end;
                if A[2,i]>A[2,j] then
                begin doi(A[2,i],A[2,j]); doi(A[4,i],A[4,j]) end
        end;
        i:=1; t:=1;
        while i<=n do
        begin
                m:=i;
                for j:=1 to n do
                if (A[2,j]<A[1,i]) and (A[2,j]>=0) then
                begin A[7,t]:=A[4,j]; inc(s1,2); inc(t); A[2,j]:=-1; inc(i); break end;
                if m=i then
                for j:=1 to n do
                if (A[2,j]=A[1,i]) and (A[2,j]>=0) then
                begin A[7,t]:=A[4,j]; inc(s1); inc(i); inc(t); A[2,j]:=-1; break end;
                if m=i then
                begin A[7,t]:=A[4,j]; inc(i); A[2,j]:=-1; inc(t) end
        end;
        k:=1;
        for i:=1 to n do
        begin A[8,i]:=k; A[9,i]:=k; inc(k) end;
        for i:=1 to n-1 do
        for j:=i+1 to n do
        begin
                if A[6,i]<A[6,j] then
                begin doi(A[6,i],A[6,j]); doi(A[8,i],A[8,j]) end;
                if A[5,i]<A[5,j] then
                begin doi(A[5,i],A[5,j]); doi(A[9,i],A[9,j]) end
        end;
        i:=1; t:=1;
        while i<=n do
        begin
                m:=i;
                for j:=1 to n do
                if (A[5,j]<A[6,i]) and (A[5,j]>=0) then
                begin A[10,t]:=A[9,j]; inc(s,2); inc(t); A[5,j]:=-1; inc(i); break end;
                if m=i then
                for j:=1 to n do
                if (A[5,j]=A[6,i]) and (A[5,j]>=0) then
                begin A[10,t]:=A[9,j]; inc(s); inc(i); inc(t); A[5,j]:=-1; break end;
                if m=i then
                begin A[10,t]:=A[9,j]; inc(i); A[5,j]:=-1; inc(t) end
        end;
        assign(f,'DUANGUA.OUT'); rewrite(f);
        if s>s1 then
        begin writeln(f,s); for i:=1 to n do writeln(f,A[8,i],#32,A[10,i]) end
        else
        begin writeln(f,s1); for i:=1 to n do writeln(f,A[3,i],#32,A[7,i]) end;
        close(f)
end.

_________________

My:
- XDA Account
- Blog
- Game

...
avatar
Nguyễn Văn Biên
Recognised Member & Recognised Developer & Protected Member & Super Administrator
Recognised Member & Recognised Developer & Protected Member & Super Administrator

Posts : 220
Reputation : 1129923
Join date : 18/06/2018
Age : 15
Location : ?

Xem lý lịch thành viên https://bien2004official.blogspot.com

Về Đầu Trang Go down

Re: Đua ngựa (4 điểm)

Bài gửi by Sponsored content


Sponsored content


Về Đầu Trang Go down

Về Đầu Trang


 
Permissions in this forum:
Bạn không có quyền trả lời bài viết