Help please with Pascal

Discussion in 'С/С++, C#, Rust, Swift, Go, Java, Perl, Ruby' started by _-[A.M.D]HiM@S-_, 23 May 2007.

  1. _-[A.M.D]HiM@S-_

    _-[A.M.D]HiM@S-_ Green member

    Joined:
    28 Dec 2005
    Messages:
    441
    Likes Received:
    454
    Reputations:
    696
    Hello, help me with pascal please. senks.

    5. Исследовать область определения и построить график ф-ции у=х/(х+3х+1).

    Thank's for all.
     
    #1 _-[A.M.D]HiM@S-_, 23 May 2007
    Last edited: 29 May 2007
    1 person likes this.
  2. _-[A.M.D]HiM@S-_

    _-[A.M.D]HiM@S-_ Green member

    Joined:
    28 Dec 2005
    Messages:
    441
    Likes Received:
    454
    Reputations:
    696
    senks
     
    1 person likes this.
  3. LolFEm

    LolFEm Elder - Старейшина

    Joined:
    8 Sep 2006
    Messages:
    160
    Likes Received:
    52
    Reputations:
    5
    хм... 8 разых программ... есть легкие есть над которыми думать надо...
    Что в виде вознаграждения... может быть предложено>?
     
  4. Ky3bMu4

    Ky3bMu4 Elder - Старейшина

    Joined:
    3 Feb 2007
    Messages:
    487
    Likes Received:
    284
    Reputations:
    42
    А на С++ не надо?)
     
  5. NetMan

    NetMan Elder - Старейшина

    Joined:
    9 Feb 2004
    Messages:
    121
    Likes Received:
    37
    Reputations:
    34
    uses crt;
    var sp,maxsp,i,n:integer;
    s:string;
    begin
    clrscr;
    write('N=');readln(n);
    write('S=');readln(s);

    maxsp:=0;
    sp:=0;
    for i:=1 to n do begin
    if s=' ' then inc(sp)
    else sp:=0;
    if sp>maxsp then maxsp:=sp;
    end;
    writeln('Max spaces=',maxsp);
    readln;
    end.
     
    1 person likes this.
  6. da_ff

    da_ff Elder - Старейшина

    Joined:
    11 Jul 2006
    Messages:
    118
    Likes Received:
    22
    Reputations:
    26
    var
    f:textfile;
    str,word:string;
    i,j,m,n:integer;
    arrstr:array of string;
    begin
    assignfile(f,'test.txt');
    reset(f);
    n:=0;
    while not eof(f) do
    begin
    readln(f,str);
    m:=Length(str);
    i:=0;
    while i<=m do
    begin
    case str of
    'а'..'я','А'..'Я':
    begin
    word:=word+str;
    inc(i);
    end;
    else
    begin
    if word<>'' then
    begin
    inc(n);
    SetLength(arrstr,n);
    word:=AnsiLowerCase(word);
    arrstr[n-1]:=word;
    word:='';
    end;
    inc(i);
    end;
    end;
    end;
    end;
    for i:=0 to n-1 do
    begin
    if arrstr='' then continue;
    m:=1;
    for j:=i+1 to n-1 do
    begin
    if arrstr[j]='' then continue;
    if arrstr=arrstr[j] then
    begin
    inc(m);
    arrstr[j]:='';
    end;
    end;
    writeln(arrstr+' '+IntToStr(m));
    arrstr:='';
    end;
    end;
     
    #6 da_ff, 26 May 2007
    Last edited: 26 May 2007
    1 person likes this.
  7. da_ff

    da_ff Elder - Старейшина

    Joined:
    11 Jul 2006
    Messages:
    118
    Likes Received:
    22
    Reputations:
    26
    var
    f:textfile;
    mainword,word,str:string;
    i,j,m,n:integer;
    arrword:array of string;
    fl_is:boolean;
    begin
    mainword:='';
    assignfile(f,'test.txt');
    reset(f);
    readln(f,str);
    m:=Length(str);
    i:=1;
    n:=0;
    while i<=m do
    begin
    case str of
    'а'..'я','А'..'Я':
    begin
    word:=word+str;
    inc(i);
    end;
    else
    begin
    if word<>'' then
    begin
    word:=AnsiLowerCase(word);
    if mainword='' then
    begin
    mainword:=word;
    word:='';
    inc(i);
    continue;
    end;
    inc(n);
    SetLength(arrword,n);
    arrword[n-1]:=word;
    word:='';
    end;
    inc(i);
    end;
    end;
    end;
    if(word<>'')and(arrword[n-1]<>word)then
    begin
    inc(n);
    SetLength(arrword,n);
    arrword[n-1]:=word;
    end;
    //
    for i:=0 to n-1 do
    begin
    if Length(arrword)>Length(mainword) then continue;
    word:=mainword;
    fl_is:=true;
    for j:=1 to Length(arrword) do
    begin
    if fl_is=false then break;
    fl_is:=false;
    for m:=1 to Length(word) do
    begin
    if arrword[j]=word[m] then
    begin
    fl_is:=true;
    word[m]:=' ';
    break;
    end;
    end;
    end;
    if fl_is=true then
    Writeln(arrword+' in '+mainword);
    end;
    end;
     
    1 person likes this.
  8. NetMan

    NetMan Elder - Старейшина

    Joined:
    9 Feb 2004
    Messages:
    121
    Likes Received:
    37
    Reputations:
    34
    Check dis! ;)
    Code:
    uses crt;
    var a,b:array [1..100] of integer;
        i,j,n,m:integer;
        fi,fo:textfile;
        skip:boolean;
    begin
            Assign(fi,'in.txt');
            Reset(fi);
            Assign(fo,'out.txt');
            Rewrite(fo);
            n:=1;
            while not eof(fi) do begin
                    read(fi,a[n]);
                    inc(n);
            end;
            m:=1;
            for i:=1 to n do begin
            skip:=false;
               for j:=1 to m do
                if b[j]=a[i] then
                            begin
                                    skip:=true;
                                    break
                            end;
    
    
            if skip then continue
                    else begin
                            inc(m);
                            b[m]:=a[i];
                            write(fo,a[i],' ');
                         end;
    
            end;
            Close(fi);
            Close(fo);
    end.
    
     
    1 person likes this.
  9. NetMan

    NetMan Elder - Старейшина

    Joined:
    9 Feb 2004
    Messages:
    121
    Likes Received:
    37
    Reputations:
    34
    Code:
    uses crt;
    
    type sotr=record
    fam:string;
    adr:string;
    end;
    
    var a,b:array [1..50] of sotr;
        c:array [1..100] of sotr;
        i,j,na,nb,nc:integer;
        skip:boolean;
    begin
            clrscr;
            write('Введите количество записей первого массива: ');readln(na);
            for i:=1 to na do begin
                    write('Введите фамилию ',i,'-ого сотрудника: ');readln(a[i].fam);
                    write('Введите адрес ',i,'-ого сотрудника: ');readln(a[i].adr);
                    c[i].fam:=a[i].fam;
                    c[i].adr:=a[i].adr;
            end;
    
            writeln;
    
            write('Введите количество записей второго массива: ');readln(nb);
            for i:=1 to nb do begin
                    write('Введите фамилию ',i,'-ого сотрудника: ');readln(b[i].fam);
                    write('Введите адрес ',i,'-ого сотрудника: ');readln(b[i].adr);
            end;
    
            writeln;
    
            nc:=na;
            for i:=1 to nb do begin
            skip:=false;
                    for j:=1 to nc do
                            if (b[i].fam=c[j].fam) and (b[i].adr=c[j].adr) then
                                            begin
                                                  skip:=true;
                                                  break
                                            end;
            if skip then continue
                    else begin
                               inc(nc);
                               c[nc]:=b[i];
                         end;
    
            end;
    
            for i:=1 to nc do begin
                    writeln('Фамилия ',i,'-ого сотрудника: ',c[i].fam);
                    writeln('Адрес ',i,'-ого сотрудника: ',c[i].adr);
            end;
            readln;
    end.
    
     
  10. valiko

    valiko Elder - Старейшина

    Joined:
    28 Jan 2007
    Messages:
    152
    Likes Received:
    144
    Reputations:
    19
    Code:
    uses crt;
    const
      eps = 10E-9;
    procedure sqr_urav(a,b,c:double;var x1,x2:double);
    var
    d,t,y,u:double;
    r:real;
    begin
    
      if abs(a) < eps then
         begin
          if abs(b) < eps then
             begin
              if abs(c) < eps then
                 writeln('infinitnoye mnojestvo')
              else
                 writeln('korney net');
              end
          else
           begin
              x1:=-c/b;
              writeln('koren ',x1);
           end;
         end
      else
       begin
        d:=(sqr(b)-4*a*c);
        t:=sqrt(d);
        if (d<0) then writeln('deystvitelnyh korney net')
         else
          begin
           x1:=(-b-t)/(2*a);
           x2:=(-b+t)/(2*a);
          end;
      end;
    end;
    
    var a,b,c,x1,x2,y1,y2,z:double;
    
    begin
      clrscr;
    {2x2+x-4=0}
      sqr_urav(2,1,-4,x1,x2);
      writeln('x1= ',x1);
      writeln('x2= ',x2);
      writeln;
    {ay2+2y-1=0}
      write('a= '); readln( a );
      sqr_urav(a,2,-1,y1,y2);
      writeln('y1= ',y1);
      writeln('y2= ',y2);
    {z=(x1+y1)/(x2-y2)}
      z:=(x1+y1)/(x2-y2);
      writeln;
      writeln('z=(x1+y1)/(x2-y2)=',z);
      readln;
    end.
    
     
    1 person likes this.
  11. valiko

    valiko Elder - Старейшина

    Joined:
    28 Jan 2007
    Messages:
    152
    Likes Received:
    144
    Reputations:
    19
    Code:
    Uses CRT;
    var
    x1,x2,y1,y2: integer; {координаты левого верхнего (x1,y1) и правого нижнего (x2,y2) углов окна} 
    c,s:char;
    
    begin
     TextBackground(Black);
     clrscr;
     writeln('Нажмите F9 для создания текстового окна');
     s:= readkey;
     if s=#0 then s:=readkey;
     if s=#67 then {F9}
     begin
     clrscr;
     x1:=10; x2:=20; y1:=10; y2:=20;
    {Создаем окно - желтые символы на синем фоне}
     Window(x1,y1,x2,y2);
     TextBackground(Blue);
     TextColor(Yellow);
     clrscr;
    
     repeat
      c := readkey;
      case c of
       #72:y1:=y1-1; {вверх}
       #75:x1:=x1-1; {влево}
       #80:y2:=y2+1; {вниз}
       #77:x2:=x2+1; {вправо}
      end;
    writeln (ord(c));
      Window(x1,y1,x2,y2);
      clrscr;
     until c=#27 {выход по Esc}
      end;
    end.
     
  12. NetMan

    NetMan Elder - Старейшина

    Joined:
    9 Feb 2004
    Messages:
    121
    Likes Received:
    37
    Reputations:
    34
    Функция указана верно?
    Эту функцию можно было бы задать как y=x/(4x+1)...
     
    1 person likes this.
  13. _-[A.M.D]HiM@S-_

    _-[A.M.D]HiM@S-_ Green member

    Joined:
    28 Dec 2005
    Messages:
    441
    Likes Received:
    454
    Reputations:
    696
    Help please

    “Множества” 8. Задан текст из латинских букв, в конце – точка. Вывести на печать все буквы, которые входят в текст один раз.
     
    2 people like this.
  14. The_HuliGun

    The_HuliGun Elder - Старейшина

    Joined:
    19 May 2007
    Messages:
    191
    Likes Received:
    84
    Reputations:
    11
    Держи задачку с множествами

    Code:
    uses crt;
    var s:string;
    i:integer;
    c:char;
    mn, mn2 : set of char;
    begin
     clrscr;
     mn:=[];
     s:='Test string.';
     for i:=1 to  length(s)-1 do
    	begin
    	 if s[i] in mn then mn2:=mn2+[s[i]] else
    	 mn:=mn+[s[i]];
    	end;
     mn:=mn-mn2;
    for c:='a' to 'z' do
     if c in mn then writeln(c);
    for c:='A' to 'Z' do
     if c in mn then writeln(c);
    
     readln
    end.
    
     
    1 person likes this.
Loading...