- Ebook Giải thuật và lập trình Lê Minh Hoàng
- Các thuật toán sắp xếp trong Pascal

Dãy hạnh phúc



Dãy số tự nhiên a1 , a2 ,a3...  ak được gọi là hạnh phúc nếu nó thoả mãn các điều kiện sau :
- Dãy trên là một dãy giảm dần .
- Với mọi i ( 1<=i <= k ) ai hoặc là số nguyên tố , hoặc phải là ước của một trong các số a1 , a2 , ... , ai
VD : 18 17 13 11 9 7 6 5 3 2 là dãy hạnh phúc
Viết chương trình nhập 1 số tự nhiên N từ bàn phím và in ra màn hình một dãy số hạnh phúc càng dài càng tốt với số hạng đầu tiên là N.

Uses crt;
Const
  max=37;
Var
  a:array[1..max] of longint;
  n,i:longint;
BEGIN
  Clrscr;
  a[1]:=1; a[2]:=1; a[3]:=2;
  For i:=4 to max do
    a[i]:=a[i-1]+a[i-2]+a[i-3];
  Write('Nhap so n:'); readln(n);
  i:=max;
  While a[i]>n do i:=i-1;
  Write(n,'=',a[i]);
  n:=n-a[i];
  While n>0 do
    Begin
      i:=i-1;
      If n>=a[i] then
        Begin
          Write('+',a[i]);
          n:=n-a[i];
        End;
    End;
  Readln;
END.


Nặc danh nói...

kho hiu wa


08:01 Ngày 06 tháng 05 năm 2013
Nặc danh nói...

đệt mẹ.... trẻ trâu... làm đếch đúg,....


17:03 Ngày 16 tháng 07 năm 2013
Nặc danh nói...

không hiểu


21:22 Ngày 03 tháng 12 năm 2013
Bé Con nói...

uses crt;
var n,i,j:integer;
a:array[1..100] of integer;
function NT(x:integer):boolean;
var h,d:integer;
kt:boolean;
begin
d:=0;
for h:=1 to x do
if x mod h=0 then d:=d+1;
if d=2 then kt:=true else kt:=false;
NT:=kt;
end;
function uoc(x,dau, cuoi: integer):boolean;
var k:integer;
begin
uoc:=false;
for k:=dau to cuoi do
if k mod x = 0 then uoc:=true;
end;

begin
clrscr;
write('nhap so;'); readln(n);
write('day so: ');
for i:=n downto 1 do
if NT(i) or (uoc(i,i+1,n)) then write(i,' ');
readln;
end.


19:14 Ngày 15 tháng 12 năm 2013
Thành Thòng Chủ nói...

const fi ='bai4.inp';
fo ='bai4.out';
var f1,f2:text;
n:longint;
procedure nhap;
begin
assign(f1,fi);
reset(f1);
readln(f1,n);
close(f1);
end;
function ktnt(l:longint):boolean;
var kt:boolean;
p:longint;
begin
kt:=true;
for p:= 2 to trunc(sqrt(l)) do
if (l mod p) = 0 then
begin
kt :=false;
break;
end;
ktnt:=kt;
end;

procedure xuly;
var i :longint;
q,w,e:boolean;
begin
for i:=n downto 2 do
begin
w:=false;
q:=ktnt(i);
if (n mod i) = 0 then
w:=true;
e:=((q=true) or (w = true)) ;
if e=true then
writeln(f2,i);
end;
end;
Begin
nhap;
assign(f2,fo);
rewrite(f2);
xuly;
close(f2);
End.


11:27 Ngày 24 tháng 08 năm 2014

Đăng nhận xét

Thành viên Blog

Tổng số lượt xem trang

Translate

Return to top of page Copyright © 2012 | Theme by Hack Tutors. Cung cấp bởi Blogger.
Các code pascal trong blog được sưu tầm, lựa chọn sao cho tối ưu nhất. Cảm ơn các tác giả đã viết thuật toán.