Часовой пояс: UTC + 3 часа




Куратор(ы):   Lord_of_Darkness   



Начать новую тему Новая тема / Ответить на тему Ответить  Сообщений: 985 • Страница 17 из 50<  1 ... 14  15  16  17  18  19  20 ... 50  >
  Пред. тема | След. тема 
В случае проблем с отображением форума, отключите блокировщик рекламы
Автор Сообщение
 
Прилепленное (важное) сообщение

Убедительная просьба ко всем, кто выкладывает исходники:
1. Обязательно пользуйтесь тэгом code (иначе очень трудно читать)
2. Старайтесь делать отступы

Если вы хотите чтобы вам помогли в написании программы, внятно излагайте задание!

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


Возможно, что нужная вам программа уже написана, поэтому советую просмотреть список здесь и здесь

Отредактировано куратором: Lord_of_Darkness. Дата: 07.07.2006 19:36



Партнер
 

Куратор темы
Статус: Не в сети
Регистрация: 03.01.2004
Откуда: Питер
Rev@n ну это же элементарно...
Код:
const MaxArrayLength = 1000;
var
   A: array [1..MaxArrayLength] of integer;
   n, i: word;
begin
{ вводим массив }
  write('Введите n:');
  readln(n);
  for i:=1 to n do
  begin
     write('Введите A[',i,']: ');
     readln(A[i]);
  end;

{ задание №1 }
  writeln('Выборка №1');
  for i:=1 to n do
    if ((A[i] mod 2) <> 0) and (A[i]<0) then
       write('A[',i,']=',A[i],'; ');

  writeln;
  writeln('Выборка №2');
{ задание №2 }
  for i:=2 to n do
    if A[i]>A[i-1] then
       write('A[',i,']=',A[i],'; ');

  readln;
end;

_________________
Здесь так мало тех, с кем легко говорить,
Еще меньше тех, с кем не страшно молчать (c)


 

Member
Статус: Не в сети
Регистрация: 08.12.2005
Откуда: Smolensk
Lord_of_Darkness
Спасибо большое, просто конец сессии а с Pascal'ем запустил, сильно...((

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


 

Помогите с лабораторной на Pascal(TP7):
"Напечатать слова которые начиеаются и кончаются одной и той же буквой."
Я лично никак не могу понять как это сделать.


 

Member
Статус: Не в сети
Регистрация: 14.01.2004
Откуда: Киев, Украина
Kolar :weep:
Код:
var
  str: string
begin
  str := 'PoP';
  if (str[1] = str[length(str)]) then ...
 

_________________
Ку ку


 

Daemon писал(а):
Kolar

Да знаю. плохо у меня с программированием.
Огромная просьба напишите полный код. Пусть вводится одно слово и прога в зависимости от совпадение начала и конца выводит да или нет.
Отредактировано куратором: Lord_of_Darkness. Дата: 24.09.2006 1:04


 

Member
Статус: Не в сети
Регистрация: 10.03.2003
Откуда: Россия, Моск...
Код:
var
  str: string
begin
  str := 'PoP';
  if (str[1] = str[length(str)]) then
    Writeln('Da')
  Else
    Writeln('Net');
End.


 

Member
Статус: Не в сети
Регистрация: 05.12.2005
Kolar
Пиши:

Код:
Program zadanie;
var s:string
begin
readln(s);
if s[1]=str[length(s)] then writeln('Da') else writeln('Net');
end.

Он же просил
Kolar писал(а):
Пусть вводится одно слово
мало ли не знает как :).


 

Куратор темы
Статус: Не в сети
Регистрация: 03.01.2004
Откуда: Питер
млин, стоило отлучится на день города, и тут сразу такие вопросы... написал же, в ЛС или АСЮ - все объясню как надо, не засоряйте ветку такими вопросами!!!

_________________
Здесь так мало тех, с кем легко говорить,
Еще меньше тех, с кем не страшно молчать (c)


 

