Вопросы от Ромарио! Опции

[Romario]

Вот вся программа, что тут не так?

Код

uses crt;
type
 data = record
   day: 1..31;
   month: 1..12;
   year: 1980..1990;
 end;

 anketa = record
   surname: char;
   sex: char;
   birth: data;
 end;

const n = 2;
label
 1,2,3,4,5;

var
 d: array[1..n] of data;
 a: array[1..n] of anketa;
 m: set of 1..12;
 i,m1,j: integer;
 ch: char;
 Mold: integer;

begin
 clrscr;

 for i:=1 to n do begin
   writeln;
   writeln;
   writeln;
   write('  ',i,'.1) ‚ўҐ¤ЁвҐ д ¬Ё«Ёо -> ');
   readln(a[i].surname);

   1:
   write('  ',i,'.2) ‚ўҐ¤ЁвҐ Ї®« -> ');
   readln(a[i].sex);
   if not a[i].sex in ['†','¦','¬','Њ'] then begin
     write(a[i].sex,' нв® зв® Ї®-ў 襬㠯®«? Њ Ё«Ё † ???');
     writeln;
     goto 1;
   end;

   writeln('  ',i,'.3) „ в  а®¦¤Ґ­Ёп : ');

   2:
   write('           ‚ўҐ¤ЁвҐ ¬Ґбпж -> ');
   readln(d[i].month);
   if (d[i].month>12)or(d[i].month<1) then begin
     write('               ‚ Ј®¤г 12 ¬Ґбп楢,   ­Ґ ',d[i].month,';)');
     writeln;
     goto 2;
   end;

   3:
   write('           ‚ўҐ¤ЁвҐ ¤Ґ­м -> ');
   readln(d[i].day);
   if (d[i].month = 2)and((d[i].day>28)or(d[i].day<1)) then begin
     write('               ‚ дҐўа «Ґ ўбҐЈ® 28 ¤­Ґ©!');
     writeln;
     goto 3;
   end;
   if not (d[i].month = 2)and((d[i].day>31)or(d[i].day<1)) then begin
     write('               ‚ н⮬ ¬ҐбпжҐ 31 ¤Ґ­м!');
     writeln;
     goto 3;
   end;

   4:
   write('           ‚ўҐ¤ЁвҐ ѓ®¤ -> ');
   readln(d[i].year);
   if (d[i].year<1950)or(d[i].year>2000) then begin
     write('               !!! „®ЇгбвЁ¬л© ўў®¤ Ј®¤  1950-2000 !!!');
     writeln;
     goto 4;
   end;
   clrscr;
 end;

 writeln;
 write('** **');
 write('============‚ и  Ѓ §  „ ­­ле============');
 write('~~ ~~');

 for i:=1 to n do begin
   writeln('----------------------------------|',i,'-п § ЇЁбм|---------------------------------');
   writeln('      ” ¬Ё«Ёп: ',a[i].surname);
   writeln('          Џ®«: ',a[i].sex);
   writeln('„ в  а®¦¤Ґ­Ёп: ',d[i].day,' / ',d[i].month,' / ', d[i].year);
 end;

 Mold:=2001;
 for i:=1 to n do begin
   if (a[i].sex='¬')or(a[i].sex='Њ') then
   if d[i].year < Mold then Mold:=d[i].year;
 end;

 writeln;
 writeln('‘ ¬®¬г бв а襬㠬г¦зЁ­Ґ -> ',2003-Mold,' «Ґв');
 write('Џ®ЁбЄ Ї® д ¬Ё«Ёп¬. ЃгЄў : ');
 readln(ch);
 write('‚бҐ д ¬Ё«ЁЁ ­  ',ch,': ');

 for i:=1 to n do
   if a[i].surname[1] = ch then write(a[i].surname,' ');
 writeln;

 5:
 write('‚ўҐ¤ЁвҐ ¬Ґбпж: ');
 readln(m1);
 if (m1<1)or(m1>12) then begin
   writeln('‚ўҐ¤ЁвҐ Їа ўЁ«м­л© ¬Ґбпж!');
   goto 5;
 end
 else
   write('‘ЇЁб®Є தЁўиЁебп ў ',m1,'®¬ ¬ҐбпжҐ: ');

 for i:=1 to n do
   if d[i].month = m1 then write(a[i].surname,' ');
 readln;
