Массивы, строки, условные операторы ... Опции

[Насянечка]

№1последовательности действительных чисел a1,a2,…,an есть только положительные и отрицательные элементы. Вычислить произведение отрицательных элементов P1 и произведение положительных элементов P2.Сравнить модуль P2 с модулем P1,указать ,какое из произведений больше.
№2Дана строка содержащая текст,заканчивающийся точкой.Вывести на экран слова, содержащие три буквы.
№3Дана последовательность действительных чисел a1,a2,…,an.Заменить все её члены,большие данного Z ,этим числом.Подсчитать количество замен.
№4Даны действительные числа a,b,c .Удвоить эти числа ,если a>=b>=c , и заменить их абсолютными значениями ,если это не так.
№5Даны числовой ряд и некоторое число E.Найти сумму трех членов ряда,модуль которых больше или равен заданному Е.Общий член ряда имеет вид : An=n!/nn
№6 Составить программу ,которая проверяет,есть ли в списке L хотя бы два одинаковых элемента
№7составить программу для вычисления значений функций F(x) на отрезке (a,b) с шагом H .Результаты представить в виде таблиц ,первый столбец который-значения аргумента,второй-соответствующие значению функции.
№8Даны действительное число а и натуральное число n.вычислить P=(a(a+1)…(a+n-1)
№9 подсчитать количество отрицательных среди чисел a,b,c
помогите пожалуйста с решением задач

Добавлено через 5 мин.

Program Zadanie7;
Uses crt;
const n=5;
var a:array[1..n] of integer;
   i,p1,p2:integer;
   label start;
Begin
  clrscr;
  p1:=1;
  p2:=1;
  for i:=1 to n do
   begin
   Write('Vvedite chisla(cherez Enter)');
      readln(a[i]);
      if a[i]>0 then
       p1:=p1*a[i]
        else
         if a[i]<0 then
          p2:=p2*a[i]

   end;
   start:
   writeln;
   writeln('p1=',p1);
   writeln('p2=',p2);
   if abs(p1)>abs(p2) then
    writeln('|p1|>|p2|')
     else if abs(p2)>abs(p1) then
      writeln('|p2|>|p1|') else
       writeln('|p2|=|p1|');
   readln;
   end.

[klem4]

Насколько я понял, это код первой задачи, вроде все верно, единственное, зачем метка start ? Она не нужна, убери ее, ну и

 Write('Vvedite chisla(cherez Enter)');

я бы поменял на writeln и вынес из цикла, то есть

// ...
Writeln('Vvedite chisla(cherez Enter)'); 
for i:=1 to n do
   begin
      readln(a[i]);
      // ...
end;
// ...

[Насянечка]

по 7 проге...

var s1, s2, n:real
begin
readln (s1);{начало промежутка}
readln (s2);{конец промежутка}
readln (n);{шаг}
if s1>s2 then{проверка промежутка}
begin
 writeln ("Первое значение должно быть левее второго!");
 close;
end;
while s1<=s2 do{подсчет и вывод} 
begin
 write (s1);
 write (" ");
 write (s1*sin(s1));
 writeln;
 s1=s1+n;
end;
end.

Добавлено через 4 мин.
var s1, s2, n:real
begin
readln (s1);{начало промежутка}
readln (s2);{конец промежутка}
readln (n);{шаг}
if s1>s2 then{проверка промежутка}
begin
writeln ("Первое значение должно быть левее второго!");
close;
end;
while s1<=s2 do{подсчет и вывод}
begin
write (s1);
write (" ");
write (s1*sin(s1));
writeln;
s1=s1+n;
end;
end.

[klem4]

вот посмотри пример как это надо делать: Табулирование функции

для твоего случая измени функцию F на

function f(x : single) : single;
begin
   F := SIN(x);
end;

Поиск -> Табулирование функции ...

[Angellore]

Номер 4:

uses crt;
var a,b,c:integer;
begin
clrscr;
write('a: '); readln(a);
write('b: '); readln(b);
write('c: '); readln©;
if (b>=c) and (a>=b) then begin
                          writeln('a>=b>=c!. x2');
                          a:=2*a;
                          b:=2*b;
                          c:=2*c;
                          end
else begin
     a:=abs(a);
     b:=abs(b);
     c:=abs©;
     end;
writeln('a: ',a,' b: ',b,' c: ',c);
readkey;

end.

[Needhelp]

№3

Program Zadanie3;
Uses crt;
const n=5;
var a:array[1..n] of integer;
i,z,k : Integer;
begin
k:=0;
WriteLn('Vvedite z');
ReadLn(z);
for i:=1 to n do
begin
Write('Vvedite posledov-t (cheres Enter)');
Read(A[i]);
end;
for i:=1 to n do
begin
if a[i]>z then
begin
a[i]:=z;
k:=k+1;
end;
end;
WriteLn('Kolichestvo zamen',k);
end.
 

Мир не без добрых людей=)

