Thảo luận Pascal nâng cao!

[mewxu]

Chán quá bài mình post chưa ai có code hoàn chỉnh à. Thử làm BFS rồi, nhưng có những test mà các khu vực chia thành nhiều vùng, thì BFS die.
Có TOPIC đề thi Nam Định rùi mọi người zo đi nào, topic này có vẻ ít dân quá, kiểm ra thì có 3 mem thôi à, chán mún chết

[vasmobifone]

Code bài hệ thống xăng trên các đảo.

Uses Crt;
Const fi = 'DAO.INP'; fo = 'DAO.OUT';
Var F : Text;
    i, n, m, u, v, d, c, so : Integer;
    td : Array[1..2, 1..200] Of Integer;
    dau : Array[1..200] Of Boolean;
    tr, hd, kq : Array[1..200] Of Byte;

Procedure DocDuLieu;
Begin
        Assign(f, fi);
        Reset(f);
        Readln(f, n, m, u, v);
        For i := 1 To n Do
                Readln(f, td[1, i], td[2, i]);
        Close(f);
        FillChar(dau, SizeOf(dau), True);
        tr[1] := 0;
        so := 0;
        Assign(f, fo);
        Rewrite(f);
End;

Function KC(i, j : Integer): Real;
Var x, y : Real;
Begin
        x := td[1, i] - td[1, j];
        y := td[2, i] - td[2, j];
        kc := Sqrt(Sqr(x)+Sqr(y));
End;

Procedure Viet;
Begin
        While tr[c] > 0 Do
        Begin
                Inc(so);
                kq[so] := hd[c];
                c := tr[c];
        End;
        Inc(so);
        kq[so] := u;
        Writeln(f, so);
        For i := so Downto 1 Do Write(f, kq[i],' ');
        Close(f);
        Halt;
End;

Procedure Hangdoi;
Begin
        d := 1;
        c := 1;
        hd[1] := u;
        dau[u] := False;
        While d <= c Do
        Begin
                For i := 1 To n Do
                If dau[i] And (kc(i, hd[d]) <= m) Then
                Begin
                        Inc(c);
                        hd[c] := i;
                        dau[i] := False;
                        tr[c] := d;
                        If i = v Then Viet;
                End;
                Inc(d);
        End;
        Writeln(f, 'NO SOLUTION!');
        Close(f);
End;

BEGIN
        DocDuLieu;
        Hangdoi;
End.

Dưới đây là đoạn code chứng minh đoạn code trên đây là hoàn toàn chính xác.

        Const fi = 'dao2.inp'; fo = 'dao2.out';

        Type dao = record
                x, y : Integer;
             End;
             mangso = Array[1..100] of Integer;

        Var f, g : Text;
            a    : Array[1..100] of dao;
            b, c : mangso;
            DD   : Array[1..100] of Boolean;
            DDmin, dem, d, dau, dich, n, sn : Integer;
            m    : Real;
            Good : Boolean;

{=== Mo file ===}
        Procedure Openf;
        Begin
                Assign(f, fi);  Reset(f);
                Assign(g, fo);  Rewrite(g);
        End;

{=== Dong file ===}
        Procedure Closef;
        Begin
                Close(f);       Close(g);
        End;

{=== Input ===}
        Procedure Input;
        Var k : Integer;
        Begin
                Readln(f, n, m, dau, dich);
                For k := 1 to n do Readln(f, a[k].x, a[k].y);
                FillChar(b, SizeOf(b), 0);
                FillChar(c, SizeOf(c), 0);
                FillChar(DD, SizeOf(DD), False);
                DDMin := Maxint;
        End;

{=== Print ===}
        Procedure Print(x : mangso; sl : Integer);
        Var k : Integer;
        Begin
                Inc(sn);
                For k := 1 to (sl - 1) do Write(g, x[k], ' ---> ');
                Writeln(g, x[sl]);
        End;

{=== Tinh Khoang Cach ===}
        Function KC(i, j : Integer) : Real;
        Begin
                KC := sqrt(sqr(abs(a[i].x-a[j].x))+sqr(abs(a[i].y-a[j].y)));
        End;

{=== Vet ===}
        Procedure Try(i : Integer);
        Var j, k : Integer;
        Begin
                If d = dich then
                Begin
                        Print(b, dem);
                        If (sn = 1) Or (dem < DDMin) then
                        Begin
                                DDMin := dem;
                                FillChar(c, SizeOf(c), 0);
                                For k := 1 to dem do c[k] := b[k];
                        End;
                End;
                For j := 1 to n do
                Begin
                        If (j <> i) And (Not DD[j]) then
                        Begin
                                Good := True;
                                For k := 1 to dem do
                                If (a[j].x = a[k].x) And (a[j].y = a[k].y) then Good := False;
                                If Good And (KC(i, j) <= m) then
                                Begin
                                        Inc(dem);
                                        b[dem] := j;
                                        DD[j] := True;
                                        d := j;
                                        Try(d);
                                        b[dem] := 0;
                                        Dec(dem);
                                        DD[j] := False;
                                End;
                        End;
                End;
        End;

