Writeln('stoimost pokupki: ',Sum/100:3:2,' rub.');
If Result = 0 Then WriteLn('pokupku sovershit nevozmojno!');
Readln;
End.
9.Описание: Из первой таблицы, где заданы коэффициенты для уравнений задания линий выписать в новую таблицу только те коэффициенты, которые формируют линию, параллельную первой в исходной таблице.
Uses CRT;
Type Line = Record
A,B,C: Integer;
End;
Var Result,I,J,N: Integer; F,G : Array[1..20] Of Line;
Begin
F[1].A := 1; F[1].B := 9; F[1].C := 2;
F[2].A := 2; F[2].B := 6; F[2].C := 3;
F[3].A := 3; F[3].B := 5; F[3].C := 1;
F[4].A := 4; F[4].B := 2; F[4].C := 4;
F[5].A := 3; F[5].B := 3; F[5].C := 1;
F[6].A := 2; F[6].B := 5; F[6].C := 2;
F[7].A := 1; F[7].B := 9; F[7].C := 5;
F[8].A := 2; F[8].B := 6; F[8].C := 1;
F[9].A := 3; F[9].B := 5; F[9].C := 2;
ClrScr;
N := 9; Result := 0; I := 1;
For J := 2 to N Do If (F[I].A = F[J].A) And (F[I].B = F[J].B) Then Begin Write('liniya ',I,' paralelna linii ',J,' ');
WriteLn(F[I].A,'X + ',F[I].B,'Y + ',F[I].C);
Result := Result + 1; End;
Writeln('naideno ',Result,' liniy');
If Result = 0 Then WriteLn('takih liniy net');
Readln;
End.
10.Описание: Имеется запись о багаже пассажира (кол-во вещей и общий вес вещей). Выяснить, имеется ли пассажир, багаж которого превышает багаж каждого из остальных пассажиров и по числу вещей и по весу. Дать сведения о багаже, число вещей в котором не меньше, чем в любом другом багаже, а вес вещей не больше, чем в любом другом багаже.
uses crt; type bagaj = record ves:double;kol_veshei: integer; end; var bagage:array[1..20] of bagaj; i,j,n,temp:byte;rez,k:double;a:boolean; begin clrscr; writeln('Vvedite kol-vo passajirov (n <= 20):'); readln(n); for i:=1 to n do begin writeln('Vvedite svedeniya o ',i,'-om bagaje passajira:'); writeln('Vvedite ves bagaja: '); readln(bagage[i].ves); writeln('Vvedite kol-vo veshei bagaja: '); readln(bagage[i].kol_veshei);end; clrscr; writeln('Bagage, sredniy ves odnoi veshi otlichaetsya ne bolee'); writeln('chem na 0.3 kg ot obshego srednego vesa:'); writeln; a:=true; for i:=1 to n do begin rez:=bagage[i].ves/bagage[i].kol_veshei; if (abs(bagage[i].ves - rez) <= 0.3) then begin a:=false; writeln('Bagage nomer ',i); writeln('ves bagaja: ',(bagage[i].ves):5:2,' kg'); writeln('kol-vo veshei: ',bagage[i].kol_veshei);writeln; end;end; if (a) then writeln('Takogo bagaja net!'); writeln; writeln('Kol-vo passajirov imeyushih bolee 2 veshei:'); writeln; temp:=0; for i:=1 to n do if (bagage[i].kol_veshei > 2) then temp:=temp+1; writeln('Takih passajirov ',temp,' chelovek'); if temp = 0 then writeln('Takih passajirov net!'); writeln; writeln('Kol-vo veshei bolshe srednego chisla veshei: '); writeln; rez:=0; temp:=0; for i:=1 to n do rez:=rez+bagage[i].kol_veshei; for i:=1 to n doif (bagage[i].kol_veshei > (rez/n)) then temp:=temp+1; writeln('Takih veshei ',temp); if temp = 0 then writeln('Takih veshei 0');.writeln; writeln('Bagage iz 1 veshi s vesom ne menee 30 kg'); writeln; temp:=0; for i:=1 to n doif bagage[i].kol_veshei = 1 thenif bagage[i].ves >= 30 thentemp:=temp+1; writeln('Imeetsya ',temp,' passajirov s takim bagajom'); readln; end.
11.Описание: 1.Список книг состоит из 10 записей. Запись содержит поля: Фамилия автора, название книги, год издания.Найти название книг данного автора, изданных с 1960 года. Program df; Uses crt; Type knigi= record Fam:string[15];Naz:string[30];Gad:integer; End; Var s:array[1..10] of knidi; I,k:integer;Av:string;Begin clrscr; For i:=1 tio 10 do begin with s[i] do begin Writeln(vvedi fam,i); Readln(fam); Writeln(vvedi nazv,i); Readln(nazv); Writeln(god); Readln(god);End;end; Writeln(vvedi av); Readln(avt); K:=length(av); For i:=1 to 10 do begin With s[i] do begin If (copy(fam,1,k)=av) and (god>1960) then writeln(nazv,nazv); End;End; End.
12.Описание: Из ведомости 3-х студентов с их оценками ( порядковый номер, Ф.И.О. и три оценки) определить количество отличников и средний бал каждого студента. Program Spic; Type wed = record n:integer ; fio:string[40] ; bal:array [1..3] of integer end;Var spisok:wed; i,j,kol,s:integer; sr:real; Begin kol:=0; with spisok do For i:=1 to 3 do begin n:=i; Write (' Vvedite FIO # ', i ,' '); Readln (fio); s:=0; For j:= 1 to 3 do begin write ( 'Vvedite ocenky: ' ); readln ( bal [j] ); s := s+ bal [j]; end; if s=15 then kol:=kol+1; sr := s/3; writeln ( fio, ', Sredniy bal = ', sr:4:1); end; writeln ( ' Kolichestvo otlichnikov = ', kol ); readln; end.
13.Описание: программа показывает пример объединения координат точек в запись. Здесь используется массив из записей типа RecPoint. Каждая такая запись содержит в себе поля с координатами x, y, z и поле комментария. Таким образом, одна запись описывает одну точку, а массив из записей представляет собой набор точек. Program Records; Uses crt; type RecPoint = record x, y, z: real; comment: string end; var Point: array [1..10] of RecPoint; i: integrer; delta: real; begin Clrscr; for i := 1 to 10 do begin Point[i].x := 2*i - 3; Point[i].y := 3*Point[i].x + 2; Point[i].z := 6*Point[i].y - 2*Point[i].x + 1; delta := Point[i].z - Point[i].x; if delta > 100 then Point[i].comment := 'z - x > 100.' else Point[i].comment := 'Нет комментариев.'; end; Writeln ('Результа расчёта (поля записи):'); Write (' ':7,'x'); Write (' ':8,'y'); Write (' ':8,'z'); Writeln (' комментарии'); for i := 1 to 10 do begin Write (Point[i].x:8:3,' '); Write (Point[i].y:8:3,' '); Write (Point[i].z:8:3,' ':2); Writeln (Point[i].comment); end; Readkey; end.
14.Описание: Выравнивание текста
uses crt;
const
l = 79; {kolvo liter, umeshayushihsya na ekrane v DOSe}
var t: text; i, j: integer; s: string; c, ost: byte;
begin clrscr;
assign(t, 'input.txt'); reset(t);
while not EoF(t) do begin readln(t, s);
for i := 1 to length(s) do if s[i] = ' ' then incc;
ost := l - length(s); {ost - kolichestvo probelov, kotorie nado}
j := 1;
while ost > 0 do begin for i := 1 to length(s) + c - 1 do if (s[i] = ' ') then begin if ost <= 0 then break;
insert(' ', s, i); dec(ost); inc(i, j); end;
inc(j); {t.k. pri prohozhdenii cikla FOR mi vstrechaem pervii probel} end;
c := 0; {obyazatel'no obnulayem kol-vo strok v stroke}
writeln(s); end;
close(t); readkey;
end.
15.Описание:Программа контроля студентов по литературе.Формируется файл вопросов и ответов
program zavd1;
uses crt;
const qfile='quest.txt'; afile='ansver.txt'; var f1,f2:text;i,k:integer; name,ansv:string;
begin clrscr;
assign(f1,qfile);
assign(f2,afile);
rewrite(f2);
reset(f1);
write('vvedi imya ?¬`п, gruppu :');
readln(name);
writeln(f2,name);
while not eof(f1) do begin readln(f1,name);
writeln(name);
write('‚ и ў?¤Ї®ў?¤м :');
readln(name);
writeln(f2,name);
readln(f1,ansv);
if ansv=name then k:=k+1;
i:=i+1;end;
writeln(f2,'‚бм®Ј® ЇЁв м :');
writeln(f2,i);
writeln(f2,'Џа ўЁ«мЁе ЇЁв м :');
writeln(f2,k);
close(f1); close(f2);
end.
Раздел: Строки
1. Описание: Из строки повторяющихся слов, отделяемых запятыми и заканчивающиеся точкой, выписать все гласные буквы в алфавитном порядке, которые входят не более чем в одно слово.
program one;
Uses CRT;
Type MyType = Set Of Char; Var S,W : String; I,K,L : Integer; J : Char; M,N : MyType; B,C : Array [1..32] of MyType;
Begin ClrScr;
M :=[' ','Ґ','с','Ё','®','г','л','н','о','п']; S := 'е«ҐЎ,¬®«®Є®, аЎг§,алЎ ,ᥫҐ¤Є .'; K := 1;
writeln(s);
While pos(',',S) > 0 Do Begin W := copy(S,1,pos(',',S));
B[K] := [];
For I := 1 To Length(W) Do B[K] := B[K] + [W[I]];
Inc(K);
delete(S,1,pos(',',S)); End;
W := S; B[K] := [];
For I := 1 To Length(W) Do B[K] := B[K] + [W[I]];
For I := 1 To K Do Begin C[I] := B[I]; For L := 1 To K Do If I <> L Then C[I] := C[I] - B[L]; End;
N := [];
For I := 1 To K Do N := N + C[I];
M := M * N;
For J := ' ' To 'п' Do If J in M Then Write(J,' ');
WriteLn; ReadKey;
End.
2.Описание: Основа алгоритма игры, согласно которой из слова образца, которое является первым в строке (в данном случае Pascal), составляются другие слова из тех же букв. Количество вхождений одной и той же буквы должно быть не больше, чем в образце.
program one;
Uses CRT;
Var S,T : String; N,I,J : Integer; A : Array [1..100] of String; F : Boolean;
Begin ClrScr;
S := 'pascal cal lasca nosok pasca sapca lapca caplan capla';
N := 1;
While pos(' ', S) > 0 Do Begin A[N] := copy(S, 1, pos(' ', S)-1);
delete(S, 1, pos(' ', S));
inc(N); End;
A[N] := S;
For I := 2 To N Do Begin F := True;
T := A[I];
For J := 1 To Length(T) Do Begin If (pos(T[J], A[1])) >0 Then T[J] := '*' Else F := False; End;
If F Then WriteLn(A[I]); End;
readln;
End.
3.Описание: Вывести каждое слово предложения задом наперед.
Program Stroki;
const chars=['.',',','!','?',' '];var S,S_out,slovo: string; i,j: integer;
begin Writeln('Vv stroku');
Readln(S);
S:= S+' ';
for i:= 1 to Length(S) do if not (S[i] in chars) then Slovo:=slovo+S[i] else if slovo <> '' then begin for j:= Length(slovo) downto 1 do S_out:=s_out+slovo[j];
s_out:=s_out+' ';
slovo:=''; end;
Writeln(S_out);
Readln;
end.
4.Описание: Расположить слова в порядке возрастания их длины в тексте.
program one;
uses crt;
var a,d,sl1,sl2 : string; i,l,k,j : longint; b : array [1..50] of string;
begin clrscr;
write('input s: ');readln(a);l:=length(a);
if a=''then halt;
if a[l]<>' ' then begin inc(l);a[l]:=' '; end;
for i:=1 to l do if a[i]=' 'then begin inc(j);b[j]:=d;d:=''; end else d:=d+a[i];
for i:=1 to j-1 do for k:=i+1 to j do begin sl1:=b[i]; sl2:=b[k];
if length(sl1)>length(sl2) then begin b[i]:=sl2; b[k]:=sl1; end; end;
for i:=1 to j do write(' ',b[i]); readln;
end.
5.Описание: Найти и заменить определенные символы в тексте (заменяемые) введенным символом с клавиатуры (заменяющий). Каждую замену сопровождать подтверждением.
program one;
uses crt;
var i,l:longint;a,a1,a2,p:string;
begin clrscr;textcolor(11);
write('vvedite text: '); readln(a);
write('zamenyaemyi simvol: '); readln(a1);
write('zamenyauschiy simvol: '); readln(a2);
if (length(a1)>1)or(length(a2)>1) then halt;l:=length(a);
for i:=1 to l do if a[i]=a1 then begin clrscr; a[i]:='_';
writeln(a);
writeln('Vy podtverzhdaete zamenu ',i,'-ogo simvola? (y/n)'); readln(p);
if p='y' then a[i]:=a2[1] else a[i]:=a1[1]; end;
clrscr;
write(a); readln;
end.
6.Описание: Найти похожее слово в предложении, которое отличается не более, чем на два символа. Пример: Pascal=Paskal=Pacsal.
program one;
var s,sl:string; m:array[1..100] of string; i,j,k,p,n,kol:integer;
beginwrite('Vvedite TEXT (slova cerez PROBEL): '); readln(s);
write('ISCEM - ? : '); readln(sl);
i:=0;
repeat inc(i);
p:=pos(' ',s);
m[i]:=copy(s,1,p-1);
delete(s,1,p);
until p=0; n:=i; m[n]:=s;
writeln('Naideno:');writeln;
for i:=1 to n do begin kol:=0;
for j:=1 to length(sl) do if pos(sl[j],m[i])<>0 then inc(kol);
if (length(m[i])-kol)<3 then writeln('*',m[i]); end; readln;
end.
7.Описание: Подсчет числа слов в тексте.
program one;
uses crt;
var tec : string; l,i,n : longint;
begin clrscr;
write('input s:');readln(tec);
l:=length(tec)+1;tec[l]:=' ';
for i:=1 to l do if tec[i]=' 'then n:=n+1;
write('in s ',n,' words');
readln;
end.
8.Описание: Максимальное слово в прдложении
program one;
Uses CRT;
Var MaxL,C : String; Pb : Byte;
Begin ClrScr;
WriteLn(vvedite predlojenie:'); ReadLn(C);
MaxL := '';
While Pos(' ',C) <> 0 Do Begin Pb := Pos(' ',C);
If Length(MaxL) < Length(Copy(C,1,Pb-1)) Then MaxL := Copy(C,1,Pb-1);
Delete(C,1,Pb); End;
If Length(MaxL) < Length(C) Then MaxL := C;
WriteLn;
WriteLn('Samaya bolshayaposledovatelnost'simvolov v predlojenii:');
WriteLn(MaxL);
ReadLn;
End.
9.Описание: Выписать слова из строки, которые начинаются с заданной буквы.
program one;
uses crt;
var a,aa,b : string; i,l,o,oo : longint;
begin clrscr;
write('string: ');readln(a);
write('bukva: ');readln(aa);l:=length(a);
if length(aa)>1 then halt;
if a[l]<>' 'then begin inc(l);a[l]:=' '; end;
for i:=1 to l do if a[i]=' 'then begin if b[1]=aa then writeln(b) else inc(o);inc(oo);b:='';
end else b:=b+a[i];
if o=oo then write('takix slov net!'); readln;
end.
10.Вводится 10 букв, а затем слово. Проверяется возможность составить введенное слово из этих символов.
program one;
uses crt;
var as:Array[1..10]of Char; s,s2:String; i,b:Byte;
beginclrscr;
Writeln('vvedite 10 simvolov:');
for i:=1 to 10 do begin rite('ь',i,': ');
readln(mas[i]); end;
write('vvedite stroku: '); readln(s);
for i:=1 to Length(s) do for b:=1 to 10 do if s[i]=mas[b] then begin s2:=s2+mas[b];
mas[b]:=' '; b:=10; end;
if s2=s then write('Iz etih simvolov mozhno sostavit' slovo ',s)else writeln('Iz etih simvolov nelzya sostavit slovo',s);
readln;
end.
11.Описание:Найти в строке минимальное и максимальное слова
program gdy;
label 1;
var s:string; m:array[1..100] of string; i,p,n:integer; ax,min:string; c:char;
begin 1:write('Vvedite stroky: '); readln(s);
if s[length(s)]<>'.' then begin writeln('ERROR: konec stroki okancivaetsia na "."'); goto 1; end;