uses crt;
var a:array[1..100]of integer;
n,t,i,dem,j,kt:integer;
begin
clrscr;
write('n='); readln(n);
if (0<n) and (n<=100) then
begin
for i:=1 to n do
begin
write('a[',i,']='); readln(a[i]);
end;
{----------------------cau-a-----------------}
dem:=0;
for i:=1 to n do
if (i mod 2=0) and (a[i] mod 2=1) then inc(dem);
writeln('so luong cac so le o vi tri chan la: ',dem);
{--------------------cau-b---------------------------}
t:=0;
for i:=1 to n do
if a[i]>1 then
begin
kt:=0;
for j:=2 to a[i]-1 do
if a[i] mod j=0 then kt:=1;
if kt=0 then t:=t+a[i];
end;
writeln('tong gia tri cac so nguyen to trong day la: ',t);
end
else writeln('vui long nhap lai');
readln;
end.

Program hotrotinhoc;

var i,n,d: byte;

t: longint;

function nt(x: byte): boolean;

var j: integer;

begin

nt:=true;

if (x=2) or (x=3) then exit;

nt:=false;

if (x=1) or (x mod 2=0) or (x mod 3=0) then exit;

j:=5;

while (j<=trunc(sqrt(x))) do

begin

if (x mod j=0) or (x mod (j+2)=0) then exit;

j:=j+6;

end;

nt:=true;

end;

begin

write('Nhap so luong phan tu : '); readln(n);

for i:=1 to n do

begin

write('a[',i,]='); readln(a[i]);

end;

d:=0; t:=0;

for i:=1 to n do

begin

if (a[i] mod 2<>0) and (i mod 2=0) then inc(d);

if nt(a[i]) then t:=t+a[i];

end;

writeln('Co ',d,' so cac so le o vi tri chan');

write('Tong gia tri cac so nguyen to trong day la : ',t);

readln

end.

uses crt;
var m,kt,kt1,i,dem,tam,j:integer;
u,v:array[1..100]of integer;
r:array[1..200]of integer;
begin
clrscr;
write('m='); readln(m);
if (0<m) and (m<=100) then
begin
{-----------------nhap-day-u----------------------}
for i:=1 to m do
begin
write('u[',i,']='); readln(u[i]);
end;
{----------------------kiem-tra-sap-khong-giam-day-u------------------}
kt:=0;
for i:=1 to m-1 do
if u[i]>u[i+1] then kt:=1;
if kt=1 then writeln('vui long nhap lai day U');
{------------------nhap-day-v--------------------------}
for i:=1 to m do
begin
write('v[',i,']='); readln(v[i]);
end;
{---------------------kiem-tra-sap-khong-giam-day-v------------------}
kt1:=0;
for i:=1 to m-1 do
if v[i]>v[i+1] then kt1:=1;
if kt1=1 then writeln('vui long nhap lai day V');
{-----------------------xu-ly-----------------------}
if (kt=0) and (kt1=0) then
begin
dem:=0;
for i:=1 to m do
begin
inc(dem);
r[dem]:=u[i];
end;
for i:=1 to m do
begin
inc(dem);
r[dem]:=v[i];
end;
for i:=1 to dem-1 do
for j:=i+1 to dem do
if r[i]>r[j] then
begin
tam:=r[i];
r[i]:=r[j];
r[j]:=tam;
end;
writeln('day khong giam R la: ');
for i:=1 to dem do
write(r[i]:4);
end;
end
else writeln('vui long nhap lai');
readln;
end.

Program hotrotinhoc;

var d,i,n: integer;

a: array[1..150] of integer;

begin

readln(n);

for i:=1 to n do readln(a[i]);

d:=0;

for i:=1 to n do if (a[i] mod 2) and (a[i] mod 3=0) then inc(d);

write(d);

readln

end.

