Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 10.06.2010, 20:44   #1
Xenon0001
 
Регистрация: 10.06.2010
Сообщений: 3
По умолчанию Turbo Pascal. Прога с процедурами.

Никак не получается, пожалуйста помогите.

1.Дана целочисленная матрица М(6,6). Поменять местами строку с максимальным элементом на главной диагонали со столбцом с заданным номером m(m<6) Введите слово.Произведите обмен первого и последнего символов.
Код:
program MATRIX;
uses crt;
label 1;
const n=6;
var
  M:array[1..n,1..n] of integer;
  x,p,k,i,y,max:integer;
 A,B,S:string;
 begin
 clrscr;
 randomize;
 for i:=1 to n do
 begin
 for y:=1 to n do
 begin
 M[i,y]:=random(100);
 write(M[i,y]:5);
 end;
 writeln;
 end;
 max:=M[1,1];
 for i:=1 to n do
 if M[i,i]>max then
 begin
 max:=M[i,i];
 x:=i;
 end;
 1: write('vvedite nomer stolbca <',n);
 readln(k);
 if k>=n then goto 1;
 for i:=1 to n do
 begin
 p:=M[i,k];
 M[i,k]:=M[x,i];
 M[x,i]:=p;
 end;
 writeln('novaja matrica');
 for i:=1 to n do
 begin
 for y:=1 to n do
 write(M[i,y]:5);
 writeln;
 end;
 writeln('vvedite slovo');
 readln(S);
 A:=copy(S,1,1);
 delete(S,1,1);
 B:=copy(S,length(S),1);
 delete(S,length(S),1);
 S:=B+S+A;
 writeln(S);
 readln
 end.
2. Выполнить сортировку элементов, расположенных ниже главной диагонали матрицы по возрастанию. Определить является ли полученная последовательность неубывающей.
Код:
program SORT;
uses crt;
const n=6;
var
  M:array[1..n,1..n] of real;
  i,k,j:integer;
  x:array[1..30] of real;
  t:real;
 begin
 clrscr;
 randomize;
 for i:=1 to n do
 begin
 for j:=1 to n do
 begin
 M[i,j]:=random(10)*sin(i);
 write(M[i,j]:5:1);
 end;
 writeln;
 end;
 k:=0;
 for i:=1 to n do
 for j:=1 to n do
 if i>j then begin
 k:=k+1;
 x[k]:=M[i,j];
 end;
 for j:=1 to k-1 do
 for i:=1 to k-j do
 if x[i]>x[i+1] then
 begin
 t:=x[i];
 x[i]:=x[i+1];
 x[i+1]:=t;
 end;
 writeln('otsort.massiv');
 k:=0;
 for i:=1 to n do
 begin
 for j:=1 to n do
 begin
 if i>j then
 begin
 k:=k+1;
 M[i,j]:=x[k];
 end;
 write(M[i,j]:5:1);
 end;
 writeln;
 end;
 readln
 end.

3. Построить график в прямоугольной системе координат для функции y=cos x2-cosx
Код:
program grag;
uses graph;
const
xn=-2*pi;
xk=2*pi;
n=20000;
var
x,dx,y:Real;
gd,gm:Integer;
begin
gd:=detect;
Initgraph(gd,gm,'');
SetBkColor(3);
SetColor(White);
SetLineStyle(0,0,1);
ClearDevice;
Line(20,240,550,240);
line(545,235,550,240);
Line(545,245,550,240);
OutTextXY(555,250,'X');
Line(240,50,240,400);
line(235,55,240,50);
Line(245,55,240,50);
OutTextXY(250,50,'Y');
dx:=(xk-xn)/n;
x:=xn;
y:=cos(x*x)-cos(x);
PutPixel(240+round(x*25),240-round(y*100),5);
Repeat
x:=x+dx;
y:=cos(x*x)-cos(x);
SetColor(5);
putpixel(240+round(x*25),240-round(y*100),5);
until x>xk;
readln;
closegraph;
end.



Меню
Код:
program KurRab;
uses crt;
type
strmenu=record
x:integer;
s:string[14];
end;
const
kol=5;
mas:array [1..kol] of strmenu=
((x:6;s:'Ввод данных'),
(x:20;s:'Сортировка'),
(x:35;s: 'График'),
(x:45;s:'Вывод данных'),
(x:63;s:'Выход'));
var
i:integer;
n:integer;
ch:char;
pv:byte; {признак ввода}
M:array [1..6,1..6] of integer;
procedure inputDan;
var
n:byte;{пункт меню}
i,j:byte;
label M1;
begin
clrscr;
writeln ('1.ручной ввод');
writeln ('2.Автоматический ввод');
writeln ('3.выход в меню');
M1: writeln ('Введите пункт меню');
readln (n);
case n of
1:begin
writeln ('Введите элементы массива');
for i:=1 to 6 do
for j:=1 to 6 do
begin
write ('M[',i,',',j,']=');
readln( M [i,j]);
end;
pv:=1;
end;
2: begin
writeln('Автоматический ввод элементов массива');
randomize;
for i:=1 to 6 do
for j:=1 to 6 do
M [i,j]:=random (100);
pv:=1;
end;
3:Exit;
else
goto M1
end;
end;

