Tin học Tây Sơn

Số rõ ràng

Go down

Số rõ ràng

Bài gửi by Admin on Thu Nov 15, 2018 4:14 pm

Kiệt mới tìm được một tài liệu định nghĩa số rõ ràng như sau: Với số nguyên dương n, Kiệt tạo số mới bằng cách lấy tổng bình phương các chữ số của nó, với số mới này ta lại lặp lại công việc trên. Nếu trong quá trình đó, ta nhận được số mới là 1, thì số n ban đầu được gọi là số rõ ràng. Ví dụ, với n = 19, ta có: 19 → (= 12 +92) 82 → 68 → 100 → 1
Như vậy, 19 là số rõ ràng.
Không phải mọi số đều rõ ràng. Ví dụ, với n = 12, ta có: 12 → 5 → 25 → 29 → 85 → 89 → 145 → 42 → 20 → 4 → 16 → 37 → 58 → 89 → 145
Kiệt rất thích thú với định nghĩa số rõ ràng này và thách đố Oanh: Cho hai số nguyên dương n và k (1 ≤ n,k ≤ 1015), hãy tìm số rõ ràng liền sau thứ k của n. Bạn hãy giúp Oanh giải câu đố này nhé!
Dữ liệu:
RORANG.INP:  Chứa 2 số nguyên n và k.
RORANG.OUT: Chứa số rõ ràng thứ k của n.
        Ví dụ:
RORANG.INP
RORANG.OUT
18 119
18 223
avatar
Admin
Admin
Admin

Posts : 658
Reputation : -39
Join date : 16/11/2015
Age : 29

Xem lý lịch thành viên http://tinhocts.forumvi.com

Về Đầu Trang Go down

Re: Số rõ ràng

Bài gửi by mainhatthong2004 on Fri Nov 16, 2018 10:30 pm

thong:
program bai5;
uses crt;
type mang=array[1..100000] of integer;
var fi,fo:text;
n,i,k:integer;
a:mang;
//--------------------------------------------
function tong(x:integer):integer;
begin
tong:=0;
while x>0 do
begin
tong:=tong+sqr(x mod 10);
x:=x div 10;
end;
end;
//--------------------------------------------------
function rorang(m:integer):boolean;
var j,h:integer;
a:mang;
begin
rorang:=true;
j:=1;
while m>0 do
begin
a[j]:=tong(m);
m:=a[j];
if a[j]=1 then
begin
rorang:=true;
exit;
end;
for h:=1 to j-1 do
if a[h]=a[j] then
begin
rorang:=false;
exit;
end;
inc(j);
end;
end;
//-------------------------------------------------
procedure doc;
begin
assign(fi,'RORANG.inp');
reset(fi);
readln(fi,n,k);
close(fi);
end;
//--------------------------------------------
procedure ghi;
begin
assign(fo,'RORANG.out');
rewrite(fo);
i:=n+1;
while k>0 do
begin
if rorang(i) then
begin
dec(k); inc(i); end else
inc(i);
end;
write(fo,i-1);
close(fo);
end;
//-------------------------------------------------
begin
clrscr;
doc;
ghi;
readln;
end.
avatar
mainhatthong2004
Teen cá tính
Teen cá tính

Posts : 76
Reputation : -25
Join date : 18/06/2018

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Số rõ ràng

Bài gửi by nguyen77 on Sat Nov 17, 2018 12:35 am

Code:
program bt;
uses crt;
type mang=array[1..100] of longint;
var n,k,r,b,i,j,dem:longint;
ok:boolean;
fo,fi:text;
a:mang;

//---------------

function tach(p:longint):longint;
var t:longint;
begin
        t:=0;
        while p<>0 do
                begin
                        t:=t+(sqr(p mod 10));
                        p:=p div 10;
                end;
        tach:=t;
end;

//----------------

function tt(a:mang;b:longint):boolean;
begin
tt:=false;
for j:=1 to i-1 do
        if b=a[j] then
                begin
                        tt:=true;
                        break;
                end;
end;

//-----------------

function rorang(x:longint):boolean;
var ok:boolean;
begin
i:=1;
a[i]:=x;
ok:=false;
        while not ok do
                begin
                if tach(a[i])=1 then
                        begin
                        ok:=true;
                        break;
                        end
                else
                        if tt(A,a[i])=true then
                                break
                        else
                                begin
                                inc(i);
                                a[i]:=tach(a[i-1]);
                                end;
                end;
        rorang:=ok;
