IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Задачка с шестеренками
straight edge
сообщение 12.04.2003 23:05
Сообщение #1


Гость






Такая вот задачка: Дана система шестеренок, т.е. для каждой шестеренки указано с какими она соединена. Необходимо определить будет ли она крутиться.
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов(1 - 9)
AlaRic
сообщение 13.04.2003 6:43
Сообщение #2


...
*****

Группа: Пользователи
Сообщений: 1 347
Пол: Мужской

Репутация: -  3  +


Помог бы, но с механикой у меня глухо!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
GLuk
сообщение 13.04.2003 7:33
Сообщение #3


Профи
****

Группа: Пользователи
Сообщений: 775
Пол: Мужской

Репутация: -  0  +


Описание расположения шестеренок в матрице? Или как-то еще???
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
reill
сообщение 13.04.2003 10:46
Сообщение #4


Пионер
**

Группа: Пользователи
Сообщений: 52

Репутация: -  0  +


Код
program shester;
begin
writeln('Все будет крутиться в любом случаи...');
end.



Можешь прям так и здавать.... ;D ;D ;D ;)

Сообщение отредактировано: volvo - 17.12.2004 11:39
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Clane
сообщение 14.04.2003 10:32
Сообщение #5


Гость






Цитата
program shester;
begin
writeln('Все будет крутиться в любом случаи...');
end.


Можешь прям так и здавать.... ;D ;D ;D ;)

Я думаю в Мифи это оценят :D
 К началу страницы 
+ Ответить 
reill
сообщение 14.04.2003 12:44
Сообщение #6


Пионер
**

Группа: Пользователи
Сообщений: 52

Репутация: -  0  +


Да это вообще универсальный вариант его везде оценят И соотвенно вознаградят по заслугам...
;D
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
trminator
сообщение 15.04.2003 9:18
Сообщение #7


Четыре квадратика
****

Группа: Пользователи
Сообщений: 579
Пол: Мужской

Репутация: -  4  +


Все строим граф Может, к завтрему гляну...


--------------------
Закон добровольного труда Зимерги:
Люди всегда согласны сделать работу, когда необходимость в этом уже отпала
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
trminator
сообщение 15.04.2003 18:45
Сообщение #8


Четыре квадратика
****

Группа: Пользователи
Сообщений: 579
Пол: Мужской

Репутация: -  4  +


Размеры шестеренок одинаковые или разные? Если не дано, наверно, одинаковые, тогда вроде все просто...


--------------------
Закон добровольного труда Зимерги:
Люди всегда согласны сделать работу, когда необходимость в этом уже отпала
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
trminator
сообщение 16.04.2003 9:16
Сообщение #9


Четыре квадратика
****

Группа: Пользователи
Сообщений: 579
Пол: Мужской

Репутация: -  4  +


Проверьте!!!
========================================
Код
program shesterenka;
var A: array[1..100,1..100] of Integer;  {Матрица смежности}
   B: array[0..100] of Integer;{В какую сторону крутится  i-я шестеренка}
   New: array[1..100]of boolean;  {Проходили ли уже эту шестеренку}
   i, j, n : integer;        {Всякие разные переменые}
   prev    : integer;        {В как сторону вертелась предыдущая}

procedure Stop(v:integer);
begin
 WriteLn('Противоречие на шестеренке #',v);
 halt
end;

function test(v:integer):boolean;
var i  :integer;
   pr :boolean;
begin pr:=true;
 for i:=1 to N do if A[v,i]=1 then
      if (B[i]<>B[prev])and(B[i]<>0) then pr:=false;
 test:=pr
end;

procedure Use(v:integer);
begin
 if test(v) then
    B[v]:=-B[prev]
 else Stop(v);
 prev:=v;
end;

procedure walk(v:integer);
var w:integer;
begin
 Use(v);
 New[v]:=false;
 for w:=1 to N do if (A[v,w]=1)and(New[w])then walk(w)
end;

begin
 Write('Input N: ');ReadLn(N);
 WriteLn('Input matrix');
 for i:=1 to N do
   for j:=1 to N do Read(A[i,j]);
 for i:=1 to n do begin
   B[i]:=0;{ничего не крутится}
   New[i]:=true
 end;

 prev:=0; B[prev]:=1;

 walk(1);  {Запускаем обход с 1-й шестеренки}

 j:=0;
 for i:=1 to N do if not new[i] then inc(j);
 if j=N then
    WriteLn('All Okay')
 else
    WriteLn('Что-то не соединено')
end.

====================================
Это если размеры одинаковые. Если разные, то вместо направления вращения надо записывать в массив B угловые скорости.
====================================
Вводить матрицу смежности для системы: если i соединена с j, то A[i,j]=1 иначе A[i,j]=-1

Сообщение отредактировано: volvo - 17.12.2004 11:40


--------------------
Закон добровольного труда Зимерги:
Люди всегда согласны сделать работу, когда необходимость в этом уже отпала
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
trminator
сообщение 20.04.2003 17:11
Сообщение #10


Четыре квадратика
****

Группа: Пользователи
Сообщений: 579
Пол: Мужской

Репутация: -  4  +


Ну так что - пошла прога или нет? Или я зря писАл? А то ни ответа, ни привета... Straight edge ты живой?


--------------------
Закон добровольного труда Зимерги:
Люди всегда согласны сделать работу, когда необходимость в этом уже отпала
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 



- Текстовая версия 23.06.2025 13:56
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"