Đến nội dung

nghethuat102

nghethuat102

Đăng ký: 16-07-2014
Offline Đăng nhập: 11-12-2016 - 10:50
***--

#569986 Chuỗi xuất hiện đúng 1 lần- kiểu file trong Pascal

Gửi bởi nghethuat102 trong 05-07-2015 - 08:43

Đây là cách 2:
 

const   fi = 'input.inp';
        fo = 'output.out';
var     a: array[0..255,'A'..'Z'] of longint;
        s: string;
 
procedure process;
var
        i: longint;
        c: char;
begin
        fillchar(a,sizeof(a),0);
        while not eoln(input) do
          begin
                readln(s);
                for i:=1 to length(s) do inc(a[i,s[i]]);
          end;
        for i:=1 to 255 do
          for c:='A' to 'Z' do
            if a[i,c] mod 2<>0 then write(c);
end;
 
BEGIN
        assign(input,fi);       reset(input);
        assign(output,fo);      rewrite(output);
        process;
        close(input);           close(output);
END.



#569794 $for$ i:=1 $to$ n $do$

Gửi bởi nghethuat102 trong 04-07-2015 - 08:26

Câu 1: O(N)

Câu 2: O(N)

Câu 3: O(log2(N));

Tất nhiên đã bỏ qua hằng số,




#525098 Lập trình Pascal

Gửi bởi nghethuat102 trong 18-09-2014 - 18:27

Viết chương trình nhập vào $2$ số $a,b$ rồi in ra giá trị $a,b$. Sau đó hoán đổi giá trị của $a,b$ rồi lại in giá trị $a,b$ ra màn hình   

 chi la doan hoan doi : 
 c1:  su dung bien phu:  c:=a;a:=b;b:=c;

 c2: khong co bien phu : a:=a+b;b:=a-b;c:=a-b;




#524767 [Pascal] Game: Banh nảy

Gửi bởi nghethuat102 trong 15-09-2014 - 22:37 

uses crt,mtime,key;
const s1='BAT DAU';
      s2='DIEM';
      s3='THOAT';
    vt:array[1..6] of 1..100=(42,47,52,57,62,67);
