Помогите составить тексты программ на Turbo Pascal
Кто чем может помогите

прог1. Вычислить наибольший (наименьший) отрицательный элемент массива.
Пояснение: С клавиатуры вводится произвольный одномерный массив типа integer (не более 10 символов), после чего делается его контрольный вывод.
Переместите все положительные элементы массива в начало, а отрицательные в конец массива.

прог2. Вычислить средней арифметический положительный (отрицательный) элемент каждой строки (столбца) матрицы.
Пояснение: Матрица 5X5 после чего делается её контрольный вывод. Поменять местами максимальный элемент заданной строки с минимальным элементом заданного столбца матрицы.

прог3. Три точки заданы своими координатами (X1,X2), (Y1,Y2), (Z1,Z2) в новом квадрате определить и напечатать точку, для которой угол между осью ординат (Oy)
и лучом, соединяющего начало координат с точкой минимума.

прог4. Определить наибольшее количество идущих подряд пробелов.

прог5. Выбор студентов заданного пола, имеющих средний бал за сессию выше "4".
Пояснение: Даны пять записей, каждая из которых имеет 3 поля: группа, ФИО студента и оценка.

Заранее спасибо!

reper
прог4

CODE

program test_string; uses strings; var TestString:string; function findMaxSpace(var toTest:string):byte; const max:byte=0; current:byte=0; var i:byte; begin for i:= 1 to Length(toTest) do  if toTest[i]=' ' then                    inc(current)                   else                    if current>max then                                    begin                                     max:=current;                                     current:=0                                    end                                   else current:=0; FindMaxSpace:=max; end; BEGIN readln(TestString); writeln(findMaxSpace(TestString)); END.

Спасибо bestya
Ты меня выручил, а то меня препод достал, я их ему еще в марте обещал показать
Теперь обрадую старика хотябы одной прогой ::
Заходи почаще, у меня всегда много вопросов ::
Когда делать будет нечего, попробуй с другими прогами поработать! Я тебе тоже помогу чем смогу, обращайся если че

Да, кстате вопрос такой: почему некоторые программы не срабатывают хотя нет ошибок!!!
Например:

program Example_63;
uses crt,graph;
const a=-70;b=70; n=70;as=1;

var gd,gm,i,k:integer;
t1,t2,h,m:real;
x0,x1,y0,y1:word;
s3,s4:string;
function f(x:real):real;
begin
if x<>0 then f:=cos(x)/X;
end;
procedure grafun(x0,x1,y0,y1,n:word; a,b:real);
var x:real;
i,u,v,xv,yv:word;
s1,s2,as1:string;
begin

xv:=round(x0-a*t1); yv:=round((y0+y1)/2);
setcolor(11); rectangle(x0,y0,x0+1,y1);
rectangle(x0,y1+1,x1,y1);
str(a:1:1,s1);str(b:1:1,s2);
setcolor(11);
line(x0,y0,x0-5,y0+5);
line(x0+1,y0,x0+6,y0+5);
line(x1,y1,x1-5,y1-5);
line(x1,y1+1,x1-5,y1+6);
setcolor(10);
outtextxy(x0+8,y0,'F(бЁ« )');
outtextxy(x1-50,y1-15,'m(¬ бб )');
moveto(x0,yv-round(f(a)*t2));
SETCOLOR(13);
for i:=1 to 10 do
begin
line(x0+i*20,y0+20,x0+i*20,y1+5);
line(x0-5,y1-18*i,x1-20,y1-18*i);
end;
setcolor(10);
for i:=1 to n do
begin
x:=a+i*h; u:=x0+round((x-a)*t1);
v:=yv-round(f(x)*t2); lineto(u,v);
end;
end;
begin
k:=1;
clrscr;
write('vedi a=');
{readln(a);
writeln;
write('vedi b=');
readln(b );
writeln;
write('vedi n=');
readln(n); }
i:=0;
Initgraph(i,i,'g:\bgi');
x0:=50;x1:=285;y0:=240;y1:=470;{a:=-10;b:=10; }
setfillstyle(1,4); bar(x0-10,y0-10,x1+10,y1+10);
h:=(b-a)/n;
m:=abs(f(a));
for i:=1 to n do if m<abs(f(a+i*h)) then m:=abs(f(a+i*h));
str(m:1:1,s3);str(-m:1:1,s4);
setcolor(10);
{ outtextxy(x0,y0,s3);
outtextxy(x1,y0,s4); }
t1:=(x1-x0)/(b-a); t2:=(y1-y0)/(2*m);
{for k:=1 to 8 do
begin}

