Cảm giác bài làm của 2 bạn hạng nhất và hạng nhì khá giống nhau nhỉ?

Bạn này chắc thích làm bài ko ai hiểu được

Nguyễn Lê Phước Thịnh cho mình hỏi sao mình chạy đc bài 1,3 đúng mà ko có điểm

chạy ra kết quả sai

Vd text 3 nè:

ok do b ghi b3 0đ nên hỏi lại

Có thể, mà sao bạn không tham gia Vòng 2?

bài 1 chạy không được

Bài làm của bạn @Tran Nguyễn Đăng Dương(bạn được 20 điểm, xếp thứ 1 chung cuộc)

-Bài 1:

program hedem;
uses crt;
const fi='hedem.inp';
fo='hedem.out';
var st:string;
hedema,hedemb:integer;
f1,f2:text;
Function heasanghe10(st1:string):integer;
var d,i,code,x,kq:integer;
begin
d:=Length(st1);
kq:=0;
x:=0;
for i:=1 to d do
begin
case st1[i] of
'0'..'9':begin
Val(st1[i],x,code);
kq:=kq*hedema+x;
end;
'A'..'F':begin
x:=ord(st1[i])-55;
kq:=kq*hedema+x;
end;
end;
end;
exit(kq);
end;
Procedure he10sangheb(kq:Integer);
var dem,d,i,x:integer;
du:array[1..100] of Integer;
begin
dem:=0;
x:=0;
repeat
dem:=dem+1;
du[dem]:=kq mod hedemb;
kq:=kq div hedemb;
until kq=0;
for i:=dem downto 1 do
begin
case du[i] of
0..9:write(f2,du[i]);
10..15:begin
x:=du[i]+55;
write(f2,Chr(x));
end;
end;
end;
end;
begin
clrscr;
assign(f1,fi); reset(f1);
assign(f2,fo); rewrite(f2);
read(f1,hedema,hedemb);
readln(f1);
read(f1,st);
he10sangheb(heasanghe10(st));
Close(f1);
Close(f2);
End.

-Bài 2:

Program ntghep;
uses crt;
const fi='ntghep.inp';
fo='ntghep.out';
var n:integer;
f1,f2:text;
Function SNTcheck(m:longint):boolean;
var i:longint;
begin
for i:=2 to trunc(sqrt(m)) do if m mod i=0 then exit(false);
exit(true);
end;
Function timsntthun(m:longint):longint;
var dem,j:longint;
begin
j:=2;
dem:=0;
repeat
while not SNTcheck(j) do inc(j);
inc(dem);
inc(j);
until dem=m;
exit(j-1);
end;
Function timsntghepthun(m:integer):longint;
var dem,k,code,kq:longint;
st,st1:string;
begin
k:=1;
kq:=0;
dem:=0;
repeat
str(timsntthun(k),st); str(timsntthun(k+1),st1);
Val(st+st1,kq,code);
if SNTcheck(kq) then inc(dem);
k:=k+2;
until dem=m;
exit(kq);
end;
Begin
clrscr;
assign(f1,fi); reset(f1);
assign(f2,fo); rewrite(f2);
read(f1,n);
write(f2,timsntghepthun(n));
Close(f1); Close(f2);
End.

-Bài 3;

Program Fibonacci;
uses crt;
const fi='fibonaci.inp';
fo='fibonaci.out';
var n:integer;
f1,f2:text;
procedure fibo(n:integer);
var i,vt:integer;
fibo:array[1..100] of Integer;
kt:boolean;
begin
fibo[1]:=1; fibo[2]:=1;
kt:=false;
for i:=3 to n do
begin
fibo[i]:=fibo[i-1]+fibo[i-2];
if fibo[i]=n then
begin
kt:=true;
vt:=i;
end;
end;
for i:=1 to n do write(f2,fibo[i],' ');
writeln(f2);
if kt then writeln(f2,'Co. ',vt)
else writeln(f2,'Khong');
write(f2,fibo[n]);
end;
Begin
clrscr;
assign(f1,fi); reset(f1);
assign(f2,fo); rewrite(f2);
read(f1,n);
fibo(n);
Close(f1); Close(f2);
End.

