Ai giúp mình bài này nhé

In dãy fibonacci ạ. Làm giúp mình mấy bài kia luôn với ạ.

Sau đây là chương trình in ra n số fibonacci ( n lấy từ file FIBO.INP ) 

{Đây là cách đơn giản nhất nhưng hơi khó nhớ }

PROGRAM FIBONACCI;

uses crt;
var i,n,f1,f2: integer;

    g:text;
BEGIN

 assign(g,'FIBO.INP');reset(g);
 readln(g,n);

 close(g);

 assign(g,'FIBO.OUT');rewrite(g);

 f1:=0;
 f2:=1;
 for i:=1 to n do
 begin
  writeln(g,f1);
  f2:=f2+f1;
  f1:=f2-f1;
 end;

 close(g);
END. 

Làm theo kiểu file được không ạ.

Code đó là cách làm theo  kiểu file đó bạn 

In dãy fibonacci ạ. Làm giúp mình mấy bài kia luôn với ạ.

Còn đây là làm theo mảng sẽ dễ nhớ và dễ hiểu

Program FIBONACI; 
Uses CRT; 
Var F:array[1..100] of integer; 
      N,I:Longint; f:text;
BEGIN 
Assign(f,'FIBO.INP');reset(f);

Readln(f,n);close(f);

Assign(f,'FIBO.OUT');rewrite(f);

F[1]:=1; F[2]:=1; 
For i:=1 to N do 
Begin 
If i>2 then F[i]:=F[i-1]+F[i-2]; 
Writeln(f,F[i]); 
End; 
Close(f);

END. 

Sao mình in không ra 8128 nhỉ.

Code mình thì mình nghĩ đúng rồi nhưng bạn thử xem lại cái test xem ?

Tách riếng cho mình bài giải nén theo dạng file với ạ.  Với sao bạn không giúp mình mấy bài trước với. Mình có đưa lên rồi.

Lồng ghép đoạn Procedure giainen đó bạn

mấy bài kia ok mình sẽ up lời giải sau nhé ^^

 

CONST   fi='XEPCHU.inp';

        fo='XEPCHU.out';

var st:array['A'..'Z'] of longint;

    i,j,N:longint;

    f:text;

    x:CHAR;

begin

     assign(f,fi); reset(f);

     readln(f,n);

     for i:=1 to n do

     begin

          read(f,x);

          ST[x]:=ST[x]+1;

     end;

     close(f);

     assign(f,fo); rewrite(f);

     for x:='A' to 'Z' do

     if st[x]<>0 then

     writeln(f,x, st[X]);

     close(f);

    END.

Đây là bài nén xâu, ai giúp mình giải xâu đi.

 

Dưới đây là một code full từ nén xâu đến giải nén xâu (xâu thuần nhất) :

PROGRAM xau;
uses crt;
var s,ss,st,si:string; i,j,l:integer; f:text;
function kttn(s:string):boolean;
 var x:char; ok:boolean;
 begin
  kttn:=true;
  for i:=1 to length(s) do
   s[i]:=upcase(s[i]);
  for i:=1 to length(s) do
   begin
    ok:=false;
    for x:='A' to 'Z' do
     if s[i]=x then ok:=true;
    if not ok then begin kttn:=false;break;end;
   end;
 end;
procedure nen(s:string;var st:string);
 begin
  ss:='';
  while s<>'' do
   begin
    i:=1;
    while (s[i+1]=s[1])and(i<length(s)) do
     inc(i);
    if i>1 then
     begin
      str(i,si);
      ss:=ss+s[1]+si;
     end
    else ss:=ss+s[1];
    delete(s,1,i);
   end;

  s:=ss;l:=2;
  while l<length(s) do
   begin
    i:=1;
    while i<=length(s)-l do
     begin
      si:=copy(s,i,l);
      j:=i+l;
      ss:=copy(s,j,l);
      while ss=si do
       begin
        j:=j+l;
        ss:=copy(s,j,l);
       end;
      if j=i+l then inc(i)
      else
       begin
        str((j-i)div l,ss);
        delete(s,i,j-i);
        si:='('+si+')'+ss;
        insert(si,s,i);
        i:=i+l+2+length(ss);
       end;
     end;
    inc(l);
   end;
  st:=s;
 end;
