Help please with Pascal

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

Hello, help me with pascal please. senks.

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

Thank's for all.

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

senks

[LolFEm]

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

[Ky3bMu4]

А на С++ не надо?)

[NetMan]

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]

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]

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]

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]

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]

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.

[valiko]

HiM@S-_']
6. Разработать программу, которая при нажатии клавиши F9 выводит на экран текстовое окно. При нажатой клавиши ? сдвигается влево левая рамка окна, при нажатии ? вправо правая рамка окна, при нажатии ? - вниз нижняя рамка окна, при нажатии ? - вверх верхняя рамка окна.

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.

[NetMan]

HiM@S-_']ф-ции у=х/(х+3х+1)
Функция указана верно?
Эту функцию можно было бы задать как y=x/(4x+1)...

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

Help please

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

[The_HuliGun]

Держи задачку с множествами


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.