grafun(x0,x1,y0,y1,b,a,n);
{a1:=a1+0.5;f(a1,a);
end;}

repeat until keypressed;
closegraph;
end.

reper

QUOTE

CODE Initgraph(i,i,'g:\bgi');

'g:\bgi' это должен быть правильный путь до файла "EGAVGA.BGI",
попробуй замени на '' и скопируй файл EGAVGA.BGI в папку с откомпилированной программой или пропиши правильный путь.

bestya помоги разобраться с прогам
чего не хватает в прог №1
№1
for i:=1 to n do begin
if a[i]<min then min:=a[i];
if a[i]>max them max:=a[i];
end;
{поиск максимума\минимума}

i:=1; j:=n; {n-кол-во эл-тов}
repeat
n:=0;
if a[i]>0 then begin n:=n+1; i:=i+1; end;
if a[j]<0 then begin n:=n+1; j:=j-1; end;
if n=0 then begin x:=a[i]; a[i]:=a[j]; a[j]:=x; i:=i+1; j:=j-1; end;
until i<j;
for i:=1 to n do wrieln(a[i]); {вывод упорядоxенного массива}

А вот и прог №4 только в другом варианте
но почемуто прога не работает (она вообще будет работать? Что надо изменить?)

№4

var s:string;
i,j,max:chortint;
begin

j:=0; max:=0;
for i:=1 to s[0] do begin {s[0] первый байт строки в котором храниться дилна}
if ord(s[i])=32 then j:=j+1; {32 - код пробела в 10 кодировке}
if (ord(s[i])<>32)and(j>max) then begin max:=j; j:=0;end;
end;
readkey; end.

Как мне быть с другими прогами
Помогите мне пожалуйста

№1

CODE

uses crt; type arr=array [1..10] of integer; const n:byte=10; max:integer=0; min:integer=0; a:arr=(-2,-3,4,-1,2,-3,3,-89,2,-45); var i,j:byte; x:integer; BEGIN clrScr; for i:=1 to n do  begin   if a[i]<min then min:=a[i];   if a[i]>max then max:=a[i];  end; writeln('min=',min,' max=',max); for i:=1 to 10 do write(a[i],' '); WriteLn; i:=1; j:=n; while i<j do  begin   if a[i]>=0 then inc(i)              else               begin                x:=a[j];                a[j]:=a[i];                a[i]:=x;                dec(j);                if i<>1 then dec(i);               end;  end; for i:=1 to 10 do write(a[i],' '); END.

на ввод массива с клавиатуры, надеюсь переделаешь сам

№4

QUOTE

i,j,max:chortint;

скорее всего должно быть byte поскольку Shortint -128..127, а если у тебя в строке пробелов будет больше чем 127?

CODE

uses crt; {если используешь внешние функции, по не забывай подключать модули} var s:string;{Да и почему в программе у тебя нет ввода этой переменной?} i,j,max:byte; begin j:=0; max:=0; readln(s);{вводим строку с клавиатуры} for i:=1 to length(s) do   begin     {s[0] первый байт строки в котором храниться дилна}     {лучше используй фунцию length, наглядние и понятнее будет}     {иногда стоит использовать не только конструкцию if ... then , но и if  ...  then ...  else}         if ord(s[i])=32 then j:=j+1 {32 - код пробела в 10 кодировке}                            else                              if j>max then                                             begin                                               max:=j;                                               j:=0;                                             end                                           else j:=0;   end; writeln(max); readkey; end.

Используй отступы и пробелы, что бы проги были более наглядные и их проще было читать.

P.S. и начни наконец сам изучать язык, а то на экзамене препод все равно завалит

Вот тебе первая прога:

CODE

program Prog1;  uses CRT;  var Arr : array [1..10] of integer;      i, j, count, temp, min, max : integer;      FlagMin, FlagMax : boolean; BEGIN  ClrScr;  FlagMin := false;  FlagMax := false;  repeat    Write('Размер массива > ');    ReadLn(count);  until (count > 0) and (count <= 10);  for i:=1 to count do  begin    Write(i, '-й элемент массива > ');    ReadLn(Arr[i]);  end;  Write('Исходный массив :');  for i:=1 to count do Write(' ', Arr[i]);  WriteLn;  {Сортировка методом пузырька}  for i:=2 to count do    for j:=count downto i do      if Arr[j-1] < Arr[j] then      begin        temp := Arr[j-1];        Arr[j-1] := Arr[j];        Arr[j] := temp;      end;  Write('Отсортированный массив :');  for i:=1 to count do Write(' ', Arr[i]);  WriteLn;  if Arr[count] < 0 then  begin    min := Arr[count];    FlagMin := true;  end;  if Arr[1] < 0 then  begin    max := Arr[1];    FlagMax := true;  end;  for i:=2 to count do    if (Arr[i] < 0) and (Arr[i-1] >= 0) then    begin      max := Arr[i];      FlagMax := true;    end;  if FlagMin then WriteLn('Минимальный отрицательный элемент : ', min)    else WriteLn('Минимального отрицательного элемента не существует');  if FlagMax then WriteLn('Максимальный отрицательный элемент : ', max)    else WriteLn('Максимального отрицательного элемента не существует'); END.

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

