РефератыИнформатикаОдОдномерные массивы. Организация ввода и вывода данных

Одномерные массивы. Организация ввода и вывода данных

Колледж Экономики и информационных технологий


Отчет по учебной практике


Дисциплина: Основы алгоритмизации.


Выполнила: Гавриляченко Н.


Группа Г-121


Проверила: Абилова Ж.М.


Уральск, 2009


Одномерные массивы.


Организация ввода и вывода данных


Вариант- 6.


Задание 1.


Организовать ввод и вывод одномерного массива А1..А10 из вещественных чисел с помощью формулы А[i]:=cos(i+2i+1).


program p1;


var a:array [1..10] of integer;


i:integer;


begin


for i:=1 to 10 do a[i]:=cos(sqr(i)+2*i+1)


for i:=1 to 10 do


writeln ('a[',i,']=',a[i]);


readln;


end.


Задание 2.


Напишите программу, которая сначало вводит 15 чисел, складывает отдельно элементы с четными номерами и складывает отдельно нечетные элементы и выдает полученные результаты.


Program p1;


Var a: array [1..15] of integer;


i,j,k,n:integer;


Begin


For i:=1 to 15 do


Read(a[i]);


For i:=1 to 15 do


Write(' ',a[i]);


For i:=1 to 15 do


Begin


If i mod 2=0 then k:=k+a[i];


If i mod 2=1 then n:=n+a[i];


End;


WriteLn('k=',k);


Writeln('n=',n);


Readln;


End.


Задание 3. Организовать одномерный массив из 20 целых чисел. Найти сумму всех квадратных элементов в массиве и вывести на экран.


program p2;


uses crt;


var a:array [1..20] of integer;


i,s:integer;


begin clrscr;


writeln ('vvedi 20 chisel');


for i:=1 to 20 do readln (a[i]);


for i:=1 to 20 do a[i]:=sqr(i);


for i:=1 to 20 do writeln ('a[','i',']=',a[i]);


for i:=1 to 20 do


s:=s+a[i];


writeln ('summa vsex kvadratnix elementov=',s);


readln;


end.


Задание 4.


Организовать одномерный массив путем заполнения его квадратами чисел от 1 до 10. Найти сумму чисел кратных 3.


Program p4;


Uses crt;


Var a:array[1..10] of integer;


i,s:integer;


Begin


ClrScr;


Writeln('vvedite 10 chisel');


for i:=1 to 10 do Readln (a[i]);


for i:=1 to 10 do a[i]:=Sqr(i);


For i:=1 to 10 do WriteLn('a[',i,']=',a[i]);


For i:=1 to 10 do


if (a[i] mod 3=0) then


s:=s+a[i];


writeln('s=',s);


Readln;


End.


Задание 5.


Организовать одномерный массив из 20 чисел. Удвоить наибольший и наименьший элементы.


Program p6;


Uses crt;


Var a:array[1..20] of integer;


i,max,min:integer;


Begin


ClrScr;


WriteLn('Vvedite massiv');


For i:=1 to 20 do readln(a[i]);


max:=a[1];


For i:=1 to 20 do If a[i]>max then max:=a[i];


max:=max*2;


min:=a[1];


For i:=1 to 20 do If a[i]<min then min:=a[i];


min:=min*2;


Writeln('Maksimalnij element massiva=',max);


Writeln('Minimalnij element massiva=',min);


Readln; End.


Задание 6.


Организовать массив из 20 чисел. Отсортировать по возрастанию. Вывести массив до и после обработки.


Program sortirovka;


Uses crt;


Var a:array[1..20] of integer;


i,j,b,d:integer;


Begin


ClrScr;


Randomize;


For i:=1 to 20 do a[i]:=random(51);


For i:=1 to 20 do Write('a[',i,']=',a[i]:3);


For j:=1 to 19 do


For i:=1 to 19 do


If a[i]>a[i+1] then


Begin


b:=a[i];


a[i]:=a[i+1];


a[i+1]:=b


End;


For i:=1 to 20 do Write('a[',i,']=',a[i]:3);


Readln;


End.


Задание 7


Организовать одномерный массив из 15 чисел. Первые 7 чисел отсортировать по возрастанию, последние 7 чисел по возрастанию. Вывести массив до и после обработки.


Program p8;


Uses crt;


Var a:array [1..15] of integer;


i,j,t,b:integer;


Begin


ClrScr;


For i:=1 to 15 do ReadLn(a[i]);


For j:=1 to 7 do


Begin


t:=j;


For i:=j to 7 do


If a[i]<a[t] then


t:=i;


b:=a[t];


a[t]:=a[j];


a[i]:=b;End;


For j:=9 to 15 do


Begin


t:=i;


For i:=j to 15 do


If a[i]<a[t] then


t:=i;b:=a[t];a[t]:=a[j];


a[j]:=b;End;


For i:=1 to 15 do


Write(' ',a[i]); End.


Задание 8.


В одномерном массиве целых чисел определить минимальный элемент, заменить его на 0. Стоящие за ним элементы на 6.


Program p2;


Var a: array [1..10] of integer;


i,min,j,t:integer;


begin


Writeln ('vvedite massiv');


For i:=1 to 10 do Readln(a[i]);


For j:=1 to 10 do


begin


min:=a[1];


t:=1;


for i:=2 to 10 do


If a[i] <min: =a[i];


t:=i;End;


a[t]:=0;


for i:=t+1 to 10 do


a[i]:=6;


for i:=1 to 10 do


Writeln('a[',i,']=',a[i]); Readln; End.


Задание 9.


Организовать одномерный массив целых положительных чисел. Найти среднее арифметическое, определить количество элементов, больших этого среднего.


Program p3;


Uses crt;


Var a :array[1..10] of integer;


i,s,n:integer;


sa,sg:real;


Begin


ClrScr;


Writeln ('vvedite massiv');


Begin


For i:=1 to 10 do Readln(a[i]);


End;


For i: =1 to 10 do


s:=s+a[i];


sa:=s/5;


For i:=1 to 10 do