var a:array[1..6,1..5000] of 0..1;
    c:array[1..5000] of 1..30;
    diem:array[1..10] of word;
    ten:array[1..10] of string[10];
    t:boolean;
    f:text;
    n:word;
    sodiem:longint;
    procedure nguoichoi(i,j:integer);
     begin
      textcolor(3);
      gotoxy(vt[i],j);
      write(chr(-78));
      textcolor(10);
      write('/\');
      textcolor(3);
      write(chr(-78));
      gotoxy(vt[i],j+1);
      textcolor(10);
      write(' ',chr(-37),chr(-37),' ');
      gotoxy(vt[i],j+2);
      textcolor(3);
      write(chr(-78),'  ',chr(-78));
     end;
    procedure may(i,j:integer);
     begin
      textcolor(15);
      if (j>0)and(j<25) then
       begin
      gotoxy(vt[i],j);
      write(chr(-78),'\/',chr(-78));
       end;
      if (j>=0)and(j<25) then
       begin
      gotoxy(vt[i],j-1);
      write(' ',chr(-37),chr(-37),' ');
      end;
      if (j>0)and(j<25) then
       begin
      gotoxy(vt[i],j-2);
      write(chr(-78),'  ',chr(-78));
      gotoxy(1,1);
       end;
     end;
    procedure xoa(i,j:integer);
     var z:integer;
     begin
      for z:=0 to 2 do
       if j+z<=24 then
        begin
         gotoxy(i,j+z);
         write('    ');
        end;
     end;
    procedure batdau;
     var   soxe,khoangcach,m,k,vty,vtx,i,j,batdau,d,w:integer;
           b:boolean;
     begin
     gotoxy(7,10);
     write('             ');
     gotoxy(7,11);
     write('             ');
     gotoxy(7,12);
     write('             ');
     textcolor(7);
     gotoxy(8,21);
     write('Nhan ESC de thoat');
     gotoxy(8,22);
     write('Nhan SPACE or ENTER de dung');
     sodiem:=0;
     vty:=22;
     vtx:=3;
     b:=true;
     nguoichoi(vtx,vty);
     gotoxy(10,8);
     textcolor(10);
     write('DIEM :  ');
     textcolor(15);
     write(sodiem);
     khoangcach:=0;
     batdau:=1;
     d:=0;
     repeat
    if khoangcach=0 then
     begin
     repeat
      khoangcach:=random(10);
     until khoangcach>5;
      d:=d+1;
      for i:=1 to 6 do
        a[i,d]:=random(2);
        c[d]:=1;
        w:=0;
      for i:=1 to 6 do
       if a[i,d]=1 then w:=w+1;
       if w>4 then
        begin
        for i:=1 to w-4 do;
         begin
        repeat
         w:=random(7);
        until (a[w,d]=1)and(w<>0);
        a[w,d]:=0;
         end;
        end;
     end
    else khoangcach:=khoangcach-1;
    for i:=batdau to d do
       begin
        c[i]:=c[i]+1;
        if c[i]=28 then batdau:=batdau+1;
        if c[i]>vty+6 then
         for j:=1 to 6 do
           if a[j,i]=1 then
            begin
            textcolor(15);
            gotoxy(18,8);
            write(sodiem+1);
            sodiem:=sodiem+1;
            end;
       end;
      timestart;
      while intime(10) do
        begin
         k:=0;
         if keypressed then
         begin
         k:=getkey;
         if (k=upkey)or(k=dnkey)or(k=rightkey)or(k=leftkey) then
         xoa(vt[vtx],vty);
           if (k=upkey)and(vty>2) then
            vty:=vty-1;
         if (k=dnkey)and(vty<22) then
           vty:=vty+1;
         if (k=rightkey)and(vtx<6) then
           vtx:=vtx+1;
         if (k=leftkey)and(vtx>1) then
           vtx:=vtx-1;
         if (k=upkey)or(k=dnkey)or(k=rightkey)or(k=leftkey) then
         nguoichoi(vtx,vty);
          if (k=enterkey)or (k=spacekey) then
            begin
            gotoxy(8,22);
            textcolor(15);
            write('Nhan SPACE or ENTER de tiep tuc');
            repeat
             m:=getkey;
            until (m=enterkey)or(m=spacekey);
            gotoxy(8,22);
            textcolor(7);
            write('Nhan SPACE or ENTER de dung     ');
            end;
          if k=esckey then
           begin
            gotoxy(8,21);
            textcolor(15);
            write('Ban thuc su muon thoat? ',chr(16));
            textcolor(10);
            write('Y');
            textcolor(15);
            write(chr(17));
            textcolor(12);
            write(' N ');
            gotoxy(33,21);
            i:=32;
            textcolor(15);
            repeat
              m:=getkey;
              if (m=rightkey)and(i=32) then
               begin
                i:=35;
                gotoxy(32,21);
                write(' ');
                gotoxy(34,21);
                write(' ');
                gotoxy(35,21);
                write(chr(16));
                gotoxy(37,21);
                write(chr(17));
                gotoxy(36,21);
               end;
              if (m=leftkey)and(i=35) then
               begin
                i:=32;
                gotoxy(35,21);
                write(' ');
                gotoxy(37,21);
                write(' ');
                gotoxy(32,21);
                write(chr(16));
                gotoxy(34,21);
                write(chr(17));
                gotoxy(33,21);
               end;
            until m=enterkey;
            if i=32 then
             begin
              b:=false;
              t:=false;
             end;
            if i=35 then
             begin
              textcolor(7);
              gotoxy(8,21);
              write('Nhan ESC de thoat               ');
             end;
            end;
           end;
           for i:=batdau to d do
          begin
           for j:=1 to 6 do
             if a[j,i]=1 then
              begin
               if (c[i]-1>=0)and(c[i]<=26) then
                 begin
                 gotoxy(vt[j],c[i]-1);
                 write('    ');
                 end;
               if (c[i]-2>=0)and(c[i]-1<=26) then
                 begin
                 gotoxy(vt[j],c[i]-2);
                 write('    ');
                 end;
                if (c[i]-3>=0)and(c[i]-2<=26) then
                 begin
                 gotoxy(vt[j],c[i]-3);
                 write('    ');
                 end;
                 nguoichoi(vtx,vty);
            end;
           for j:=1 to 6 do
           if a[j,i]=1 then
            begin
              may(j,c[i]);
            {  nguoichoi(vtx,vty); }
            end;
          end;
           delay(1000);
          end;
         {cho nay dat code no khi dung nhau}
     until b=false;
     end;
    procedure khoitao;
     var i,j:integer;
     begin
       for i:=1 to 25 do
         begin
         textcolor(3);
          gotoxy(40,i);
          write(chr(-78));
          gotoxy(72,i);
          write(chr(-78));
         textcolor(red);
          write('o o o o');
         end;
       for i:=1 to 6 do
         begin
         gotoxy(vt[i],12);
         write('0000');
          end;
       for i:=41 to 71 do
        begin
         textcolor(3);
         gotoxy(i,25);
         write(chr(-36));
        end;
       textcolor(12);
       gotoxy(15,4);
       write('RACING GAME');
       gotoxy(5,2);
       textcolor(green);
       write('*******************************');
       gotoxy(5,6);
       write('*******************************');
     end;
    procedure luachon;
     var i,k:integer;
      begin
       textcolor(8);
       gotoxy(8,21);
       write('Nhan ESC de thoat');
       gotoxy(8,22);
       write('Nhan SPACE or ENTER de dung');
       i:=10;
       gotoxy(10,i);
       textcolor(15);
       write(chr(-81),'  ',s1);
       gotoxy(10,i+1);
       textcolor(7);
       write('   ',s2);
       gotoxy(10,i+2);
       write('   ',s3);
       repeat
         k:=getkey;
         if (k=dnkey)and(i<12) then
          begin
           textcolor(7);
           gotoxy(10,i);
           write('   ');
           if i=10 then write(s1)
           else if i=11 then write(s2);
           i:=i+1;
           textcolor(15);
           gotoxy(10,i);
           write(chr(-81),'  ');
           if i=11 then write(s2)
           else if i=12 then write(s3);
          end;
         if (k=upkey)and(i>10) then
          begin
           textcolor(7);
           gotoxy(10,i);
           write('   ');
           if i=11 then write(s2)
           else if i=12 then write(s3);
           i:=i-1;
           textcolor(15);
           gotoxy(10,i);
           write(chr(-81),'  ');
           if i=10 then write(s1)
           else if i=11 then write(s2);
          end;
       until k=enterkey;
       if i=12 then t:=false
       else if i=11 then
              begin
               gotoxy(7,10);
               write('                ');
               gotoxy(7,11);
               write('                ');
               gotoxy(7,12);
               write('                ');
               textcolor(15);
               gotoxy(10,10);
               write(chr(-81),'  QUAY LAI');
               for k:=1 to 9 do
                 begin
                  textcolor(red);
                  gotoxy(11,10+k);
                  write(k);
                  textcolor(7);
                  write(' ',ten[k]);
                  gotoxy(22,10+k);
                  write(diem[k]);
                 end;
                 gotoxy(10,10);
                 repeat
                 k:=getkey;
                 until k=enterkey;
                 for k:=0 to 9 do
                  begin
                   gotoxy(10,10+k);
                   write('                ');
                  end;
              end
            else batdau;
      end;
begin
  clrscr;
  khoitao;
  t:=true;
  assign(f,'pacing.out');
  reset(f);
  for n:=1 to  9 do
   readln(f,diem[n]);
  for n:=1 to 9 do
   readln(f,ten[n]);
   close(f);
  repeat
    luachon;
     assign(f,'pacing.out');
    rewrite(f);
  for n:=1 to 9 do
  writeln(f,diem[n]);
  for n:=1 to 9 do
  writeln(f,ten[n]);
   close(f);
  until  t=false;
end. 

code nhẹ hơn . đẹp hơn . vậy thì đi làm game khác được rồi . công nhận anh giỏi thiệt

Mình sắp hoàn thành game đua xe rồi bạn :) , tuy có hơi rối nhưng và thiếu 1 ít  thuật toán cho việc đụng xe!, nhưng dù sao cũng thấy vui vì làm đc như thế này 