QUOTE

прог3. Три точки заданы своими координатами (X1,X2), (Y1,Y2), (Z1,Z2) в новом квадрате определить и напечатать точку, для которой угол между осью ординат (Oy) и лучом, соединяющего начало координат с точкой минимума.

Бессвязный поток слов, объясни.
Добавлено:
О, первая прога у тебя уже есть, ну да ладно...

Обращение к bestya:
Спасибо за помощь
С четвертой прогой я разобрался!
Ну а на счет проги №1 не совсем ясно.

Ну а тебе Twizzted вопрос (в общем он для всех)
Запускаю значит я программу над которой ты трудился!
И вроде бы все нормально, но после ввода элементов массива программа прекращает свою работу
Чего ей еще не хватает?

Да, кстати bestya я уже второй месяц продолжаю пролистывать учебник Фаронова В.В. Turbo Pascal 7.0.
А ты бы, какой учебник посоветовал?

Так, я чуть не забыл! В проге №3 .........с точкой, минимальный. В смысле:

прог3. Три точки заданы своими координатами (X1,X2), (Y1,Y2), (Z1,Z2) в новом квадрате определить и напечатать точку, для которой угол между осью ординат (Oy)
и лучом, соединяющего начало координат с точкой, минимальный.
Как теперь? Возможно решить?

Хочу сказать еще немного о проге №3
Понятнее будет сказано так:

прог3. Три точки заданы своими координатами А(X1,У1), В(Х2,Y2), С(Х3,У3) в новом квадрате определить и напечатать точку, для которой угол между осью ординат (Oy)
и лучом, соединяющего начало координат с точкой, минимальный.

Теперь все понятно!!!

Только что разобрался с первой прогой.
перед END. надо readkey; вставить.
А как с другими (№2, №3,№5) ничего в голову не лезет, мож у кого есть какие то идеи!

reper

QUOTE

Только что разобрался с первой прогой. перед END. надо readkey; вставить.

Можешь просто в свойствах программы (экзешника) отключить опцию "Закрывать по завершению работы"

QUOTE

Только что разобрался с первой прогой. перед END. надо readkey; вставить.

Если прямо из редактора хочешь посмотреть результаты работы программы, то Alt+F5

Я сегодня добрый, вот написал тебе еще 5-ю прогу:

CODE

program Prog5;  uses CRT;  type TSex = (male, female);  student = record    group : string;    sex : TSex;    FIO : string;    mark : real;  end;  var Arr : array [1..5] of student;      ch : char;      s : TSex;      i : integer; BEGIN  Arr[1].group := 'VT-04';  Arr[1].sex := male;  Arr[1].FIO := 'Ivanov Ivan Ivanovich';  Arr[1].mark := 4.5;  {...}  ClrScr;  repeat    Write('Пол студента (м/ж) > ');    ReadLn(ch);  until ch in ['м', 'ж'];  if ch = 'м' then s := male    else s := female;  WriteLn('Студенты :');  for i := 1 to 5 do    if (Arr[i].sex = s) and (Arr[i].mark > 4) then      Write(Arr[i].FIO, ' ', Arr[i].group, ' - ', Arr[i].mark); END.

Вместо {...} вставишь аналогичные описания еще четырех студентов - Arr[2], ... , Arr[5]

Twizzted спасибо за твою доброту!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Но надеюсь на этом она не кончилась (У МЕНЯ ВСЕГО ЛИШЬ ДВЕ ПРОГИ ОСТАЛОСЬ, МОЖ ПОМОЖЕШЬ А?)
Кстати могу опять их перечислить (но только ради тебя) это №2, №3!

Смотрите что у меня есть!!!
Это же прога №2

uses crt;
var
a:array[1..5,1..5] of integer;
i,j,x,j1,i1,i2,j2,min,max:integer;
sred:real;
begin
textcolor(lightgreen);
clrscr;
randomize;
{§ Ї®«­Ґ­ЁҐ б«гз ©­л¬Ё зЁб« ¬Ё}
for i:=1 to 5 do
begin
for j:=1 to 5 do
begin
a[i,j]:=random(100)-50;
write(a[i,j]:4);
end;
writeln;
end;
writeln;writeln;

