задача на массивы

[maxwel6064]

Добрый день. нужна ваша помощь с решением нескольких похожих задач на массивы. Вот условие:


1). Ввести число n. Ввести последовательность этих чисел. В последовательности все члены, которые меньше наибольшего члена последовательности, увеличить в 2 раза. вывести полученную последовательность.
2) Ввести число n. Ввести последовательность этих чисел. вычислить, сколько цифр равны максимуму и сколько минимуму. Вывести числа, убрав равные максимуму и минимуму.

Заранее огромное спасибо за любое решение программ.

[Mad_Cat]

1). Ввести число n. Ввести последовательность этих чисел. В последовательности все члены, которые меньше наибольшего члена последовательности, увеличить в 2 раза. вывести полученную последовательность.

var i,im,n:integer;
a:array[1..20] of real;
begin
readln(n);
for i:=1 to n do
readln(a[i]);
im:=1;
for i:=2 to n do
if a[i]>a[im] then im:=i;
for i:=1 to n do begin
if a[i]<a[im] then a[i]:=a[i]*2;
write(a[i]:6:3);
end;
readln;
end.

[Poma][a]

Согласен. Только можно хранить не индекс массива, а его наибольший символ. Разницы не будет, только вместо a[im] будем писать m. Как-не-как экономия
И если автору нужно будет сделать массив вещественных чисел, то исправить одно слово - не проблема, а так наверно лучше писать Integer...

[maxwel6064]

Может кто может еще и вторую задачу решить?

[badnum23]

program Project2;

var
  i, n: Integer;
  a: array [1..100] of Integer;
  max, min, maxK, minK: Integer;

begin
  readLn(n);
  for i := 1 to n do
    readLn(a[i]);
  max := a[1];
  min := max;
  for i := 2 to n do
  begin
    if a[i] > max then max := a[i];
    if a[i] < min then min := a[i];
  end;
  maxK := 0;
  minK := 0;
  for i := 1 to n do
  begin
    if (a[i] <> max) and (a[i] <> min) then
      write(a[i], ' ')
    else if a[i] = max then
      inc(maxK)
    else if a[i] = min then
      inc(minK);
  end;
  writeLn;
  writeLn(maxK, ' ', minK);
  ReadLn;
end.