Đến nội dung

Hình ảnh

Lập trình Pascal

pascal

  • Please log in to reply
Chủ đề này có 200 trả lời

#41
nghethuat102

nghethuat102

    Trung sĩ

  • Thành viên
  • 147 Bài viết
uses crt;
var i,j,k,n,t:integer;
    s,ss:string;
  function nt(t:integer):boolean;
   var c:integer;
   begin
   nt:=false;
   if t<2 then exit;
   for c:=2 to trunc(sqrt(t)) do
    if t mod c=0 then exit;
    nt:=true;
   end;
  begin
  repeat
   write('n,k=');
   readln(n,k);
  until(k<=n)and(1<=n)and(n<=50);
   n:=n-1;
   s:='2';
   i:=3;
   while (n>0)do
    begin
    if nt(i)=true then
       begin
       n:=n-1;
       str(i,ss);
       s:=s+ss;
       end;
       i:=i+2;
    end;
    writeln(s);
    ss:=s;
    n:=0;
    i:=1;
    s:=s+'1';
  while (n<k)and(i<>length(s)) do
   begin
    if s[i]>s[i+1] then
       begin
        delete(s,i,1);
        n:=n+1;
        i:=1;
       end
    else i:=i+1;
   end;
   delete(s,length(s),1);
   while n<k do
         begin
         delete(s,1,1);
         n:=n+1;
         end;
   if s='' then writeln('0') else writeln(s);
  n:=0;
  i:=1;
  while (n<k)and(i<>length(ss)) do
   begin
    if ss[i]<ss[i+1] then
       begin
        delete(ss,i,1);
        n:=n+1;
        i:=1;
       end
    else i:=i+1;
  end;
   while n<k do
      begin
      n:=n+1;
      delete(ss,length(ss),1);
      end;
 if ss='' then writeln('0') else writeln(ss);
  readln;
  end.

Bài viết đã được chỉnh sửa nội dung bởi nghethuat102: 28-07-2014 - 15:51


#42
hocpascal

hocpascal

    Trung sĩ

  • Thành viên
  • 109 Bài viết

Hai đoạn dưới thấy hơi giống mà k bik sửa thế nào, nếu làm đc hoặc hay hơn thì bạn hãy sáng tạo đi!!

Cho số nguyên N gồm M chữ số 

Y/c: Xóa đi K chữ số trong N để được số nhỏ nhất

Bạn xem Code mình như này có hợp lí không nha?

 var s,s2: string;
 n,i,j,vt,d,tong,t,k: integer;
function VTmin(i,j:integer): integer;
var a,m,vt: integer; min: char;
begin
min:=s[i]; vt:=i;
for a:=i+1 to j do
if min>s[a] then
begin
min:=s[a]; vt:=a;
end;
vtmin:=vt;
end;
begin
writeln('nhap s va k'); read(s,k);
Writeln('So nho nhat la:');
s2:='';
vt:=vtmin(1,k+1);
s2:=s2+s[vt];
i:=1;
while length(s2) <> (length(s)-k) do
begin
inc(i);
vt:=vtmin(vt+1,k+i);
s2:=s2+s[vt];
end;
if length(s2)= length(s)-k then write(s2);
readln;
readln
end.
Mình chưa tìm được Test sai!


#43
hocpascal

hocpascal

    Trung sĩ

  • Thành viên
  • 109 Bài viết

Bạn đưa mình test sai xem mình test có sai dau nhi?

câu lệnh nhập Read(s,k); bạn nhập xâu s và cách ra nhập k



#44
hocpascal

hocpascal

    Trung sĩ

  • Thành viên
  • 109 Bài viết

1-1  ,   2-1, ...

OK! cảm ơn nha mình thêm đoạn này nữa hì cứ mải đi tính toán không để ý dữ liệu
repeat
write('s,k :');
readln(s,k);
tam:=length(s);
until (k<=tam);
 if length(s)=k then
write('0')
else


#45
hocpascal

