Hello, help me with pascal please. senks. 5. Исследовать область определения и построить график ф-ции у=х/(х+3х+1). Thank's for all.
хм... 8 разых программ... есть легкие есть над которыми думать надо... Что в виде вознаграждения... может быть предложено>?
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.
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;
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;
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.
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.
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.
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.
Help please “Множества” 8. Задан текст из латинских букв, в конце – точка. Вывести на печать все буквы, которые входят в текст один раз.
Держи задачку с множествами 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.