If a[i]>sa then


Begin


n:=n+1;


End;


Writeln ('srednee arifmeticheskoe=', sa:3:2);


Writeln ('V massive',n,'elementov bolshih sred.arifmetich'); Readln; End.


Задание 10.


Организовать массив. Определить среднее арифметическое и геометрическое, сравнить их между собой, если ср. арифметическое>ср. геометрического, то прибавить к каждому элементу массива 2, если ср. геометрическое>ср. арифметического, то умножить на 2.


Program p4;


Uses crt;


Var a :array[1..10] of integer;


c,n:real;


i:integer;


Begin


ClrScr;


Writeln('vvedite massiv');


for i:=1 to 10 do readln(a[i]);


for i:=1 to 10 do


c:=(c+a[i]);


c:=c/10;


for i:=1 to 10 do


n:=sqr(10);


if c>n then for i:=1 to 10 do


a[i]:=a[i]+2 else if n>c then for i:=1 to 10 do a[i]:=a[i]*2;


Writeln('c=',c,' n=',n);


Readln;


End.


Задание 11.


Дан массив 10 целых чисел. Отсортируйте его, найдите в нем контрольное число. Все элементы до контрольного числа замените на противоположные.


Program p5;


Uses crt ;


Var a:array [1..10] of integer;


c,b,i,t,j:integer;


begin


Writeln('vvedite massiv');


For i:=1 to 10 do Readln(a[i]);


For j:=1 to 10 do


Begin


t:=j;


For i:=j to 10 do


If a[i]<a[t] then t:=i;


b:=a[t];


a[t]:=a[j];


a[j]:=b;


End;


Write('vivesti kontrolnoe chislo b=');


readln(b);


c:=0;


For i:=1 to 10 do


if a[i]=b then c:=i;


If c:=0 then


WriteLn('ravnih b net')


else for i:=1 to c-1 do a[i]:=-a[i];


For i:=1 to 10 do write(a[i]:2);


Readln;


End.


Задание 12.


Дан массив, состоящий из 20 символов. Отсортировать его по возрастанию. Ввести 2 числа a и b от 0 до 255. Определить количество элементов, входящие в отрезок [char(a), char(b)].


Program p6;


Uses crt;


Var a:array[1..10] of integer;


i,j,b,t,c,f:integer;


Begin


Writeln('vvedite 20 elemenyov');


for i:=1 to 20 do Readln(a[i]);


for j:=1 to 20 do


Begin


t:=j;


for i:=j to 20 do


if a[i]<a[t] then t:=i;


b:=a[t];


a[t]:=a[j];


a[j]:=b;


End;


writeln('vvedite 2 chisla c<f');


Readln(c,f);


Writeln('elementi vhodyachie v otrezok [c,f]');


for i:=1 to 20 do


if (a[i]>=c) and (a[i]<=f) then write(a[i]:3);


WriteLn;


For i:=1 to 20 do


Write(' ',a[i]);


Readln;


End.


Задание 13.


Дан одномерный массив из 10 целых чисел. Среди элементов массива найти корни квадратного уравнения x2
+5-6=0. Если таковые отсутствуют, то вывести сообщение об этом.


ProgramP8;


var m:array [1..5] of integer;


p, i:integer;


a,b,c,x1,x2:real;


D:real;


Begin


a:=1;


b:=5;


c:=-6;


D:=b*b-4*a*c;


If D>0 then


begin


x1:=(-b+sqrt(D))/(2*a);


x2:=(-b-sqrt(D))/(2*a);


Writeln('pervii koren yravneniya=',x1:1:1);


Writeln('vtoroi koren yravneniya=',x2:1:1);


Writeln('Vvedite massiv');


For i:=1 to 5 do Readln(m[i]); p:=0;


For i:=1 to 5 do


If x1=m[i] then


p:=i;


if p<>0 then Writeln (' ',x1:1:1,' est v massive'); end else


Writeln(' ',x1:1:1,' net v massive');


For i:=1 to 5 do If x2=m[i] then p:=i;


if p<>0 then begin Writeln ('',x2:1:1,' est v massive');end else


Writeln(' ',x2:1:1,' net v massive');


Readln;End.


Вариант
12
.


Задание 14.


Дан массив из 10 чисел, отсортируйте его. Найдите в нем контрольное число. Все элементы после контрольного числа заменить на их квадраты.


Рrogram p1;


Uses crt;


Var a:array[1..10] of integer;


c,b,i,j,t:integer;


Begin


ClrScr;


Writeln('vvedite 10 chisel');


For i:=1 to 10 do ReadLn(a[i]);


For j:=1 to 10 do


Begin


t:=j;


for i:=j to 10 do


If a[i]<a[t] then t:=i;


b:=a[t];


a[t]:=a[j];


a[j]:=b;


End;


Write('vvedite kontrolnoe chislo b=');


Readln(b);


a[t]:=0;


for i:=t+1 to 10 do


a[i]:=sqr(a[i]);


For i:=1 to 10 do


if a[i]=b then c:=i;


If c=0 then


Writeln('a[',i,']=',a[i]); Readln; End.


Задание 15.


Напишите программу, которая вводит с клавиатуры 30 целых чисел, определяет среднее арифметическое первых десяти чисел, вторых десяти и последних десяти. После этого определяется максимальное и минимальное среднее арифметическое и выводится сообщение.


Program p2;


Uses crt;


Var a:array[1..30]of integer;


i,max,min:integer;


s,sa[1],sa[2],sa[3]:real;


Begin


Writeln('vvedite massiv');


for i:=1 to 30 do Readln(a[i]);


Begin


for i:=1 to 10 do


s:=s+a[i];


sa[1]:=s/10;


Writeln('srednee arifmeticheskoe pervih 10 chisel=',sa[1]:2:2);


for i:=11 to 20 do


s:=s+a[i];


sa[2]:=s/10;


Writeln('srednee arifmeticheskoe vtorih 10 chisel=',sa[2]:2:2);


for i:=21 to 30 do


s:=s+a[i];