#517289 Lập trình Pascal

Gửi bởi nghethuat102 trong 03-08-2014 - 09:48



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.



#516005 Lập trình Pascal

Gửi bởi nghethuat102 trong 28-07-2014 - 14:17

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.



#514847 Tuyển tập bài tập Pascal

Gửi bởi nghethuat102 trong 23-07-2014 - 16:10

Để thật sự ngẫu nhiên thì cần có lệnh Randomize;

Em có thể cho từng chữ số của số $\overline{abcd}$ random

Ví dụ a:=random(10); b:=random(10); ...

Hoặc cả số x:=random(10000); sẽ được số x ngẫu nhiên trong khoảng $0\le x \le 9999$

 

Để phân tích và so sánh cho điểm, em cần phải tách từng chữ số của số có 4 chữ số được nhập vào rồi ghi vào a[1], b[1], c[1], d[1] chẳng hạn.

Sau đó so sánh a[1] với a, nếu bằng thì +10 cho điểm, nếu không thì so với b, nếu bằng thì +1 cho điểm, v.v...

 

Mệt quá thì em thư giãn bằng mấy cái này: (Tất cả đều là sản phẩm của Borland Pascal 7)

(Xephinh chạy rất mượt trên Windows XP, Win7 phải chạy bằng Batch Dos.

Cobac4 chạy bằng Batch Dos sẽ có âm thanh thực!)