function ktcd(st:string):boolean;
 begin
  ktcd:=false;
  for i:=1 to length(st) do
   if st[i]='(' then begin ktcd:=true; break; end;
 end;
procedure giainen(st:string;var s:string);
 var d,c:byte; code:integer;
 begin
  while ktcd(st) do
   begin
    i:=1; c:=0;
    while st[i]<>'(' do inc(i);
    d:=1; j:=i+1;
    while c<d do
     begin
      inc(j);
      if st[j]='(' then inc(d);
      if st[j]=')' then inc(c);
     end;
    si:=copy(st,i,j-i+1);
    delete(st,i,j-i+1);
    delete(si,1,1);
    delete(si,length(si),1);
    j:=i;
    while st[j+1] in['0'..'9'] do inc(j);
    ss:=copy(st,i,j-i+1);
    delete(st,i,j-i+1);
    val(ss,l,code);
    for j:=1 to l do
     insert(si,st,i);
   end;
  i:=1;
  while i<=length(st) do
   begin
    inc(i);
    if st[i] in['0'..'9'] then
     begin
      j:=i;
      while st[j+1] in['0'..'9'] do inc(j);
      ss:=copy(st,i,j-i+1);
      delete(st,i,j-i+1);
      val(ss,l,code);
      ss:=st[i-1];
      for j:=1 to l-1 do insert(ss,st,i);
      i:=i+l-1;
     end;
   end;

  s:=st;
 end;
BEGIN

 assign(f,'XAU.INP');reset(f);

readln(f,s);close(f);

assign(f,'XAU.OUT');rewrite(f);
 if kttn(s) then
  begin
   nen(s,st);
   writeln(f,'Chuoi sau khi nen la: ',st);
   giainen(st,s);
   writeln(f,'Chuoi sau khi giai nen la: ',s);
  end
 else write(f,'Xau ko thuan nhat.');

close(f);
END.

CHo hỏi bài tìm dãy con đơn điệu với ạ.

Đây là bài làm dãy con đơn điệu tăng dài nhất được lấy dữ liệu từ file Day.INP :

PROGRAM Day_con_don_dieu_dai_nhat;

uses crt;

Const Max=5000;

Var a,L,T:array [1..Max] of integer;

    i,j,N,jmax:integer;

    g:text;

Procedure Nhap;

Var f:text;

Begin

assign(f,'Day.INP');reset(f);

N:=0;

while not eof (f) do

      begin

      N:=N+1;

      read(f,a[N]);

      end;

close(f);

End;

Procedure quyhoachdong;

Begin

L[1]:=1;T[1]:=0;a[N+1]:=32767;

for i:=2 to N+1 do

    begin

    jmax:=0;

    L[i]:=1;

    for j:=1 to i-1 do

        if (a[j]<=a[i])and (L[i]< L[j]+1) then

        begin

        L[i]:=L[j]+1;

        jmax:=j;

        end;

    T[i]:=jmax;

    end;

End;

Procedure Truyvet(m:integer);

Begin

m:=T[m];

if m=0 then exit;

truyvet(m);write(g,a[m],' ');

End;

Procedure ghi;

Begin

assign(g,'Day.OUT');rewrite(g);

quyhoachdong;truyvet(N+1);

close(g);

End;

BEGIN

Clrscr;

Nhap;Ghi;

END.

bài 1 :cho hỏi bài tìm số hoàn hảo cho biết có bao nhiêu số hoàn hảo và in ra các số đó. ( làm theo file được không ạ).

PROGRAM So_hoan_hao; 
uses crt; 

Var S,n,i,j: integer; 
BEGIN
Clrscr; 
Write('Nhap so n : '); readln(n); 
For i:=1 to n do 
begin 
S:=0; 
For j:=1 to i do 
if i mod j = 0 then 
S:=S+j; 
if S = 2*i then 
write(i:6); 
end; 
Readln; 
END.