{б।­ҐҐ Ї® бва®Є ¬}
for i:=1 to 5 do
begin
sred:=0;
for j:=1 to 5 do
sred:=sred+a[i,j];
sred:=sred/5;
writeln('б।­ҐҐ §­ 祭ЁҐ ',i,' бва®ЄЁ= ',sred:3:0);
end;
writeln;

{бв।­ҐҐ Ї® бв®«Ўж ¬}
for j:=1 to 5 do
begin
sred:=0;
for i:=1 to 5 do
sred:=sred+a[i,j];
sred:=sred/5;
writeln('б।­ҐҐ §­ 祭ЁҐ ',j,' бв®«Ўж = ',sred:3:0);
end;
writeln;
readkey; {§ ¤Ґа¦Є ЇҐаҐ¤ ®зЁбвЄ®© нЄа ­ , ўҐ¤м ­Ґ Ї®¬Ґй Ґвбп}
clrscr;
for i:=1 to 5 do
begin
for j:=1 to 5 do
write(a[i,j]:4);
writeln;
end;
writeln; writeln;

{ᬥ­ ¬Ґбв???}
write('‚ўҐ¤Ё ­®¬Ґа бва®ЄЁ ');
readln(i);
max:=a[i,1];
i1:=i;
j1:=1;
for j:=1 to 5 do
if a[i,j]>max then
begin {б®еа ­Ґ­ЁҐ Ё­¤ҐЄб ¬ ЄбЁ¬ «м­®Ј® §­ 祭Ёп}
max:=a[i,j];
i1:=i;
j1:=j;
end;
writeln('¬ ЄбЁ¬ «м­®Ґ §­ 祭ЁҐ ',i,' бва®ЄЁ: ',max:3);

write('‚ўҐ¤Ё ­®¬Ґа бв®«Ўж ');
readln(j);
min:=a[1,j];
i2:=1;
j2:=2;
for i:=1 to 5 do
if a[i,j]<min then
begin
min:=a[i,j];
i2:=i;

j2:=j;

end;
writeln('¬Ё­ЁЁ¬ «м­®Ґ §­ 祭ЁҐ ',j,' бв®«Ўж : ',min:3);
writeln;


a[i1,j1]:=min;
writeln(i1,' ',j1); {¤«п Ў®«ҐҐ «ҐЈЄ®© Їа®ўҐаЄЁ}
a[i2,j2]:=max;
writeln(i2,' ',j2); {Ё §¤Ґбм ¤«п нв®Ј® ¦Ґ}

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

readkey;
end.

Осталась всего одна!!!!!!!!!!!
помогите мне с ней разобраться.
Я даже условие еще раз могу показать! Вот! Смотрите!

прог3. Три точки заданы своими координатами А(X1,У1), В(Х2,Y2), С(Х3,У3) в новом квадрате определить и напечатать точку, для которой угол между осью ординат (Oy)
и лучом, соединяющего начало координат с точкой, минимальный.

прог3. Три точки заданы своими координатами А(X1,У1), В(Х2,Y2), С(Х3,У3) в первом квадрате определить и напечатать точку, для которой угол между осью ординат (Oy)
и лучом, соединяющего начало координат с точкой, минимальный.

Назнаю даже как объяснить(на рисунке былоб понятнее), но попробую.
Зададим точке А значения Х1=2, У1=3, тогда угол между осью ординат(Оу) и лучем соединяющим точку А с началом координат можно найти по тангенсу угла
tg(угла)=Х1/У1 ,т.е. 2/3. Если точка В(Х2,У2) имеет координаты В(4,2), то tg(угла)=4/2, ну и т.д. Делаем вывод: чем меньше Х и больше У тем меньше угол.
Как только все это расписать в Паскале?

препод достал еще задал две проги сделать
Вот они:
new1. Вычислить значение функции F, при изменении любых двух аргументов по закону арифметической прогрессии (табулирование функции).
Значение аргумента выбрать самостоятельно из области допустимых значений таким образом, чтобы каждый из аргументов организовать в виде двух вложенных циклов с постусловием на внешнем цикле, с предусловием на внутреннем цикле.
Вот значение функции написаной на Паскале (где a и b константы a=2, b=3)
f:=4*x*sqrt(a)*ln(e*exp(-b*y*y/x))

new2. Объединение каждой последовательности пары строк в одну строку.
Пояснение: Составить программу обработки текстовых данных, хранящихся в произвольном файле на магнитном диске.
Текстовые данные во входном файле создаются с помощью текстового редактора, например, блокнота. Длина строки файла не должна превышать 80 символов. Текст исходного файла должен позволять тестировать программу в нормальных, граничных и исключительных условиях.