end.

[trminator]

У тебя там в проверке in... были скобки пропущены. И еще: пожалуйста, перекодируй программу и ставь флажок "Пометьте это, если вы будете добавлять код (JS, например), или не любите смайлики"

Вот твоя программа. Она работает  :D

Код

uses
crt;
type
data = record
  day: 1..31;
     month: 1..12;
 year: 1980..1990;
end;

anketa = record
  surname: string;
      sex: char;
    birth: data;
end;

const
n = 2;

label
1,2,3,4,5;

var
d: array[1..n] of data;
a: array[1..n] of anketa;
m: set of 1..12;
i,m1,j: integer;
ch: string;
Mold: integer;

begin

  clrscr;

  for i:=1 to n do
   begin
  writeln;
  writeln;
  writeln;
  write('  ',i,'.1) Input surname -> ');
  readln(a[i].surname);
    1: write('  ',i,'.2) Input sex -> ');
  readln(a[i].sex);
   if not (a[i].sex in ['W','w','m','M']) then
     begin
     write(a[i].sex,' Input W, w, M or m');
     writeln;
     goto 1;
     end;
   writeln('  ',i,'.3) Birthday : ');
    2: write('      Input month -> ');
  readln(d[i].month);
   if (d[i].month>12)or(d[i].month<1) then
    begin
    write('      There is 12 months in year but not ',d[i].month,' ');
    writeln;
    goto 2;
    end;
    3: write('      Input day -> ');
  readln(d[i].day);
   if (d[i].month = 2)and((d[i].day>2)or(d[i].day<1)) then
    begin
    write('      д?ўа <? ўб??R 28 ¤-?c!');
    writeln;
    goto 3;
    end;
   if not (d[i].month = 2)and((d[i].day>31)or(d[i].day<1)) then
      begin
      write('      This month has 31 day!');
      writeln;
      goto 3;
      end;
    4: write('      Input year -> ');
  readln(d[i].year);
   if (d[i].year<1950)or(d[i].year>2000) then
    begin
    write('     !!! Input between 1950-2000      !!!');
    writeln;
    goto 4;
    end;
  clrscr;
 end;

writeln;
write('_________________________________________________________________ _______________');
write('~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~');
for i:=1 to n do
begin
writeln('----------------------------------|',i,'-st record|---------------------------------');
writeln(' Surname: ',a[i].surname);
writeln('     Sex: ',a[i].sex);
writeln('Birthday: ',d[i].day,' / ',d[i].month,' / ', d[i].year);
end;

  Mold:=2001;
   for i:=1 to n do
    begin
if (a[i].sex='m')or(a[i].sex='M') then
 if d[i].year < Mold then Mold:=d[i].year;
    end;

  writeln;
  writeln(' Oldest man is -> ',2003-Mold,' years old');
  write('Searchin surname. Input : ');
  readln(ch);
  write('Surnames -  ',ch,': ');

   for i:=1 to n do
    if a[i].surname = ch then write(a[i].surname,' ');

  writeln;
  5: write('Input month: ');
readln(m1);
 if (m1<1)or(m1>12) then begin
    writeln('Input correctly!');
   goto 5;
   end
   else
   write('Searching for birthday in ',m1,'month: ');

   for i:=1 to n do
    if d[i].month = m1 then write(a[i].surname,' ');

  readln;

end.

[Romario]

Действительно работает, спасибо! 8)

[Romario]

Может кто раздобрился и поможет мне решить остальные задачки? ??? :-/

[AlaRic]

