game box tin - Chém code như chém gió

M

mikelhpdatke

Bài này e cũng làm trên Spoj rồi, nhưng nộp nó toàn báo chạy quá lâu. Mặc dù kt trên máy vẫn đúng
 
S

starlove_maknae_kyuhyun

Em có cái code này, thấy chạy thử text trên thì đúng, không biết có đúng thật không nên mọi người thử xem nha.
Mã:
var d,e,n,k,m,i,j:integer;
    f,g:text;
    a:array[1..100,1..100]of char;
    kt:array[1..100,1..100]of boolean;
procedure input;
begin
     assign(f,'bai1.inp');
     reset(f);
     readln(f,n,m);
     for i:=1 to n do
         begin
              for j:=1 to n do read(f,a[i,j]);
              readln(f);
         end;
     close(f);
end;
function ktmang(k:integer):integer;
begin
     for i:=1 to k do
         for j:=1 to k do
             if a[i,j]='0' then inc(d);
     ktmang:=d;
end;
procedure xuli;
begin
      d:=0;
      for k:=1 to n do
          if ktmang(k)=1 then break;
end;
procedure output;
begin
     assign(g,'bai1.out');
     rewrite(g);
     write(g,k);
     close(g);
end;
BEGIN
     input;
     xuli;
     output;
END.

Chào bạn !
Theo mình thì bài của bạn có thể hiểu sai đề !
mình mới đọc qua thì chắc bạn sẽ hiểu là hình vuông lấy ô (1;1) làm một góc !
vì vậy khi mình thử bộ test với ô đầu tiên là 0 và giá trị m=1 thì kết quả luôn là 1 !

đây là code của mình nó hơi dài nhưng dễ hiểu , các bạn có thể tối ưu hóa :

PHP:
 const
     fi='BAI1.INP'; fo='BAI1.OUT';
 var
   n,m:word;
   a:array[1..100,1..100] of 0..1;
   kq:word;
 procedure input;
  var
    f:text;
    i,j:word;
  begin
     assign(f,fi);
     reset(f);
     readln(f,n,m);
     for i:=1 to n do
      for j:=1 to n do
       read(f,a[i,j]);
     close(f);
  end;


 procedure xuli;
  var
    i,j,q,p:word;
    kxd,kyd,kxs,kys:word;
    dem,max:word;
  begin
    max:=0;
     for i:=1 to n do
      for j:=1 to n do
       begin
          kxd:=i; kyd:=j; kxs:=i; kys:=j;
          while (kxs<n) and ( kys<n) do
           begin
              inc(kxs) ; inc(kys);
              dem:=0;
             for q:=kxd to kxs do
               for p:=kyd to kys do
                 begin
                     if a[q,p]=0 then inc(dem);
                     if dem=m then begin kq:=kxs-kxd+1; max:=dem ; exit end;
                 end;
               if dem>max then begin max:=dem; kq:=kxs-kxd+1; end;
           end;
       end;
  end;

 procedure output;
  var
    f:text;
  begin
     assign(f,fo); rewrite(f);
     write(f,kq);
     close(f);
  end;

BEGIN
    input;
    xuli;
    output;
END.

Starlove thân !
 
H

hocmai.diendan

Bài anh quang đúng rồi. Bài anh Thành sai rồi. Đề bài thì yêu cầu đọc và xuất từ tệp bwpoints mà, sao lại là tệp cuong vậy nè.
P/s: t-mod mới của box Tin là ai vậy? Trưởng nhóm nữa à?

Anh set theo đề xuất của Smod. Em liên hệ với Smod để cập nhật thông tin và được giải đáp nhé!
 
1

11thanhkhoeo

Vì các bạn tham gia ở đây đều là các học sinh giỏi, chúng ta có thể code tức là chúng ta hiểu thuật toán.

Thành mong các bạn khi code 1 bài nào đó thì cũng nói luôn thuật toán cho mọi người cùng hiểu, qua đó có thể cải tiến thuật toán theo cách của mình

Thân
 
C

cuong276

