кому надо №338(Ласкутки)  сделано с помощью алгаритма Очередь

правда у неё ран таим на 5 тесте

var a:array [0..101,0..1001] of longint;
Q:array [1..2,1..10000] of longint;
i,j,n,m,UN,UK,i1,j1,SK,x1,y1:longint;

Procedure Sosed(x,y:longint);
begin
if a[x,y]=0 then begin
                  Q[1,UK]:=x; Q[2,UK]:=y;
                  UK:=UK+1; a[x,y]:=-1;
                 end;
end;

Begin

readln(n,m);
for i:=1 to n do
for j:=1 to m do read(a[i,j]);
for i:=0 to m+1 do begin
                   a[i,0]:=-1;
                   a[i,m+1]:=-1;
                   end;
for j:=1 to m do begin
                  A[0,j]:=-1;
                  a[n+1,j]:=-1;
                 end;
SK:=0;
for i:=1 to n do
for j:=1 to m do
  if a[i,j]=0 then begin UN:=1; UK:=1; SK:=SK+1; Q[1,UK]:=i; Q[2,UK]:=j; UK:=UK+1; a[i,j]:=SK;
   while UN<>UK do begin
                   i1:=Q[1,UN];
                   j1:=Q[2,UN];
                   UN:=UN+1;
                   Sosed(i1-1,j1);
                   Sosed(i1+1,j1);
                   Sosed(i1,j1-1);
                   Sosed(i1,j1+1);
                   end;
                   end;
writeln(SK);

end.

правда тоже рантаим помогите кто решил

ты крут а где в моём ошибка

Я писал про ошибку в вашем алгоритме очередь

Проблема с задачей на acmp.ru Друзья. Вроде код такой как писали в классе.

var g:array[1..1000,1..1000]of longint;
n,i,s,k,j:longint;
p:array[1..1000]of boolean;
procedure DFS(v:integer);
var j:integer;
begin
p[v]:=false;
for j:=1 to n do
if (G[v,i]=1)and(p[j]=true) then DFS(j);
end;
begin
assign(input, 'input.txt'); reset(input);
  assign(output, 'output.txt'); rewrite(output);
read(n,s);
for i:=1 to n do
for j:=1 to n do
read(g[i,j]);
k:=-1;
for i:=1 to n do p[i]:=true;
for i:=1 to n do
if p[i]=true then begin
k:=k+1;
DFS(i);end;
write(k);
end.

Что не так на третьем тесте не проходит!!

Так как ты сказал я вроде исправил, но все6 равно ошибка на 3-ем тесте((

var g:array[1..1000,1..1000]of longint;
n,i,s,k,j:longint;
p:array[1..1000]of boolean;
procedure DFS(v:integer);
var j:integer;
begin
p[v]:=false;
for j:=1 to n do
if (G[v,j]=1)and(p[j]=true) then DFS(j);k:=k+1;
end;
begin
assign(input,'input.txt'); reset(input);
assign(output,'output.txt'); rewrite(output);
read(n,s);
for i:=1 to n do
for j:=1 to n do
read(g[i,j]);
k:=-1;
for i:=1 to n do p[i]:=true;
for i:=1 to n do
if p[i]=true then begin
DFS(s);end;
write(k);
end.

P.S Не помогайте ему!!!!

var p:array [1..1000] of boolean;
    g:array [1..100,1..100] of longint;
    k,i,n,s,j:longint;

procedure dfs(v:longint);
var i:longint;
 begin
 
 p[v]:=false;
 k:=k+1;
 
 for i:=1 to n do
  if (g[v,i]=1)and(p[i]=true) then dfs(i);
 
 end;
 
begin

   assign(input, 'input.txt'); reset(input);
 assign(output, 'output.txt'); rewrite(output); 
 
readln(n,s);

for i:=1 to n do
 for j:=1 to n do
 read(g[i,j]);
 
for i:=1 to n do
p[i]:=true;

k:=-1;
dfs(s);
writeln(k);

end.

Вот как у меня

Раз-два, раз-два

var a,b:array[1..300]of integer;
    i,j,n,l:integer;
    f:boolean;
procedure del(var k:integer);
var x:array[1..300]of integer;
    i,os:integer;
begin
        os:=0;
        for i:=k downto 1 do
        begin
                x[i]:=(os*10+b[i])div 2;
                os:=(os*10+b[i])mod 2;
        end;
        while x[k]=0 do k:=k-1;
        for i:=1 to k do b[i]:=x[i];
end;
begin
        assign(input, 'input.txt');reset(input);
        assign(output, 'output.txt');rewrite(output);
        readln(n);
        a[1]:=2;
        for i:=2 to n do
        begin
                a[i]:=1;
                f:=true;
                for j:=1 to n do b[j]:=a[j];
                l:=i;
                for j:=1 to i do
                begin
                        f:=(b[1]mod 2=0);
                        if f then del(l) else break;
                end;
                if not(f) then a[i]:=2;
        end;
        for i:=n downto 1 do write(a[i]);
end.

Тебе не задрало тупо копиравать

Игра с монеткой

var p:array[0..20]of byte;
    n,m,k,s,i:longint;
begin
        assign(input, 'input.txt');reset(input);
        assign(output, 'output.txt');rewrite(output);
        readln(n,m);
        for i:=0 to n do p[i]:=0;
        k:=0;
        while p[0]=0 do
        begin
                s:=0;
                for i:=1 to n do
                s:=s+p[i];
                if s>=m then k:=k+1;
                i:=n;
                while p[i]=1 do
                begin
                        p[i]:=0;
                        i:=i-1;
                end;
                p[i]:=1;
        end;
        writeln(k);
end.

№465
var f:array[1..1000]of ansistring;i,n:integer;
function sum(a,b:ansistring):ansistring;
var x,y,z:array[1..10000]of integer;nx,ny,nz,i,err:integer;ans,c:ansistring;
begin
        nx:=length(a);ny:=length(b);
        for i:=1 to nx do val(a[i],x[nx-i+1],err);
        for i:=1 to ny do val(b[i],y[ny-i+1],err);
        if nx>ny then nz:=nx else nz:=ny;
        for i:=1 to nz+1 do z[i]:=0;
        for i:=1 to nz do
        begin
                z[i]:=z[i]+x[i]+y[i];
                if z[i]>9 then begin z[i+1]:=1;z[i]:=z[i] mod 10; end;
        end;
        if z[nz+1]>0 then nz:=nz+1;
        ans:='';
        for i:=nz downto 1 do begin str(z[i],c);ans:=ans+c; end;
        sum:=ans;
end;
begin
        assign(input, 'input.txt'); reset(input);
        assign(output, 'output.txt'); rewrite(output);
        readln(n);
        f[1]:='2';f[2]:='3';
        for i:=3 to n do f[i]:=sum(f[i-2],f[i-1]);
        writeln(f[n]);
end.