attachicon.gifXepHinh.rar

uses crt;
var  ck,ck1:char;
     a,b,c,d:integer;
     f:text;
     w:array[0..9] of boolean;
   procedure chonso;
    var i:integer;
     begin
     for i:=0 to 9 do
       w[i]:=true;
         randomize;
         repeat a:=random(10);until w[a]=true;
         w[a]:=false;
         repeat b:=random(10);until w[b]=true;
         w[b]:=false;
         repeat c:=random(10);until w[c]=true;
         w[c]:=false;
         repeat d:=random(10);until w[d]=true;
         w[d]:=false;
     end;
   procedure hoi;
    begin
     gotoxy(4,19);
     write('Ban co choi tiep khong?(c/k)   ');
    repeat
     gotoxy(34,19);
     clreol;
     read(ck1);
    until (ck1='c')or(ck1='k');
    end;
   procedure ke;
    var i:integer;
    begin
     for i:=1 to 80 do
     write('*');
    end;
   procedure sailam;
      begin
      gotoxy(3,17);
      writeln('Ban da cho diem sai o lan nao do phai khong?');
      gotoxy(1,18);
      ke;
      hoi;
      end;
   procedure hanhdong1;
     var n,k,i,a1,a2:integer;    s:string;
         q:array[1..4] of integer;
      begin
      clrscr;
      gotoxy(1,1);
      ke;
      gotoxy(22,3);
      writeln('Moi ban thu tai suy luan!');
         for i:=1 to 7 do
          begin
          gotoxy(1,7+i-1);
          write(' Lan doan ',i,': ');
          repeat
          gotoxy(20,7+i-1);
          clreol;
          read(n);
          k:=1;
          str(n,s);
          if (length(s)=3)or(length(s)=4) then
          begin
          k:=0;
          q[4]:=n mod 10;
          q[3]:=(n mod 100)div 10;
          q[2]:=(n div 100)mod 10;
          q[1]:=n div 1000;
          for a1:=1 to 3 do
          for a2:=a1+1 to 4 do
           if q[a1]=q[a2] then k:=k+1;
          end;
          until k=0;
           if a=q[1] then k:=k+10;
           if b=q[2] then k:=k+10;
           if c=q[3] then k:=k+10;
           if d=q[4] then k:=k+10;
           if (a=q[2])or(a=q[3])or(a=q[4]) then k:=k+1;
           if (b=q[1])or(b=q[3])or(b=q[4]) then k:=k+1;
           if (c=q[1])or(c=q[2])or(c=q[4]) then k:=k+1;
           if (d=q[1])or(d=q[2])or(d=q[3]) then k:=k+1;
           if k=40 then break
           else
               begin
               gotoxy(27,7+i-1);
               if k div 10=0 then write('0',k)
               else
               write(k);
               end;
          end;
         gotoxy(2,14);
         if k<>40 then
           write('Da het luot doan, so can tim la: ',a,b,c,d)
         else
           write('Chuc mung ban da doan dung, so can tim la: ',a,b,c,d);
          gotoxy(1,15);
         ke;
         hoi;
      end;
   procedure hanhdong2;
     var i:integer;
      begin
      gotoxy(1,1);
      ke;
      end;
   procedure tambiet;
      begin
      clrscr;
      gotoxy(33,12);
      writeln('Chao tam biet!');
      gotoxy(23,14);
      writeln('@ Written by: Nguyen Huu Phong - 2014');
      readln;
      end;
 begin
 repeat
  clrscr;
  gotoxy(21,1);
  writeln('TRO CHOI DOAN SO GIUA BAN VA MAY');
  gotoxy(4,3);
  writeln('cho mot so co 4 chu so khac nhau. Ban phai tim ra so nay qua 7 lan doan.');
  writeln('Sau moi lan doan may se cho ban mot thong tin dang xA yB. Voi x la so chu so');
  writeln('ban doan dung va nam dung vi tri con y la so chu so dung nhung sai vi tri.');
  gotoxy(27,7);
  writeln('AN 1 HOAC 2 DE LUA CHON');
  writeln;
  write('  1. Ban la nguoi doan so');
  write('             2. May tinh se doan so cua ban ');
  {_____________________________________________________________________}
    repeat
     gotoxy(71,9);
     clreol;
     read(ck);
    until (ck='1')or(ck='2');
  if ck='1' then
     begin
     chonso;
     hanhdong1;
     end
  else hanhdong2;
   if ck1='k' then tambiet;
 until ck1='k';
 readln;
  end.