hocpascal

    Trung sĩ

  • Thành viên
  • 109 Bài viết

:v đề ,dịch k ra?

TẬP PHẦN TỬ TRÙNG TẬP CHỈ SỐ

         viết chuơng trình nhập từ bàn phím số nguyên dương N(n<=15), tiếp theo nhập vào dãy số nguyên A=a1,...,an. hãy tièm tập hợp nhiều nhất các phần tử của A thỏa mãn điều kiện: tập hợp giá trị các phần tử thuộc tập hợp đó trùng với tập chỉ số của các phần tử thuộc tập hợp đó. thông báo ra màn hình số lượng phần tử và tập chỉ số(tăng dần) của tập hợp tìm được.

VD: N=5, A=1 4 1 5 2

thì số lượng phần tử là 4

tập chỉ số tìm được là :1 2 4 5

n=2, A= 2 4 => không có tập nào


Bài viết đã được chỉnh sửa nội dung bởi hocpascal: 29-07-2014 - 21:23


#46
hxthanh

hxthanh

    Tín đồ $\sum$

  • Hiệp sỹ
  • 3915 Bài viết

TẬP PHẦN TỬ TRÙNG TẬP CHỈ SỐ

         viết chuơng trình nhập từ bàn phím số nguyên dương N(n<=15), tiếp theo nhập vào dãy số nguyên A=a1,...,an. hãy tièm tập hợp nhiều nhất các phần tử của A thỏa mãn điều kiện: tập hợp giá trị các phần tử thuộc tập hợp đó trùng với tập chỉ số của các phần tử thuộc tập hợp đó. thông báo ra màn hình số lượng phần tử và tập chỉ số(tăng dần) của tập hợp tìm được.

VD: N=5, A=1 4 1 5 2

thì số lượng phần tử là 4

tập chỉ số tìm được là :1 2 4 5

n=2, A= 2 4 => không có tập nào

Thử code này xem đúng không

var n,i,j:shortint;
      A: array[1..15] of Byte;
      SetA, SetB: Set of Byte;
begin
   Write('Nhap so tu nhien n (n<16), n='); Readln(n);
   SetA:=[]; SetB:=[];
   j:=0;
   Write('Nhap ',n, ' so nguyen duong moi so cach nhau mot dau cach: ');
   For i:=1 to n do
   begin
     read(A[i]);
     if not(A[i] in SetA) then
     begin
       SetA:= SetA +[A[i]];
       SetB:= SetB +[i];
       inc(j)
     end;
   end;
if SetB<=SetA then
begin
  Writeln('So luong phan tu la: ', j);
  Write('Tap chi so la '); for i:=1 to 127 do if i in SetB then write(i,' ')
end else
Write('Khong co tap thoa man');
Readln;
Readln;
end.


#47
hocpascal

hocpascal

    Trung sĩ

  • Thành viên
  • 109 Bài viết

Tks, thầy, h em mới biết câu: SetA, SetB: Set of Byte;

bạn ơi mình hỏi tí nha 

vd: xâu s='02'

val(s,so); làm sao để số đó =02 nhỉ nó ra so=2 ko a`?



#48
nghethuat102

nghethuat102

    Trung sĩ

  • Thành viên
  • 147 Bài viết

bạn ơi mình hỏi tí nha 

vd: xâu s='02'

val(s,so); làm sao để số đó =02 nhỉ nó ra so=2 ko a`?

Thi neu co truong hop do ban writeln('0',s); la dc roi!



#49
hocpascal

hocpascal

    Trung sĩ

  • Thành viên
  • 109 Bài viết

Thi neu co truong hop do ban writeln('0',s); la dc roi!

 

Bạn xem đề này câu a thì OK rồi còn câu b tui không hiểu nếu bạn hiểu giải thích hộ cái nha

Viết các số tự nhiên từ 1 tới 2009 theo một vòng tròn cùng chiều quay kim đồng hồ.
Cũng theo chiều đó, bắt đầu từ số 1, cư đếm từ 1 đến 612 thì xóa số đó đi.