sa[3]:=s/10;


Writeln('srednee arifmeticheskoe tretih 10 chisel=',sa[3]:2:2);


End;


max:=sa[1];


for i:=1 to 3 do


if sa[i]>max then


Begin


max:=sa[i];


End;


min:=a[1];


for i:=1 to 3 do


if sa[i]<min then


Begin


min:=sa[i];


End;


Двумерные массивы. Организация ввода и вывода.


Задание 16.


Организовать два массива a[i] и b[i] целых чисел. Окружность задана уравнением (х-1)2
+(у+2)2
=16. Среди соответствующих пар (a[i], b[i]) вывести те, которые являются координатами внешних точек окружности.


Program p3;


Uses crt;


Var a:array[1..10]of integer;


b:array[1..10]of integer;


i:integer;


x,y:real;


Begin


ClrScr;


Writeln('Vvedite massiv a');


For i:=1 to 10 do Readln(a[i]);


Writeln('Vvedite massiv b');


For i:=1 to 10 do Readln(b[i]);


Writeln(' koordinati vneshnih tochek okrugnosti (x-1)^2+(y+2)^2');


For I:=1 to 10 do


If Sqr(a[i]-1)+Sqr(b[i]+2)>16 then


Writeln('[',a[i],',',b[i],']');


Readln;


End.


Задание 17.


Дана функция Z=6x2
+7y. Организовать двумерный массив, значений функции Z от индексов i, j.


а)Определить максимум, минимум функции;


б) Найти среднее арифметическое.


Program p1;


Uses crt;


Var z:array[1..3,1..3] of integer;


i,j,min,max:integer;


sa,s:real;


Begin


ClrScr;


for i:=1 to 3 do


For j:=1 to 3 do


Begin


z[i,j]:=6*Sqr(i)+7*j;


Writeln('z[',i,',',j,']=',z[i,j]); End;


max:=z[1,1];


for i:=1 to 3 do


For j:=1 to 3 do


If z[i,j]>max then


max:=z[i,j];


writeln('maksimalnoe znachenie=',max);


min:=z[1,1];


for i:=1 to 3 do


For j:=1 to 3 do


If z[i,j]<min then


min:=z[i,j];


writeln('Minimalnoe znachenie=',min);


For i:=1 to 3 do


For j:=1 to 3 do


s:=s+z[i,j];


sa:=s/9;


Writeln('srednee arifmeticheskoe=',sa:2:2);


Readln;


End.


Задание 17.


Дана матрица целых чисел размером 5х6 (random). Отсортировать каждую строку матрицы по возрастанию. Вывести матрицу до и после обработки.


Program p2;


Uses crt;


Var a: array[1..5,1..6] of integer;


i,j,n,t:integer;


Begin


ClrScr;


Randomize;


For i:=1 to 5 do


For j:=1 to 6 do a[i,j]:=random(50);


For i:=1 to 5 do begin


For j:=1 to 6 do Write(a[i,j]:3);


Writeln;


End;


Writeln;


For i:=1 to 5 do


For n:=1 to 5 do


For j:=1 to 5 do


If a[i,j]>a[i,j+1] then


Begin


t:=a[i,j];


a[i,j]:=a[i,j+1];


a[i,j+1]:=t;


End;


For i:=1 to 5 do


Begin


For j:=1 to 6 do


Write(a[i,j]:3);


Writeln;


End;


Readln;


end.


Задание 18.


Дана матрица целых чисел размером 3х5. Заменить все положительные элементы на 5, все отрицательные на 3, все нули на нуль.


Program p3;


Uses crt;


Var a:array[1..3,1..5] of integer;


i,j:integer;


Begin


ClrScr;


Writeln('vvedite elementi massiva');


For i:=1 to 3 do


for j:=1 to 5 do Read(a[i,j]);


For i:=1 to 3 do


For j:=1 to 5 do


Begin


If a[i,j]>0 then a[i,j]:=5;


If a[i,j]<0 then a[i,j]:=3 end;


For i:=1 to 3 do begin


For j:=1 to 5 do


Write(a[i,j]:2);


Writeln;End;


readln;


End.


Задание 19.


Даны две матрицы А и В размером 4х4. Вычислить и вывести на экран матрицу С=А+В. Найти сумму элементов матрицы С, кратных 3, но не кратных 2.


Program p4;


Uses crt;


Var A,B,C:array[1..4,1..4] of integer;


i,j,sum:integer;


begin


ClrScr;


Writeln('vvedite elementi massiva A');


For i:=1 to 4 do


For j:=1 to 4 do Read(A[i,j]);


Writeln('vvedite elementi massiva B');


For i:=1 to 4 do


For j:=1 to 4 do Read(B[i,j]);


Writeln;


For i:=1 to 4 do


For j:=1 to 4 do


C[i,j]:=A[i,j]+B[i,j];


Write('C[i,j]=',C[i,j]);


for i:=1 to 4 do


For j:=1 to 4 do


Writeln(c[i,j]);


for i:=1 to 4 do


For i:=1 to 4 do


For j:=1 to 4 do


If (C[i,j] mod 3=0) and (c[i,j] mod 2<>0) then


sum:=sum+c[i,j];


Writeln('symma elementov matrici C=',sum:2);


For i:=1 to 4 do


For j:=1 to 4 do


Writeln('C[',i,', ',j,']=',C[i,j]);writeln; Readln; End.


Задание 20.


Даны две матрицы А и В. Сравнить матрицы поэлементно. Найти количество элементов матрицы А, больших, чем элементы матрицы В и наоборот. Сравнить их. Вывести сообщение: А>В или В>А.


Program p5;


Uses crt;


var a,b:array [1..4,1..4] of integer;


i,j,t,k:integer;


Begin


ClrScr;


Writeln('vvedite elementi matrici a');


For i:=1 to 4 do


For j:=1 to 4 do Read(a[i,j]);


Writeln('vvedite elementi massiva b');


For i:=1 to 4 do


For j:=1 to 4 do Read(b[i,j]);


For i:=1 to 4 do


