Các số đặc biệt

Bài 1. Tìm tất cả các chữ số có ba chữ số  abc  (số Amstrong) sao cho tổng các lập phương của các chữ số thì bằng chính số đó   abc  = a^3 + b^3 + c^3. 

Program TIM_SO;
USES crt;
VAR i,j,k:INTEGER; 

BEGIN
    Writeln('CAC SO DUOI DAY CO 3 CHU SO ');
    Writeln('MA TONG LAP PHUONG CUA 3 CHU SO BANG CHINH NO:');
    Writeln('---------------------');
    FOR i:=1 TO 9 DO
    FOR j:=0 TO 9 DO
    FOR k:=0 TO 9 DO
    IF (100*i+10*j+k)=(i*i*i + j*j*j + k*k*k) THEN
    Writeln(i,j,k,' = ',i,'^3 + ',j,'^3 + ',k,'^3');
    Readln
END.

Bài 2. Nhập vào một số nguyên không âm, kiểm tra xem nó có phải là số nguyên tố hay không?

Program SO_NGUYEN_TO;
USES crt;
VAR i,n: INTEGER; 

BEGIN
      Clrscr;
      Writeln('KIEM TRA SO NGUYEN TO:');
      Writeln('------------------------');
      Write ('Nhap so can kiem tra n = '); readln(n);
  IF (n=0) OR (n=1) THEN
      Writeln(n,'  Khong phai la so nguyen to')
  ELSE
      BEGIN
            i:=1;
          REPEAT i:= i+1;
          UNTIL (n MOD i= 0) OR (i*i>n);
          IF i*i>n THEN
            Writeln (n,' la so nguyen to')
          ELSE Writeln (n,'  khong phai la so nguyen to');
      END;
      Readln
END.

Bài 3: In ra các số nguyên tố nhỏ hơn hoặc bằng N (N là số nguyên không âm được nhập từ bàn phím).

Program CAC_SO_NGUYEN_TO;
USES crt;
VAR n,i,t: INTEGER;
BEGIN
    Clrscr;

           Writeln('IN RA CAC SO NGUYEN SO <=N');
          Writeln('---------------------------');
          Write('Nhap n = ');readln(n);
    IF n<2 THEN
          Writeln('Khong co so nguyen to nao <=',n)
    ELSE
        BEGIN
                Writeln('Cac so nguyen to <= ',n,' la:');
                FOR i := 2 TO n DO
                BEGIN
                          t:= 1;
                REPEAT  t:= t+1;
                UNTIL ( i MOD t = 0) OR ( t*t>i ) ;
                IF( t*t>i) THEN
                      Write(i:4);
                END;
        END;
    Readln
END.

Bài 3. Viết chương trình đổi số thập phân ra nhị phân:

Program Doi_thap_phan_ra_nhi_phan;

Var He10, N, Y: Word; He2,Tam:String;

Begin

Writeln('DOI SO TU HE THAP PHAN SANG HE NHI PHAN');

Writeln('         -----------------');

Writeln;

Write('-Nhap so nguyen he thap phan: ');

Readln(He10);

N:=He10;

He2:=' ';

Repeat

Y:=He10 Mod 2;

Str(Y, Tam);

He2:=Tam + He2;

He10:= He10 Div 2;

Until He10 = 0;

Writeln;

Writeln('+So he 10 la : ',N);

Writeln('+Doi sang he 2 la: ',He2);

Writeln;

Writeln('      Bam phim <Enter> de ket thuc');

Readln

End.

Bài 2. Viết chương trình đổi số thập phân ra bát phân:

Program Doi_thap_phan_ra_bat_phan;

Var He10,N,Y:Word; He8,Tam:String;

Begin

Writeln('DOI SO TU HE THAP PHAN SANG HE BAT PHAN');

Writeln('         -----------------');

Writeln;

Write('-Nhap so nguyen he thap phan: ');

Readln(He10);

N:=He10;

He8:=' ';

Repeat

Y:=He10 Mod 8;

Str(Y, Tam);

He8:=Tam + He8;

He10:= He10 Div 8;

Until He10 = 0;

Writeln;

Writeln('+So he 10 la : ',N);

Writeln('+Doi sang he 8 la: ',He8);

Writeln;

Writeln('      Bam phim <Enter> de ket thuc');

Readln

End.

Bài 3: Viết chương trình Pascal Đổi số thập phân sang hệ thập lục - hệ 16

Program Doi_thap_phan_ra_thap_luc;

Var He10,N,Y:Word; He16,Tam:String;

Begin

Writeln('DOI SO TU HE THAP PHAN SANG HE THAP LUC PHAN');

Writeln('         -----------------');

Writeln;

Write('-Nhap so nguyen he thap phan: ');

Readln(He10);

N:=He10;

He16:=' ';

Repeat

Y:=He10 Mod 16;

If Y < 10 Then

Str(Y, Tam)

Else

Tam:=Chr(Y+55);

He16:=Tam + He16;

He10:= He10 Div 16;

Until He10 = 0;

Writeln;

Writeln('+So he 10 la  : ',N);

Writeln('+Doi sang he 16 la: ',He16);

Writeln;

Writeln('      Bam phim <Enter> de ket thuc');

Readln