Member
Статус: Не в сети
Регистрация: 07.12.2005
Практика по программированию уже кончается, а задачи решить так и не могу (не один я такой тупой). Кто может помогите (из-за этих заданий зависит останусь ли я учиться дальше...): *В квадратных скобках обозначал индекс, например а[n] - это а энное.

1. Даны числовой ряд и некоторое число ε. Найти наименьший номер члена последовательности, для которого выполняется условие |a[n] - a| < ε. Вывести на экран этот номер и все эле-менты a[i], где I = 1, 2, … , n.

a[n]=x/(2*a[n-1]^x) a[1] = x.

2. Дана последовательность действительных чисел a[1], a[2], …, a[n]. Требутся домножить все члены последовательности a[1], a[2], …, a[n] на квадрат ее наименьшего члена, если a[k]≥0, и на квадрат ее наибольшего члена, если a[k] < 0 (1 ≤ k < n).

3. Дана действительная матрица размером n x m, все элементы которой различны. В каждой строке выбирается элемент с наименьшим значением, затем среди этих чисел выбирается наибольшее. Указать индексы элемента с найденным значением.

4. Дан текст из строчных латинских букв, за которыми сле-дует точка. Напечатать все буквы, входящие в текст не менее двух раз.

Первую нужно срочно решить. Осталось еще несколько, но вначале хотя бы эти...
Плиз, хелп! :weep:


 

Member
Статус: Не в сети
Регистрация: 20.12.2005
Откуда: Волгоград
1) Если этот символ есть «А», то задать матрицу X(N,N). Найти Min элемент среди всех элементов, находящиеся над главной диагональю и Max элемент среди всех элементов, находящихся под главной диагональю.

2) Если символ есть «С», то в заданных целочисленных массивах A(K), B(L) и C(M) найти и отписать номера тех элементов, значение которых равны нулю.

_________________
Все в этом Мире имеет какой то смысл. В нем нет ничего бесполезного или случайного...


 

Куратор темы
Статус: Не в сети
Регистрация: 03.01.2004
Откуда: Питер
Shagrath
№1
Код:
uses crt;
function power(num, pow : extended):extended;
begin
  power:=exp(ln(num)*pow);
end;

var
  A: array[1..1000] of extended;
  n, i: integer;
  x, eps, fa: real;
begin
  clrscr;
  write('x = ');
  readln(x);
  write('eps = ');
  readln(eps);
  write('a = ');
  readln(fa);
  A[1]:=x;
  n:=1;
  repeat
    inc(n);
    a[n]:=x/(2*power(a[n-1],x));
  until abs(a[n]-fa) < eps;

  writeln;
  for i:=1 to n do
    write('A[',i,'] = ',A[i]:10:7,' ');
  writeln;
  write('n = ',n);
  readln;
end.

по идее а (которое фигурирует в |a[n] - a| < ε) должно быть равно 0.

№2
Код:
const mn = 10;
var
   A: array[1..mn] of real;
   i: integer;
   min, max: real;
begin
   for i:=1 to mn do
   begin
       write('A[',i,'] = ');
       readln(A[i]);
       if i>1 then
       begin
          if A[i]>max then max:=A[i];
          if A[i]<min then min:=A[i];
       end
       else begin
           min:=A[i];
           max:=A[i];
       end;
   end;

   max:=sqr(max);
   min:=sqr(min);
   for i:=1 to nm do
     if A[i]>=0 then A[i]:=A[i]*min
     else A[i]:=A[i]*max;
end.

Добавлено спустя 8 минут, 29 секунд
№3
Код:
var
    A: array [1..n,1..m] of real;
    B: array [1..n] of real;
    min: real;
    i, j: integer;
 . . . . . . . . . . . . . . .
for i:=1 to n do
begin
  min:=A[i,1];
  for j:=1 to m do
    if A[i,j]<min then min:=A[i,j];
  B[i]:=min;
end;

min := B[1];
for i:=1 to n do
   if B[i]<min then min:=B[1];

for i:=1 to n do
  for j:=1 to m do
     if A[i,j]=min then
     begin
        write('min = ',min,' i=',i,' j=',j);
     end;


