Chủ đề này có 13 trả lời

[Tu Pham]

Cho một xâu kí tự T, chiều dài không quá 250 kí tự.

a)     Đếm số lượng số nguyên tố tạo từ xâu T.

b)    Tìm số nguyên tố P, biết P có giá trị nhỏ hơn 10⁵. Dữ liệu cho đảm bảo T chứa ít nhất 1 số nguyên tố.

Dữ liệu vào: Cho tệp P.INP gồm 1 dòng duy nhất là xâu T

Dữ liệu ra: Xuất ra màn hình

-         Dòng 1: Số lượng số nguyên tố có được

-         Dòng 2: Số P cần tìm

P.INP

Kết quả hiện lên màn hình

Test1234#one5426

4

23

 

[vanlong12]

la p laf so nt lon 

 

Cho một xâu kí tự T, chiều dài không quá 250 kí tự.

a)     Đếm số lượng số nguyên tố tạo từ xâu T.

b)    Tìm số nguyên tố P, biết P có giá trị nhỏ hơn 10⁵. Dữ liệu cho đảm bảo T chứa ít nhất 1 số nguyên tố.

Dữ liệu vào: Cho tệp P.INP gồm 1 dòng duy nhất là xâu T

Dữ liệu ra: Xuất ra màn hình

-         Dòng 1: Số lượng số nguyên tố có được

-         Dòng 2: Số P cần tìm

P.INP

Kết quả hiện lên màn hình

Test1234#one5426

p là số nt lớn nhất trong day hả

[vanlong12]

bạn thử làm như thế này xem sao?

 

 

uses crt;

var a:array[1..100]of integer;

f:text;

v,e,w,r,b,i,j,k,n,s,g:integer;

rt,l,st:string;

function nt(x:integer):boolean;

var s,t,i:integer;kt:boolean;

begin

s:=0;

kt:=false;

for i:= 1 to x do

if x mod i=0  then s:=s+1;

if s=2 then kt:=true;

nt:=kt;

end;

begin

assign(f,'p.inp');

reset(f);

while not eof(f) do

begin

read(f,l);

st:=st+l;

l:='';

end;

close(f);

for i:=1 to length(st) do

if st[i] in['0'..'9'] then

rt:=rt+st[i];

j:=0;

for i:=1 to length(rt) do

begin

j:=j+1;

val(rt[i],k,g);

a[j]:=k;

end;

for i:=1 to j do

if nt(i)  then w:=w+1;

assign(f,'p.out');

rewrite(f);

write(f,w);

writeln(f);

s:=0;

for i:=1 to j do

if nt(a[i]) then begin

v:=i;                b:=a[v];

while nt(a[v]) do

begin

v:=v+1;

if nt(a[v]) then b:=b*10+a[v];

end;

if b>s then s:=b;

b:=0;

end;

 

write(f,s);

close(f);

readln

end.

[Mystic]

 

bạn thử làm như thế này xem sao?

 

 

uses crt;

var a:array[1..100]of integer;

f:text;

v,e,w,r,b,i,j,k,n,s,g:integer;

rt,l,st:string;

function nt(x:integer):boolean;

var s,t,i:integer;kt:boolean;

begin

s:=0;

kt:=false;

for i:= 1 to x do

if x mod i=0  then s:=s+1;

if s=2 then kt:=true;

nt:=kt;

end;

begin

assign(f,'p.inp');

reset(f);

while not eof(f) do

begin

read(f,l);

st:=st+l;

l:='';

end;

close(f);

for i:=1 to length(st) do

if st[i] in['0'..'9'] then

rt:=rt+st[i];

j:=0;

for i:=1 to length(rt) do

begin

j:=j+1;

val(rt[i],k,g);

a[j]:=k;

end;

for i:=1 to j do

if nt(i)  then w:=w+1;

assign(f,'p.out');

rewrite(f);

write(f,w);

writeln(f);

s:=0;

for i:=1 to j do

if nt(a[i]) then begin

v:=i;                b:=a[v];

while nt(a[v]) do

begin

v:=v+1;

if nt(a[v]) then b:=b*10+a[v];

end;

if b>s then s:=b;

b:=0;

end;

 

write(f,s);

close(f);

readln

end.

 

Sửa lại đi bạn ở đoạn nhập dữ liệu vào chắc chắn bị lỗi (vì thiếu ổ đĩa d)

[vanlong12]

ê,,chú em,,anh đau có vao ổ dia dau,,,vào tp lun mà...

[Mystic]

ê,,chú em,,anh đau có vao ổ dia dau,,,vào tp lun mà...

Thì ở đây này :

phải là asign(f,'d:\p.inp');

thì nó mới đọc được dữ liệu chứ ???

Còn nữa:

+Ko cần phải làm p.out đâu vì kq xuất trực tiếp ra màn hình luôn mà .

=> Xem lại bài đi ,copy lại rồi past trong tubor pascal chạy thử coi có bị lỗi ko !