For j:=1 to 4 do


Begin


If a[i,j]>b[i,j] then t:=t+1;


If b[i,j]>a[i,j] then k:=k+1;


end;


Writeln('t=',t);


Writeln('k=',k);


If t>k then Writeln('elementi massiva a bolshe b') else


Writeln('elementi massiva b bolshe a');


If t=k then Writeln('elementi massiva a i b ravni');


Writeln;


Readln;


End.


Задание 21.


Организовать двумерный массив (размерность 3х3). Вывести на экран в виде матрицы.


Program p1;


Uses crt;


var a:array[1..3,1..3] of integer;


i,j:integer;


Begin


ClrScr;


Writeln('vvedite elementi matrici: a[',i,' ',j,']');


For i:=1 to 3 do


For j:=1 to 3 do


Readln(a[i,j]);


For i:=1 to 3 do begin


For j:=1 to 3 do


Write(a[i,j]:3);


Writeln;end;


Readln;


End.


Задание 22.


Дана матрица 4х3 целых чисел. Найти сумму элементов, сумма индексов которых является:


а) Четным числом;


б) Кратно 3.


Program P2;


var a:array[1..4,1..3] of integer;


i,j,S:integer;


Begin


For i:=1 to 4 do


For j:=1 to 3 do


read(a[i,j]);


For i:=1 to 4 do


for j:=1 to 3 do


If (i+j) mod 2 =0 then


S:=S+a[i,j];


Writeln('Summa elementov,sum indeksov kot chetnaya=',S);


For i:=1 to 4 do


for j:=1 to 3 do


if (i+j) mod 3 =0 then


S:=S+a[i,j];


Writeln('Summa el-v,sum indeksov kratna 3=',S);


Readln;


End.


Задание 23.


Дана матрица вещественных чисел 3х3. Диагональные элементы матрицы заменить на максимальные.


Program z;


uses crt;


var a:array [1..3,1..3] of integer;


i,j,max:integer;


begin


clrscr;


writeln('vvedite massiv');


For i:=1 to 3 do


For j:=1 to 3 do


readln(a[i,j]);


For i:=1 to 3 do


For j:=1 to 3 do


if a[i,j]>max then max :=a[i,j];


writeln('max=',max);


For i:=1 to 3 do begin


a[i,i]:=max;


a[i,3+1-i]:=max; end;


for i:=1 to 3 do begin


for j:=1 to 3 do write(a[i,j]);


writeln;


end; readln;end.


Задание 24.


Написать программу, которая вводит по строкам с клавиатуры двумерный массив и вычисляет сумму его элементов:


а) По столбцам;


б) По строкам.


Program P4;


var a:array [1..3,1..3] of integer;


i,j,Sh1,Sh2,Sh3,Sd1,Sd2,Sd3:integer;


Begin


for i:=1 to 3 do


for j:=1 to 3 do read(a[i,j]);


for i:=1 to 3 do begin


Sd1:=a[i,1]+Sd1;


Sd2:=a[i,2]+Sd2;


Sd3:=a[i,3]+Sd3; end;


for j:=1 to 3 do begin


Sh1:=a[1,j]+Sh1;


Sh2:=a[2,j]+Sh2;


Sh3:=a[3,j]+Sh3;end;


Writeln('Symma 1-i stroki=',Sh1);


Writeln('Symma 2-i stroki=',Sh2);


Writeln('Symma 3-i stroki=',Sh3);


Writeln('Symma 1-go stolbca=',Sd1);


Writeln('Symma 2-go stolbca=',Sd2);


Writeln('Symma 3-go stolbca=',Sd3); readln; End.


Задание 25.


Организовать двумерный массив (5х5) случайных целых чисел из отрезка [0,60]. Найти минимальный элемент среди элементов, расположенных выше главной диагонали.


ProgramP5;


var a:array [1..5,1..5] of integer;


i,j,min:integer;


Begin


randomize;


For i:=1 to 5 do


For j:=1 to 5 do a[i,j]:=random(61);


Writeln('Matrica do obrabotki');


For i:=1 to 5 do begin


For j:=1 to 5 do write(a[i,j]:5); writeln;end;


min:=a[1,5];


For i:=1 to 5 do


For j:=1 to 5 do


if (i<j) and (a[i,j]<min) then min:=a[i,j];


Writeln('Minimym=',min);


Readln;


end.


Организация подпрограмм с помощью функций.


Задание 26.


Написать функцию, которая вычисляет объем цилиндра. Параметрами функции должны быть радиус и высота цилиндра.


Program p1;


Var H,R,O:Real;


function Obem(R,H:real):real;


Begin


Obem:=Pi*Sqr(R)*H;


End;


Begin


Writeln('vvedite R i H');


Readln(R,H);


O:=obem(R,H);


Writeln('Obem=',O:2:2);


Readln;


End.


Задание 27.


Написать фукцию, возвращающую:


а) минимальное среди двух;


б) максимальное среди двух;


Program p2;


Uses crt;


Var a,b:integer;


min,max:integer;


Function maximum(a,b:integer):integer;


Begin


ClrScr;


if a>b then maximum:=a


else maximum:=b;


End;


Function minimum(a,b:integer):integer;


Begin


if a<b then minimum:=a


else minimum:=b;


End;


Begin


Read(a,b);


max:=maximum(a,b);


min:=minimum(a,b);


Write('mininimum=',min);


Write('maximum=',max);End.


Задание 28.


Написать функцию нахождения дискриминанта уравнения и определяющая количество корней (т.е. принимает значения: 0,1, 2).


Program Z3;


var a,b,c:integer;


Function D(a,b,c:integer):integer;


Begin


if Sqr(b)-4*a*c>0 then D:=2;


If Sqr(b)-4*a*c=0 then D:=1;


If Sqr(b)-4*a*c<0 then D:=0;


end;


Begin


Writeln('Vvedite a,b,c');


Readln(a,b,c);


Writeln('Yravnenie imeet' ,D(a,b,c),' kornei' );


Readln;


end.