_________________
Здесь так мало тех, с кем легко говорить,
Еще меньше тех, с кем не страшно молчать (c)


 

Member
Статус: Не в сети
Регистрация: 07.12.2005
Lord_of_Darkness Огромное спасибо за эти три задачи! Очень выручил.
Сегодня препод придрался к тому, что не здал прошлые две задачки (мм... не врубаюсь). Вот, первую нужно как можно раньше, вторая вообще не понимаю, помогите:

1. Имеется часть катушки с автобусными билетами. Номер билета шестизначный. Составить программу, определяющую количество билетов на катушке, если меньший номер билета – N, больший номер билета - M (билет является счастливым, если сумма первых трех его цифр равна сумме последних трех).

2. Дана действительная матрица размером n x m. Требуется преобразовать матрицу следующим образом: поэлементно вычесть последнюю строку из всех строк, кроме последней.


 

Куратор темы
Статус: Не в сети
Регистрация: 03.01.2004
Откуда: Питер
№4
Код:
const
  offset = 96;
var
  symb: array [1..26] of word;
  text: string;
  i: word;

.....................

i:=1;
while s[i]<>'.' do
begin
   if (ORD(S[i])>=97) and (ORD(S[i])<=122) then
      inc(symb[ORD(S[i])-offset]);
end;

for i:=1 to 26 do
  if symb[i]>2 then
     write(CHR(i+offset),', '); 


новые:

№1
видимо нужно орпеделить не количество билетов, а количество счастливых билетов. это элементарно.
Код:
var
   tmp: array [1..6] of byte;
   i, j, tnum, LuckyCount: integer;
  ..............

LuckyCount:=0;
for i:=N to M do
begin
   tnum:=1000000;
   tmp[1]:=i div tnum;
   for j:=2 to 6 do
   begin
      tnum:=tnum/10;
      tmp[j]:=(i div tnum)-tmp[j-1]*10;
   end;
   if (tmp[1]+tmp[2]+tmp[3]=tmp[4]+tmp[5]+tmp[6]) then
        inc(LuckyCount);
end;


№2 ну тут уж совсем делать нечего.
Код:
for i:=1 to n-1 do
  for j:=1 to m do
     A[i,j]:=A[i,j]-A[n,j];

_________________
Здесь так мало тех, с кем легко говорить,
Еще меньше тех, с кем не страшно молчать (c)


 

Куратор темы
Статус: Не в сети
Регистрация: 03.01.2004
Откуда: Питер
GrifeX
Цитата:
Если этот символ есть «А», то задать матрицу X(N,N). Найти Min элемент среди всех элементов, находящиеся над главной диагональю и Max элемент среди всех элементов, находящихся под главной диагональю.

Код:
var
   i, j, k: integer;
   min, max: real;

for i:=1 to N do
  for j:=1 to N do
  begin
     write('X[',i,',',j,'] = ');
     readln(X[i,j]);
  end;

min:=X[1,N];
max:=X[N,1];

k:=1;
for i:=2 to N do
begin
  for j:=1 to k do
     if X[j,i]<min then X[j,i]:=min;
  inc(k);
end;

k:=2;
for i:=1 to N do
begin
  for j:=k to N do
     if X[j,i]>max then X[j,i]:=max;
  inc(k);
end;


Цитата:
Если символ есть «С», то в заданных целочисленных массивах A(K), B(L) и C(M) найти и отписать номера тех элементов, значение которых равны нулю.

тут вообще проще некуда.

Код:
write('A = ');
for i:=1 to k do
  if A[i]=0 then write(i,', ');

writeln;
write('B = ');
for i:=1 to L do
  if B[i]=0 then write(i,', ');

writeln;
write('C = ');
for i:=1 to M do
  if C[i]=0 then write(i,', ');

_________________
Здесь так мало тех, с кем легко говорить,
Еще меньше тех, с кем не страшно молчать (c)


Последний раз редактировалось Lord_of_Darkness 02.10.2006 0:56, всего редактировалось 2 раз(а).

 

