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

Lí do sai bài này là chia 2 vế cho $\sqrt{x+1}$ mà chưa xét trường hợp $\sqrt{x+1}=0$ dẫn tới sót nghiệm x=1

(y) Đang định góp ý

.

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à ?

bạn có thể phân tích rõ hơn chỗ bđt bunhia đc ko

BĐT bunhia cho bộ 4 số $(a_1^2+b_1^2+c_1^2+d_1^2)(a_2^2+b_2^2+c_2^2+d_2^2)\geq (a_1a_2+b_1b_2+c_1c_2+d_1d_2)^2$

Áp dụng cho $a_1=\sqrt{\frac{a}{b+c}}$, $b_1=\sqrt{\frac{b}{c+a}}$, $c_1=\sqrt{\frac{c}{d+a}}$, $d_1=\sqrt{\frac{d}{a+b}}$

                     $a_2=\sqrt{a(b+c)}$, $b_2=\sqrt{b(c+d)}$, $d_2=\sqrt{c(d+a)}$, $d_2=\sqrt{d(a+b)}$

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 ?

 

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.

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é ^^

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. 

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. 

Ở 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

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 ... ?

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)

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

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

mình sưu tầm được ít toán dạng trắc nghiệm IQ về tư duy logic , hình tượng , số , ngôn ngữ đưa lên đây để mọi người chơi cho vui .
1 .Snap31.jpg
2 .Snap32.jpg
3. Snap33.jpg
4.Snap34.jpg
5 .Snap39.jpg
6.Snap35.jpg
7.Snap36.jpg
8 .Snap37.jpg

T nghĩ là : 1.E ; 2.D ; 3.F ; 4.F ; 5.(P-Q) ; 6.A ; 7.A ; 8.C

T nghĩ là : 1.E ; 2.D ; 3.F ; 4.F ; 5.(P-Q) ; 6.A ; 7.A ; 8.C

mình làm đc pascal ruj

Cái pic này từ lâu rồi :3

Mình thấy ý tưởng này hay, nếu được thì BQT hãy thay đổi như thế và mặt định luôn, không cho các TV thay đổi.

 

Về tên theo VMF Style thì :

 

Đại tướng $\rightarrow$ Giáo sư VMF

 

Thượng tướng $\rightarrow$ PGS VMF

 

.

.

.

 

Rồi cứ thế hạ xuống cho đến lính mới . Ai thích thì like, không thích thì ném đá nhẹ thôi nghe

Mình thấy như thế này cũng rất là hay