21. Сформировать файл, имеющий следующую структуру
type книга=record автор:string;
название:string;
год издание:integer;
издательство:string;
количество страниц:integer;
end;
и определить:
o      есть ли в библиотеке книги данного автора;
o      найти книгу с наибольшим количеством страниц;
o      найти названия книг данного автора, изданных с указанного года, в данном издательстве.

22. Сформировать файл, имеющий следующую структуру
type знакомый=record фамилия:string;
номертел:10000..99999;
адрес:string;
end;
и определить:
o      есть ли в книжке телефон данного человека;
o      кому принадлежит данный телефон;
o      список людей, живущих на данной улице
...

Код

program number21;
const n=5;
type book=record
avtor:string;
name:string;
year:integer;
pub:string;
str:integer;
end;
var
mas:array[1..n] of book;
avtor2,pub2,avt:string;
pages,years,i:integer;
file1:file of book;
begin
assign(file1, 'C:Files2.txt');
rewrite(file1);
for i:=1 to n do
begin
writeln('автор'); readln(mas[i].avtor);
writeln('книга'); readln(mas[i].name);
writeln('год'); readln(mas[i].year);
writeln('издатель'); readln(mas[i].pub);
writeln('страницы'); readln(mas[i].str);
write(file1,mas[i]);
end;
writeln('фамилия автора'); readln(avt);
for i:=1 to n do
if avt=mas[i].avtor then writeln('книги есть');
pages:=mas[1].str;
for i:=2 to n do
if pages<mas[i].str then
begin
pages:=mas[i].str;
writeln('книга ',mas[i].name);
end;
writeln('издатель,автор,год');
readln(pub2); readln(avtor2); readln(years);
for i:=1 to n do
if (pub2=mas[i].pub) and (avtor2=mas[i].avtor) and (years<mas[i].year) then
begin
for i:=1 to n do
write(mas[i].name,' ');
end;
close(file1);
end.


program number22;
const n=5;
type friend=record
familia:string[20];
number:10000..99999;
adres:string;
end;
var
sup:array[1..n] of friend;
teleph,spisok:string;
i:integer;
teleph2:longint;
file1:file of friend;
begin
assign(file1, 'C:Files.txt');
rewrite(file1);
for i:=1 to n do
begin
writeln('фамилия'); readln(sup[i].familia);
writeln('телефон'); readln(sup[i].number);
writeln('адрес'); readln(sup[i].adres);
write(file1,sup[i]);
end;
writeln('ввести нужную фамилию'); readln(teleph);
for i:=1 to n do
if teleph=sup[i].familia then writeln(sup[i].number);
writeln('ввести нужный телефон'); readln(teleph2);
for i:=1 to n do
if teleph2=sup[i].number then writeln(sup[i].familia);
writeln('ввести нужную улицу'); readln(spisok);
for i:=1 to n do
if spisok=sup[i].adres then writeln(sup[i].familia);
close(file1);
end.

[AlaRic]

19. Сформировать файл, имеющий следующую структуру
type преподаватель=record фамилия:string;
предмет:string;
факультет:string;
курс:1..5;
количество часов:integer;
end;
и определить:
o      преподавателя имеющего самую большую нагрузку;
o      список предметов, которые читает данный преподаватель;
o      объем часов на данном факультете и данном курсе.

Код

program number19;
const n=5;
type prep=record
fam:string;
clas:string;
fak:string;
curs:1..5;
hour:integer;
end;
var
mas:array[1..n] of prep;
fam2,fak2:string;
grus,curs2,grus1,summa,i:integer;
file1:file of prep;
begin
assign(file1, 'C:Files3.txt');
rewrite(file1);
for i:=1 to n do
begin
writeln('фамилия'); readln(mas[i].fam);
writeln('предмет'); readln(mas[i].clas);
writeln('факультет'); readln(mas[i].fak);
writeln('курс'); readln(mas[i].curs);
writeln('часы'); readln(mas[i].hour);
write(file1,mas[i]);
end;
grus:=mas[1].hour;
for i:=2 to n do
if grus1<mas[i].hour then
grus1:=mas[i].hour;
writeln(mas[i].fam, ' - самый загруженный',grus1,' часов');
writeln('фамилия препода'); readln(fam2);
for i:=1 to n do
if fam2=mas[i].fam then
writeln(' ведет ',mas[i].clas);
writeln('факультет и курс'); readln(fak2); readln(curs2);
summa:=0;
for i:=1 to n do
if (fak2=mas[i].fak) and (curs2=mas[i].curs) then
summa:=summa+mas[i].hour;
writeln('кол-во часов: ',summa);
close(file1);
end.