У кого какие предложения, пишите!

Ау! Народ вы где?
Я так сам все проги сделаю!

Кстати у меня уже есть прога new2.
Можете на ней не отвлекаться, ну а другие две все же лучше сделать!

Давайте не проходите момо!

Если кому то очень хочется посмотреть на прогу new2, то пишите(не напишите не покажу)!

QUOTE

Ау! Народ вы где?  Я так сам все проги сделаю!

А вот это действительно хорошая идея.

QUOTE

А вот это действительно хорошая идея.

Кому нечего делать посидите над этой прогой:

new1. Вычислить значение функции F, при изменении любых двух аргументов по закону арифметической прогрессии (табулирование функции).
Значение аргумента выбрать самостоятельно из области допустимых значений таким образом, чтобы каждый из аргументов организовать в виде двух вложенных циклов с постусловием на внешнем цикле, с предусловием на внутреннем цикле.
Вот значение функции написаной на Паскале (где a и b константы a=2, b=3)
f:=4*x*sqrt(a)*ln(e*exp(-b*y*y/x))

А остальные у меня есть!

Народ спасите!!!!!! не могу решить жуть а не прога!!


Вводные данные представляют собой последовательность целых чисел, состоящую из нескольких подпоследовательностей, каждая из которых заканчивается 0.(0 не принадлежит последовательности) Сформулируйте новую последовательность, в которой сохранен порядок следования подпоследовательностей, но внутри каждой подпоследовательности числа следуют в обратном порядке.
(например:
ввод:1 10 3 9 0 7 6 2 0 4 5 8 1 2 11 1 3 0
вывод:9 3 10 1 0 2 6 7 0 1 3 11 1 2 8 5 4 0)

Под рукой нет ни Турбо Паскаля фор Дос ни даже Делфи, отказался от них.
Могу только экспромтом:

CODE

{ вводите масив: a[i], где i=1,n } b : Array[1..20] of Integer; //Пробегаем весь массив a[i] до "0" формируя подмассив b[j] и выводим его наоборот. for i:=1 to n do begin j:=j+1; if(a[i] <> 0) b[j]:=a[i]; // формируем подмасив.  else   begin    //ну и выводим его наоборот.    while j<>0 do     begin      Write(b[j], ", ");      j:=j-1     end;   end; end;

Вроде правильно ...

Спасибо))
а можно еще написать как мне вводить этот массив из файла, он же из файла берется я правильно понимаю?
Числа же просто так не появятся)
заранее спасибо)

Mariana2

QUOTE

он же из файла берется

можно и из клавиатуры ввести.

можно расписать плиз? я в паскале дуб дубом, а надо очень)

CODE

Procedure Proc var n, i:Integer; a : Array[1..20] of Integer; b : Array[1..20] of Integer; begin Read('n=', n); for i:=1 to n do begin Read('a[',i,']=', a[i]); end; //Пробегаем весь массив a[i] до "0" формируя подмассив b[j] и выводим его наоборот. for i:=1 to n do begin j:=j+1; if(a[i] <> 0) b[j]:=a[i]; // формируем подмасив. else  begin   //ну и выводим его наоборот.   while j<>0 do    begin     Write(b[j], ", ");     j:=j-1    end;  end; end;

спасибо)))))))))))

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

Mariana2
А можно на С или на С++ написать ???

Хотя:

CODE

Var UserFile : Text;    FileName, TFile : String;   a : Array[1..20] of Integer;   i:Integer; Begin Writeln('Введите имя файла '+        +'(полный путь) только текстовый файл:'); readln(FileName); Assign(UserFile, FileName + '.txt'); Reset(UserFile); while not eof(UserFile) do begin   i:=i+1;   Readln(UserFile,a[i]); end; Close(UserFile); Readln; End.

Спа-си-бо!!!))))

Мне нужно на ТУРБОПАСКАЛЕ написать

пожалуйста напишите на этом языке

Привет!) Снова я) Нужна помощь в простой проге. Язык турбопаскаль.

В 1м файле 3 фамилии в другом 2, нужно объединить эти файлы и вывести на экран все фамилии

Mariana2
Госсподи, барышня, на кого Вы учитесь, надеюь не на it-специальности?
Простой запрос к гуглу "работа с файлами pascal" решит любые Ваши проблемы.

я учусь на эексперементатора физика ядерщика. с паскалем мы работаем так просто чтобы фигней по маяться. нас будут в дальнейшем обучать С и С++ с самых азов