Em làm được phần chấm điểm thôi, còn phân tích thì e chịu




#514690 Tuyển tập bài tập Pascal

Gửi bởi nghethuat102 trong 22-07-2014 - 22:28

 

Em làm tốt lắm, 10 điểm!

Tuy nhiên, chương trình của em chạy không mượt bằng file ví dụ trên kia, em biết tại sao không?

Là do cái Delay đó! Phải nói là Delay là cái procedure dở hơi nhất của Pascal. Nó chỉ làm chậm chương trình, nghĩa là khi lệnh Delay được gọi thì chương trình chết dí luôn tại đó cho đến hết thời gian trễ mới thôi! (lúc đó ta không làm gì được)

Thử tưởng tượng em xây dựng một game xếp hình chẳng hạn, khi đối tượng chuẩn bị rơi xuống (đang Delay) thì các lệnh xoay, dịch chuyển, v.v... chưa đến lượt thực hiện, cho đến khi nó rơi xuống rồi mới có tác dụng! Thế thì chơi làm sao được?

 

Sau rất nhiều thời gian mày mò nghiên cứu giải pháp khắc phục, cuối cùng tôi cũng viết được ra cái Unit MTime này

attachicon.gifMTIME.rar

(Em giải nén ra và copy MTime.tpu vào thư mục BIN của Pascal, code nguồn của MTime tôi không thể share được!)

Với unit MTime, em được cung cấp các lệnh sau:

TimeStart; {Dùng để bắt đầu ghi thời gian}

TimeCurrent là một giá trị kiểu longint dùng để đo quãng thời gian chạy chương trình kể từ khi lệnh TimeStart; được gọi

InTime(x:longint); Là một giá trị logic kiểu boolean trong đó x tương đương với 1/10 giây.

InTime(x); được sử dụng sau khi gọi TimeStart; với ý nghĩa là Trong khoảng thời gian x thì InTime(x) có giá trị true, ngoài khoảng thời gian đó thì InTime(x) có giá trị false

Giá trị logic này rất hay ở chỗ, khi nó đang có hiệu lực thì ta có thể thực hiện bất cứ lệnh gì cho đến khi nó false thì thôi! Cái này Delay không làm được!

 

