Luỵen thi HSG Chan Hưng

Bài : DÃY CON DƯƠNG LIÊN TỤC LỚN NHẤT
Cho dãy số nguyên a1,a2,...an, hãy tìm dãy con gồm các phần tử dương liên tục, và là dãy con có độ dài lớn nhất trong dãy đã cho

program day_con_DUONG;
uses crt;
var a:array[1..100] of longint;
n:longint;
{-------------------------------}
procedure nhap;
var i:integer;
begin
write(`nhap n=`);readln(n);
for i:=1 to n do
begin
write(`a[`,i,`]=`);
readln(a[i]);
end;
end;
{----------------------------}
function ktduong(i,j:longint):boolean;
var k:longint;
kt:boolean;
begin
kt:=true;
for k:=i to j do
if a[k]<0 then kt:=false;
ktduong:=kt;
end;
{----------------------------}
var i,j:longint;
max,k,id:byte;
Begin
clrscr;
nhap;
max:=1;
for i:=1 to n-1 do
for j:=1+i to n do
if (a[i]>0) and (a[j]>0) then
begin
if ktduong(i,j) then k:=j-i;
if max begin
max:=k;
id:=i;
end;
end;
writeln(`Doan con duong dai nhat cua day:`);
for i:=id to id+max do
write(a[i]:6);
readln ;
end.

Bai:SỐ XỨNG THẬP PHÂN VÀ ĐỐI XỨNG NHỊ PHÂN
Nhap vao so n, tim tat ca cac so nguyen
Program doi_xung_TP_Nphan;
uses crt;
{----------------------------}
function doixung(s:string):boolean;
var s1:string;
i:integer;
kt:boolean;
Begin
s1:=``;
kt:=false;
for i:=length(s) downto 1 do
s1:=s1+s[i];
if s1=s then kt:=true;
doixung:=kt;
End;
{-----------------------------}
function doiNP(n:integer):string;
var s,s1:string;
i:integer;
begin
s:=``;
while n>0 do
begin
if (n mod 2)=0 then
s:=`0`+s
else
s:=`1`+s ;
n:=n div 2;
end;
doiNP:=s;
End;
{---------------------------}
var n,i:integer;
s:string;
Begin
clrscr;
write(`nhap n=`); readln(n);
writeln(`Cac so tu nhien`);
writeln(`vua doi xung thap phan vua doi xung nhi phan<`,n);
for i:=1 to n do
begin
str(i,s);
if doixung(s) and doixung(doiNp(i)) then
write(i:5);
end;
readln;
End.

NGUYÊN TỐ TƯƠNG ĐƯƠNG
Hai số tự nhiên được gọi là số nguyên tố tương đương nếu chúng có chung các ước nguyên tố
VD: 75 và 15 là các số nguyên tố tường đương vì có chung các ước nguyên tố 3 và 5
Cho 2 số tự nhiên m,n kiểm tra xem chúng có là số nguyên tố tương đương hay không?

Program so_Nt_tuong_duong;
uses crt;
type Ma=array[1..1000]of longint;
var n,m:longint;
a,b:Ma;
k,h:longint;
{------------------------}
Function NT(n:longint):boolean;
var kt:boolean;
i:longint;
Begin
kt:=true;
for i:=2 to round(sqrt(n)) do
if n mod i=0 then
kt:=false;
NT:=kt;
End;
{------------------------}
var i,j:longint;
kt:boolean;
BEGIN
clrscr;
write(`nhap n=`);readln(n);
write(`nhap m=`); readln(m);
{Lap mang a gom cac uoc cua n}
k:=0;
for i:=2 to n do
if