Задание 29.


Написать функцию нахождения общего сопротивления при параллельном соединении двух проводников.


Rобщ.
=


Program Z4;


var R1,R2,rez:real;


function Sopr(R1,R2:real):real;


Begin


Sopr:=1/R1+1/R2;


End;


Begin


Writeln('Vvedite R1 i R2');


Readln(R1,R2);


rez:=Sopr(R1,R2);


Writeln('Soprotivlenie=',Sopr(R1,R2):2:2);


Readln;


End.


Задание 30.


Написать функцию, вычисляющую процент от числа. Параметры- число и процент.


>

Program Z5;


var N,P,rez:real;


function Procent (N,P:real):real;


Begin


Procent:=(N*P)/100;


End;


begin


Writeln('Vvedite chislo i procent');


Readln(N,P);


rez:=Procent(N,P);


Writeln('Procent=',Procent(N,P):2:2);


Readln;


End.


Вариант-9.


Задание 31.


Даны три стороны треугольника. Написать функцию нахождения площади вписанной в треугольник окружности.


Program z1;


Var o,a,b,c,S,r,p:real;


Function Ploschad(a,b,c:real):real;


var p,s:real;


Begin


p:=(a+b+c)/2;


S:=Sqrt(p*(p-a)*(p-b)*(p-c));


r:=(2*S)/(a+b+c);


ploschad:=Pi*Sqr(r);


End;


Begin


Writeln('vvedite tri storoni treygolnika');


readln(a,b,c);


O:=Ploschad(a,b,c);


Writeln('ploschad ravna=',O:2:2);


Readln;


End.


Задание 32.


Написать функцию нахождения начальной скорости по конечной скорости, по времени изменения скорости, по ускорению.


Program p2;


Var v,v0,t,a:Real;


Function Skorost(v,v0,a:real):real;


Begin


Skorost:=v-a*t;


End;


Begin


Writeln('vvedite konech.skorost, vremya i yskorenie');


Readln(a,t,v);


v0:=Skorost(a,t,v);


Writeln('Nachalnaya skorost ravna=',v0:4:2);


Readln;


End.


Задание 33.


Написать программу, которая вычисляет квадратный корень произведения трех вещественных чисел, введенных с клавиатуры.


Program z3;


Var kor,a,b,c:real;


Function Koren(a,b,c:real):Real;


Begin


Koren:=Sqrt(a*b*c);


End;


Begin


Writeln('vvedite tri chisla');


Readln(a,b,c);


Kor:=Koren(a,b,c);


Writeln('koren chisel raven=',kor:2:2);


Readln;


End.


Задание 34.


Написать функцию, которая вычисляет значение выражения от аргументов a и b. tg(a)+ctg(b).


Program p4;


Var arg,a,b:real;


Function Argymenti(a,b:real):real;


Begin


Argymenti:=sin(a)/cos(a)+cos(b)/sin(b);


End;


Begin


Writeln('vvedite dva chisla');


Readln(a,b);


Arg:=Argymenti(a,b);


Writeln('Znachenie virazheniya ravno=',Arg:2:2);


Readln;


End.


Задание 35.


Написать функцию, определяющую среднее арифметическое среди элементов в массиве.


Program p5;


uses crt;


Var a:array[1..4] of real;


i:integer;


sa:real;


Function Srednee(var a:array of real):real;


Var sum:real;


Begin


For i:=0 to 3 do


Sum:=sum+a[i];


Srednee:=sum/4;


End;


Begin


ClrScr;


Writeln('vvedite massiv');


For i:=1 to 4 do


Readln(a[i]);


sa:=Srednee(a);


Writeln('srednee arifmeticheskoe=',sa:4:2);


Readln;


End.


Организация подпрограмм с помощью процедур.


Задание 36


Даны две точки с координатами (х1, х2), (у1,у2). Найти длину отрезка.


а) без параметра


Procedure dlina;


Var x1,x2,y1,y2:integer;


d:real;


Begin


Writeln('vvedite koordinati');


Write('x1='); readln(x1);


Write('x2='); readln(x2);


Write('y1='); readln(y1);


Write('y2='); readln(y2);


d:=Sqrt(sqr(x1-x2)+sqr(y1-y2));


Writeln('dlina=',d);


End;


Begin


Dlina;


Readln;


End.


б) с параметром


Program p2;


Procedure dlina(x1,x2,y1,y2:integer);


Var d:real;


begin


d:=Sqrt(Sqr(x1-x2)+sqr(y1-y2));


