Помогите решить) очень нужно) завтра олимпиада, срочно нужно решить)

 

cоnst S = '54765287694769587387647836748';
var
N, P : Integer;
begin
N := 0;
for P := 1 to Length(S) do N := N + Ord(S[P]) - 48;
if N mod 3 = 0 then WriteLn('Да') else WriteLn('Нет');
end.

начало 1-ой задачи)

 

Решение 1-ой задачи)

 

Вторая задача:

program z2;
uses crt;
var
n,m,i,j,k:integer;
f,f1:text;
mas:array [1..30000] of byte;
begin
ClrScr;
assign(f,'a.in');
reset(f);
read(f,n);
read(f,m);
for i:=1 to n do
begin
for j:=1 to m do
begin
read(f,k);
mas[k]:=mas[k]+1;
end;
readln(f);
end;
close(f);
assign(f1,'a.out');
rewrite(f1);
for i:=1 to 30000 do if mas[i]=n then write(f1,i);
close(f1);
end.

 

спасибо) все работает)

 

Третья

program z3;
uses crt;
var
f,f1:text;
B:array [0..100] of byte;
N,i:byte;
begin
assign(f,'a.in');
assign(f1,'a.out');
reset(f);
rewrite(f1);
read(f,N);
close(f);
B[N]:=1;
while B[N]<>0 do
begin
i:=0;
while B[i]=1 do
begin
B[i]:=0;
inc(i);
end;
B[i]:=1;
for i:=0 to N-1 do
if B[i]=1 then
begin
write(f1,i+1);
write(f1,' ');
end;
writeln(f1);
end;
close(f1);
end.

 

Третья

program z3;
uses crt;
var
f,f1:text;
B:array [0..100] of byte;
N,i:byte;
begin
assign(f,'a.in');
assign(f1,'a.out');
reset(f);
rewrite(f1);
read(f,N);
close(f);
B[N]:=1;
while B[N]<>0 do
begin
i:=0;
while B[i]=1 do
begin
B[i]:=0;
inc(i);
end;
B[i]:=1;
for i:=0 to N-1 do
if B[i]=1 then
begin
write(f1,i+1);
write(f1,' ');
end;
writeln(f1);
end;
close(f1);
end.

Спасибо) только в выходном файле получается:
1
2
1 2
3
1 3
2 3
1 2 3

Нужно:
1
2
3
1 2
1 3
2 3
1 2 3

 

Цитирую строку из формулировки задания 3: "Варианты могут быть выведены в произвольном порядке."

 

Цитирую строку из формулировки задания 3: "Варианты могут быть выведены в произвольном порядке."

Спасибо за помощь остальные задания я уже сделал)