end;

//--------------

begin
clrscr;
assign(fi,'rorang.inp');
reset(fi);
read(fi,n);
read(fi,k);
assign(fo,'rorang.out');
rewrite(fo);
while dem<k do
        begin
        if rorang(n)=true then
                begin
                inc(dem);
                inc(n);
                end
        else
                inc(n);
        end;
write(fo,n-1);
close(fi);
close(fo);
readln;
end.
avatar
nguyen77
Năng động
Năng động

Posts : 68
Reputation : -22
Join date : 18/06/2018

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Số rõ ràng

Bài gửi by Cao Hải Dương on Sat Nov 17, 2018 11:36 am

CODE:
Program so_ro_rang;
Uses crt;
Type mang=array[1..100] of longint;
Var fi,fo:text; n,k,i:longint;
a:mang;

Function tongbp(x:longint):longint;
Begin
tongbp:=0;
While x<>0 do
Begin
tongbp:=tongbp+sqr(x mod 10);
x:=x div 10;
End;
End;

Function rorang(x:integer):boolean;
Var i,j:integer;
a:mang;
Begin
rorang:=true;
i:=1;
While x>0 do
Begin
a[i]:=tongbp(x);
x:=a[i];
If a[i]=1 then
Begin
rorang:=true;
exit;
End;
For j:=1 to i-1 do
If a[j]=a[i] then
Begin
rorang:=false;
exit;
End;
inc(i);
End;
End;

Begin
Clrscr;
Assign(fi,'RORANG.INP');Reset(fi);
Read(fi,n); Read(fi,k); Close(fi);
Assign(fo,'RORANG.OUT');Rewrite(fo);
i:=n+1;
While k>0 do
If rorang(i) then
Begin
dec(k);
inc(i);
End
Else inc(i);
Write(fo,i-1);
Close(fo);
Readln;
End.
avatar
Cao Hải Dương
Năng động
Năng động

Posts : 56
Reputation : -1
Join date : 18/06/2018
Age : 14
Location : Bình Định

Xem lý lịch thành viên http://starduongdesign.blogspot.com

Về Đầu Trang Go down

Re: Số rõ ràng

Bài gửi by Nguyễn Văn Biên on Sat Nov 17, 2018 12:29 pm

CODE:
program RORANG;
type mang=array[1..100] of longint;
var fi,fo:text;
n,k,i:longint;
A:mang;

function tong(x:longint):longint;
begin
tong:=0;
while x<>0 do
begin
tong:=tong+sqr(x mod 10);
x:=x div 10
end
end;

function rr(x:integer):boolean;
var i,j:integer;
A:mang;
begin
rr:=true; i:=1;
while x>0 do
begin
A[i]:=tong(x); x:=A[i];
if A[i]=1 then begin rr:=true; exit end;
for j:=1 to i-1 do
if a[j]=a[i] then begin rr:=false; exit end;
inc(i)
end
end;

begin
assign(fi,'RORANG.INP'); reset(fi);
read(fi,n,k); close(fi);
i:=n+1;
while k>0 do
if rr(i) then begin dec(k); inc(i) end
else inc(i);
assign(fo,'RORANG.OUT'); rewrite(fo);
write(fo,i-1);
close(fo)
end.
avatar
Nguyễn Văn Biên
S-mod
S-mod

Posts : 186
Reputation : 21
Join date : 18/06/2018
Age : 14
Location : ?

Xem lý lịch thành viên https://bien2004official.blogspot.com

Về Đầu Trang Go down

Re: Số rõ ràng

Bài gửi by tonguyengiahan237 on Sat Nov 17, 2018 12:48 pm

Code:
Program Ro_rang_tep;
Uses crt;
Type MangRR=array[1..100] of longint;
Var n,k:longint;
fi,fo:text;

Procedure Docdl(Var n,k:longint;Var fi:text);
Begin
Assign(fi,'RORANG.INP');
Reset(fi);
Read(fi,n,k);
Close(fi);
End;

Function Binh_phuong(n:longint):longint;
Var Bp:longint;
Begin
Bp:=0;
While n<>0 do
Begin
Bp:=Bp+sqr(n mod 10);
n:=n div 10;
End;
Binh_phuong:=Bp;
End;