Ví dụ:

uses Mtime, crt, key;
var ch:integer;
begin
  clrscr;
  TimeStart;
  While InTime(300) do
       begin
       gotoxy(1,10);
       Write('Chuong trinh se ket thuc sau 30 giay nua, an Esc de ket thuc  ', (TimeCurrent div 10):3);
       if keypressed then ch:=getkey;
       if ch=27 then exit;
       end;
 end.

 

  uses mtime,crt,key;
  var x,y,a,ch:integer;
  begin
  clrscr;
  x:=40;
  y:=12;
  while intime(500) do
  begin
          gotoxy(x,y);
          a:=random(10);
          write(a);
          if keypressed then
                begin
                ch:=getkey;
                if (ch=-72)and(y>1) then y:=y-1
                else if (ch=-80)and(y<24) then y:=y+1
                else if (ch=-75)and(x>1) then x:=x-1
                else if (ch=-77)and(x<79) then x:=x+1
                else if (ch=27) then exit;
                end;
                clrscr;
 end;
  readln;
  end. 
 nhanh hơn thiệt, hay quá!!



#514646 Tuyển tập bài tập Pascal

Gửi bởi nghethuat102 trong 22-07-2014 - 19:56

 

Bài toán:

Lập chương trình (BP Pascal) hiển thị chính giữa màn hình 1 số tự nhiên $x$. Cứ sau khoảng 0,5 giây $x$ sẽ tự thay đổi một cách ngẫu nhiên trong khoảng từ 0 đến 9. Yêu cầu: Trong quá trình chạy chương trình: Nếu từ bàn phím ấn các phím $\uparrow, \downarrow, \rightarrow, \leftarrow$ thì $x$ di chuyển vị trí hiển thị lên, xuống, phải, trái một đơn vị hiển thị.(Trong phạm vi màn hình $24\times 79$). Nếu ấn phím Esc thì kết thúc chương trình.

 

Giống như thế này :D

attachicon.gifCHAYCHU.rar

 

uses key,crt;
var x,y,a:integer; b:boolean;ch:integer;
        begin
        clrscr;
        x:=40;
        y:=12;
        b:=true;
        repeat
          gotoxy(x,y);
          a:=random(10);
          write(a);
          delay(500);
          if keypressed then
                begin
                ch:=getkey;
                if (ch=-72)and(y>1) then y:=y-1
                else if (ch=-80)and(y<24) then y:=y+1
                else if (ch=-75)and(x>1) then x:=x-1
                else if (ch=-77)and(x<79) then x:=x+1
                else if (ch=27) then b:=false;
                end;
                clrscr;
        until b=false;
        end.
Hihi, thầy xem đúng chưa ạ!



#514473 Tuyển tập bài tập Pascal

Gửi bởi nghethuat102 trong 21-07-2014 - 22:33

Em code lại cái này bằng Pascal coi :)

Hihi,đợi ngày mai a ơi, em sắp ngủ rồi! Nhưng bài này thấy thú vị lắm,đêm nằm mơ thuật toán đã :icon6:




#514424 Tuyển tập bài tập Pascal

Gửi bởi nghethuat102 trong 21-07-2014 - 18:57

Đây là đề thi tin học trẻ năm nay của tỉnh!

1.Kiểm tra xâu

   Bạn Tí khoe là mình đã làm một đoạn văn toàn "B" tức là mọi từ đều bắt đầu bằng chữ B, các bạn trong lớp muốn kiểm tra xem điều đó có đúng không. Em giúp các bạn bằng cách hãy viết chương trình nhập vào từ bàn phím đoạn Văn của Tí và kiểm tra xem có đúng là toàn "B" hay không.

   Input: "Bup be bang bong" 

             "Buoi chieu mua bay"

             ...........................

   Output:True

               False

              ..........................