[Angellore]

Номер 9:

uses crt;
var num,a,b,c:integer;
begin
clrscr;
write('a: '); readln(a);
write('b: '); readln(b);
write('c: '); readln©;
num:=0;
if a<0 then inc(num);
if b<0 then inc(num);
if c<0 then inc(num);
writeln('Число отрицательных элементов равно: ',num);
readkey;
end.

[klem4]

Angellore
В решении 4 задачи у тебя ошибка, для
a:1
b:2
c:3

должно выдавать
2
4
6
...

[Angellore]

Angellore
В решении 4 задачи у тебя ошибка, для
a:1
b:2
c:3

должно выдавать
2
4
6
...

1>=2>=3 ?

[klem4]

Извиняюсь, мой косяк, одним глазом на суловие посмотрел

[Angellore]

Номер 8:

uses crt;
var P,a,n,c:integer;
begin
clrscr;
write('a: '); readln(a);
write('n: '); readln(n);
c:=1;
p:=a;
while c<n do begin
             p:=p*(a+c);
             inc©;
end;
writeln('P now: ',P);
readkey;
end.

[Needhelp]

№2

 const
  delimiter = [#32, ',', '.', '!', ':'];
type
  wrd_info = record
    start, len: byte;
  end;

function get_words(s: string;
         var words: array of wrd_info): integer;
var
  count: integer;

  i, curr_len: byte;

begin
  count := -1; i := 1;
  while i <= length(s) do begin

 отсюда    while (s[i] in delimiter) and (i <= length(s)) do inc(i);

    curr_len := 0;
    while not (s[i] in delimiter) and (i <= length(s)) do begin
      inc(i); inc(curr_len);
    end;

    if curr_len > 0 then begin
      inc(count);
      with words[count] do begin
        start := i - curr_len;
        len := curr_len
      end;
    end;

  end;
  get_words := count + 1;
end;


const
  max_word = 255;
  z =3;
var
  words: array[1 .. max_word] of wrd_info;
  i, n: integer;

const
  s: string = 'thats all aall kol pol dol.';

begin
  n := get_words(s, words);
  writeln('words:');
  for i := 1 to n do
  if z=words[i].len then
  begin
    writeln(copy(s, words[i].start, words[i].len));
    end;
end.

Отсюда взял Разбиение на слова. Все способы. ...
Думать особо не надо=)

[klem4]

восьмая пожалуй так...

p := 1;
for i := 0 to n - 1 do
  p := p * (a + i);

[Angellore]

Я 8 выкладывал. Вроде, правильно
А вот 7, правда табличка дурацкая, и неудобная для дробных/больших значение, но это уже сама поправиш

uses crt;
var x2,a,b,i,x1,y1,H:integer;
function f(x: real):real;
begin
f:=x+3;
end;

begin
clrscr;
writeln('Enter a: '); readln(a);
writeln('Enter b: '); readln(b);
writeln('Enter H: '); readln(H);
clrscr;
x1:=7;
y1:=4;
gotoxy(1,4);
writeln('  x:');
gotoxy(1,3);
writeln('------------------------------------------------------');
gotoxy(1,5);
writeln('------------------------------------------------------');
gotoxy(1,7);
writeln('------------------------------------------------------');
gotoxy(1,6);
writeln('f(x):');
x2:=a;
while x2<=b do begin
              gotoxy(x1,y1);
              writeln(x2);
              gotoxy(x1,y1+2);
              writeln(f(x2):1 :0);
              inc(x1,3);
              inc(x2,H);
              end;

readkey;
end.

Сообщение отредактировано: Angellore - 17.04.2007 19:35

[klem4]

Angellore

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

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