[vanlong12]

Thì ở đây này :

phải là asign(f,'d:\p.inp');

thì nó mới đọc được dữ liệu chứ ???

Còn nữa:

+Ko cần phải làm p.out đâu vì kq xuất trực tiếp ra màn hình luôn mà .

=> Xem lại bài đi ,copy lại rồi past trong tubor pascal chạy thử coi có bị lỗi ko !

vao bin ma doc..con o dau xat tep ra lun cung chang sao

[Mystic]

 

bạn thử làm như thế này xem sao?

 

 

uses crt;

var a:array[1..100]of integer;

f:text;

v,e,w,r,b,i,j,k,n,s,g:integer;

rt,l,st:string;

function nt(x:integer):boolean;

var s,t,i:integer;kt:boolean;

begin

s:=0;

kt:=false;

for i:= 1 to x do

if x mod i=0  then s:=s+1;

if s=2 then kt:=true;

nt:=kt;

end;

begin

assign(f,'p.inp');

reset(f);

while not eof(f) do

begin

read(f,l);

st:=st+l;

l:='';

end;

close(f);

for i:=1 to length(st) do

if st[i] in['0'..'9'] then

rt:=rt+st[i];

j:=0;

for i:=1 to length(rt) do

begin

j:=j+1;

val(rt[i],k,g);

a[j]:=k;

end;

for i:=1 to j do

if nt(i)  then w:=w+1;

assign(f,'p.out');

rewrite(f);

write(f,w);

writeln(f);

s:=0;

for i:=1 to j do

if nt(a[i]) then begin

v:=i;                b:=a[v];

while nt(a[v]) do

begin

v:=v+1;

if nt(a[v]) then b:=b*10+a[v];

end;

if b>s then s:=b;

b:=0;

end;

 

write(f,s);

close(f);

readln

end.

 

Làm sai rồi !!!

Với thuật toán ngây thơ vãi 

.Đó là m chỉ mới xét các số nguyên tố có 1 chữ số ,còn số có 2 chữ số ,3 chữ số thì sao ?

 Về nghiên cứu và sửa lại 

[vanlong12]

o,,!!anh thu het rui chu em oi,,ok tat,,,tap doc hiu van ban di la vua rui,,,hehe

[Tu Pham]

cám ơn 

 

 

bạn thử làm như thế này xem sao?

 

 

uses crt;

var a:array[1..100]of integer;

f:text;

v,e,w,r,b,i,j,k,n,s,g:integer;

rt,l,st:string;

function nt(x:integer):boolean;

var s,t,i:integer;kt:boolean;

begin

s:=0;

kt:=false;

for i:= 1 to x do

if x mod i=0  then s:=s+1;

if s=2 then kt:=true;

nt:=kt;

end;

begin

assign(f,'p.inp');

reset(f);

while not eof(f) do

begin

read(f,l);

st:=st+l;

l:='';

end;

close(f);

for i:=1 to length(st) do

if st[i] in['0'..'9'] then

rt:=rt+st[i];

j:=0;

for i:=1 to length(rt) do

begin

j:=j+1;

val(rt[i],k,g);

a[j]:=k;

end;

for i:=1 to j do

if nt(i)  then w:=w+1;

assign(f,'p.out');

rewrite(f);

write(f,w);

writeln(f);

s:=0;

for i:=1 to j do

if nt(a[i]) then begin

v:=i;                b:=a[v];

while nt(a[v]) do

begin

v:=v+1;

if nt(a[v]) then b:=b*10+a[v];

end;

if b>s then s:=b;

b:=0;

end;

 

write(f,s);

close(f);

readln

end.c

 

Làm sai rồi !!!

Với thuật toán ngây thơ vãi 

.Đó là m chỉ mới xét các số nguyên tố có 1 chữ số ,còn số có 2 chữ số ,3 chữ số thì sao ?

 Về nghiên cứu và sửa lại 

 

cám ơn bạn đã gởi jup code (đúng hay sai k sao, để mình tham khảo).. thanks ...

 

[Mystic]

cám ơn 

Đó chưa hợp lý đâu nên bạn chưa cần tham khảo vội kẻo sai .Để tối mai mình post bài làm của mình lên cho (nếu làm được) giowg mình phải học đã cảm ơn bạn đã ghé thăm box

[Tu Pham]

Đó chưa hợp lý đâu nên bạn chưa cần tham khảo vội kẻo sai .Để tối mai mình post bài làm của mình lên cho (nếu làm được) giowg mình phải học đã cảm ơn bạn đã ghé thăm box

uh...

[Tu Pham]

 

bạn thử làm như thế này xem sao?

 

 

uses crt;

var a:array[1..100]of integer;

f:text;

v,e,w,r,b,i,j,k,n,s,g:integer;

rt,l,st:string;

function nt(x:integer):boolean;

var s,t,i:integer;kt:boolean;