[Romario]

Короче буду решать сам по задаче Сразу возникли вопросы  Вот задача:

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

Ввести матрицу, вывести и найти среднее арифметическое не сложно, проблема у меня возникла с этим : ВЫШЕ ГЛАВНОЙ ДИАГОНАЛИ... Я тут даже схему набросал

[img]www.rgweb.hut.ru/pascal/1.gif[/img]

ТАк вот подскажите алгоритм, как сказать компу, что плюсовал все положительные элементы которые СТОЯТ ВЫШЕ ГЛАВНОЙ ДИАГОНАЛИ...

[Alex]

if j>i then begin end;{j-столбец;i-строка}

[Alex]

Код

const n=5;
var a:array[1..n,1..n] of integer;
i,j,sum:integer;
begin
 sum:=0;
 for i:=1 to n do
   for j:=1 to n do begin
     write('a[i,j]=');
     readln(a[i,j]);
     if (j>i)and(a[i,j]>0) then sum:=sum+a[i,j];
   end;
 writeln('Сумма положительных эл выше глав диаг равна ',sum);
 readln
end.

[Romario]

хммм, всё оказалось так просто
Тогда вот задачка:
Дана матрица размерности N на M. Найти строку, в которой максимальный элемент минимален в соответствующем столбце.

Я решал так:

Код

uses crt;
const
 par = 2;                      
 rand = 6;                    
label
 1,2,3,4;
var
 matrix: array[1..10,1..10] of integer;
 i,j,r,t,m,n,s: integer;
 min,max: integer;

begin
 clrscr;
 writeln;
 writeln('                         Введите размер матрицы');
 write('    Строк - > ');
 readln(n);
 write(' Столбцов - > ');
 readln(m);
 writeln;
 writeln('                               Ввод матрицы');
 writeln('  Для ввода с клавиатуры нажмите - 1');
 writeln('   Для случайного ввода - 2');

 3: write(' -> ');
 readln(s);
 if (s<1)or(s>2) then goto 3;
 if s=1 then goto 1;
 if s=2 then goto 2;

 1: writeln;
 for i:=1 to n do
 for j:=1 to m do begin
   write('элемент [',i,',',j,'] -> ');
   readln(matrix[i,j]);
 end;
 goto 4;

 2: writeln;
 randomize;
 for i:=1 to n do
   for j:=1 to m do matrix[i,j]:=random(rand);

 4: writeln('                            Матрица');
 for i:=1 to n do
   for j:=1 to m do
     if j<m then write(matrix[i,j]:par)
     else writeln(matrix[i,j]:par);

 max:=matrix[1,1];
 for i:=1 to 1 do
   for j:=1 to m do
     if matrix[i,j]>max then begin
       max:=matrix[i,j];
       r:=j;
     end;

 min:=matrix[1,r];
 for i:=1 to n do
   for j:=r to r do
     if matrix[i,j]<min then min:=matrix[i,j];
 writeln;
 if max = min then writeln(' -> ',max)
 else begin
   writeln(' Такого нет...');
   writeln('   Max = ',max);
   writeln('   Min = ',min);
 end;

 writeln;
 write('Нажмите любую клавишу...');
 readkey;
end.

Хотелось бы узнать у проффесоналов насколько правильно и удобно я её написал да и работает она почему-то через раз... Может заодно ещё и поправите чего

