Форум программистов, компьютерный форум, киберфорум
Наши страницы
Turbo Pascal
Войти
Регистрация
Восстановить пароль
 
Рейтинг 5.00/4: Рейтинг темы: голосов - 4, средняя оценка - 5.00
GETupProgramm
0 / 0 / 0
Регистрация: 27.08.2012
Сообщений: 4
#1

Найти наибольшее из значений компонент файла

27.08.2012, 12:31. Просмотров 710. Ответов 7
Метки нет (Все метки)

Файлы:
1)Дан файл F, компонентами которого являются действительные числа. Найти, наибольшее из значений компонент файла F, если их несколько, то под-считать число таких элементов. Результаты поиска записать в отдельный файл.
Строки:
2)Дан текст. Группы символов, разделенные пробелами (одним или несколькими) и не содержащие пробелов внутри себя, будем называть словами. Найти все слова, в которых доля букв a, b максимальна.
Процедуры и функции. Модули:
3)Составьте подпрограмму поиска минимального элемента, расположенного под главной диагональю, и максимального элемента, расположенного над главной диагональю заданной вещественной матрицы Anxm.

Добавлено через 12 минут
Вот я тут пытался...
1)Файлы:
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Program nomer 1 ;
var f,f1: file of real;
n,i: integer;
a,mx: real;
begin
assign(f,'file');
rewrite(f);
write('Сколько чисел записать в файл? n=');
readln (n);
writeln('Введите в файл ',n,' вещественных чисел');
for i:=1 to n do
 begin