Chào bạn !
Theo mình thì bài của bạn có thể hiểu sai đề !
mình mới đọc qua thì chắc bạn sẽ hiểu là hình vuông lấy ô (1;1) làm một góc !
vì vậy khi mình thử bộ test với ô đầu tiên là 0 và giá trị m=1 thì kết quả luôn là 1 !

đây là code của mình nó hơi dài nhưng dễ hiểu , các bạn có thể tối ưu hóa :

PHP:
 const
     fi='BAI1.INP'; fo='BAI1.OUT';
 var
   n,m:word;
   a:array[1..100,1..100] of 0..1;
   kq:word;
 procedure input;
  var
    f:text;
    i,j:word;
  begin
     assign(f,fi);
     reset(f);
     readln(f,n,m);
     for i:=1 to n do
      for j:=1 to n do
       read(f,a[i,j]);
     close(f);
  end;


 procedure xuli;
  var
    i,j,q,p:word;
    kxd,kyd,kxs,kys:word;
    dem,max:word;
  begin
    max:=0;
     for i:=1 to n do
      for j:=1 to n do
       begin
          kxd:=i; kyd:=j; kxs:=i; kys:=j;
          while (kxs<n) and ( kys<n) do
           begin
              inc(kxs) ; inc(kys);
              dem:=0;
             for q:=kxd to kxs do
               for p:=kyd to kys do
                 begin
                     if a[q,p]=0 then inc(dem);
                     if dem=m then begin kq:=kxs-kxd+1; max:=dem ; exit end;
                 end;
               if dem>max then begin max:=dem; kq:=kxs-kxd+1; end;
           end;
       end;
  end;

 procedure output;
  var
    f:text;
  begin
     assign(f,fo); rewrite(f);
     write(f,kq);
     close(f);
  end;

BEGIN
    input;
    xuli;
    output;
END.

Starlove thân !

Anh ơi! Em thử chạy chương trình của anh với bộ text mà đề bài cho thì thấy chạy cho kết quả ra ở bai1.out là 2. Trong khi đó kết quả đề bài lại là 3.
Thân!
 
M

mikelhpdatke

Cách của e là. Kt lần lượt từ mảng n*n về 1*1. Nếu đúng thì break.

Mã:
program phoinguyenlieu;
Var A:array[0..100,0..100] Of Integer;
    C:array[0..100,0..100] Of Boolean;
   n,k:integer;
   f,g:text;
Procedure Init;
 Var i,j:integer;
Begin
  FillChar(c,SizeOf(c),True);


  Assign(f,'BAI1.INP');
  reset(f);
   Read(f,n);
  Readln(f,k);
  For i:=1 to n do
   For j:=1 to n do
     Begin
      Read(f,A[i,j]);
       If A[i,j]=0 then C[i,j]:=False;
      end;
  Close(f);
End;
Function kt(m:integer):Boolean;
Var i,j,d:integer;
   Begin
     kt:=False;
     d:=0;
        For i:=1 to m do
          For j:=1 to m do
            Begin
               IF not C[i,j] then inc(d);
               IF d>k then exit(False);
            end;
   kt:=True;
   end;

Procedure Install;
Var l,m:integer;
   Begin
      m:=n;
Assign(g,'BAI1.OUT');
rewrite(g);
         For l:=m downto 1 do IF kt(l) then
          begin
          write(g,l);
          break;
          end;
Close(g);
   end;

begin
  Init;
  Install;
  readln
end.
 
C

cuong276

Bài của Đạt bị lỗi 85. Hình như thiếu dấu ";" ở đâu đó thì phải. Đạt kiểm tra lại chương trình đi nha
Thân!
 
M

mikelhpdatke