Writeln(dlina=',d:2:2);


end;


begin


Writeln('vvedite koordinati');


Write('x1='); Readln(x1);


Write('x2='); Readln(x2);


Write('y1='); readln(y1);


write('y2='); Readln(y2);


Dlina(x1,x2,y1,y2);


Readln;


End.


Вариант-9


Задание 37.


Найдите x из пропорции .


Programp1;


Var a,b,c:real;


Procedure proporciya(a,b,c:real);


Var x:real;


Begin


x:=((a+b)*(a+c))/(b-c);


Writeln('proporciya=',x:2:2);


End;


Begin


Writeln('vvedite znacheniya a,b,c');


Readln(a,b,c);


Proporciya(a,b,c);


Readln;


End.


Задание 38.


Даны координаты вершин треугольника. Найти его периметр.


Program p6;


Var x1,y1,x2,y2,x3,y3:real;


Procedure Perimetr(x1,y1,x2,y2,x3,y3:real);


Var P,d1,d2,d3:real;


Begin


d1:=Sqrt(sqr(x1-x2)+sqr(y1-y2));


Writeln('dlina1=',d1:2:2);


d2:=Sqrt(sqr(x2-x3)+sqr(y2-y3));


Writeln('dlina2=',d2:2:2);


d3:=Sqrt(sqr(x1-x3)+sqr(y1-y3));


Writeln('dlina3=',d3:2:2);


If (d1+d2>d3) and (d2+d3>d1) and (d1+d3>d2) then


P:=d1+d2+d3 else


Writeln('Takogo treygolnika ne sychestvyet');


Writeln('Perimetr=',P:2:2);


End;


Begin


Writeln('vvedite koordinati');


Write('x1='); Readln(x1);


Write('x2='); Readln(x2);


Write('x3='); Readln(x3);


Write('y1='); Readln(y1);


Write('y2='); Readln(y2);


Write('y3='); Readln(y3);


Perimetr(x1,y1,x2,y2,x3,y3);


Readln;


End.


Задание 39.


Определить среднесуточную температуру, если показания термометра: утром-no
C, вечером- ko
C, днем- mo
C.


Program p3;


Var n,k,m:real;


Procedure Temperatyra(n,k,m:real);


Var sst:real;


Begin


sst:=(n+k+m)/3;


Writeln('Temperatyra=',sst:2:2);


End;


Begin


Writeln('vvedite pokazaniya termometra ytrom,vecherom i dnem');


Readln(n,k,m);


Temperatyra(n,k,m);


readln;


End.


Задание 40.


За какое время пешеход доберется до соседнего города, если его скорость равна V(км/ч), а расстояние- S(км).


Program p2;


Var S,v:real;


Procedure Vremya(s,v:real);


Var t:real;


Begin


t:=s/v;


Writeln('Vremya=',t:2:2);


End;


Begin


Writeln('vvedite skorost i rasstoyanie');


readln(s,v);


Vremya(s,v);


Readln;


End.


Задание 41.


Найти площадь круга S, вписанного в квадрат со стороной a.


Program p5;


Var a:real;


Procedure Ploschad(a:real);


Var s:real;


Begin


S:=pi*sqr(a/2);


Writeln('ploschad=',s:2:2);


End;


Begin


Writeln('vvedite dliny storoni a');


Readln(a);


Ploschad(a); Readln; End.


Задание 42.


Найти значение выражения y= (a+b+c)2
.


Program p4;


Var a,b,c,d:real;


Procedure Virazhenie(a,b,c,d:real);


Var y:real;


Begin


d:=3;


a:=2*d;


b:=3*d;


c:=d/2;


y:=sqr(a+b+c);


Writeln('Virazhenie=',y:2:2);


End;


Begin


Virazhenie(a,b,c,d);


Readln;


End.


Вариант- 5.


Задание 43.


Дан одномерный массив. Найти и вывести на экран значения и номера элементов не превосходящих контрольное число. Оформить процедурой.


Program p2;


Var a:array[1..5] of integer; i,n:integer;


Procedure Massiv(a:array of integer;n:integer);


Var i:integer;


begin


for i:=0 to 5 do


If a[i]<=n then begin


Writeln('a[',i,']=' ,a[i]);


end;end;


Begin


Writeln('vvedite kontrolnoe chislo');


Readln(n);


Writeln('vvedite massiv');


For i:=1 to 5 do


Readln(a[i]);


Massiv(a,n);


Readln;


End.


Задание 44.


Дана функция y=ax3
+bx2
+cx+d. Вывести в виде таблицы значения функции на отрезке [-k,k]. Вычисления оформить функцией y(a,b,c,d,k).


Program p3;


Var a,b,c,d,y:real;


x,k:integer;


Function Tablica(a,b,c,d:real; x:integer):real;


Begin


Tablica:=a*x*x*x+b*sqr(x)+c*x+d;


End;


Begin


Writeln('vvedite znacheniya fynccii');


Readln(a,b,c,d,k);


For x:=-k to k do


begin


y:=Tablica(a,b,c,d,x);


Writeln('y=',y:2:2);


End;


Readln;


End.


Задание 45.


Даны 4 числа a,b,c,d. Найти объемы параллелепипедов на отрезках a,b,c,d. Среди объемов найти наименьший. Вычисление объемов оформить функцией V(a,b,c).


Program p4;


Var v:array[1..4] of integer;


min,i, a,b,c,d,v1,v2,v3,v4:integer;


Function Obem(a,b,c,d:integer):integer;


Begin


obem:=a*b*c;


end;


Begin


Writeln('vvedite znacheniya peremennih');


readln(a,b,c,d);


v[1]:=obem(a,b,c,d);


v[2]:=obem(d,c,b,a);


v[3]:=obem(b,a,d,c);


v[4]:=obem(c,d,a,b);


for i:=1 to 4 do Writeln('obem',i,'parallelepipeda=',v[i]:2);


min:=v[1];


for i:=1 to 4 do


if v[i]<min then


min:=v[i];


writeln('min=',min);


Readln;


End.


Комбинированный тип.


Объявление записи.


Задание 46.


Дан список учащихся из 10 записей. Каждая запись имеет поле фамилия, имя, номер класса, буква.


а) Найти однофамильцев из одного класса;


б) Найти двух учащихся тезок.


Program z;


type ycheniki=record


fam:string[15];


imya:string[10];


class:record


bykva:char;


god:integer;


end;


end;


var spisok:array [1..6] of ycheniki;


i,j:integer;


begin


for i:=1 to 6 do begin


with spisok[i] do begin


writeln('vvedite familiu ychenika',i);


readln(fam);


writeln('vvedite imya',i);


readln(imya);


writeln('vvedite ego klass',i);


readln(class.god);


writeln('vvedite bykvy klassa');


readln(class.bykva);


end;end;


writeln;


writeln('spisok odnofamilcev v odnom klasse:');


for i:=1 to 5 do


for j:=i+1 to 6 do


if (spisok[i].fam=spisok[j]. fam) and


(spisok[i].class.god=spisok[j].class.god)


and (spisok[i].class.bykva=spisok[j].class.bykva)


then writeln(spisok[j].fam, ' ',spisok[i].imya, ' ',


spisok[i].class.god.bykva,' ',


spisok[j].imya, ' ',spisok[j].class.god.bykva);


writeln('Ychashiesya tezki:');


for i:=1 to 5 do


for j:=i+1 to 6 do


if (Spisok[i].fam=spisok[j].fam)and(spisok[i].imya=spisok[j].imya)


then