[Romario]

Код

program number21;
const n=5;
type book=record
avtor:string;
name:string;
year:integer;
pub:string;
str:integer;
end;
var
mas:array[1..n] of book;
avtor2,pub2,avt:string;
pages,years,i:integer;
file1:file of book;
begin
assign(file1, 'C:Files2.txt');
rewrite(file1);
for i:=1 to n do
begin
writeln('автор'); readln(mas[i].avtor);
writeln('книга'); readln(mas[i].name);
writeln('год'); readln(mas[i].year);
writeln('издатель'); readln(mas[i].pub);
writeln('страницы'); readln(mas[i].str);
write(file1,mas[i]);
end;
writeln('фамилия автора'); readln(avt);
for i:=1 to n do
if avt=mas[i].avtor then writeln('книги есть');
pages:=mas[1].str;
for i:=2 to n do
if pages<mas[i].str then
begin
pages:=mas[i].str;
writeln('книга ',mas[i].name);
end;
writeln('издатель,автор,год');
readln(pub2); readln(avtor2); readln(years);
for i:=1 to n do
if (pub2=mas[i].pub) and (avtor2=mas[i].avtor) and (years<mas[i].year) then
begin
for i:=1 to n do
write(mas[i].name,' ');
end;
close(file1);
end.

У меня вопрос к этой задачке...
1) Как сделать так, чтобы в этом цикле:

Код

writeln('фамилия автора'); readln(avt);
for i:=1 to n do
 if avt=mas[i].avtor then writeln('книги есть');

если введена не существующая в базе фамилия, то выдавалась месага Такого автора в базе нет!
Понимаю, что в цикл включать нельзя, потому как он выдаст эту строку столько раз, сколько элементов =)))
2) Цикл нахождения книги, у которой наибольшее кол-во страниц считаю НЕВЕРНЫМ!

Код

pages:=mas[1].str;
for i:=2 to n do
 if pages<mas[i].str then begin
   pages:=mas[i].str;
   writeln('книга ',mas[i].name);
 end;

Почему цикл начинается со 2-го элемента, а если эта книга 1-й элемент? )))
3) Не объсянит ли мне автор эти строки:

Код

for i:=1 to n do
 if (pub2=mas[i].pub) and (avtor2=mas[i].avtor) and (years<mas[i].year) then begin
   for i:=1 to n do
     write(mas[i].name,' ');
   end;

Не могу понять... ввожу верные данные, но он ничего не выводит ((((((
4) Что означает в этом цикле:

Код

for i:=1 to n do begin
 writeln('автор'); readln(mas[i].avtor);
 writeln('книга'); readln(mas[i].name);
 writeln('год'); readln(mas[i].year);
 writeln('издатель'); readln(mas[i].pub);
 writeln('страницы'); readln(mas[i].str);
 write(file1,mas[i]);
end;

Строка write(file1,mas[i]);

Жду с нетерпением!

[AlaRic]

1) Как сделать так, чтобы в этом цикле:

writeln('фамилия автора'); readln(avt);
for i:=1 to n do
if avt=mas[i].avtor then writeln('книги есть');

если введена не существующая в базе фамилия, то выдавалась месага Такого автора в базе нет!
Понимаю, что в цикл включать нельзя, потому как он выдаст эту строку столько раз, сколько элементов =)))

if avt=mas[i].avtor then writeln('книги есть') else writeln('Автора нет');

2) Цикл нахождения книги, у которой наибольшее кол-во страниц считаю НЕВЕРНЫМ!

pages:=mas[1].str;
for i:=2 to n do
if pages<mas[i].str then
begin
pages:=mas[i].str;
writeln('книга ',mas[i].name);
end;

Почему цикл начинается со 2-го элемента, а если эта книга 1-й элемент? )))

Потому что мы присвоили pages значение первого элемента, а затем сравниваем это значение с остальными!

[AlaRic]