write('a',i,'=');
readln(a);
write(f,a);
end;
writeln('Содержание исходного файла:');
reset(f);
read(f,mx);
write(mx:0:2,'  ');
while not eof(f) do
begin
read (f,a);
write (a:0:2,'  ');
if a>mx then mx:=a;
end;
close(f);
writeln;
assign (f1,'file');
rewrite (f1);
write ('Максимальное значение=',mx:0:2);
readln;
close (f1);
readln;
end.
2)Cтроки:
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
Program nomer2;
var a: array [1..10] of string;
s, sl: string; 
i, j, k, kb: integer;
dbmax, db: real;
begin
write ('s='); readln (s); s:=s+' ';
sl:=''; 
j:=1;
dbmax:=0;
for i:=1 to length (s) do 
if s[i]<>' ' then 
begin
sl:=sl+s[i]; 
if s[i] in ['a','b'] then 
inc(kb); 
end
else 
begin
a[j]:=sl; 
inc(j);
db:=kb/length(sl);
sl:=''; 
inc(k); 
if db>dbmax then  
begin
dbmax:=db;
kb:=0; 
db:=0; 
end;
else
begin
kb:=0; 
db:=0;
end;
end;
writeln('Максимальную долю букв =',dbmax:4:4);
if dbmax>0 then
begin
writeln ('содержат следующие слова');
for j:=1 to k do 
begin
kb:=0; 
db:=0;
sl:=a[j];
for i:=1 to length(sl) do 
if sl[i] in ['a','b'] then 
inc(kb);
db:=kb/length(sl);
if db=dbmax then writeln(a[j]); 
end; 
end;
end.
3)Процедуры и функции:
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Program nomer 35;
uses crt;
const n=5;
var a: array[1..n,1..m] of integer;
i,j: byte; max,min: integer;
begin
randomize;
clrscr;
writeln('исходный массив: ');
for i:=1 to n do
begin
for j:=1 to m do
begin
a[i,j]:=random(19)-9;
write(a[i,j]:4);
end;
writeln;
end;
writeln;
max:=a[1,2];   {max - максимум над главной диагональю}
min:=a[2,1];   {min - минимум под главной диагональю}
for i:=1 to n-1 do              
for j:=i+1 to m do
if a[i,j]>max then max:=a[i,j];
for i:=2 to n do                 
for j:=1 to m-1 do
if a[i,j]<min then min:=a[i,j];
writeln('максимум над главной диагональю = ',max);
writeln('минимальный элемент под главной диагональю = ',min);
end.
Но каждая работает не правильно ((( поправте плиз
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
27.08.2012, 12:31
Ответы с готовыми решениями:

Найти наибольшее среди значений компонент файла F с четными номерами
Решить программу на языке Turbo Pascal для решения задачи. Файл F заполнить...

Найти наибольшее среди значений компонент файла F с четными номерами
Задача №3. Решить программу на языке Turbo Pascal для решения задачи. Файл F...

Найти наибольшее значение компонент файла
Вот условие: &quot;Дан файл F, компоненты которого являются целыми числами. Найти...

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

Найти количество элементов файла и наибольшее из значений
Привет, кто может помогите пжл написать программу с комментариями, что да как...

7
Puporev
Модератор
54407 / 41979 / 28995
Регистрация: 18.05.2008
Сообщений: 98,888
27.08.2012, 12:52 #2
Лучший ответ Сообщение было отмечено Памирыч как решение

Решение

1.
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Program nomer1;//пробелы в имени нельзя
var f: file of real;
    f1:text;  //результат нужно писать в текстовый файл
    n,i,k: integer;
    a,mx: real;
begin
assign(f,'file');
rewrite(f);
write('Сколько чисел записать в файл? n=');
readln (n);
writeln('Введите в файл ',n,' вещественных чисел');
for i:=1 to n do
 begin
  write('a',i,'=');
  readln(a);
  write(f,a);
 end;
writeln('Содержание исходного файла:');
reset(f);
read(f,mx);
write(mx:0:2,' ');
k:=1;
while not eof(f) do
 begin
  read (f,a);
  write (a:0:2,'  ');
  if a>mx then  //если больше макс, то новый макс
   begin
    mx:=a;
    k:=1;
   end
  else if a=mx then k:=k+1;//если равен макс, то считаем
 end;
writeln;
close(f);
assign (f1,'file1.txt');
rewrite (f1);
write (f1,'Max=',mx:0:2);
if k>1 then write(f1,' k=',k);
close (f1);
writeln('Результат записан в файл file1.txt');
readln
end.
1
ВАСИЛЕВС
557 / 480 / 168
Регистрация: 14.02.2012
Сообщений: 1,561
27.08.2012, 12:59 #3
GETupProgramm, во второй программе строка 30. Там лишняя ; перед else.
0
MayaNash
1291 / 459 / 151
Регистрация: 24.08.2011
Сообщений: 2,247
27.08.2012, 13:36 #4
вторая программа - возьмите строку с несколькими пробелами в одном месте и разберите на бумажке что именно будет делать ваш алгоритм. есть маленькая логическая ошибочка, разберете - сразу найдете
0
GETupProgramm
0 / 0 / 0
Регистрация: 27.08.2012
Сообщений: 4
27.08.2012, 14:20  [ТС] #5
Цитата Сообщение от Керра Посмотреть сообщение
вторая программа - возьмите строку с несколькими пробелами в одном месте и разберите на бумажке что именно будет делать ваш алгоритм. есть маленькая логическая ошибочка, разберете - сразу найдете
вроде бы разобрался спасибо)
p.s. помогите кто-нибудь с 3. я в процедурах и функциях вообще 0...
0
Puporev
Модератор
54407 / 41979 / 28995
Регистрация: 18.05.2008
Сообщений: 98,888
27.08.2012, 14:30 #6
Цитата Сообщение от GETupProgramm Посмотреть сообщение
расположенного под главной диагональю, и максимального элемента, расположенного над главной диагональю заданной вещественной матрицы Anxm.
Я вот например не люблю этот тупизм. Главная диагональ это все же атрибут квадратной матрицы nxn, а в условии прямоугольная nxm.
0
GETupProgramm
0 / 0 / 0
Регистрация: 27.08.2012
Сообщений: 4
27.08.2012, 14:52  [ТС] #7
Во второй задаче не разобрался всетаки (
0
Puporev
Модератор
54407 / 41979 / 28995
Регистрация: 18.05.2008
Сообщений: 98,888
27.08.2012, 16:16 #8
Лучший ответ Сообщение было отмечено Памирыч как решение

Решение

2.
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Program nomer2;
uses crt;
var s, sl, s2: string;
    n, i, j, k, kb: integer;
    dbmax: real;
begin
clrscr;
writeln('Введите текст латинскими буквами, между словами пробелы:');
readln (s);
n:=length(s);
i:=1;
dbmax:=0;
sl:='';//слово с макс кол a,b
while i<=n do //пока не конец строки
if (s[i]<>' ') and((i=1)or(s[i-1]=' ')) then //если не пробел и первый или перед ним пробел
 begin
  s2:=''; //новое слово
  j:=i;
  while(j<=n)and(s[j]<>' ') do//пока не конец и не пробел, составим его
   begin
    s2:=s2+s[j];
    j:=j+1;
   end;
  kb:=0;
  for j:=1 to length(s2) do
  if s2[j] in ['a','b'] then inc(kb);
  if kb/length(s2)>dbmax then
   begin
    dbmax:= kb/length(s2); //если макс
    sl:=s2;//запомним слово
   end;
  i:=i+length(s2);
 end
else i:=i+1;
if dbmax=0 then write('Текст не содержит букв a,b')
else write('Максимальная доля букв a,b=',dbmax:0:2,' в слове ',sl);
readln
end.
Добавлено через 57 минут
3.
оставил nxm, но сделал квадратную.
Текст модуля.
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
unit matrica;
interface
const nmax=20;
type mtr=array[1..nmax,1..nmax] of real;
procedure Matrix(var a:mtr;var n,m:byte);
procedure MinMax(a:mtr;n,m:byte;min,max:real);
implementation
procedure Matrix;
var i,j:byte;
begin
repeat
write('Количество строк до ',nmax,' n=');
readln(n);
until n in [1..nmax];
m:=n;{квадратная}
writeln('Исходная матрица:');
for i:=1 to n do
 begin
  for j:=1 to m do
   begin
    a[i,j]:=10*random;
    write(a[i,j]:5:2);
   end;
  writeln;
 end;
writeln;
end;
 
procedure MinMax;
var i,j:byte;
begin
min:=a[2,1];
max:=a[1,2];
for i:=1 to n do
for j:=1 to m do
if (j>i) and (a[i,j]>max) then max:=a[i,j]
else if(j<i)and(a[i,j]<min) then min:=a[i,j];
writeln('Минимальный элемет под главной диагональю=',min:0:2);
writeln('Максимальный элемент над главной диагональю=',max:0:2);
end;
end.
Текст программы.
Pascal
1
2
3
4
5
6
7
8
9
10
11
uses crt,matrica;
var a:mtr;
    n,m:byte;
    mn,mx:real;
begin
clrscr;
randomize;
Matrix(a,n,m);
MinMax(a,n,m,mn,mx);
readln
end.
Добавлено через 7 минут
По модулям прочитай это.
http://www.pascal.helpov.net/index/pascal_modules_programming
1
27.08.2012, 16:16
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
27.08.2012, 16:16

Найти наименьшие из значений компонент файла с четными номерами
помогите пожалуйста такое вот задание:Дан файл f, компоненты которого являются...

Записать в файл g наибольшее значение первых пяти компонент файла f, затем - следующих пяти компонент и т.д.
Прошу помогите решить задачу!!!.. я уже не могу голова кипит не знаю как делать...

Найти наибольшее из модулей из значений модулей компонентов файла с нечётными номерами
Создание и чтение простых типизированных файлов. Записать в файл N...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
8
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru