Три нерешенных примера, которые ждут решения

var a:array[1..10000] of longint;
    n,m,i,j:longint;
begin
readln(n);
for i:=1 to n do
  read(a[i]);
for i:=1 to n do
  if a[i]>=0 then write(a[i],' ');
end.

var a:array[1..10000] of longint;
    i,s,n:longint;
begin
readln(n);
s:=1;
for i:=1 to n*2-1 do
  if i mod 2=1 then s:=s*i;
write(s);
end.

var a:array[1..10000] of longint;
    i,s,n,x,k,j:longint;
begin
readln(n);
k:=0;
repeat
k:=k+1;
a[k]:=n mod 10;
n:=n div 10;
until n=0;
if k mod 2=0 then begin
for i:=1 to k-1 do
if (i mod 2=1) then
for j:=i+1 to k do
  if (j mod 2=1) and(a[i]=a[j]) then begin write('NO');halt;end;
end else
for i:=1 to k-1 do
if (i mod 2=0) then
for j:=i+1 to k do
  if (j mod 2=0) and(a[i]=a[j]) then begin write('NO');halt;end;
  write('YES');
readln;
end.

var a:array[1..10000] of longint;
    i,s,n,x,k,j:longint;
begin
readln(n);
k:=0;
repeat
k:=k+1;
a[k]:=n mod 10;
n:=n div 10;
until n=0;
if k mod 2=0 then begin
for i:=1 to k-1 do
if (i mod 2=1) then
for j:=i+1 to k do
  if (j mod 2=1) and(a[i]=a[j]) then begin write('NO');halt;end;
end else
for i:=1 to k-1 do
if (i mod 2=0) then
for j:=i+1 to k do
  if (j mod 2=0) and(a[i]=a[j]) then begin write('NO');halt;end;
  write('YES');
readln;
end.

Uses
 CRT;
Var
 n,k,i:longint;
 m:set of byte;
begin
repeat
 readln(n);
until (n>=1000) and (n<10000);
n:=abs(n);
m:=[];
repeat
 m:=m+[n mod 10];
 inc(k);
 n:=n div 10;
until n=0;
for i:=0 to 9 do
 if i in m then inc(n);
if n=k then write('Âåðíî')
else write('Íå âåðíî');
end.