Function Tim_srr(n:integer):boolean;
Var i,j:integer;
A:MangRR;
Begin
Tim_Srr:=true;
i:=1;
While n>0 do
Begin
A[i]:=Binh_phuong(n);
n:=A[i];
If A[i]=1 then
begin
Tim_srr:=true;
exit;
end;
For j:=1 to i-1 do
If A[j]=A[i] then
Begin
Tim_srr:=false;
exit;
End;
i:=i+1;
End;
End;

Procedure Vietdl(Var n,k:longint;Var fo:text);
Var i:longint;
Begin
Assign(fo,'RORANG.OUT');
Rewrite(fo);
i:=n+1;
While k>0 do
If Tim_srr(i)=true then
Begin
k:=k-1;
i:=i+1;
End
Else i:=i+1;
Write(fo,i-1);
Close(fo);
End;

BEGIN
Clrscr;
Docdl(n,k,fi);
Vietdl(n,k,fo);
Readln;
END.
avatar
tonguyengiahan237
Teen Chính hiệu
Teen Chính hiệu

Posts : 28
Reputation : -2
Join date : 06/11/2018
Age : 14
Location : TT Phú Phong Huyện Tây Sơn Tỉnh Bình Định

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Số rõ ràng

Bài gửi by Nguyễn Ngọc Thiên on Sat Nov 17, 2018 1:58 pm

Code:
program sororang;
uses crt;

var  a:array[1..100000] of integer;
      fi,fo:text;
      n,i,k:integer;
//--------------------------------------------
function tg(x:integer):integer;
begin
tg:=0;
while x>0 do
begin
tg:=tg+sqr(x mod 10);
x:=x div 10;
end;
end;
//--------------------------------------------------
procedure doc;
begin
assign(fi,'rorang.inp');
reset(fi);
readln(fi,n,k);
close(fi);
end;
//--------------------------------------------
function rorang(m:integer):boolean;
var j,h:integer;

begin
rorang:=true;
j:=1;
while m>0 do
begin
a[j]:=tg(m);
m:=a[j];
if a[j]=1 then
begin
rorang:=true;
exit;
end;
for h:=1 to j-1 do
if a[h]=a[j] then
begin
rorang:=false;
exit;
end;
inc(j);
end;
end;
//-------------------------------------------------
procedure ghi;
begin
assign(fo,'rorang.out');
rewrite(fo);
i:=n+1;
while k>0 do
begin
if rorang(i) then
begin
dec(k); inc(i); end else
inc(i);
end;
write(fo,i-1);
close(fo);
end;
//-------------------------------------------------
begin
clrscr;
doc;
ghi;
readln;
end.
avatar
Nguyễn Ngọc Thiên
Teen Chính hiệu
Teen Chính hiệu

Posts : 17
Reputation : -4
Join date : 06/11/2018
Age : 13
Location : Bình tường, Tây Sơn, Bình Định

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Số rõ ràng

Bài gửi by quantran on Sat Nov 17, 2018 1:59 pm

Code:
program bai;
var fi,fo:text;
n,i,k:integer;
a:array[1..100000] of integer;
//-------------------------------------------------
procedure nhap;
begin
assign(fi,'rorang.inp');
reset(fi);
readln(fi,n,k);
close(fi);
end;
//--------------------------------------------
function tach(x:integer):integer;
begin
tach:=0;
while x>0 do
begin
tach:=tach+sqr(x mod 10);
x:=x div 10;
end;
end;
//--------------------------------------------------
function rr(t:integer):boolean;
var
j,h:integer;
begin
rr:=true;
j:=1;
while t>0 do
begin
a[j]:=tach(t);
t:=a[j];
if a[j]=1 then
begin
rr:=true;
exit;
end;
for h:=1 to j-1 do
if a[h]=a[j] then
begin
rr:=false;
exit;
end;
inc(j);
end;
end;
//--------------------------------------------
procedure xuli;
begin
assign(fo,'RORANG.out');
rewrite(fo);
i:=n+1;
while k>0 do
begin
if rr(i) then
begin
k:=k-1;
i:=i+1;
end
else
i:=i+1;
end;
write(fo,i-1);
close(fo);
end;
//-------------------------------------------------
begin
nhap;
xuli;
readln;
end.
avatar
quantran
Teen cá tính
Teen cá tính

Posts : 73
Reputation : -20
Join date : 18/06/2018
Age : 14
Location : Binh Thuan-Tay Son-Binh Dinh

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Số rõ ràng

Bài gửi by Tạ Thúy Phượng on Sat Nov 17, 2018 2:06 pm