{=== Xu li ===}
        Procedure Process;
        Begin
                sn := 0;
                dem := 1;
                b[1] := dau;
                Try(dau);
                If DDMin > 0 then
                Begin
                        Writeln(g, 'Tong so duong di : ',sn);
                        Writeln(g, 'Duong di toi uu  : ');
                        Print(c, DDMin);
                End
                Else
                Writeln(g, 'Khong cos duong di toi uu tu ',dau,' den ',dich);
                Closef;
        End;

{=== MAIN ===}
        BEGIN
                Openf;
                Input;
                Process;
        END.

Chúc các bạn học tốt!

[evashopping]

Đề bài: Cho dãy số nguyên b: b[1],b[2],...,b[n]. Tìm dãy số nguyên a sao cho:
b[I]=a[i-1]+a[I]+a[i+1] với a[n]=a[0], a[n+1]=a[1].

Mình giải như sau:

const fi='dulieu.inp';
      fo='ketqua.out';
var a,b:array[0..300] of real;
    f:text;
    tong,tong1,tong2,tong3:real;
    N,i:integer;

procedure nhap;
  var i:integer;
  begin
     assign(f,fi);
     reset(f);
     readln(f,N);
     for i:=1 to N do read(f,b[i]);
     close(f);
  end;

procedure tim_a(i:integer);
  var k:integer; tam:real;
  begin
     tam:=tong;
     k:=2;
     while k+1<i do
         begin
            tam:=tam-b[k];
            inc(k,3);
         end;
     while k-1>i do
         begin
            tam:=tam-b[k];
            dec(k,3);
         end;
     if N mod 3 = 1 then a[i]:=tam
         else a[k-1]:=b[k]-tam;
  end;

procedure xuly;
  var i:integer;
  begin
     assign(f,fo);
     rewrite(f);
     for i:=1 to N do tong:=tong+b[i];
     tong:=tong/3;
     i:=1;
     while i<=N do
        begin
           tong1:=tong1+b;
           tong2:=tong2+b[i+1];
           tong3:=tong3+b[i+2];
           inc(i,3);
        end;
     if tong = trunc(tong) then
             begin
                If N mod 3 = 0 then
                    if (tong1=tong2) and (tong2=tong3) then write(f,'VO SO NGHIEM')
                        else
                           begin
                              for i:=1 to N do tim_a(i);
                              if a[0]<>0 then a[n]:=a[0];
                              for i:=1 to N do write(f,a:0:0,'   ');
                           end;
             end
        else write(f,'VO NGHIEM');
     close(f);
  end;

BEGIN
   nhap;
   xuly;
END.

Nhưng kết quả không in ra file ketqua.out. Rõ ràng tư duy không có gì sai. Mình nghĩ thủ tục tim_a lỗi nhưng không biết khắc phục thế nào.
Mong mọi ng giúp đỡ [IMG]data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAEAAAABAQMAAAA l21bKAAAAA1BMVEXh5PJm+yKVAAAAAXRSTlMAQObYZgAAAApJR EFUCNdjYAAAAAIAAeIhvDMAAAAASUVORK5CYII=[/IMG]

[TruongTamPhong]

Mọi người check giúp mình chương trình trên đi.
Mình nghĩ thủ tục tim_a có vấn đề. Mình đang băn khoăn trong thủ tục tim_a thì tham số đưa vào là i, nhưng biến k hoàn toàn có thể xác định theo i. Vậy kết quả sau khi thực hiện thủ tục có biến k nhưng biến k lúc đó được xác định rõ ràng, có thể nói là hằng số. Như thế có được không?

[thangemxuananh]

Làm thế nào để sắp xếp 1 dãy theo thứ tự từ điển.
VD: cho dãy :1,2,3,…,11 sắp xếp thành:1,10,11,2,3,4,…9
Ai biết giúp em với. em thank trước

[nguyenduong2402]

Làm thế nào để sắp xếp 1 dãy theo thứ tự từ điển.
VD: cho dãy :1,2,3,…,11 sắp xếp thành:1,10,11,2,3,4,…9
Ai biết giúp em với. em thank trước

Gọi N là độ dài của chữ số dài nhất.
Thêm các số 0 vào trước các số có độ dài chữ số <N.
Sắp xếp bình thường [IMG]data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAEAAAABAQMAAAA l21bKAAAAA1BMVEXh5PJm+yKVAAAAAXRSTlMAQObYZgAAAApJR EFUCNdjYAAAAAIAAeIhvDMAAAAASUVORK5CYII=[/IMG]

[minhkiet0907]

Gọi N là độ dài của chữ số dài nhất.
Thêm các số 0 vào trước các số có độ dài chữ số <N.
Sắp xếp bình thường [IMG]data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAEAAAABAQMAAAA l21bKAAAAA1BMVEXh5PJm+yKVAAAAAXRSTlMAQObYZgAAAApJR EFUCNdjYAAAAAIAAeIhvDMAAAAASUVORK5CYII=[/IMG]

Em hơi kém :emlaugh: , anh có thể chỉ rõ hơn cho em được không ạ [IMG]data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAEAAAABAQMAAAA l21bKAAAAA1BMVEXh5PJm+yKVAAAAAXRSTlMAQObYZgAAAApJR EFUCNdjYAAAAAIAAeIhvDMAAAAASUVORK5CYII=[/IMG]