Lại bắt đầu từ số còn lại đứng sau số vùa bị xóa,lặp lại quá trình đến khi còn 1 số thì dừng lại.
a) Hỏi số còn lại là số nào?

b) Muốn số còn lại là số thứ L( 0<L<2010); thì bắt đầu bằng số nào
Dữ liệu vào nhập từ bàn phím số L;

 

 



#50
nghethuat102

nghethuat102

    Trung sĩ

  • Thành viên
  • 147 Bài viết

bạn chưa xem hộ tui à, máy bữa nay nghĩ mãi mà vẫn chưa ra

Câu a số cần tìm là 104 à?



#51
hocpascal

hocpascal

    Trung sĩ

  • Thành viên
  • 109 Bài viết

ngày mai nhất định sẻ làm đc câu b,sao nó khó thế hè?

câu a số cần tìm là 80 bạn a`



#52
hocpascal

hocpascal

    Trung sĩ

  • Thành viên
  • 109 Bài viết


ngày mai nhất định sẻ làm đc câu b,sao nó khó thế hè?

bạn xem code câu b mình viết có sai không nha

uses crt;
var  c:array[1..2009] of boolean;
p,i,dem,con,j,n: longint;
begin
clrscr;
fillchar(c,sizeof(c),false);
con:=2009;
i:=0; dem:=0;
while con>1 do
begin
inc(i);
if i= 2010 then i:=1;
if  c[i]=false then
begin
dem:=dem+1;
        if dem mod 612 = 0 then
        begin
        c[i]:=true;
        write(i:8);
        dec(con);
        end;
end;
end;
writeln;
for i:=1 to 2009 do
if c[i]=false then write(i);
readln;
readln
end. }


#53
hocpascal

hocpascal

    Trung sĩ

  • Thành viên
  • 109 Bài viết

câu a số cần tìm là 80 bạn a`

câu a không phải b



#54
nghethuat102

nghethuat102

    Trung sĩ

  • Thành viên
  • 147 Bài viết


câu a không phải b

   var a:array[1..2009] of boolean;
    i,j,n,l,d:integer;
    begin
     fillchar(a,sizeof(a),false);
    i:=0;     n:=2009;    d:=0;
      while (n>1) do
      begin
       i:=i+1;
       if i=2010 then i:=1;
       if (a[i]=false) then d:=d+1;
       if d=612 then
          begin
            a[i]:=true;
            d:=0;
            n:=n-1;
          end;
      end;
     for i:=1 to 2009 do
         if a[i]=false then writeln(i);
     writeln('_____');
     repeat
     write('l=');
     readln(l);
     until (1<=l)and(l<=2009);
     if l>80 then d:=l-79
     else if l<80 then d:=2009-80+l;
     writeln(d);
 readln;
    end.
 xem xem có sai k? đó là làm vs câu a theo cách của bạn!


#55
nghethuat102

nghethuat102

    Trung sĩ

  • Thành viên
  • 147 Bài viết


câu a không phải b

var a:array[1..2009] of integer;
    i,j,n,d,l:integer;
    begin
    for i:=1 to 2009 do
     a[i]:=i;
    n:=2009;
    i:=1;
    while (n>1) do
          begin
           i:=i+611;
           while i>n do i:=i-n;
           for j:=i to n-1 do
               a[j]:=a[j+1];
               n:=n-1;
 
          end;
    writeln(a[1]);
   writeln('_________');
  repeat
    write('l=');
    readln(l);
  until (1<=l)and(l<=2009);
    d:=1;
    if l>80 then d:=l-79;
    if l<80 then d:=2009-80+l;
    writeln(d);
    readln;
    end.
Còn đây là cách của mình, câu a sẻ thấy nhanh hơn nhiều !


#56
hocpascal

hocpascal

    Trung sĩ

  • Thành viên
  • 109 Bài viết


 