code:
program bai;
var fi,fo:text;
n,i,k:integer;
a:array[1..100000] of integer;
//-------------------------------------------------
procedure nhap;
begin
assign(fi,'rorang.inp');
reset(fi);
readln(fi,n,k);
close(fi);
end;
//--------------------------------------------
function tach(x:integer):integer;
begin
tach:=0;
while x>0 do
       begin
       tach:=tach+sqr(x mod 10);
       x:=x div 10;
       end;
end;
//--------------------------------------------------
function tt(t:integer):boolean;
var
j,h:integer;
begin
tt:=true;
j:=1;
while t>0 do
       begin
       a[j]:=tach(t);
       t:=a[j];
       if a[j]=1 then
               begin
               tt:=true;
               exit;
               end;
       for h:=1 to j-1 do
       if a[h]=a[j] then
               begin
               tt:=false;
               exit;
               end;
       inc(j);
       end;
end;
//--------------------------------------------
procedure xuli;
begin
assign(fo,'RORANG.out');
rewrite(fo);
i:=n+1;
while k>0 do
       begin
       if tt(i) then
               begin
               k:=k-1;
               i:=i+1;
               end
       else
               i:=i+1;
       end;
write(fo,i-1);
close(fo);
end;
//-------------------------------------------------
begin
nhap;
xuli;
readln;
end.
avatar
Tạ Thúy Phượng
Năng động
Năng động

Posts : 63
Reputation : -19
Join date : 18/06/2018
Location : Binh Thuan-Tay Son-Binh Dinh

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Số rõ ràng

Bài gửi by lohan on Sat Nov 17, 2018 2:08 pm

Code:
program SRR;
uses crt;
type mang=array[1..100000] of integer;
var    fi,fo:text;
        n,i,k,dem:integer;
        a:mang;

function tong(x:integer):integer;
 begin
  tong:=0;
  while x>0 do
  begin
  tong:=tong+sqr(x mod 10);
  x:=x div 10;
  end;
 end;

function rorang(m:integer):boolean;
 var j,h:integer;
    a:mang;
  begin
  rorang:=true;
  j:=1;
  while m>0 do
  begin
  a[j]:=tong(m);
  m:=a[j];
  if a[j]=1 then
  begin
  rorang:=true;
  exit;
  end;
        for h:=1 to j-1 do
        if a[h]=a[j] then
  begin
        rorang:=false;
        exit;
  end;
 inc(j);
    end;
end;


begin
clrscr;
    assign(fi,'rorang.inp');
    reset(fi);
    read(fi,n);
    read(fi,k);
    assign(fo,'rorang.out');
    rewrite(fo);
    while dem<k do
        begin
        if rorang(n)=true then
          begin
          inc(dem);
          inc(n);
          end
        else
                inc(n);
        end;
write(fo,n-1);
close(fi);
close(fo);
readln;
end.
avatar
lohan
Teen Chính hiệu
Teen Chính hiệu

Posts : 20
Reputation : -3
Join date : 06/11/2018
Age : 14

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Số rõ ràng

Bài gửi by huynhtanluc on Sat Nov 17, 2018 4:37 pm

Code:
program SO_RR;
uses crt;
type mang=array[1..1000] of longint;
var n,k,r,b,i,j:longint;
    OK:boolean;a:mang;

function tach(var x:longint):longint;
begin
    tach:=0;
    while x<>0 do
    begin
      tach:=tach+(sqr(x mod 10));
      x:=x div 10;
    end;
    A[i]:=tach;
    inc(i);
    x:=tach
end;

function tt(a:mang;b:longint):boolean;
begin
  tt:=false;
  for j:=1 to i-1 do
      for k:=j+1 to i do
      if b=A[j] then
      if A[j]=A[k] then
      begin
        tt:=true;
        break;
      end;
end;

Begin
clrscr;
    i:=1;
    repeat write('Nhap n: '); readln(n); until n>0;
    OK:=false; r:=n;
    while not OK do
      begin
      b:=tach(r);
      if b=1 then
        begin
        OK:=true;
        break;end
        else if tt(A,b)=true then break;
        end;
      if OK=true then write(n,' la so ro rang')
        else write(n,' khong la so ro rang');
        readln;
end.
avatar
huynhtanluc
Năng động
Năng động

Posts : 61
Reputation : -14
Join date : 18/06/2018

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Số rõ ràng

Bài gửi by Sponsored content


Sponsored content


Về Đầu Trang Go down

Về Đầu Trang


 
Permissions in this forum:
Bạn không có quyền trả lời bài viết