Tin học Dãy nghịch thế (pascal)

[Nhật Hạ !]

[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.

Giúp mình câu b với ạ

DÃY NGHỊCH THẾ
Cho dãy số (a1, a2, a3, ..., an) là một hoán vị bất kỳ của tập hợp (1, 2, 3, ..., n). Dãy số (b1, b2, b3, ..., bn) gọi là nghịch thế của dãy a nếu bi là số phần tử đứng trước số i trong dãy a mà lớn hơn i.
Ví dụ:
Dãy a là: 3 2 5 7 1 4 6
Dãy b là: 4 1 0 2 0 1 0
a. Cho dãy a, hãy xây dựng chương trình tìm dãy b.
b. Cho dãy b, xây dựng chương trình tìm dãy a.
Dữ liệu vào: Trong file NGICH.INP với nội dung:
-Dòng đầu tiên là số n (1 <= n <= 10 000).
-Các dòng tiếp theo là n số của dãy a, mỗi số cách nhau một dấu cách,
-Các dòng tiếp theo là n số của dãy b, mỗi số cách nhau bởi một dấu cách.
Dữ liệu ra: Trong file NGHICH.OUT với nội dung:
-N số đầu tiên là kết quả của câu a
-Tiếp đó là một dòng trống và sau đó là n số kết quả của câu b (nếu tìm được dãy a).

 

[CuongGrove]

Mình làm được rồi bạn ơi, nhưng cách của mình nó hơi bựa. Thay vì có một công thức cụ thể để từ b => a thì mình kiểm tra từng hoán vị của các số từ 1 => n rồi kiểm tra xem nó có thỏa mãn với dãy b hay không.
Bạn tham khảo thử nha :

Const
    Input = 'Input.inp';
    Output = 'Output.out';
Var f : text;
    n,i : word;
    DaySo_A,DaySo_B : array[1..10000] of word;
    MangBoolean : array[1..10000] of boolean;
Procedure GhiKetQua;
    Var j : word;
    Begin
        For j:=1 to n do Write(f,DaySo_A[j],' ');
        Writeln;
    End;      
Function SoNghichThe(SoDangXet : word) : word;
    Var j,k,BienDem : word;
    Begin
        BienDem:=0;
        For j:=1 to n do
            If     DaySo_A[j] = SoDangXet then
                Begin
                    For k:=1 to j do
                        If DaySo_A[k] > SoDangXet then Inc(BienDem);
                    break;
                End;
        SoNghichThe:=BienDem;
    End;                  
Function KiemTra : boolean;
    Var j : word;
        a : boolean;
    Begin
        a :=true;
        For j:=1 to n do
            If DaySo_B[j] <> SoNghichThe(j) then a:=false;
        KiemTra:=a;
    End;  
Procedure HoanVi_N_So (i : word);
    Var j :word;
    Begin
        If i <= n then
            For j:=1 to n do
                Begin
                    If (MangBoolean[j] = false) then
                        Begin
                            DaySo_A[i] := j;
                            MangBoolean[j] := true;
                            HoanVi_N_So(i+1);
                            MangBoolean[j] := false;
                        End;
                End;
        If (i = n) and (KiemTra = true) then GhiKetQua;
    End;                      
Begin
    Assign(f,Input);
    Reset(f);
    Readln(f,n);
    For i:=1 to n do Read(f,DaySo_B[i]);
    Close(f);
    Assign(f,Output);
    Rewrite(f);
    HoanVi_N_So(1);
    Close(f);
End.

Bạn làm rồi thì gửi cho mình xem với!

 

[Nhật Hạ !]

Mình làm như này nè...

Var a,c:array[1..100] of longint;
g:text;
n,i,d,b,j,k: longint;
Begin
Assign(g,'Ngich.inp'); Reset(g);
Readln(g,n);
For i:=1 to n do read(g,a[i]);
For d:=1 to n do
Begin
b:=0;
For i:=1 to n do
  If a[i]=d then break else
    If a[i]>d then inc(b);
write(b:4);
End;
writeln;

For i:=1 to n do read(g,a[i]);
   For i:=1 to n do
  Begin
  k:=0;
  For j:=1 to n do
    Begin
    If c[j]=0 then inc(k);
    If k=a[i]+1 then Begin c[j]:=i; break; End;
    End;
  End;

For i:=1 to n do write(c[i]:4);
Readln;
End.

 

[Elishuchi]

Mình làm như này nè...

Var a,c:array[1..100] of longint;
g:text;
n,i,d,b,j,k: longint;
Begin
Assign(g,'Ngich.inp'); Reset(g);
Readln(g,n);
For i:=1 to n do read(g,a[i]);
For d:=1 to n do
Begin
b:=0;
For i:=1 to n do
  If a[i]=d then break else
    If a[i]>d then inc(b);
write(b:4);
End;
writeln;

For i:=1 to n do read(g,a[i]);
   For i:=1 to n do
  Begin
  k:=0;
  For j:=1 to n do
    Begin
    If c[j]=0 then inc(k);
    If k=a[i]+1 then Begin c[j]:=i; break; End;
    End;
  End;

For i:=1 to n do write(c[i]:4);
Readln;
End.

bạn làm cả câu a,b ở đây hả

 

[Elishuchi]

Mình làm như này nè...

Var a,c:array[1..100] of longint;
g:text;
n,i,d,b,j,k: longint;
Begin
Assign(g,'Ngich.inp'); Reset(g);
Readln(g,n);
For i:=1 to n do read(g,a[i]);
For d:=1 to n do
Begin
b:=0;
For i:=1 to n do
  If a[i]=d then break else
    If a[i]>d then inc(b);
write(b:4);
End;
writeln;

For i:=1 to n do read(g,a[i]);
   For i:=1 to n do
  Begin
  k:=0;
  For j:=1 to n do
    Begin
    If c[j]=0 then inc(k);
    If k=a[i]+1 then Begin c[j]:=i; break; End;
    End;
  End;

For i:=1 to n do write(c[i]:4);
Readln;
End.

code của bạn vậy mình thấy là hoàn thiện rồi còn gì
câu b theo mình đầu chương trình phải khởi tạo mảng c với lệnh: fillchar(c,sizeof(c),0);

 

[Nhật Hạ !]

code của bạn vậy mình thấy là hoàn thiện rồi còn gì
câu b theo mình đầu chương trình phải khởi tạo mảng c với lệnh: fillchar(c,sizeof(b),0);

Mình làm cả câu a với câu b được rồi đó bạn.
Cái khởi tại mảng đó mình chưa học

 

[Elishuchi]

Mình làm cả câu a với câu b được rồi đó bạn.
Cái khởi tại mảng đó mình chưa học

à cái lệnh đó dùng để khởi tạo mảng c với toàn bộ giá trị bằng 0

 

[Leonier]

Mình làm như này nè...

Var a,c:array[1..100] of longint;
g:text;
n,i,d,b,j,k: longint;
Begin
Assign(g,'Ngich.inp'); Reset(g);
Readln(g,n);
For i:=1 to n do read(g,a[i]);
For d:=1 to n do
Begin
b:=0;
For i:=1 to n do
  If a[i]=d then break else
    If a[i]>d then inc(b);
write(b:4);
End;
writeln;

For i:=1 to n do read(g,a[i]);
   For i:=1 to n do
  Begin
  k:=0;
  For j:=1 to n do
    Begin
    If c[j]=0 then inc(k);
    If k=a[i]+1 then Begin c[j]:=i; break; End;
    End;
  End;

For i:=1 to n do write(c[i]:4);
Readln;
End.

Umm, nhưng bạn ơi, cho mình hỏi cái này có cần close không ạ