Форум АНТИЧАТ
Страница 1 из 2 1 2 >
Показывать 40 сообщений этой темы на одной странице

Форум АНТИЧАТ (https://forum.antichat.xyz/index.php)
-   С/С++, C#, Delphi, .NET, Asm (https://forum.antichat.xyz/forumdisplay.php?f=24)
-   -   Help please with Pascal (https://forum.antichat.xyz/showthread.php?t=40654)

_-[A.M.D]HiM@S-_ 23.05.2007 00:07
Help please with Pascal
 
Hello, help me with pascal please. senks.

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

Thank's for all.

_-[A.M.D]HiM@S-_ 23.05.2007 00:11
senks

LolFEm 23.05.2007 12:53
хм... 8 разых программ... есть легкие есть над которыми думать надо...
Что в виде вознаграждения... может быть предложено>?

Ky3bMu4 23.05.2007 13:39
А на С++ не надо?)

NetMan 25.05.2007 23:55
Цитата:
Сообщение от _-[A.M.D]HiM@S-_
1. Заданы натуральное число n, символы S1, ... , Sn Подсчитать наибольшее количество идущих подряд символов пробела.
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[i]=' ' then inc(sp)
else sp:=0;
if sp>maxsp then maxsp:=sp;
end;
writeln('Max spaces=',maxsp);
readln;
end.

da_ff 26.05.2007 14:53
Цитата:
Сообщение от _-[A.M.D]HiM@S-_
7. Задан текст. Необходимо построить список слов, который есть в этом тексте. Определить сколько раз встречается каждое слово в этом тексте.
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[i] of
'а'..'я','А'..'Я':
begin
word:=word+str[i];
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[i]='' then continue;
m:=1;
for j:=i+1 to n-1 do
begin
if arrstr[j]='' then continue;
if arrstr[i]=arrstr[j] then
begin
inc(m);
arrstr[j]:='';
end;
end;
writeln(arrstr[i]+' '+IntToStr(m));
arrstr[i]:='';
end;
end;

da_ff 27.05.2007 13:59
Цитата:
Сообщение от _-[A.M.D]HiM@S-_
8. Задана последовательность слов, разделенных пропусками. Принимая первое слово за образец, выбрать те слова, которые могут быть получены из образца, путем перестановки букв.
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[i] of
'а'..'я','А'..'Я':
begin
word:=word+str[i];
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[i])>Length(mainword) then continue;
word:=mainword;
fl_is:=true;
for j:=1 to Length(arrword[i]) do
begin
if fl_is=false then break;
fl_is:=false;
for m:=1 to Length(word) do
begin
if arrword[i][j]=word[m] then
begin
fl_is:=true;
word[m]:=' ';
break;
end;
end;
end;
if fl_is=true then
Writeln(arrword[i]+' in '+mainword);
end;
end;

NetMan 28.05.2007 16:47
Цитата:
Сообщение от _-[A.M.D]HiM@S-_
3. Дан файл f, компоненты которого являются целыми числами. Получить файл g, образованный из файла f исключением повторных вхождений одного и того же числа.
Check dis! ;)
Код:
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.

NetMan 28.05.2007 19:18
Цитата:
Сообщение от _-[A.M.D]HiM@S-_
4. Заданы два массива записей, каждый из которых содержит фамилии и адреса сотрудников. Составленная программа должна перенести (в любом порядке) записи с двух массивов в третий, причем с двух одинаковых записей переносится только одна.
Код:
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.

valiko 29.05.2007 01:46
Цитата:
Сообщение от _-[A.M.D]HiM@S-_
2. Вычислить Z = (X1 + Y1) / (Х2 - Y2), где Х1 и Х2 - корни уравнения 2x2 +x – 4=0;Y1 и Y2 – корни уравнения ay2 + 2у - 1 = 0. (Все корни действительные).
Код:
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.


Время: 19:48
Страница 1 из 2 1 2 >
Показывать 40 сообщений этой темы на одной странице