begin

s:=0;

kt:=false;

for i:= 1 to x do

if x mod i=0  then s:=s+1;

if s=2 then kt:=true;

nt:=kt;

end;

begin

assign(f,'p.inp');

reset(f);

while not eof(f) do

begin

read(f,l);

st:=st+l;

l:='';

end;

close(f);

for i:=1 to length(st) do

if st[i] in['0'..'9'] then

rt:=rt+st[i];

j:=0;

for i:=1 to length(rt) do

begin

j:=j+1;

val(rt[i],k,g);

a[j]:=k;

end;

for i:=1 to j do

if nt(i)  then w:=w+1;

assign(f,'p.out');

rewrite(f);

write(f,w);

writeln(f);

s:=0;

for i:=1 to j do

if nt(a[i]) then begin

v:=i;                b:=a[v];

while nt(a[v]) do

begin

v:=v+1;

if nt(a[v]) then b:=b*10+a[v];

end;

if b>s then s:=b;

b:=0;

end;

 

write(f,s);

close(f);

readln

end.

 

 thanks!... nhiều nhiều...

[Mystic]

Cho một xâu kí tự T, chiều dài không quá 250 kí tự.

a)     Đếm số lượng số nguyên tố tạo từ xâu T.

b)    Tìm số nguyên tố P, biết P có giá trị nhỏ hơn 10⁵. Dữ liệu cho đảm bảo T chứa ít nhất 1 số nguyên tố.

Dữ liệu vào: Cho tệp P.INP gồm 1 dòng duy nhất là xâu T

Dữ liệu ra: Xuất ra màn hình

-         Dòng 1: Số lượng số nguyên tố có được

-         Dòng 2: Số P cần tìm

P.INP

Kết quả hiện lên màn hình

Test1234#one5426

4

23

Này bạn đáng lẽ là có 5 số nguyên tố chứ ? (trong xâu có 2 số 2 mà);

Code:

 

program gty;

uses crt;

var w,q,i,n,j,k,l,z,x:integer;

f1:text;

ss,s,s1,y,s2:string;

f:array[1..100] of string;

a:array[1..1000] of char;

b,c,d:array[1..1000] of integer;

function nt(n:integer):boolean;

var i,s:integer;

kt:boolean;

begin

s:=0;

kt:=false;

for i:=1 to n do

if n mod i=0 then s:=s+1;

if s=2 then kt:=true;

nt:=kt;

end;

function xau(s:string):integer;

var i,n,k,l,p,z:integer;

t:string;

begin

i:=1;

k:=length(s);

z:=0;

repeat

      while k>=1 do

      begin

      t:='';

           for j:=i to k do

           t:=t+s[j];

           val(t,p,l);

           if nt(p) then z:=z+1;

           k:=k-1;

      end;

i:=i+1;

k:=length(s);

until i>length(s);

xau:=z;

end;

function xa(s:string):integer;

var i,k,l,p,z,r,tg:integer;

a:array[1..100] of integer;

t:string;

begin

i:=1;

k:=length(s);

z:=0;

r:=0;

repeat

      while k>=1 do

      begin

      t:='';

           for j:=i to k do

           t:=t+s[j];

           val(t,p,l);

           if nt(p) then

              begin

              r:=r+1;

              a[r]:=p;

              end;

           k:=k-1;

      end;

i:=i+1;

k:=length(s);

until i>length(s);

for i:=1 to r-1 do

begin

j:=i+1;

while j<=r do

      if (a[j]=a[i])or(a[j]>10000) then

         begin

         for k:=j to r do

         a[k]:=a[k+1];

         r:=r-1;

         end else j:=j+1;

end;

for i:=1 to r-1 do

for j:=i+1 to r do

if  a[i]<a[j] then

    begin

    tg:=a[i];

    a[i]:=a[j];

    a[j]:=tg;

    end;

xa:=a[1];

end;

begin

clrscr;

assign(f1,'d:\p.inp');

reset(f1);

while not eof(f1) do

readln(f1,s);

close(f1);

for i:=1 to length(s) do

if s[i] in ['0'..'9'] then

   begin

   n:=n+1;

   a[n]:=s[i];

   b[n]:=i;

   end;

c[1]:=1;

z:=0;

for i:=1 to n do

    if b[i]+1<>b[i+1] then

       begin

       z:=z+1;

       d[z]:=i;

       c[z+1]:=i+1;

       end;

i:=1;x:=0;

repeat

ss:='';

      for j:=c[i] to d[i] do

      ss:=ss+a[j];

      x:=x+1;

      f[x]:=ss;

      i:=i+1;

until i>z;

w:=xa(f[1]);

for i:=1 to x do

begin

q:=q+xau(f[i]);

if xa(f[i])>=w then w:=xa(f[i]);

end;

writeln('Co ',q,' so nguyen to');

writeln('So nguyen to P:',w);

readln

end.

P/s:code khá dài .....