End.

Bài 4.  Viết chương trình Pascal Đổi số thập phân sang hệ bất kỳ

Program Doi_thap_phan_ra_he_bat_ky;

Var He10,N,Y,HeN: Word;  He,Tam:String;

Begin

Writeln('DOI SO TU HE THAP PHAN SANG HE BAT KY');

Writeln('         -----------------');

Writeln;

Write('-Nhap so nguyen he thap phan: ');

Readln(He10);

N:=He10;

Write('-Doi sang he nao: ');

Readln(HeN);

He:=' ';

Repeat

Y:=He10 Mod HeN;

If Y < 10 Then

Str(Y, Tam)

Else

Tam:=Chr(Y+55);

He:=Tam + He;

He10:= He10 Div HeN;

Until He10 = 0;

Writeln;

Writeln('+So he 10 la  : ',N);

Writeln('+Doi sang he: ',HeN:2,' la: ',He);

Writeln;

Writeln('      Bam phim <Enter> de ket thuc');

Readln

End.

Bài 5.  Viết chương trình Pascal Tìm số thứ tự mã ASCII của ký tự trong chuỗi

Program So_thu_Tu_ma_ASCII;

Var St:String;i:Byte;Begin

Writeln('SO THU TU MA ASCII CUA TUNG KY TU TRONG CHUOI');

Writeln('          --------------------');

Write('-Nhap chuoi: ');

Readln(St);

Writeln;

For i:=1 To Length(St) Do

Write(' ',Ord(St[i]));

Writeln;

Writeln;

Writeln('    Bam phim <Enter> de ket thuc');

Readln

End.

Bài 6. Viết chương trình Pascal Đổi số tập phân sang số la mã

Program So_La_Ma;

Var

So,So1,i:Integer;

St:String;

Begin

Writeln('DOI SO THAP PHAN SANG SO LA MA');

Writeln('        ------------');

Writeln;

Write('-Nhap so nguyen: ');

Readln(So);

So1:=So;

St:=' ';

For i:=1 To (so Div 1000) Do

St:=St+'M';

So:=So Mod 1000;

If So >= 900 Then

Begin

St:=St+'CM';

So:=So-900;

End

Else

If So >=500 Then

Begin

St:=St+'I';

So:=So-500;

End

Else

If So >=400 Then

Begin

St:=St+'CD';

So:=So-400;

End;

For i:=1 To (so Div 100) Do

St:=St+'C';

So:=So Mod 100;

If So >= 90 Then

Begin

St:=St+'XC';

So:=So-90;

End

Else

If So >=50 Then

Begin

St:=St+'L';

So:=So-50;

End

Else

If So >=40 Then

Begin

St:=St+'XL';

So:=So-40;

End;

For i:=1 To (so Div 10) Do

St:=St+'X';

So:=So Mod 10;

If So >= 9 Then

Begin

St:=St+'IX';

So:=So-9;

End

Else

If So >=5 Then

Begin

St:=St+'V';

So:=So-5;

End

Else

If So >=4 Then

Begin

St:=St+'IV';

So:=So-4;

End;

For i:=1 To So Do

St:=St+'I';

Writeln;

Writeln('+So thap phan: ',So1);

Writeln('+So La ma : ',St);

Writeln;

Writeln('  Bam phim <Enter> de ket thuc');

Readln

End.

Bài 7. Viết chương trình Pascal Đổi số la mã ra số thập phân

Program So_La_Ma;

Label l1;

Var

St:String;

tiep:Char;

i,So:Integer;

Begin

Writeln('DOI SO LA MA RA SO THAP PHAN');

Writeln('       ------------');

Writeln;

L1:Write('-Nhap so La ma: ');

Readln(St);

So:=0;

i:=Length(St);

While i > 0 Do

Case St[i] Of

'I':Begin

So:=So+1;

i:=i-1;

End;

'V':If (i > 1) And (St[i-1] = 'I') Then

Begin

So:=So+4;

i:=i-2;

End

Else

Begin

So:=So+5;

i:=i-1;

End;

'X':If (i > 1) And (St[i-1] = 'I') Then

Begin

So:=So+9;

i:=i-2;

End

Else

Begin

So:=So+10;

i:=i-1;

End;

'L':If (i > 1) And (St[i-1] = 'X') Then

Begin

So:=So+40;

i:=i-2;

End

Else

Begin

So:=So+50;

i:=i-1;

End;

'C':If (i > 1) And (St[i-1] = 'X') Then

Begin

So:=So+90;

i:=i-2;

End

Else

Begin

So:=So+100;

i:=i-1;

End;

'D':If (i > 1) And (St[i-1] = 'C') Then

Begin

So:=So+400;

i:=i-2;

End

Else

Begin

So:=So+500;

i:=i-1;

End;

'M':If (i > 1) And (St[i-1] = 'C') Then

Begin

So:=So+900;

i:=i-2;

End

Else

Begin

So:=So+1000;

i:=i-1;

End;

End;

Writeln('+So La ma    : ',St);

Writeln('+Doi ra thap phan: ',So);

Writeln;

Write('-Tiep tuc nua khong (c/k) ');

Readln(tiep);

If UpCase(tiep)='C' Then

Goto l1;

End.