var a:array[1..2009] of integer;
    i,j,n,d,l:integer;
    begin
    for i:=1 to 2009 do
     a[i]:=i;
    n:=2009;
    i:=1;
    while (n>1) do
          begin
           i:=i+611;
           while i>n do i:=i-n;
           for j:=i to n-1 do
               a[j]:=a[j+1];
               n:=n-1;
 
          end;
    writeln(a[1]);
   writeln('_________');
  repeat
    write('l=');
    readln(l);
  until (1<=l)and(l<=2009);
    d:=1;
    if l>80 then d:=l-79;
    if l<80 then d:=2009-80+l;
    writeln(d);
    readln;
    end.
Còn đây là cách của mình, câu a sẻ thấy nhanh hơn nhiều !

 

bạn giải thích hộ tớ tại sao d:=1;

    if l>80 then d:=l-79;
    if l<80 then d:=2009-80+l; ma lại tìm được số đầu tiên nha


#57
nghethuat102

nghethuat102

    Trung sĩ

  • Thành viên
  • 147 Bài viết

 

bạn giải thích hộ tớ tại sao d:=1;

    if l>80 then d:=l-79;
    if l<80 then d:=2009-80+l; ma lại tìm được số đầu tiên nha

 

bạn cứ làm lệch đi của vị trí bắt đầu bao nhiêu đơn vị thì số cuối cùng cũng lệch đi mấy nhiêu đơn vị thôi! cái này giống cái đồng hồ đó thôi, vầy nên lấy vị trí bắt đầu là 1 làm mốc thì cho ta số cuối cùng là 80, nếu tăng vị trí bắt đầu là 2 thì số cuối chắc hẳn 81 ...



#58
hocpascal

hocpascal

    Trung sĩ

  • Thành viên
  • 109 Bài viết

 

bạn giải thích hộ tớ tại sao d:=1;

    if l>80 then d:=l-79;
    if l<80 then d:=2009-80+l; ma lại tìm được số đầu tiên nha

 

Bài toán: Cho bốn số tự nhiên. hãy đặt các dấu (+ , -) vào các số sao cho tổng chia hết cho 10



#59
nghethuat102

nghethuat102

    Trung sĩ

  • Thành viên
  • 147 Bài viết


Bài toán: Cho bốn số tự nhiên. hãy đặt các dấu (+ , -) vào các số sao cho tổng chia hết cho 10

uses crt;
var a:array[1..100] of 0..1;
    b:array[1..100] of integer;
    S:longint; i,n,d:integer;
    procedure ink;
     var i:integer;
     begin
      s:=0;
     for i:=1 to n do
      if a[i]=0 then s:=s-b[i] else s:=s+b[i];
      if (s mod 10<>0)or(s=0) then exit;
       write(S:7);
       gotoxy(8,4+N+d);
       write('= ');
     for i:=1 to n do
      if a[i]=0 then write('-',b[i]) else write('+',b[i]);
       writeln;
      d:=d+1;
     end;
    procedure thu(k:integer);
     var i:integer;
     begin
     for i:=0 to 1 do
      begin
       a[k]:=i;
       if (k=n) then ink else thu(k+1);
      end;
     end;
begin
clrscr;
    writeln('n la so so tu nhien!');
    write('n=');
    readln(n);
    for i:=1 to n do
        begin
        write('b[',i,']=');
        readln(b[i]);
        end;
    writeln;
    d:=0;
    S:=0;
    thu(1);
    writeln('co ',d,' cach!');
    readln;
end.


#60
hxthanh

hxthanh

    Tín đồ $\sum$

  • Hiệp sỹ
  • 3915 Bài viết

Chương trình trên vẫn có hạn chế cho một số th!! cái đó chưa nghĩ ra cách sửa!! :mellow:

Chương trình hay đấy chứ em!

Em thử nói điều hạn chế mà em thấy cần khắc phục xem mọi người có giúp gì được không?







Được gắn nhãn với một hoặc nhiều trong số những từ khóa sau: pascal

0 người đang xem chủ đề

0 thành viên, 0 khách, 0 thành viên ẩn danh