Member
Статус: Не в сети
Регистрация: 07.12.2005
Lord_of_Darkness Чертовски благодарен. Спасли меня от провала!


 

Member
Статус: Не в сети
Регистрация: 07.12.2005
Вот, остались последние практические. Сдать эти задачки, и всё... Если можно, конечно... Надеюсь не выгонят:

1. Среди тех строк целочисленной матрицы, которые содер-жат только нечетные элементы, найти строку с максимальной суммой модулей элементов.
2. Определить, сколько раз в строке встречается заданное слово. {Задачку, вроде, решил, только не знаю как определять это слово, если после него в строке стоит запятая или точка... работает только с пробелом}
3. В задаче: "Имеется часть катушки с автобусными билетами. Номер билета шестизначный. Составить программу, определяющую количество счастливых билетов на катушке, если меньший номер билета – N, больший номер билета
M (билет является счастливым, если сумма первых трех его цифр равна сумме последних трех)." Нужно решить её обязательно с процедурой или функцией.. Завтра уже сдавать...


 

3. Навскидку. Может и некрасиво, но должно работать ;-)

Код:
Function Lucky(N,M:Integer):Integer;
Var
   I,J,Res,Left,Right,temp:Integer;
 
Begin
   For I:=N To M Do
      Begin
         temp := I;
         Right:=0;
         Left:=0;
         For J:=1 To 6 Do
            Begin
               ost:=temp mod 10;
               temp:=(temp-ost)/10;
               If J<=3 Then
                  Right:=Right+Ost
               Else
                  Left:=Left+Ost;
            End;
         If Left=Right Then
            Inc(Res);
      End;
   Lucky:=Res;
End;


 

Куратор темы
Статус: Не в сети
Регистрация: 03.01.2004
Откуда: Питер
Shagrath по второй - сделай массив-константу разделителей
Код:
const
  splitters: array [1..3] of char = (' ' , ',' , '.');

либо для простоты проверки так:
Код:
type
   TSplitters = set of char;
const
   Splitters: TSplitters = [' ' , ',' , '.'];
var
   AnyChar: char;
 . . . . .
  if AnyChar in Splitters then
    { это знак-разделитель }

остальное сейчас посмотрю.

_________________
Здесь так мало тех, с кем легко говорить,
Еще меньше тех, с кем не страшно молчать (c)


 

Lord_of_Darkness у кого код подсчета счастливых билетов быстрее? ;-)


 

Куратор темы
Статус: Не в сети
Регистрация: 03.01.2004
Откуда: Питер
Shagrath

Задача №1

Код:
uses crt;
const
  m = 5;
  n = 6;
var
  A: array [1..m,1..n] of integer;
  i, j, max, tempmax, index: integer;
  flag: boolean;
begin
  clrscr;
  randomize;
  for i:=1 to m do
  begin
    for j:=1 to n do
    begin
      A[i,j]:=random(20)-10;
      write(A[i,j], ' ');
    end;
    writeln;
  end;

  index:=0;
  for i:=1 to m do
  begin
    flag:=false;
    tempmax:=0;
    for j:=1 to n do
    begin
      if (A[i,j] mod 2) <> 0 then flag := true
      else flag := false;
      tempmax:=tempmax+abs(A[i,j]);
    end;
    if flag then
    begin
      max:=tempmax;
      index:=i;
    end;
  end;

  if index > 0 then
   write('номер строки ',index,', сумма = ',max)
  else
   write('нет строк, удовлетворяющих условию.');
  readln;
end.


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

_________________
Здесь так мало тех, с кем легко говорить,
Еще меньше тех, с кем не страшно молчать (c)


Показать сообщения за:  Поле сортировки  
Начать новую тему Новая тема / Ответить на тему Ответить  Сообщений: 985 • Страница 17 из 50<  1 ... 14  15  16  17  18  19  20 ... 50  >
-

Часовой пояс: UTC + 3 часа


Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 2


Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Перейти:  
Создано на основе phpBB® Forum Software © phpBB Group
Русская поддержка phpBB | Kolobok smiles © Aiwan