-Bài 4:

Program map;
uses crt;
const fi='map.inp';
fo='map.out';
type arr=array[0..2001,0..71] of Char;
var area,tam:arr;
e,f:array[1..4] of Integer;
ch:char;
st:string;
i,j,x,y,vtdx,vtdy,vtcd,vtcdm:integer;
dem,max:longint;
f1,f2:text;
Procedure mapfinding(a,b:integer; var c:arr);
var k:integer;
begin
if (a>0) and (a<=x) and (b>0) and (b<=y) and (c[a,b]=ch) then
begin
vtcd:=a;
c[a,b]:='*';
inc(dem);
for k:=1 to 4 do mapfinding(a+e[k],b+f[k],c);
end;
end;
Begin
clrscr;
assign(f1,fi); reset(f1);
assign(f2,fo); rewrite(f2);
readln(f1,ch);
e[1]:=-1; e[4]:=1; f[2]:=-1; f[3]:=1;
i:=0;
repeat
readln(f1,st);
inc(x);
for y:=1 to Length(st) do area[x,y]:=st[y];
until eof(f1);
tam:=area;
for i:=1 to x do
for j:=1 to y do
if tam[i,j]=ch then
begin
mapfinding(i,j,tam);
if max<dem then
begin
max:=dem;
vtdx:=i;
vtdy:=j;
vtcdm:=vtcd;
end;
dem:=0;
end;
mapfinding(vtdx,vtdy,area);
writeln(f2,max,' ',vtdx,' ',vtdy,' ',vtcdm);
for i:=vtdx to vtcdm do
begin
for j:=1 to y do write(f2,area[i,j]);
writeln(f2);
end;
Close(f1);
Close(f2);
End.

-Bài 5:

Program smart;
uses crt;
const fi='smart.inp';
fo='smart.out';
type AsVBs=record
a,v,b:string;
end;
AVBs=record
a,v,b:string;
end;
AsVB=record
a,v,b:string;
end;
AisB=record
a,b:string;
end;
Question=record
a,typea,v,b,typeb:string;
end;
var AsVBsinfo:array[0..101] of AsVBs;
AVBsinfo:array[0..101] of AVBs;
AsVBinfo:array[0..101] of AsVB;
AisBinfo:array[0..101] of AisB;
Questions:array[0..101] of Question;
i,j,k,noAsVBs,noAVBs,noAsVB,noAisB,noQuestions,vt:integer;
f1,f2:text;
st,st1,st2,st3:string;
check,check1,check2:boolean;
Procedure readinfo;
begin
repeat
readln(f1,st);
if st='#' then break;
for i:=1 to 3 do
begin
j:=1;
while (st[j]<>' ') and (st[j]<>'.') do inc(j);
case i of
1:st1:=upcase(copy(st,1,j-1));
2:st2:=upcase(copy(st,1,j-1));
3:st3:=upcase(copy(st,1,j-1));
end;
Delete(st,1,j);
end;
Delete(st,Length(st),1);
st:=upcase(st);
if st1='DOES' then
begin
inc(noQuestions);
Questions[noQuestions].a:=st2;
Questions[noQuestions].v:=st3;
Questions[noQuestions].b:=st;
end
else if st2='IS' then
begin
inc(noAisB);
AisBinfo[noAisB].a:=st1;
AisBinfo[noAisB].b:=st+'S';
end
else if (st1[Length(st1)]='S') and (st3[Length(st3)]='S') then
begin
inc(noAsVBs);
AsVBsinfo[noAsVBs].a:=st1;
AsVBsinfo[noAsVBs].v:=st2;
AsVBsinfo[noAsVBs].b:=st3;
end
else if st1[Length(st1)]='S' then
begin
inc(noAsVB);
write(st1,' ',st2,' ',st3,' ',st,' AsVB');
AsVBinfo[noAsVB].a:=st1;
AsVBinfo[noAsVB].v:=st2;
AsVBinfo[noAsVB].b:=st3;
end
else if st3[Length(st3)]='S' then
begin
inc(noAVBs);
AVBsinfo[noAVBs].a:=st1;
AVBsinfo[noAVBs].v:=st2;
AVBsinfo[noAVBs].b:=st3;
end;
until eof(f1);
end;
Begin
clrscr;
assign(f1,fi); reset(f1);
assign(f2,fo); rewrite(f2);
readinfo;
for i:=1 to noQuestions do
begin
for j:=1 to noAisB do
begin
if Questions[i].a=AisBinfo[j].a then Questions[i].typea:=AisBinfo[j].b;
if Questions[i].b=AisBinfo[j].a then Questions[i].typeb:=AisBinfo[j].b;
end;
if (Questions[i].typea='') and (Questions[i].typeb='') then writeln(f2,'No.')
else
begin
check:=false;
check1:=false;
check2:=false;
if (Questions[i].typea<>'') and (Questions[i].typeb<>'') then
begin
for j:=1 to noAsVBs do
begin
if (Questions[i].typea=...

Bài làm của bạn @Encyclopedia(bạn được 20 điểm, xếp thứ 2 chung cuộc vì nộp bài chậm hơn bạn @Tran Nguyễn Đăng Dương)

bài 1:

var st:string;
hedema,hedemb:integer;
f,g:text;
const fi='hedem.inp';
fo='hedem.out';
Function doisanghe10(st1:string):integer;
var d,i,code,x,kq:integer;
begin
d:=Length(st1);
kq:=0;
x:=0;
for i:=1 to d do
begin
case st1[i] of
'0'..'9':begin
Val(st1[i],x,code);
kq:=kq*hedema+x;
end;
'A'..'F':begin
x:=ord(st1[i])-55;
kq:=kq*hedema+x;
end;
end;
end;
exit(kq);
end;
Procedure chuyen10sangb(kq:Integer);
var dem,d,i,x:integer;
du:array[1..100] of Integer;
begin
dem:=0;
x:=0;
repeat
dem:=dem+1;
du[dem]:=kq mod hedemb;
kq:=kq div hedemb;
until kq=0;
for i:=dem downto 1 do
begin
case du[i] of
0..9:write(g,du[i]);
10..15:begin
x:=du[i]+55;
write(g,Chr(x));
end;
end;
end;
end;
begin
assign(f,fi); reset(f);
assign(g,fo); rewrite(g);
read(f,hedema,hedemb);
readln(f);
read(f,st);
chuyen10sangb(doisanghe10(st));
Close(f);
Close(g);
End.

bài 2:

const fi='ntghep.inp';
fo='ntghep.out';
var n:integer;
f1,f2:text;
Function SNTcheck(m:longint):boolean;
var i:longint;
begin
for i:=2 to trunc(sqrt(m)) do if m mod i=0 then exit(false);
exit(true);
end;
Function timsntthun(m:longint):longint;
var dem,j:longint;
begin
j:=2;
dem:=0;
repeat
while not SNTcheck(j) do inc(j);
inc(dem);
inc(j);
until dem=m;
exit(j-1);
end;
Function timsntghepthun(m:integer):longint;
var dem,k,code,kq:longint;
st,st1:string;
begin
k:=1;
kq:=0;
dem:=0;
repeat
str(timsntthun(k),st); str(timsntthun(k+1),st1);
Val(st+st1,kq,code);
if SNTcheck(kq) then inc(dem);
k:=k+2;
until dem=m;
exit(kq);
end;
Begin
assign(f1,fi); reset(f1);
assign(f2,fo); rewrite(f2);
read(f1,n);
write(f2,timsntghepthun(n));
Close(f1); Close(f2);
End.

bài 3:

const fi='fibonaci.inp';
fo='fibonaci.out';
var n:integer;
f1,f2:text;
procedure fibo(n:integer);
var i,vt:integer;
fibo:array[1..100] of Integer;
kt:boolean;
begin
fibo[1]:=1; fibo[2]:=1;
kt:=false;
for i:=3 to n do
begin
fibo[i]:=fibo[i-1]+fibo[i-2];
if fibo[i]=n then
begin
kt:=true;
vt:=i;
end;
end;
for i:=1 to n do write(f2,fibo[i],' ');
writeln(f2);
if kt then writeln(f2,'Co. ',vt)
else writeln(f2,'Khong');
write(f2,fibo[n]);
end;
Begin
assign(f1,fi); reset(f1);
assign(f2,fo); rewrite(f2);
read(f1,n);
fibo(n);
Close(f1); Close(f2);
End.

bài 4:

type arr=array[0..2001,0..71] of Char;
var area,tam:arr;
e,f:array[1..4] of Integer;
ch:char;
st:string;
i,j,x,y,vtdx,vtdy,vtcd,vtcdm:integer;
dem,max:longint;
f1,f2:text;
const fi='map.inp';
fo='map.out';
Procedure mapfinding(a,b:integer; var c:arr);
var k:integer;
begin
if (a>0) and (a<=x) and (b>0) and (b<=y) and (c[a,b]=ch) then
begin
vtcd:=a;
c[a,b]:='*';
inc(dem);
for k:=1 to 4 do mapfinding(a+e[k],b+f[k],c);
end;
end;
Begin
assign(f1,fi); reset(f1);
assign(f2,fo); rewrite(f2);
readln(f1,ch);
e[1]:=-1; e[4]:=1; f[2]:=-1; f[3]:=1;
i:=0;
repeat
readln(f1,st);
inc(x);
for y:=1 to Length(st) do area[x,y]:=st[y];
until eof(f1);
tam:=area;
for i:=1 to x do
for j:=1 to y do
if tam[i,j]=ch then
begin
mapfinding(i,j,tam);
if max<dem then
begin
max:=dem;
vtdx:=i;
vtdy:=j;
vtcdm:=vtcd;
end;
dem:=0;
end;
mapfinding(vtdx,vtdy,area);
writeln(f2,max,' ',vtdx,' ',vtdy,' ',vtcdm);
for i:=vtdx to vtcdm do
begin
for j:=1 to y do write(f2,area[i,j]);
writeln(f2);
end;
Close(f1);
Close(f2);
End.
//THE END

bài 5

const fi='bxl.inp';
fo='bxl.out';
type AsVBs=record
a,v,b:string;
end;
AVBs=record
a,v,b:string;
end;
AsVB=record
a,v,b:string;
end;
AisB=record
a,b:string;
end;
Question=record
a,typea,v,b,typeb:string;
end;
var AsVBsinfo:array[0..101] of AsVBs;
AVBsinfo:array[0..101] of AVBs;
AsVBinfo:array[0..101] of AsVB;
AisBinfo:array[0..101] of AisB;
Questions:array[0..101] of Question;
i,j,k,noAsVBs,noAVBs,noAsVB,noAisB,noQuestions,vt:integer;
f1,f2:text;
st,st1,st2,st3:string;
check,check1,check2:boolean;
Procedure readinfo;
begin
repeat
readln(f1,st);
if st='#' then break;
for i:=1 to 3 do
begin
j:=1;
while (st[j]<>' ') and (st[j]<>'.') do inc(j);
case i of
1:st1:=upcase(copy(st,1,j-1));
2:st2:=upcase(copy(st,1,j-1));
3:st3:=upcase(copy(st,1,j-1));
end;
Delete(st,1,j);
end;
Delete(st,Length(st),1);
st:=upcase(st);
if st1='DOES' then
begin
inc(noQuestions);
Questions[noQuestions].a:=st2;
Questions[noQuestions].v:=st3;
Questions[noQuestions].b:=st;
end
else if st2='IS' then
begin
inc(noAisB);
AisBinfo[noAisB].a:=st1;
AisBinfo[noAisB].b:=st+'S';
end
else if (st1[Length(st1)]='S') and (st3[Length(st3)]='S') then
begin
inc(noAsVBs);
AsVBsinfo[noAsVBs].a:=st1;
AsVBsinfo[noAsVBs].v:=st2;
AsVBsinfo[noAsVBs].b:=st3;
end
else if st1[Length(st1)]='S' then
begin
inc(noAsVB);
write(st1,' ',st2,' ',st3,' ',st,' AsVB');
AsVBinfo[noAsVB].a:=st1;
AsVBinfo[noAsVB].v:=st2;
AsVBinfo[noAsVB].b:=st3;
end
else if st3[Length(st3)]='S' then
begin
inc(noAVBs);
AVBsinfo[noAVBs].a:=st1;
AVBsinfo[noAVBs].v:=st2;
AVBsinfo[noAVBs].b:=st3;
end;
until eof(f1);
end;
Begin
assign(f1,fi); reset(f1);
assign(f2,fo); rewrite(f2);
readinfo;
for i:=1 to noQuestions do
begin
for j:=1 to noAisB do
begin
if Questions[i].a=AisBinfo[j].a then Questions[i].typea:=AisBinfo[j].b;
if Questions[i].b=AisBinfo[j].a then Questions[i].typeb:=AisBinfo[j].b;
end;
if (Questions[i].typea='') and (Questions[i].typeb='') then writeln(f2,'No.')
else
begin
check:=false;
check1:=false;
check2:=false;
if (Questions[i].typea<>'') and (Questions[i].typeb<>'') then
begin
for j:=1 to noAsVBs do
begin
if (Questions[i].typea=AsVBsinfo[j].a) and (Questions[i].typeb=AsVBsinfo[j].b) and (Questions[i].v=AsVBsinfo[j].v) then
begin
writeln(f2,'Yes.');
...

Bài làm của bạn Minh Lê(Link trang cá nhân: https://hoc24.vn/id/2720062)(bạn được 19,9 điểm, xếp thứ 3 chung cuộc)

// Bài 1 (hedem):

var s: string; a, b: integer; fi, fo: text; procedure open_file(s: string); begin assign(fi, s + '.INP'); reset(fi); assign(fo, s + '.OUT'); rewrite(fo); end; procedure close_file; begin close(fi); close(fo); end; function decode(var s: string; base: integer): integer; var i, n, ans, x: integer; begin n := length(s); ans := 0; for i := 1 to n do begin if (s[i] >= '0') and (s[i] <= '9') then x := ord(s[i]) - 48 else x := ord(s[i]) - 55; ans := base * ans + x; end; exit(ans); end; function encode(x, base: integer): string; var c: char; ans: string; begin ans := ''; while x <> 0 do begin if x mod base <= 9 then c := chr(x mod base + 48) else c := chr(x mod base + 55); ans := c + ans; x := x div base; end; exit(ans); end; begin open_file('hedem'); readln(fi, a, b); readln(fi, s); write(fo, encode(decode(s, a), b)); close_file; end.

// Bài 2 (ntghep)

const INF = 36000000; var pr, mf: array[1..INF] of longint; k, pr_size: longint; fi, fo: text; procedure open_file(s: string); begin assign(fi, s + '.INP'); reset(fi); assign(fo, s + '.OUT'); rewrite(fo); end; procedure close_file; begin close(fi); close(fo); end; procedure build; var i, j: longint; begin pr_size := 0; for i := 2 to INF do begin if mf[i] = 0 then begin mf[i] := i; inc(pr_size); pr[pr_size] := i; end; for j := 1 to pr_size do if (pr[j] > i) or (pr[j] * i > INF) then break else mf[pr[j] * i] := pr[j]; end; end; function calc(k: longint): longint; var i, x: longint; x1, x2: string; begin for i := 1 to pr_size div 2 do begin str(pr[2*i - 1], x1); str(pr[2*i], x2); val(x1 + x2, x); if mf[x] = x then begin if k = 1 then exit(x) else dec(k); end; end; end; begin open_file('ntghep'); build; read(fi, k); write(fo, calc(k)); close_file; end.

// Bài 3 (fibonaci)

var i, n: longint; fib: array[1..30] of longint; fi, fo: text; procedure open_file(s: string); begin assign(fi, s + '.INP'); reset(fi); assign(fo, s + '.OUT'); rewrite(fo); end; procedure close_file; begin close(fi); close(fo); end; procedure build; begin fib[1] := 1; fib[2] := 1; for i := 3 to n do fib[i] := fib[i - 2] + fib[i - 1]; end; procedure print1; begin for i := 1 to n do write(fo, fib[i], ' '); writeln(fo); end; procedure print2; begin for i := 1 to n do if fib[i] = n then begin writeln(fo, 'Có. ', i); exit; end; writeln(fo, 'Không'); end; procedure print3; begin writeln(fo, fib[n]); end; begin open_file('fibonaci'); read(fi, n); build; print1; print2; print3; close_file; end.

// Bài 4 (map)

var i, j: longint; n, m: longint; s, x, y, z: longint; land: array[1..2000] of string; visited: array[1..2000, 1..70] of boolean; c: char; u, v: longint; _s, _x, _y, _z: longint; front, back: longint; queue: array[1..140000] of record first, second: longint; end; fi, fo: text; procedure open_file(s: string); begin assign(fi, s + '.INP'); reset(fi); assign(fo, s + '.OUT'); rewrite(fo); end; procedure close_file; begin close(fi); close(fo); end; procedure qpush(i, j: longint); begin inc(back); with queue[back] do begin first := i; second := j; end; end; procedure qinit(i, j: longint); begin front := 1; back := 0; qpush(i, j); visited[i, j] := true; _s := 1; _x := i; _y := j; _z := i; end; function is_valid1(i, j: longint): boolean; begin exit((i >= 1) and (i <= n) and (j >= 1) and (j <= m) and (land[i, j] = c) and (not visited[i, j])); end; procedure qupdate1(i, j: longint); begin qpush(i, j); visited[i, j] := true; inc(_s); if i > _z then _z := i; end; function is_valid2(i, j: longint): boolean; begin exit((i >= 1) and (i <= n) and (j >= 1) and (j <= m) and (land[i, j] = c)); end; procedure qupdate2(i, j: longint); begin qpush(i, j); land[i, j] := '*'; end; begin open_file('map'); readln(fi, c); n := 0; while not eof(fi) do begin inc(n); readln(fi, land[n]); end; m := length(land[1]); s := 0; for i := 1 to n do for j := 1 to m do if is_valid1(i, j) then begin qinit(i, j); while front <= back do begin u := queue[front].first; v := queue[front].second; inc(front); if is_valid1(u - 1, v) then qupdate1(u - 1, v); if is_valid1(u + 1, v) then qupdate1(u + 1, v); if is_valid1(u, v - 1) then qupdate1(u, v - 1); if is_valid1(u, v + 1) then qupdate1(u, v + 1); end; if _s > s then begin s := _s; x := _x; y := _y; z := _z; end; end; qinit(x, y); while front <= back do begin u := queue[front].first; v := queue[front].second; inc(front); if is_valid2(u - 1, v) then qupdate2(u - 1, v); if is_valid2(u + 1, v) then qupdate2(u + 1, v); if is_valid2(u, v - 1) then qupdate2(u, v - 1); if is_valid2(u, v + 1) then qupdate2(u, v + 1); end; writeln(fo, s, ' ', x, ' ', y, ' ', z); for i := x to z do begin for j := 1 to m do write(fo, land[i, j]); writeln(fo); end; close_file; end.

// Bài 5 (bxl)

const mol = 1000007; const base = 37; var i, j, n, v: longint; a, b: string; s: array[0..4] of string; d: array[0..1000006] of boolean; define: array[0..1000006] of string; f1, f2, f3: boolean; fi, fo: text; procedure open_file(s: string); begin assign(fi, s + '.INP'); reset(fi); assign(fo, s + '.OUT'); rewrite(fo); end; procedure close_file; begin close(fi); close(fo); end; function hash(s: string): longint; var i, n, d: longint; begin n := length(s); d := 0; for i := 1 to n do d := (base*d + ord(s[i]) - 97) mod mol; exit(d); end; begin open_file('bxl'); while not eof(fi) do begin readln(fi, s[0]); i := 1; s[1] := ''; n := length(s[0]); if (n = 1) then break; for j := 1 to n do begin if s[0][j] = ' ' then begin inc(i); s[i] := ''; end else if (s[0][j] >= 'A') and (s[0][j] <= 'Z') then s[i] := s[i] + chr(ord(s[0][j]) + 32) else if (s[0][j] >= 'a') and (s[0][j] <= 'z') then s[i] := s[i] + s[0][j]; end; if s[1] = 'does' then begin a := define[hash(s[2])]; b := define[hash(s[4])]; f1 := d[hash(s[2] + ' ' + s[3] + ' ' + b )]; f2 := d[hash(a + ' ' + s[3] + ' ' + s[4])]; f3 := d[hash(a + ' ' + s[3] + ' ' + b )]; if f1 or f2 or f3 then writeln(fo, 'Yes.') else writeln(fo, 'No.'); end else if s[2] = 'is' then define[hash(s[1])] := s[4] + 's' else d[hash(s[1] + ' ' + s[2] + ' ' + s[3])] := true; end; close_file; end.

// THE END

Bài làm của bạn @TRẦN MINH HOÀNG(bạn được 7 điểm)

Câu 1:

var
m:longint; a,b,i:byte; n:string;
fi,fo:text;

procedure open_file(x:string);
begin
assign(fi,x+'.inp'); reset(fi);
assign(fo,x+'.out'); rewrite(fo);
end;

procedure close_file;
begin
close(fi);
close(fo);
end;

function doi1(x:char):byte;
begin
if x in ['A'..'Z'] then exit(ord(x)-55)
else VAL(x,doi1);
end;

function doi2(x:byte):string;
begin
if (0<=x) and (x<=9) then str(x,doi2)
else doi2:=chr(x+55);
end;

function amub(a,b:byte):int64;
begin
if b=0 then amub:=1 else amub:=amub(a,b-1)*a;
end;

begin
open_file('hedem');
readln(fi,a,b);
read(fi,n);
m:=0;
for i:=1 to length(n) do inc(m,doi1(n[i])*amub(a,length(n)-i));
n:='';
while m>=b do
begin
n:=doi2(m mod b)+n;
m:=m div b
end;
n:=doi2(m)+n;
write(fo,n);
close_file;
end.

Câu 2:

var
k,i,m:integer;
A:Array[1..501] of longint;
fi,fo:text;

procedure open_file(x:string);
begin
assign(fi,x+'.inp');
reset(fi);
assign(fo,x+'.out');
rewrite(fo);
end;

procedure close_file;
begin
close(fi);
close(fo);
end;

function NT(a:longint):boolean;
var i:longint;
begin
if a<=1 then exit(false) else
for i:=2 to trunc(sqrt(a)) do if (a mod i)=0 then exit(false);
exit(true);
end;

procedure NTers;
var i:integer;
begin
i:=0;
m:=2;
while i<500 do
begin
if NT(m) then begin inc(i); A[i]:=m; end;
m:=m+1;
end;
end;

function C_B(a,b:integer):qword;
var x,y:string;
begin
STR(a,x); STR(b,y); VAL(x+y,C_B);
end;

begin
open_file('ntghep');
readln(fi,k);
NTers;
i:=0;
m:=1;
while i<k do
begin
if NT(C_B(A[m],A[m+1])) then inc(i);
inc(m,2)
end;
write(fo,A[m-2],A[m-1]);
close_file;
end.

Câu 3:

var
n,i:byte;
fi,fo:text;

procedure open_file(x:string);
begin
assign(fi,x+'.inp');
reset(fi);
assign(fo,x+'.out');
rewrite(fo);
end;

procedure close_file;
begin
close(fi);
close(fo);
end;

function Fib(a:byte):longint;
begin
if a<=2 then Fib:=1 else Fib:=Fib(a-1)+Fib(a-2);
end;

procedure first;
var i:byte;
begin
for i:=1 to n do write(fo,Fib(i),' ');
end;

procedure second;
var i:byte;
begin
while Fib(i+1)<=n do
inc(i);
if Fib(i)=n then writeln(fo,'Co. ',i) else writeln(fo,'Khong')
end;

procedure third;
begin
write(fo,Fib(n))
end;

begin
open_file('Fibonaci');
read(fi,n);
first;
writeln(fo,'');
second;
third;
close_file;
end.

Bài làm của bạn @Luân Đào(bạn được 4 điểm)

program b1;

const fi = 'hedem.inp';

fo = 'hedem.out';

var a,t: string;

x,k: integer;

y: integer;

f: text;

function decto(a,n:integer):string;

var res,t: string;

begin

t := '0123456789abcdef';

repeat

res := t[(a mod n)+1] + res;

a := a div n;

until a = 0;

decto := res;

end;

function todec(a: string; n: integer):integer;

var res,i: integer;

begin

res := 0;

for i := length(a) downto 1 do begin

res := res + (ord(a[i]) - 48)*trunc(exp((length(a)-i)*ln(n)));

end;

todec := res;

end;

procedure ip;

begin

assign(f,fi);

reset(f);

readln(f,x,y);

read(f,a);

close(f);

end;

begin

ip;

assign(f,fo);

rewrite(f);

k:=todec(a,x);

t:=decto(k,y);

write(f,t);

close(f);

end.

program b2;

var k :smallint;

f1,f2: text;

const fi ='ntghep.inp';

fo ='ntghep.out';

function ktra(i :int64) :boolean;

var

j :longint;

begin

for j:=2 to trunc(sqrt(i)) do

if (i mod j=0) then exit(false);

exit(true);

end;

procedure chay;

var

i :longint;

j :int64;

kq,dem:smallint;

s,s2:string;

begin

kq:=0; i:=2; dem:=0;

while (kq<k) do

begin

if (ktra(i)) then

begin

inc(dem);

str(i,s);

if (dem mod 2=0) then

begin

val(s2+s,j);

if (ktra(j)) then inc(kq);

dem:=0;

end

else s2:=s;

end;

inc(i);

end;

write(f2,j);

end;

begin

assign(f1,fi); reset(f1);

assign(f2,fo); rewrite(f2);

read(f1, k);

chay;

close(f1); close(f2);

end.

program b3;

Const fi = 'fibonaci.inp';

fo = 'fibonaci.out';

var n: integer;

f : text;

a,b: array[1..30] of integer;

dem,i,p,j,l: integer;

procedure ip;

begin

assign(f,fi);

reset(f);

repeat

readln(f,n);

until n<=30;

close(f);

end;

procedure op;

begin

assign(f,fo);

rewrite(f);

i:=1;

for i:=1 to n do a[i]:=0;

a[1]:=1;

a[2]:=1;

j:=1;

for j:=3 to n do a[j]:=a[j-2]+a[j-1];

p:=1;

for p:=1 to n-1 do write(f,a[p],' ');

writeln(f,a[n]);

for l:= 1 to n do

b[l]:=a[l] - n;

for i:=1 to n do

if b[i] = 0 then writeln(f,'Co. ', i);

dem:=0;

for i:=1 to n do

if b[i] <> 0 then dem:=dem+1;

if dem = n then writeln(f,'Khong');

write(f,a[n]);

close(f);

end;

begin

ip;

op;

end.

Bài làm của bạn @lê chí hiếu(bạn được 3 điểm)

bài 2

const fi='ntghep.inp'; fn='ntghep.out'; var t,i,k,n,kt:longint; s,s1:string; f:text; function nt(n:longint):boolean; var i:longint; begin for i:= 2 to trunc(sqrt(n)) do if n mod i=0 then exit(false); exit(true); end; {--------------------} begin assign(f,fi);reset(f); readln(f,n); close(f); assign(f,fn);rewrite(f); i:=0;k:=1; while i<=n do begin inc(k); if nt(k) then begin str(k,s1); if kt=1 then begin kt:=0; s:=s+s1; val(s,t); if nt(t) then i:=i+1; if i=n then break; s:=''; end else if kt=0 then begin s:=s1; kt:=1; end; end; end; writeln(f,s); close(F); end.

bài 3

fi='fibonaci.inp'; fn='fibonaci.out'; var a:array[0..1000] of int64; i,n:longint; f:text; kt:boolean; begin assign(f,fi);reset(f); readln(f,n); a[1]:=1; a[2]:=1; close(f); assign(f,fn);rewrite(F); i:=2; write(F,'1 1 '); while i<n do begin inc(i); a[i]:=a[i-1]+A[i-2]; write(f,a[i],' '); end; writeln(f); for i:=1 to n do if a[i]=n then begin kt:=true; break; end; if kt=true then writeln(f,'Co. ',i) else writeln(f,'Khong'); writeln(f,a[n]); close(F); end.