3) Не объсянит ли мне автор эти строки:
for i:=1 to n do
if (pub2=mas[i].pub) and (avtor2=mas[i].avtor) and (years<mas[i].year) then
begin
for i:=1 to n do
write(mas[i].name,' ');
end;
Не могу понять... ввожу верные данные, но он ничего не выводит ((((((

Найти название книг данного автора, изданных с указанного года в данном издательстве!

Что означает в этом цикле:

for i:=1 to n do
begin
writeln('автор'); readln(mas[i].avtor);
writeln('книга'); readln(mas[i].name);
writeln('год'); readln(mas[i].year);
writeln('издатель'); readln(mas[i].pub);
writeln('страницы'); readln(mas[i].str);
write(file1,mas[i]);
end;

Строка write(file1,mas[i]);

Запись в файл массива данных типа book!

[AlaRic]

Кстати обьясни 20 задачу - там два возраста каких-то!

[Alex]

Дана матрица размерности N на M. Найти строку, в которой максимальный элемент минимален в соответствующем столбце.

Romario, ты должен определить размер матрицы зарание
типа
const n=5;m=8;
но уж никак не

writeln('     Введите размер матрицы');
  write('    Строк - > ');
  readln(n);
  write(' Столбцов - > ');
  readln(m);

Так можно используя только динамические массивы.
Это пока одна ошибка, я лучше потом тебе текст проги приведу...

[Alex]

Да, и по возможности не используй метки!!!!!Плохое это дело и используется только в крайних случаях!!!!!!

[AlaRic]

Может у него крайний случай?
Хотя я метками кажется никогда не пользовался!

[Alex]

Там крайнего вообще ничего нет!

[Alex]

Дана матрица размерности N на M. Найти строку, в которой максимальный элемент минимален в соответствующем столбце.

Вот мое решение:

Код

uses crt;
const n=3;m=4;
var a:array[1..m,1..n] of integer;i,j,k,l,min,max,str:integer;
{k-номер столбца, где находится максимальный элемент строки}
begin
 ClrScr;
 for i:=1 to m do
   for j:=1 to n do begin
     write('a[',i,',',j,']=');
     readln(a[i,j]);
   end;

 for i:=1 to m do begin
   max:=a[i,1];
   for j:=1 to n do
     if a[i,j]>max then begin max:=a[i,j];k:=j end;
   min:=a[1,k];
   for l:=1 to n do
     if a[l,k]<min then min:=a[l,k];
   if min=max then begin str:=i;break;end;
 end;
 writeln('The number of needed string is ',str);
 readln
end.

Во-вторых твоя ошибка в том,что ты ищешь максимальный элемент во всей матрице, а надо в каждой строке!

[Romario]

Alex
а почему так нельзя?

Код

writeln('     Введите размер матрицы');  
  write('    Строк - > ');  
  readln(n);  
  write(' Столбцов - > ');  
  readln(m);

работает ведь

Да, и по возможности не используй метки!!!!!Плохое это дело и используется только в крайних случаях!!!!!!

Объясним мне кто-нить толком, почему не рекомендуется использоваться метками и чем тогда пользоваться?

AlaRic
Хрен его знает... обибка наверно, пусть будет 1 возраст
Ну я же спрашивал в массиве! А так, как ты сказал фигня получается...

Код

writeln('фамилия автора'); readln(avt);  
for i:=1 to n do  
if avt=mas[i].avtor then writeln('книги есть')
else writeln('Автора нет');  

Потому что мы присвоили pages значение первого элемента, а затем сравниваем это значение с остальными!

но не работает всё-равно - факт! Нужный элемент первый, а говорит, что такого нет

Запись в файл массива данных типа book!

т.е он записывает эти строки разом?

Код

writeln('автор'); readln(mas[i].avtor);  
writeln('книга'); readln(mas[i].name);  
writeln('год'); readln(mas[i].year);  
writeln('издатель'); readln(mas[i].pub);  
writeln('страницы'); readln(mas[i].str);