Mình đã test nhiều lần trước khi mang lên đây, không có lỗi j` cả, bạn thay đường dẫn file chia đấy. Xem xét kỹ nha.
Thân
 
C

cuong276

Xem kĩ rồi! Hoặc là chương trình của bạn sai, hoặc là máy của mình có vấn đề. Cóp code chạy lại thử coi nha.
Thân!
 
Q

quanghero100

Cách của e là. Kt lần lượt từ mảng n*n về 1*1. Nếu đúng thì break.

Mã:
program phoinguyenlieu;
Var A:array[0..100,0..100] Of Integer;
    C:array[0..100,0..100] Of Boolean;
   n,k:integer;
   f,g:text;
Procedure Init;
 Var i,j:integer;
Begin
  FillChar(c,SizeOf(c),True);


  Assign(f,'BAI1.INP');
  reset(f);
   Read(f,n);
  Readln(f,k);
  For i:=1 to n do
   For j:=1 to n do
     Begin
      Read(f,A[i,j]);
       If A[i,j]=0 then C[i,j]:=False;
      end;
  Close(f);
End;
Function kt(m:integer):Boolean;
Var i,j,d:integer;
   Begin
     kt:=False;
     d:=0;
        For i:=1 to m do
          For j:=1 to m do
            Begin
               IF not C[i,j] then inc(d);
               IF d>k then exit(False);
            end;
   kt:=True;
   end;

Procedure Install;
Var l,m:integer;
   Begin
      m:=n;
Assign(g,'BAI1.OUT');
rewrite(g);
         For l:=m downto 1 do IF kt(l) then
          begin
          write(g,l);
          break;
          end;
Close(g);
   end;

begin
  Init;
  Install;
  readln
end.
Bài của em anh chưa có test thử nhưng cái thuật toán của em anh thấy có vấn đề. Đó là em đang thu nhỏ dần về góc trên bên trái với cạnh trên cùng và cạnh bên trái là mốc (nói cách khác là em lấy ô (1;1)) để là mốc thì phải. Liệu cách đó của em có hợp lí không? Anh ví dụ như cái hình vuông k*k nó không có chứa ô (1;1) mà nó nằm vùng giữa của mảng n*n hoặc nằm ở phía góc dưới bên phải, góc trên bên phải hay góc dưới bên trái thì sao lúc đó có tìm được nghiệm hay không. Nếu em chọn việc thu ma trận để tìm nghiệm thì theo anh cần bổ xung thêm các bước kiểm tra thu vào trung tâm thu về các góc nữa mới okê dc
Thân!!!
 
M

mikelhpdatke

Chậc, e hiểu sai đề bài rồi, e cứ nghĩ lấy 1,1 làm mốc~~. Để e nghĩ lại đã, tks a :D
 
M

mikelhpdatke

Thuật: Duyệt tất cả cách có thể đặt phôi i*i vào. Dĩ nhiên chỉ tìm gốc trên đỉnh bên trái rồi kiểm tra. AE xem xem có vấn đề j` ko

Mã:
program phoinguyenlieu;
Var A:array[0..100,0..100] Of Integer;
    C:array[0..100,0..100] Of Boolean;
   n,k,m:integer;
   f,g:text;
Procedure Init;
 Var i,j:integer;
Begin
  FillChar(c,SizeOf(c),True);


  Assign(f,'C:\BAI1.INP');
  reset(f);
   Read(f,n);
  Readln(f,k);
  For i:=1 to n do
   For j:=1 to n do
     Begin
      Read(f,A[i,j]);
       If A[i,j]=0 then C[i,j]:=False;
      end;
  Close(f);
End;
Function ktm(i,j:integer):Boolean;
Var d,z,x:integer;
   Begin
     ktm:=False;
      d:=0;
     For z:=i to m do
      For x:=j to m do
            Begin
               IF not C[z,x] then inc(d);
               IF d>k then exit(False);
            end;
   ktm:=True;
   end;

Function kt(m:integer):Boolean;
Var i,j,d,l,p:integer;
   Begin
     kt:=False;
     d:=0;
        For i:=1 to n-m+1 do
          For j:=1 to n-m+1 do
            Begin
               IF ktm(i,j) then
                begin
                   IF ktm(i,j) then
                   Exit(True);
                End;
            end;
   kt:=False;
   end;

Procedure Install;
Var l:integer;
   Begin
      m:=n;
Assign(g,'C:\BAI1.OUT');
rewrite(g);
         For l:=m downto 1 do IF kt(l) then
          begin
          write(g,l);
          break;
          end;
Close(g);
   end;

begin
  Init;
  Install;
  readln
end.
 
S

starlove_maknae_kyuhyun

xin lỗi mọi người bài trên mình có bị đánh lừa một số bộ test các bạn thông cảm nha !
sau đây mình sẽ post lại code ! các bạn nhận xét xem sao nhak !


PHP:
 const
     fi='BAI1.INP'; fo='BAI1.OUT';
 var
   n,m:word;
   a:array[1..100,1..100] of 0..1;
   kq:word;
 procedure input;
  var
    f:text;
    i,j:word;
  begin
     assign(f,fi);
     reset(f);
     readln(f,n,m);
     for i:=1 to n do
      for j:=1 to n do
       read(f,a[i,j]);
     close(f);
  end;


 procedure xuli;
  var
    i,j,q,p:word;
    kxd,kyd,kxs,kys:word;
    dem,max:word;
  begin
    max:=0;
     for i:=1 to n do
      for j:=1 to n do
       begin
          kxd:=i; kyd:=j; kxs:=i; kys:=j;
          while (kxs<n) and ( kys<n) do
           begin
              inc(kxs) ; inc(kys);
              dem:=0;
             for q:=kxd to kxs do
               for p:=kyd to kys do
                 begin
                     if a[q,p]=0 then inc(dem);
                     if dem=m then begin kq:=kxs-kxd+1; max:=dem ; exit end;
                 end;
               if dem>max then begin max:=dem; kq:=kxs-kxd+1; end;
           end;
       end;
  end;

 procedure output;
  var
    f:text;
    {i,j:word;   }
  begin
     assign(f,fo); rewrite(f);
     write(f,kq);
     close(f);
  end;

BEGIN
    input;
    xuli;
    output;
END.
 
S

starlove_maknae_kyuhyun

Bài 1 đề olympic 30-4 THPT chuyên Lê Quí Đôn ( Vũng Tàu )

Tuyển nhân viên :
công ty phần mềm máy tính a có số lượng nhân viên rất lớn để tiện việc quản lý ,công ty đã cấp cho mỗi nhân viên một mã số , mã số của mỗi nhân viên là một số nguyên dương, hai nhân viên bất kì thì có mã số khác nhau . tuy nhiên sau một thời gian thì có một số nhân viên nghỉ hưu hoặc chuyển công tác , nên công ty phải tiến hành tuyển thâm k nhân viên mới. các nhân viên mới này sau khi đưcọ tuyển vào cũng sẽ được cấp một mã số ( là một số nguyên dương )
yêu cầu : với n nhân viên có (còn lại )của công ty tương ứng với các mã số là $a_1$,$a_2$ ......$a_n$ , hãy tìm k mã số nhỏ nhất để cấp cho k nhân viên mới tuyển vào sao cho vẫn thỏa mãn hai nhân viên bất kỳ (cả nhân viên cũ và nhân viên mới ) có mã số khác nhau .
Dữ liệu : vào từ file ; RECRUIT.INP ' có nội dung như sau :
* dòng đầu tiên chưa hai số nguyên dương lần lượt là n và k (k<=n)
* n dòng tiếp theo , dòng thứ i là số nguyên dương $a_i$ ( $i = 1;2....n $,$a_i$$<=2.10^{9} $
Kết quả ghi vào file 'RECRUIT.OUT' k mã số theo thứ tự từ nhỏ đến lớn ( mỗi má số trên một dòng )


Ví dụ
RECRUIT.INP

RECRUIT.OUT
 
M

mikelhpdatke

xin lỗi mọi người bài trên mình có bị đánh lừa một số bộ test các bạn thông cảm nha !
sau đây mình sẽ post lại code ! các bạn nhận xét xem sao nhak !


PHP:
 const
     fi='BAI1.INP'; fo='BAI1.OUT';
 var
   n,m:word;
   a:array[1..100,1..100] of 0..1;
   kq:word;
 procedure input;
  var
    f:text;
    i,j:word;
  begin
     assign(f,fi);
     reset(f);
     readln(f,n,m);
     for i:=1 to n do
      for j:=1 to n do
       read(f,a[i,j]);
     close(f);
  end;


 procedure xuli;
  var
    i,j,q,p:word;
    kxd,kyd,kxs,kys:word;
    dem,max:word;
  begin
    max:=0;
     for i:=1 to n do
      for j:=1 to n do
       begin
          kxd:=i; kyd:=j; kxs:=i; kys:=j;
          while (kxs<n) and ( kys<n) do
           begin
              inc(kxs) ; inc(kys);
              dem:=0;
             for q:=kxd to kxs do
               for p:=kyd to kys do
                 begin
                     if a[q,p]=0 then inc(dem);
                     if dem=m then begin kq:=kxs-kxd+1; max:=dem ; exit end;
                 end;
               if dem>max then begin max:=dem; kq:=kxs-kxd+1; end;
           end;
       end;
  end;

 procedure output;
  var
    f:text;
    {i,j:word;   }
  begin
     assign(f,fo); rewrite(f);
     write(f,kq);
     close(f);
  end;

BEGIN
    input;
    xuli;
    output;
END.

Code của a độ phức tạp bao nhiểu nhế ?? Của e hình như O(N^4) thì phải, hơi chóng mặt
 
M

mikelhpdatke

Bài 1 đề olympic 30-4 THPT chuyên Lê Quí Đôn ( Vũng Tàu )

Tuyển nhân viên :
công ty phần mềm máy tính a có số lượng nhân viên rất lớn để tiện việc quản lý ,công ty đã cấp cho mỗi nhân viên một mã số , mã số của mỗi nhân viên là một số nguyên dương, hai nhân viên bất kì thì có mã số khác nhau . tuy nhiên sau một thời gian thì có một số nhân viên nghỉ hưu hoặc chuyển công tác , nên công ty phải tiến hành tuyển thâm k nhân viên mới. các nhân viên mới này sau khi đưcọ tuyển vào cũng sẽ được cấp một mã số ( là một số nguyên dương )
yêu cầu : với n nhân viên có (còn lại )của công ty tương ứng với các mã số là $a_1$,$a_2$ ......$a_n$ , hãy tìm k mã số nhỏ nhất để cấp cho k nhân viên mới tuyển vào sao cho vẫn thỏa mãn hai nhân viên bất kỳ (cả nhân viên cũ và nhân viên mới ) có mã số khác nhau .
Dữ liệu : vào từ file ; RECRUIT.INP ' có nội dung như sau :
* dòng đầu tiên chưa hai số nguyên dương lần lượt là n và k (k<=n)
* n dòng tiếp theo , dòng thứ i là số nguyên dương $a_i$ ( $i = 1;2....n $,$a_i$$<=2.10^{9} $
Kết quả ghi vào file 'RECRUIT.OUT' k mã số theo thứ tự từ nhỏ đến lớn ( mỗi má số trên một dòng )


Ví dụ
RECRUIT.INP


RECRUIT.OUT
Bài này chắc chắn phải xử lý số lớn nếu muốn chạy nhanh, vì không thể duyệt trâu bò được, khó nhai :-?
 
Q

quanghero100

Bài 1 đề olympic 30-4 THPT chuyên Lê Quí Đôn ( Vũng Tàu )

Tuyển nhân viên :
công ty phần mềm máy tính a có số lượng nhân viên rất lớn để tiện việc quản lý ,công ty đã cấp cho mỗi nhân viên một mã số , mã số của mỗi nhân viên là một số nguyên dương, hai nhân viên bất kì thì có mã số khác nhau . tuy nhiên sau một thời gian thì có một số nhân viên nghỉ hưu hoặc chuyển công tác , nên công ty phải tiến hành tuyển thâm k nhân viên mới. các nhân viên mới này sau khi đưcọ tuyển vào cũng sẽ được cấp một mã số ( là một số nguyên dương )
yêu cầu : với n nhân viên có (còn lại )của công ty tương ứng với các mã số là $a_1$,$a_2$ ......$a_n$ , hãy tìm k mã số nhỏ nhất để cấp cho k nhân viên mới tuyển vào sao cho vẫn thỏa mãn hai nhân viên bất kỳ (cả nhân viên cũ và nhân viên mới ) có mã số khác nhau .
Dữ liệu : vào từ file ; RECRUIT.INP ' có nội dung như sau :
* dòng đầu tiên chưa hai số nguyên dương lần lượt là n và k (k<=n)
* n dòng tiếp theo , dòng thứ i là số nguyên dương $a_i$ ( $i = 1;2....n $,$a_i$$<=2.10^{9} $
Kết quả ghi vào file 'RECRUIT.OUT' k mã số theo thứ tự từ nhỏ đến lớn ( mỗi má số trên một dòng )


Ví dụ
RECRUIT.INP
5 3
3
1
6
9
8
RECRUIT.OUT
2
4
5
Mã:
uses crt;
var f1,f2:text;
    i,n,m,d,k:longint;
    a:array[0..1000] of longint;
procedure quicksort(h,l:longint);
var x,i,j,tg:longint;
begin
  i:=h;
  j:=l;
  x:=a[random(h-l+1)+l];
  repeat
    while a[i]<x do inc(i);
    while a[j]>x do dec(j);
    if i<=j then
      begin
         tg:=a[i];
         a[i]:=a[j];
         a[j]:=tg;
         inc(i);
         dec(j);
      end;
  until i>j;
  if i<l then quicksort(i,l);
  if j>h then quicksort(h,j);
end;
begin
   assign(f1,'RECRUIT.INP');
   reset(f1);
   assign(f2,'RECRUIT.OUT');
   rewrite(f2);
       fillchar(a,sizeof(a),0);
       readln(f1,n,m);
       for i:=1 to n do
        readln(f1,a[i]);
       quicksort(1,n);
       i:=-1;
       d:=0;
       a[n+1]:=maxlongint;
       repeat
         inc(i);
         if (d<m) and (a[i+1]-a[i]>1) then
            begin
                k:=a[i];
                repeat
                    inc(k);
                    if k<a[i+1] then
                       begin
                          inc(d);
                          writeln(f2,k);
                       end;
                until (k=a[i+1]) or (d=m);
            end;
       until d=m;
   close(f2);
   close(f1);
end.
bài này thiệt ra giới hạn 2.10^9 chỉ là giới hạn của các phần tử thôi chứ n không thể là 2.10^9 được do đó việc xử lí không cần phải xử lí số lớn đâu :) :) cái giới hạn đó chỉ là để ta chọn kiểu dữ liệu thích hợp cho mảng thôi
 
1

11thanhkhoeo

$2*10^9$ thì có lấy được int64 không Quang nếu không thì phải xử lí số lớn rồi cu


bài cắt phôi cần phải xét tất cả các ô làm ô đâu

vd ô (1,1) có thể cắt đc sản phẩm bao nhiêu, ô (2,1)... ô (n,n) ... rồi so sánh

Thân
 
Q

quanghero100

$2*10^9$ thì có lấy được int64 không Quang nếu không thì phải xử lí số lớn rồi cu


bài cắt phôi cần phải xét tất cả các ô làm ô đâu

vd ô (1,1) có thể cắt đc sản phẩm bao nhiêu, ô (2,1)... ô (n,n) ... rồi so sánh

Thân

Bài đó em chắc chắn là không xử lí số lớn gì hết anh ưi em thử một vài test có các phần tử mang giá trị lớn trong đó có phần tử mang giá trị max là 2.10^9 rùi anh ưi hông tin anh cứ việc test thử bài em đi :D chỉ cần số lượng phần tử không vượt cái mảng em khai báo còn lại các phần tử anh nhập tùy ý miễn là trong giới hạn thì chạy oki hết :D
 
Top Bottom