procedure sortDan;
begin
end;
procedure grahpFun;
begin
end;
procedure outputDan;
begin
end;

begin
n:=1;
repeat
textattr:=7;
clrscr;
for i:=1 to kol do
begin
gotoxy (mas[i].x,3);
write (mas[i].s);
end;
 textattr:=87;
   gotoxy (mas[n].x,3);
 write (mas[n].s);
 ch:=readkey;
 case ch of
#13:case n of
 1:inputDan;
 2:sortDan;
 3:grahpfun;
 4:outputDan;
 end;
#0:begin
 ch:=readkey;
 case ch of
#77:
 if n<kol then
 n:=n+1
 else
 n:=1;
#75:
 if n>1 then
 n:=n-1
 else
 n:=kol;
 end;
 end;
 end;
 until (ch=#13)and (n=5)or(ch=#27);
 textattr:=7;
 clrscr;
 end.
Вставить в меню процедуру график, сортировки массива 1 задания, вывод полученной сортировки вывести в процедуру вывода данных.

Последний раз редактировалось Stilet; 11.06.2010 в 09:14.
Xenon0001 вне форума Ответить с цитированием
Старый 10.06.2010, 21:39   #2
Sibedir
Тот ещё
Старожил
 
Аватар для Sibedir
 
Регистрация: 14.11.2007
Сообщений: 2,242
По умолчанию

Цитата:
Поменять местами строку с максимальным элементом на главной диагонали со столбцом с заданным номером
Если m <> строке с максимальным элементом на главной диагонали неизбежно произойдет перемешивание.
Sibedir вне форума Ответить с цитированием
Старый 10.06.2010, 21:49   #3
Xenon0001
 
Регистрация: 10.06.2010
Сообщений: 3
По умолчанию

Пускай перемешивается, сортировку провести уже с полученным массивом.

надо хотя бы какую нибудь прогу получить на выходе.

Последний раз редактировалось Stilet; 11.06.2010 в 09:14.
Xenon0001 вне форума Ответить с цитированием
Старый 11.06.2010, 08:32   #4
Sibedir
Тот ещё
Старожил
 
Аватар для Sibedir
 
Регистрация: 14.11.2007
Сообщений: 2,242
По умолчанию

Код:
const
  N = 6;

var
  M: array [1..N,1..N] of Integer;
  col, row, _row, _col, val, i: Integer;
  A, B, S: string;

begin
  Randomize;
  for row:=1 to N do begin
    for col:=1 to N do begin
      M[col,row] := Random(100);
      Write (M[row,col]:5);
    end;
    writeln;
  end;

  val := M[1,1];
  for i := 1 to N do
    if M[i,i] > val then begin
      val := M[i,i];
      _row := i;
    end;

  _col := 0;
  while (_col < 1) or (_col > N) do begin
    Write ('vvedite nomer stolbca 0<k<',n, ': ');
    Readln (_col);
  end;

  for i := 1 to N do begin
    val := M[_row,i];
    M[_row,i] := M[i,_col];
    M[i,_col] := val;
  end;

  Writeln ('novaja matrica');
  for row := 1 to N do begin
    for col := 1 to N do
      Write (M[row,col]:5);
    Writeln;
  end;

  Writeln ('vvedite slovo');
  Readln (S);
  A := Copy (S,1,1);
  Delete (S,1,1);
  B := Copy (S,length(S),1);
  Delete (S,length(S),1);
  S := B + S + A;
  writeln(S);
  readln;
end.
Sibedir вне форума Ответить с цитированием
Старый 11.06.2010, 08:43   #5
VintProg
not
Участник клуба
 
Аватар для VintProg
 
Регистрация: 27.06.2009
Сообщений: 1,399
По умолчанию

Цитата:
Turbo Pascal. Прога с процедурами.
Конечно с процедурами, не без них же .
VintProg вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Turbo Pascal 7.0 @vror@ Помощь студентам 2 05.05.2010 16:58
Turbo Pascal 7.0 @vror@ Помощь студентам 2 05.05.2010 01:15
Turbo Pascal or Pascal ABC Ikram Паскаль, Turbo Pascal, PascalABC.NET 0 27.04.2010 13:44
а free pascal не читает задачи которые написаны на turbo pascal? demonara Паскаль, Turbo Pascal, PascalABC.NET 3 25.05.2009 16:28