writeln(spisok[j].fam, ' ', spisok[i].imya, ' ',spisok[i].class.god.bykva,' ',


spisok[j].imya, ' ', spisok[j].class.god.bykva);


writeln('Spisok ychashixsya s odinakovoi bykvoi klassa:');


for i:=1 to 5 do


for j:=i+1 to 6 do


if spisok[i].class.bykva=spisok[j].class.bykva


then


writeln(spisok[i].fam, ' ',spisok[i].imya, ' ',spisok[i].class.god, ' ',


(spisok[j].fam, ' ',spisok[j].imya, ' ',spisok[j].class.god);


readln;


Задание 47.


Написать программу, выдающую сведения об ассортименте игрушек в магазине. Структура записи: название игрушки, цена, количество, возрастные границы.


А)вывести названия игрушек, которые подходят детям до 3 лет;


Б)самая дорогая игрушка;


В)название игрушки, которая по стоимости не превышает х тг и подходит ребенку в возрасте до а лет.


Program Assortiment;


type Igryshki=record


name:string[15];


cena:integer;


kol:integer;


vozr:integer;


end;


var Magazin:array [1..6] of Igryshki;


i,j,max,x,a,b:integer;


Begin


for i:=1 to 6 do begin


with igryshki[i] do begin


writeln('Vvedite nazvanie igryshki',i);


readln(name);


writeln('Cena:');


readln(cena);


writeln('Kolichestvo:');


readln(kol);


writeln('Vozrastnie granici:');


readln(vozr);


end;end;


Writeln;


Writeln('Samaya dorogaya igryshka:');


max:=igryshki[1].cena;


For i:=1 to 6 do


if igryshki[i].cena>max then begin


max:=igryshki[i].cena;


Writeln(igryshki[i].name, ' ', max); end;


Writeln('Igryshki dlya detei v vozraste 3 let:');


For i:=1 to 6 do


if igryshki[i].vozr=3 then begin


Writeln(igryshki[i].name, ' stoimostu ',igryshki[i].cena, 'tg'); end;


writeln('vvedite stoimost');


readln(x);


For i:=1 to 6 do


if (igryshki[i].cena<x) then begin


writeln('Igryshki ' ,igryshki[i].name, 'stoimostu ' ,igryshki[i].cena,' ne previshaut ',x,' tg' ); end;


writeln('vvedite vozrast ');


readln(a);


For i:=1 to 6 do


if igryshki[i].vozr=a then begin


writeln(igryshki[i].name , 'podxodyat dlya vozrasta' , igryshki[i].vozr); end;


readln;


end.


Задание 48.


Список книг состоит из 10 записей:


Поля: Фамилия автора;


Название книги;


Год издания;


Количество страниц;


а) Найти название книг данного автора, изданных с 1960 года.


б) Определить имеются ли книги с названием «Информатика», если да, то сообщить фамилию авторов, год издания и количество страниц.


в) Вывести название книг и их авторов, если количество страниц превосходит среднее количество страниц по всему списку.


PROGRAM P1;


Type knigi=record


fam:string;


name:string;


page:integer;


god:integer;


End;


Var Spisok:array[1..5] of knigi;


i,o,summa:integer; m:string;


Sr:real;


Begin


For i:=1 to 5 do


Begin


With Spisok[i] do


Begin


Writeln('Vvedite familiu avtora', i);


Readln(fam);


Writeln('Vvedite nazvanie knigi', i);


Readln(name);


Writeln('vvedite god izdaniya');


Readln(god);


Writeln('Vvedite kolichestvo stranic');


Readln(page);


End;


End;


Writeln;


Writeln('Spisok knig izdannih s 1960 goda');


Writeln('Vvedite imya avtora');


Readln(m);


For i:=1 to 5 do


If (m=spisok[i].fam) and (spisok[i].god>=1960) then


Writeln(spisok[i].fam,' ',spisok[i].name,' ',spisok[i].god);


Writeln('Imeutsya li knigi s nazvaniem "Informatika"?');


For i:=1 to 5 do


begin


If spisok[i].name='Informatika' then


Writeln(Spisok[i].fam,' ',spisok[i].god,' ',spisok[i].page); o:=o+1 end;


if o=0 then Writeln('Takih knig net');


Summa:=0;


For i:=1 to 5 do


Summa:=Summa+Spisok[i].page;


Sr:=Summa/5;


Writeln('Srednee kolichestvo stranic=',Sr:2:2);


For i:=1 to 5 do


If Spisok[i].page>Sr THEN


Writeln('Stranici prevoshodyawie srednee kolichestvo stranic po spisky ',Spisok[i].fam,' ',Spisok[i].name);


Readln;


End.


Файловая переменная.


Типизированные файлы.


Задание 49.


а) Организовать файл CHISLA.dat с целыми числами.


Program p1;


Var f:file of integer;


n,i,c:integer;


Begin


Writeln('sozdat fail iz celih chisel');


Assign (f,'c:uchebaCHISLA.dat');


Rewrite(f);


Readln(n);


For i:=1 to n do


Begin


Read(c);


Write(f,c);


End;


End.


б) Составить программу, подсчитывающую количество элементов в файле, их сумму, среднее арифметическое.


program p3;


var


f:file of integer;


i,n,s:integer;


elem,k:integer; sum:integer;sa:real;


begin


assign(f,'c:uchebakolichestvo.txt');


reset(f);


sum:=0; k:=0;


while not eof (f) do


begin


read(f,elem); k:=k+1;


sum:=sum+elem;


end;


writeln('summa elementov=',sum);


sa:=sum/k;


writeln('sa=',sa:4:2);


readln;


end.


Вариант 4в.


Задание 50.


Организовать символьный файл f из Nкомпонент. После этого организовать файл g, содержащий все компоненты файла f в обратном порядке. Вывести содержимое файлов на экран.


Program p1;


Var f,g:file of char;


n,i:integer;


c:char;


a:array[1..10] of char;


Begin


Assign(f,'c:uchebaSimvoli.txt');


Rewrite(f);


Writeln('Vvedite kolichestvo komponent ');