(Mấy bài bạn nói rõ đề ra giùm ... như vậy thì chả biết nó là dạng gì ... ví dụ như dãy fibonacci thì mình cũng chat hiểu là viết dãy hay tìm số hay tìm dãy ... nữa :3)

CHo hỏi bài tìm dãy con đơn điệu với ạ.

Bạn có thể nói rõ hơn được không ?

Dãy đơn điệu tăng giảm dài ngắn như thế nào ... ?

Ở những đoạn đó nói rõ hơn đi bạn .Vs lại ví dụ có vấn đề rồi bạn ạ !

okey mình đã làm được rồi cảm ơn

.

Có ai học chuyên Tin không điểm danh cái để mình tạo topic

Mình chuyên Tin nè bạn vừa mí thi thành phố xong !!!

Thế tỉnh đã biết kq chưa ?

Bạn có đề thi huyện của bạn ko cho mình xin .

Và đề thi tỉnh nữa ...

Ừ tý mình up cho

Thi thành phố vẫn chưa biết kết quả nhưng khá khả quan

Mí cả đề Hà Nội lần này cho hơi dễ ^^

Chưa có kết quả bạn à nhưng mình thi giải lớp 9

Thế huyện được giải mấy ?

Mình nhất huyện nên đi thi thành phố :3

vậy  mình sẽ cố gắng để đổi dc tên ,,, cố lên    

Để nick name như thế cũng được rồi mà ?

Nhập biểu thức vào máy tính : 

$X=X+1:A=A+\frac{1}{\sqrt{5}}\left ( \left ( \frac{1+\sqrt{5}}{2} \right )^{X+1}-\left ( \frac{1-\sqrt{5}}{2} \right )^{X+1} \right )$

Ấn CALC : X?0 A?0 . Ấn bằng liên tiếp cho đến X=60 thì giá trị của A là KQ cần tìm.

#Câu hỏi phụ : Nhập biểu thức như trên. ấn bằng liên tiếp bao giờ A lớn hơn hoặc bằng 1 tỉ thì X chính là số ngày cần tìm

Nhập biểu thức vào máy tính : 

$X=X+1:A=A+\frac{1}{\sqrt{5}}\left ( \left ( \frac{1+\sqrt{5}}{2} \right )^{X+1}-\left ( \frac{1-\sqrt{5}}{2} \right )^{X+1} \right )$

Ấn CALC : X?0 A?0 . Ấn bằng liên tiếp cho đến X=60 thì giá trị của A là KQ cần tìm.

#Câu hỏi phụ : Nhập biểu thức như trên. ấn bằng liên tiếp bao giờ A lớn hơn hoặc bằng 1 tỉ thì X chính là số ngày cần tìm

Cách này sai nhé bởi vì nó chỉ tìm được số viên bi bỏ vào hộp trong ngày thứ x chứ không phải số viên bi có trong hộp.

Nhầm tý.

Đã sửa

An bỏ một lượng bi vào hộp theo nguyên tắc: ngày thứ nhất bỏ vào 1 viên bi, ngày thứ 2 bỏ vào 2 viên bi, từ ngày thứ 3 trở đi mỗi ngày bỏ vào số bi bằng tổng số bi đã bỏ vào 2 ngày trước đó. Hỏi sau 2 tháng (60 ngày) trong hộp của An có bao nhiêu viên bi?   Trình bày cụ thể

Nhập biểu thức vào máy tính : 

$X=X+1:A=\frac{1}{\sqrt{5}}\left ( \left ( \frac{1+\sqrt{5}}{2} \right )^{X+1}-\left ( \frac{1-\sqrt{5}}{2} \right )^{X+1} \right )$

Ấn CALC : X?0 . Ấn bằng liên tiếp cho đến X=60 thì giá trị của A là KQ cần tìm.

#Câu hỏi phụ : Nhập biểu thức như trên. ấn bằng liên tiếp bao giờ A lớn hơn hoặc bằng 1 tỉ thì X chính là số ngày cần tìm