2. Điền số vào lưới ô vuông

   Trong giờ giả lao, bạn An thường thấy các bạn rủ nhau chơi:"T.Roa Zero", An chợt nghĩ ra một trò chơi khác nhằm giúp phát triển tư duy cho các bạn. Trò chơi của An được mô tả như sau: An có một tấm bìa trên đó kẻ thành lưới các ô vuông kích thước N*N, đồng thời có rất nhièu các mảnh giấy ô vương nhỏ trên đó ghi các số 0,1,-1. An đó các bạn trong lớp hãy đặt các mảnh giấy ô vuông nhỏ vào các ô trên lưới ô vuông sao cho tổng các số của mọi hình vuông con 2x2 đều bằng 0 và tổng các số của lưới là lớn nhất. Em hãy viết chương trình thực hiện trò chơi bạn An đã đưa ra.

   Input:

           số n(1<=n<=255);

   Output:

           Dòng đầu ghi số nguyên là tổng lớn nhất của lưới;

           N dòng tiếp ghi các giá trị là các số trên các mảnh giấy đã đặt vào, các giá trị cách nhau ít nhất một dấu cách.

   Vd: 

      n=3;

      3

      1  0  1

      0 -1  0

      1  0  1

3. Che mắt mèo

   Trên bàn cờ ô vuông N*N tại mỗi ô vuông có thể xếp hoặc một con mèo, hoặc một quân cờ. Hai con mèo trên bàn cờ sẽ nhìn thấy nhau nếu trên đường thẳng nối chúng theo hàng ngang, hàng dọc hay đường chéo không có quân cờ nào cả.

   Hãy tìm cách xếp mèo và quân cờ như trên sao cho số mèo lớn nhất mà không có con mèo nào nhìn thấy nhau?

   Input:

      nhập vào n(1<=n<=1000);

   Output:

      N dòng đầu, trên mỗi dòng ghi vị trí xếp mèo hay cờ( Nếu là mèo thì ghi M, còn nếu là cờ thì ghi O), các giá trị cách nhau ít nhất một dấu cách.

      Dòng tiếp theo, ghi ra số nguyên dương  là số mèo lớn nhất xếp được trên bàn cờ

   Vd:

     n=3;

     M O M

     O O O

     M O M

     4

 




#514293 1 bài thuật toán trong tin học 10

Gửi bởi nghethuat102 trong 21-07-2014 - 09:14



Cho 1 dãy số gồm n phần tử gồm các số hạng 0;1;2. Hãy sắp xếp để các số 0 đứng ở giữa, các số 1 lên đầu, các số 2 đứng cuối.

P/s: chuẩn bị thi tin học 9, ôn luôn phần lớp 10

Bài này thấy hay hay, mình thấy có rất nhiều cách để làm ^^

var a,b:array[1..100] of 0..2;
    i,j,n,m:integer;
    begin
    write('n=');
    readln(n);
    for i:=1 to n do
        begin
        write('a[',i,']=');
        readln(a[i]);
        end;
    i:=1;
    j:=n;
    for m:=1 to n do
        if a[m]=1 then
            begin
               b[i]:=1;
               i:=i+1;
            end
        else if a[m]=2 then
             begin
               b[j]:=2;
               j:=j-1;
             end;
       for i:=1 to n do
           write(b[i]:3);
       readln;
       end.



#513337 số siêu may mắn

Gửi bởi nghethuat102 trong 17-07-2014 - 09:19



Một số được gọi là may mắn nếu trong biểu diễn trong hệ cơ số 10 chỉ gồm các chữ số 4 và 7. Chẳng hạn, các số 47, 744, 4 là may mắn, các số 5, 17, 467 không là các số may mắn.

Một số được gọi là siêu may mắn nếu là số may mắn và có cùng số chữ số 7 và 4. Chẳng hạn 47, 7744, 474477 là các số siêu may mắn và 4, 744, 467 không là các số siêu may mắn.

Yêu cầu: Cho trước số nguyên dương n, tìm số siêu may mắn nhỏ nhất không nhỏ hơn n.

Dữ liệu: Vào từ tập tin văn bản SMM.INP gồm duy nhất số nguyên dương n (1 ≤ n ≤ 109).

Kết quả: Ghi ra tập tin văn bản SMM.OUT số siêu may mắn nhỏ nhất không nhỏ hơn n.

 