Readln(n); writeln;


writeln('vvedite komponenti');


For i:=1 to n do


Begin


Readln(c);


Write(f,c);


End;


Close(f);


Reset(f);


Assign(g,'c:uchebaSimvol_.txt');


Rewrite(g);


i:=1;


While not eof (f) do


Begin


read(f,c);


a[i]:=c;


i:=i+1;


end;


for i:=n downto 1 do


Write(g,a[i]);


Close(f);


Close(g);


Reset(g);


Writeln('simvoli faila g');


While not eof(g) do


Begin


Read(g,c);


Writeln(c,' ');


End;


Close(g);


Readln;End.


Задание 51.


Организовать файл символов из N компонент. Определить символ, встречающийся в файле наиболее часто. Вывести на экр ан этот символ и его количество в файле.


Program z3;


var f:file of char;


i,n,k,j,max:integer;


c:char;


a:array [1..100] of char;


s:array [1..100] of integer;


Begin


writeln('Sozdat fail iz simvolov');


assign(f,'c:docume~13193~10016~1uchebabaza4.txt');


rewrite(f);


writeln('vvesti kolichestvo komponentov');


readln(n);


for i:=1 to n do


begin


readln(c);


write(f,c);


end;


close(f);


reset(f);


i:=1;


while not eof(f) do


begin


read(f,c);


a[i]:=c;


i:=i+1;


end;


for k:=1 to i do S[k]:=1;


for k:=1 to i do


for j:=k+1 to i do


if a[k]=a[j] then s[k]:=s[k]+1;


max:=s[1];


n:=1;


for k:=1 to i do


if max<s[k] then begin


max:=s[k];n:=k;end;


for k:=1 to i do


if s[k]=max then


writeln('simvol ', a[n],' vstrechaetsya ',n,' raz');


readln;end


.


Задание 52.


Напишите программу организующую хранение в файле нескольких записей (до 10) о результатах экзамена. Каждая запись содержит 3 поля: номер записи, фамилия, оценка. Организуйте вывод всей информации по форме: {1 Иванов 3}


Program Z1;


type ekzamen=record


n:integer;


fam:string [15];


oc:integer;


end;


var baza1:file of ekzamen;


rez:array [1..10] of ekzamen;


i:integer; y:integer;f:string[100];


begin


write('vvedite chislo ychenikov');readln(y);


f:='c:docume~13193~10016~1uchebabaza1.txt';assign(baza1,f);rewrite(baza1);


for i:=1 to 10 do begin


with rez[i] do begin


Writeln('Familiya');


readln(fam);


Writeln('Ocenka');


readln(oc);


end;end;


writeln;


reset(baza1);


Writeln('Rezyltati ekzamena:');


for i:=1 to 10 do


Writeln(i,' ', rez[i].fam, ' ', rez[i].oc);


Readln;end.


Текстовые файлы.


Задание 53


Организовать файл из Nстрок (текстовый) text.txt.


Program p1;


Uses Crt;


Var f:text;


i,n:integer;


c:string;


Begin


ClrScr;


Writeln('sozdanie tekstovogo faila ');


Writeln('vvedite kolichestvi strok');


Readln(n);


Assign(f,'c:uchebatext.txt');


Rewrite(f);


For i:=1 to n do


Begin


Readln(c);


Writeln(f,c);


End;


Close(f);


Readln;


End.


Задание 54


Подсчитать среднюю длину строк из файла text.txt.


Program p2;


Uses crt;


Var f:text;


i,n,d:integer;


c:string;


Sa:real;


Begin


ClrScr;


Writeln('Nahozhdenie srednej dlini stroki');


Writeln;


Assign(f,'c:uchebatext.txt');


Reset(f);


d:=0;


While not eof(f) do


begin


Readln(f,c);


n:=n+1;


d:=d+length(c);


End;


Sa:=d/n;


Writeln('srednee arifmeticheskoe=',sa:4:2);


Repeat Until Keypressed;


End.


Задание 55


Удалить из текстового файла все пробелы(delete (St, n, 1).


St - строка, n- позиция, 1-количество удаляемых символов.


Program p3;


Var f:text;


i,n:integer;


c:string;


Begin


Assign(f,'c:uchebatext.txt');


Reset(f);


While not eof(f) do


Begin


Readln(f,c);


for i:=1 to length(c) do


if c[i]=' ' then delete(c,i,1);


Writeln('Vivod faila bez probelov:',c);


End;


Readln;


End.


Задание 56


В текстовом файле text.txt определить максимальную длину строки.


Program p2;


Uses crt;


Var f:text;


i,n,max:integer;


c:string;


a:array[1..100] of integer;


Begin


ClrScr;


Assign(f,'c:uchebatext.txt');


Reset(f);


i:=1;


While not eof(f) do


Begin


Readln(f,c);


a[i]:=length(c);


i:=i+1;


End;


n:=i;


max:=a[1];


for i:=1 to n do


Begin


If a[i]>max then max:=a[i]; end;


Writeln('maksimalnaya dlina stroki=',max);


End.


Задание 57


Строки из файла text.txt разбить на части нечетные по счету строки. Записать в файл text.txt, четные- в text2.txt


Programp5;


Uses crt;


var f,g,h:text;


c:string;


i,n:integer;


Begin


ClrScr;


Writeln('Sortirovka strok faila na chetnie i nechetnie');


Writeln;


Assign(f,'c:uchebatext.txt');


Reset(f);


Assign(g,'c:uchebatext1.txt');


Rewrite(g);


Assign(h,'c:uchebatext2.txt');


Rewrite(h);


i:=0;


While not eof(f) do


Begin


Readln(f,c);


i:=i+1;


If(i mod 2)=0 then


Writeln(g,c) else


Writeln(h,c);


End;


Close(h); Close(g); End.

Сохранить в соц. сетях:
Обсуждение:
comments powered by Disqus

Название реферата: Одномерные массивы. Организация ввода и вывода данных

Слов:4513
Символов:53347
Размер:104.19 Кб.