uses crt;
var a:array[1..150]of integer;
dem,n,i:integer;
begin
clrscr;
write('n='); readln(n);
if (0<n) and (n<=150) then
begin
for i:=1 to n do
begin
write('a[',i,']='); readln(a[i]);
end;
dem:=0;
for i:=1 to n do
if (a[i] mod 2=0) and (a[i] mod 3=0) then inc(dem);
writeln('so cac so chan chia het cho 3 trong day la: ',dem);
end
else writeln('vui long nhap lai');
readln;
end.

uses crt;
var a:array[1..20]of integer;
i,dem:integer;
begin
clrscr;
for i:=1 to 20 do
begin
write('a[',i,']='); readln(a[i]);
end;
{-----------------------------xuat-day-------------------------}
writeln('day ban vua nhap la:');
for i:=1 to 20 do
write(a[i]:4);
{-----------------------------xuat-cac-so-nguyen-duong-----------------}
writeln;
writeln('cac so nguyen duong trong day la:');
for i:=1 to 20 do
if a[i]>0 then write(a[i]:4);
{------------------------dem-trong-day-co-bao-nhieu-so-lon-hon-10-----------------}
dem:=0;
for i:=1 to 20 do
if a[i]>10 then inc(dem);
writeln('so gia tri lon hon 10 trong day la: ',dem);
readln;
end.

uses crt;
var a:array[1..20]of integer;
i,dem:integer;
begin
clrscr;
for i:=1 to 20 do
begin
write('a[',i,']='); readln(a[i]);
end;
{-----------------------------xuat-day-------------------------}
writeln('day ban vua nhap la:');
for i:=1 to 20 do
write(a[i]:4);
{-----------------------------xuat-cac-so-nguyen-duong-----------------}
writeln;
writeln('cac so nguyen duong trong day la:');
for i:=1 to 20 do
if a[i]>0 then write(a[i]:4);
{------------------------dem-trong-day-co-bao-nhieu-so-lon-hon-10-----------------}
dem:=0;
for i:=1 to 20 do
if a[i]>10 then inc(dem);
writeln('so gia tri lon hon 10 trong day la: ',dem);

uses crt;
var i,n,t:integer;
a:array[1..200]of integer;
max,min:longint;
kq:real;
begin
clrscr;
write('n='); readln(n);
if (0<n) and (n<=200) then
begin
for i:=1 to n do
begin
write('a[',i,']='); readln(a[i]);
end;
{-------------------------gia-tri-nho-nhat------------------------}
min:=maxint;
for i:=1 to n do
if min>a[i] then min:=a[i];
writeln('gia tri nho nhat la: ',min);
{-------------------------gia-tri-lon-nhat------------------------}
max:=a[1];
for i:=1 to n do
if max<a[i] then max:=a[i];
writeln('gia tri lon nhat la: ',max);
{------------------------trung-binh-cong-cua-day-so---------------}
t:=0;
for i:=1 to n do
t:=t+a[i];
kq:=t/n;
writeln('trung binh cong cua day so la: ',kq:4:2);
end
else writeln('vui long nhap lai');
readln;
end.

Bài 1:

uses crt;
var a:array[1..50]of integer;
n,t,i:integer;
begin
clrscr;
write('n='); readln(n);
if (n<=0) or (n>50) then writeln('vui long nhap lai')
else begin
{---------------------------cau-a-----------------------------}
for i:=1 to n do
begin
write('a[',i,']='); readln(a[i]);
end;
{---------------------------cau-b-----------------------------}
t:=0;
for i:=1 to n do
if a[i] mod 2=0 then t:=t+a[i];
writeln('tong cac so chan trong day la: ',t);
end;
readln;
end.

Bài 2:

uses crt;
var a:array[1..50]of integer;
n,i,x:integer;
begin
clrscr;
write('n='); readln(n);
if (n<=0) or (n>50) then writeln('vui long nhap lai')
else begin
{---------------------------cau-a-----------------------------}
for i:=1 to n do
begin
write('a[',i,']='); readln(a[i]);
end;
{---------------------------cau-b-----------------------------}
write('nhap x='); readln(x);
writeln('cac phan tu co gia tri bang ',x,' trong day la: ');
for i:=1 to n do
if a[i]=x then write(a[i]:4);
end;
readln;
end.