Ví dụ 1:

4500 =>4747

 

Ví dụ 2:

47 =>47

 

Đây là bài của mình!!

var s:string;
    i,j,n,a,b:integer;   c:boolean;
    begin
    write('s=');
    readln(s);
      a:=0;
      b:=0;
      for i:=1 to length(s) do
          if s[i]='4' then a:=a+1
          else if s[i]='7' then b:=b+1;
      if (a+b=length(s))and(a>=b) then
         begin
           i:=length(s);
           while a<>b do
                 begin
                  if s[i]='4' then
                     begin
                     s[i]:='7';
                     b:=b+1;
                     a:=a-1;
                     end;
                  i:=i-1;
                 end;
         end
      else if a+b<=length(s) then
           begin
           n:=length(s);
           if ((b>a)and(a>0)and(b>0))or(s[1]>'7') then   s:='0'+s;
           if length(s) mod 2<>0 then s:='0'+s;
           a:=length(s) div 2;
           b:=a;
           c:=false;
           i:=0;
           if n=length(s) then
              begin
               for i:=1 to length(s) do
                   if (s[i]<>'7')and(s[i]<>'4') then
                      begin
                      if (s[i]<'7')and(s[i]>'4') then
                         begin
                         s[i]:='7';
                         b:=b-1;
                         c:=true;
                         end
                      else if s[i]<'4' then
                           begin
                           s[i]:='4';
                           a:=a-1;
                           end;
                      if c=true then break;
                      end
                   else if s[i]='7' then b:=b-1
                   else if s[i]='4' then a:=a-1;
             end;
             for j:=i+1 to length(s) do
                 if a>0 then
                    begin
                    s[j]:='4';
                    a:=a-1;
                    end
                 else s[j]:='7';
             end;
        writeln(s);
readln;
end.



#513251 Lập trình Pascal

Gửi bởi nghethuat102 trong 16-07-2014 - 20:14

Qui trình ốc sên
Một con ốc sên bò lên 1 ngọn cây có chiều dài n (đơn vị độ dài). Ban ngày trời nắng nóng nó nên nó chỉ bò lên cao được 1 (đơn vị độ dài) và hao tổn 2 (đơn vị năng lượng). Đến ban đêm trời mát mẻ nó có thể trèo lên cao được một đoạn gấp đôi đoạn đường đã có trước đây nhưng nó sẽ mất 4 (đơn vị năng lượng)
Lịch trình bò lên của con ốc sên được kí hiệu bằng N và D nếu ốc sên bò lúc ban ngày thì được ghi N con ban đêm thi ghi D
Yêu cầu: Hãy chỉ cho ốc sên một lịch trình bò lên ngon cây sao cho vừa đúng lên tới ngọn và lượng năng lượng tiêu tốn là ít nhất. Giả thuyêt lúc ban đầu ốc sên đã ở trên cây với khoảng cách đến mặt đất là 1 (đơn vị độ dài)
Dữ liệu vào: Nhập từ bàn phím 1 so nguyên dương N(N<=10000)
Dữ liệu ra: Đưa ra màn hình gồm hai dòng.Dòng đầu ghi một sô nguyên dương là năng lượng ốc sên đã tiêu tốn, dòng tiếp theo ghi chuỗi kí tự N và D
Input 
10

Output

12
NDND

Mình làm ý tưởng thế này không biết đúng không!

         var s:string;

       n,i,d:integer;
       begin
       repeat
       write('n=');
       readln(n);
       until (n>=1)and(n<=10000);
       s:=''; d:=0;
       while n>1 do
             begin
             if (n mod 2<>0)or(n=2) then
                begin
                 n:=n-1;
                 s:=s+'N';
                 d:=d+2;
                end
             else
                 begin
                  n:= n div 2;
                  s:=s+'D';
                  d:=d+4;
                 end;
             end;
       writeln('nang luong ton : ',d);
       for i:=length(s) downto 1  do
           write(s[i]);
       readln;
       end.



  1. Diễn đàn Toán học
  2. → Đang xem trang cá nhân: Likes: nghethuat102