code map thôi đủ mệt rồi =))

chán mí bạn ghê á!!!!

uses math;
var n,i:longint;
s:int64;
f:array[-10..1000000] of int64;
procedure dq(n:longint);

begin
if n<=1000000 then
begin
s:=s+f[n];
exit;
end
else
begin
dq(n div 2);
dq(n div 3);
dq(n div 4);
end;
end;
begin
assign(input,'dprc.inp');reset(input);
assign(output,'dprc.out');rewrite(output);
for i:=1 to 1000000 do
begin
f[i]:=max(i,f[i div 2]+f[i div 3]+f[i div 4]);
//write(f[i],' ');
end;
while not seekeof do
begin
readln(n);
s:=0;
dq(n);
writeln(s);
end;
end.

const fi='xau.inp';
fo='xau.out';
var f1,f2:text;
st1,st2:string;
d1,d2:integer;
begin
assign(f1,fi); reset(f1);
assign(f2,fo); rewrite(f2);
readln(f1,st1);
readln(f1,st2);
d1:=length(st1);
d2:=length(st2);
if d1>d2 then writeln(f2,st1)
else if d1<d2 then writeln(f2,st2)
else writeln(f2,st2);
close(f1);
close(f2);
end.

Program hotrotinhoc;

const fi='XAU.inp';

fo='XAU.out';

var f: text;

a,b: string;

procedure ip;

begin

assign(f,fi);

reset(f);

readln(f,a);

read(f,b);

close(f);

end;

procedure out;

begin

assign(f,fo);

rewrite(f);

if length(a)>length(b) then write(f,'Xau a dai hon');

if length(b)>length(a) then write(f,'Xau b dai hon');

if length(a)=length(b) then write(f,'Xau nhap sau');

close(f);

end;

begin

ip;

out;

end.

Program Day_con1b;

Type KM= array[1..100] of integer;

Var M:KM; k,i,j,n,ldau, dai,

Max: integer;

Function TONG(A:KM;m,l:byte):Integer;

Var Tam,i:integer;

Begin

Tam:=0;

For i:=m to m+l do

Tam:=Tam + A[i];

TONG:=Tam;

End;

Begin

Write('Nhap so n: '); Readln(n);

For i:=1 to n do

Begin

Write('[',i,']=');

Readln(M[i]);

End;

Max:=M[1];

dai:=1;

ldau:=1;

For i:= 1 to n do

For j:=0 to n-i+1 do

if TONG(M,i,j)> Max then

Begin

ldau:=i;

Max:=Tong(M,i,j) ;

dai:=j+1

End;

for k:=ldau to ldau+dai-1 do

write(m[k],' ');

Readln

End.

có cho độ dài của đoạn con đó không bạn?

const fi='nix.inp';
fo='nix.out';
var
f:text;
j,i,n,max:0..100;
a,b,l,m: array [0..101] of integer;
procedure ip;
begin
assign(f,fi);
reset(f);
readln(f,n);
for i:= 1 to n do
read(f,a[i]);
close(f);
end;
procedure out;
begin
assign(f,fo);
rewrite(f);
for i:= 0 to n do
l[i] := 1;
for i:= 1 to n do
for j:= i to n do
if (a[j] > a[i] ) and (l[j] < l[i] + 1 ) then
begin
l[j] := l[i] + 1;
m[j]:= i;
end;
max:=0;
for i:= 1 to n do
if l[i] > max then
begin
j:=i;
max:=l[i];
end;
while m[j] <> 0 do
begin
l[j]:=-l[j];
j:=m[j];
end;
l[j]:=-l[j];
for i:= 1 to n do
if l[i] < 0 then write(f,i,' ');

close(f);
end;
BEGIN
ip;
out;
END.

bạn cho thêm vài ví dụ nữa đi