Вопрос № 166316: Здравствуйте, уважаемые эксперты, очень надеюсь, что вы поможете в решении этой задачи - необходимо написать программу на языке Turbo Pascal. Суть задачи заключается в следующем - Даны несколько отрезков различной длины и две точки с координатами (x1...
Вопрос № 166369: Дан двумерный массив размерностью 4x6, заполненный целыми числами с клавиатуры. Сформировать одномерный массив, каждый элемент которого равен пер¬вому четному
элементу соответствующей строки, если такого нет, то равен нулю. помогите пожалуйста. пр...Вопрос № 166370: Здравствуйте, уважаемые эксперты. Очень вас прошу напишите пожалуйста комментарии к программе, реализующей игру "Сапер". Они там есть, просто нужны более подробные, потому что программа очень для меня сложная и многих условий и решени...
Вопрос № 166.316
Здравствуйте, уважаемые эксперты, очень надеюсь, что вы поможете в решении этой задачи - необходимо написать программу на языке Turbo Pascal. Суть задачи заключается в следующем - Даны несколько отрезков различной длины и две точки с координатами (x1, y1) и (x2, y2). Необходимо построить ломанную, звенья которой могут располагаться только параллельно осям координат, соединяющую эту пару точек, или вывести и сообщение, о том, что это сделать невозможно. Решение, продемонстрировать графически.
Отправлен: 02.05.2009, 19:41
Вопрос задал: Monoxpom (статус: Посетитель)
Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 6)
Отвечает: Зенченко Константин Николаевич
Здравствуйте, Monoxpom!
Смотрите приложение. Программа поочередно изменяет координату Х или У, и после суммирования длин всех отрезков проверяет совпадает ли конечная точка. Если совпала то показывает решение. Также проверяется правило ломаной = соседние отрезки не должны лежать на одной прямой. Сожалею, но не проверяется моменты, если отрезки имеют больше одной общей точки или общие начало и конец отрезков, поэтому иногда показываются
замкнутые области. Эксперементировал с А=1:1,В=3:7 и отрезками длиной: 2,1,2,1,2; 2,1,1,1,2,1,1,1,2; все по 3; 1,2,3,4,1,2,1,2. Вопросы задавайте в мини-форум. Удачи Вам.
Приложение:
Ответ отправил: Зенченко Константин Николаевич (статус: Профессор) Украина, Киев ---- Ответ отправлен: 05.05.2009, 20:41
Как сказать этому эксперту "спасибо"?
Отправить SMS
#thank 248683 на номер 1151 (Россия) | Еще номера >>
Вам помогли? Пожалуйста, поблагодарите эксперта за это!
Вопрос № 166.369
Дан двумерный массив размерностью 4x6, заполненный целыми числами с клавиатуры. Сформировать одномерный массив, каждый элемент которого равен пер¬вому четному элементу соответствующей строки, если такого нет, то равен нулю. помогите пожалуйста. проблема в том, что берется последний четный элемент каждой строки, а нужно первый. вот код: program name; uses crt; label 1; var a:array [1..2,1..2] of integer; c:array [1..6] of integer; i,j,k,x:integer; begin clrscr; for i:=1 to 2 do begin for
j:=1 to 2 do begin readln(a[i,j]); end; end; for i:=1 to 2 do begin for j:=1 to 2 do begin write (a[i,j], ' '); end; writeln; end; x:=1; for i:=1 to 2 do begin for j:=1 to 2 do begin end; if a[i,j] mod 2=0 then begin c[x]:=a[i,j];{inc(x);} end; end; writeln; for j:=1 to 2 do write(c[j],' '); end.
Отвечает: Тимошенко Дмитрий
Здравствуйте, Борисова Екатерина Андреевна!
Добавьте в ваше условие проверки на четность оператор break т.е. должно быть так if a[i,j] mod 2=0 then begin c[x]:=a[i,j]; inc(x); break; end; Да, и условие конечно же должно быть на строку выше, внутри цикла по j.
В этом случае первый же найденный четный элемент прервет цикл по строке и запомнит его в массиве. А по выходу из цикла по j вам нужно проверять, например, с помощью вашей переменной x был ли найден четный элемент и если нет, то добавлять
в массив 0. Например так if x=i then begin c[x]:=0; inc(x); end; Надеюсь понятно, изъяснил. Вопросы в форум.
Ответ отправил: Тимошенко Дмитрий (статус: 9-й класс)
Ответ отправлен: 03.05.2009, 20:44
Как сказать этому эксперту "спасибо"?
Отправить SMS
#thank 248588 на номер 1151 (Россия) | Еще номера >>
Вам помогли? Пожалуйста, поблагодарите эксперта за это!
Отвечает: Victor Pyrlik
Здравствуйте, Борисова Екатерина Андреевна!
не очень понятно условие - найти четный элемент в строке и перейти на другую, или взять первый элемент в строке и проверить его на четность? т.е. если надо найти первый элемент в строке - достаточно пройти в цикле (одном) 4 итерации - просмотреть все первые элементы каждой строки. Если надо в каждой строке найти четный (первый который встретится) элемент занести в массив и если нет в этой строке такого элемента то занести 0 и просмотреть следующую строку..
В
любом случае, размеры массивов у вас не верны. для массива 4 x 6 это будет a:array [1..4,1..6] of integer т.к. у нас 4 строки по 6 элементов в каждой строке. тогда, массив с = array[1..4] of integer т.к. всего по одному элементу может быть с каждой строки а строк всего 4
вот код для обоих вариантов, там 2 процедуры которые вызываются последовательно.. т.е. вводим 4 числа и нажимаем Enter примерно так: 1 2 2 4 5 6 <Enter> 2 5 6 8 4
7 <Enter> и так 4 раза для формирования массива 4 х 6
Код:
program name; uses crt; {Дан двумерный массив размерностью 4x6, заполненный целыми числами с клавиатуры. Сформировать одномерный массив, каждый элемент которого равен пер¬вому четному элементу соответствующей
строки, если такого нет, то равен нулю. помогите пожалуйста. проблема в том, что берется последний четный элемент каждой строки, а нужно первый.}
var a:array [1..4,1..6] of integer; // 4 строки по 6 чисел в каждой строке c:array [1..4] of integer; i,j:integer; s:string; // для первого варианта -------------------------------------------------------- procedure Solve1; begin for i:=1 to 4 do begin for j:=1 to 6 do
begin read(a[i,j]); end; end; writeln('--------------------'); for i:=1 to 4 do begin if a[1,i] mod 2=0 then c[i]:=a[1,i] else c[i]:= 0; end; writeln; for j:=1 to 4 do write(c[j],' '); readln(s); end; // для второго варианта ------------------------------------------------------- procedure Solve2; begin for i:=1 to 4 do begin for j:=1 to 6 do begin read(a[j,i]);
end; end; writeln('--------------------'); for i:=1 to 4 do begin for j:= 1 to 6 do begin if a[j,i] mod 2=0 then begin c[i]:=a[j,i];{inc(x);} break; end else c[i]:= 0; end; end; writeln; for j:=1 to 4 do writeln(c[j]);
end; // основная программа ---------------------------------------------------------- begin clrscr;
Solve1; writeln('--------------------'); Solve2; writeln('--------------------'); readln(); end.
--------- Жизнь игрушка – пока играешь сам..
Ответ отправил: Victor Pyrlik (статус: Профессионал) Россия, Екатеринбург Тел.: 89043822027 ICQ: 490191733 ---- Ответ отправлен: 03.05.2009, 22:35
Как сказать этому эксперту "спасибо"?
Отправить SMS
#thank 248593 на номер 1151 (Россия) | Еще номера >>
Вам помогли? Пожалуйста, поблагодарите эксперта за это!
Вопрос № 166.370
Здравствуйте, уважаемые эксперты. Очень вас прошу напишите пожалуйста комментарии к программе, реализующей игру "Сапер". Они там есть, просто нужны более подробные, потому что программа очень для меня сложная и многих условий и решений я там не пониммаю. Заранее спасибо...
Код:
Program
Mines; Uses CRT; {подключение библиотеки расширенного ввода-вывода} Const NR=10; NC=20; {размер поля NR строк и NC столбцов} NM=10; {количество мин} Type TMineMark=(mmClosed, mmOpened, mmMarked, mmSuspicious); TMineNumber=0..8; {количество мин}
TFieldCell = Record {тип-запись описывает структурированные переменные} Mine : Boolean; {наличие мины} Mark : TMineMark; {отметка} Around : TMineNumbe
r; {количество мин вокруг ячейки} End;
TMineField=Array[1..NR,1..NC] of TFieldCell; {поле, состоящее из NR-строк и NR-столбцов} Var Field:TMineField; X,Y,R:Integer; pc,sc:Char; {-----------------------------------------------------------------} Procedure InitField(var F:TMineField); {очистка игрового поля} Var i,j:Integer; Begin For i:=1 to NR Do For j:=1 to NC Do Begin {определение пустых ячеек по строкам и столбцам} F[i,j].Mine:=False;
{отсутствует мина} F[i,j].Mark:=mmClosed; {нет отметок} F[i,j].Around:=0; {количество мин вокруг ячеек равно 0, поэтому очищаем игровое поле} End; {закрытие цикла} End; {-----------------------------------------------------------------} Procedure FillMines(var F:TMineField); {расстановка мин} Var i,j,k,m:Integer; Begin For k:=1 to NM do Begin {при заданном количестве мин} m:=Random(NR*NC-k+1)+1; {определяем оставшееся к
оличество ячеек, при этом расстановка мин ведется произвольно} For i:=1 to NR Do For j:=1 to NC Do {по строкам и столбцам} If Not F[i,j].Mine Then Begin {нет мины} m:=m-1; {переходим дальше} If m=0 Then F[i,j].Mine:=True; {мина в ячейке, поэтому условие истинно} End; End; End; {-----------------------------------------------------------------} Procedure CountAround(var F:TMineField); {считать количество мин
вокруг ячеек} Var i,j,ii,jj:Integer; Begin For i:=1 to NR Do For j:=1 to NC Do If not F[i,j].Mine Then For ii:=-1 to 1 Do For jj:=-1 to 1 Do {обойти соседние ячейки} If (i+ii>=1) And (i+ii<=NR) And (j+jj>=1) And (j+jj<=NC) Then {если ячейка в пределах поля} If F[i+ii,j+jj].Mine Then F[i,j].Around:=F[i,j].Around+1; End; {---------------
--------------------------------------------------} Procedure OpenField(var F:TMineField; R,C:Integer); {открыть} Var i,j,ii,jj:Integer; Comp:Boolean; Begin If F[R,C].Mark=mmClosed Then F[R,C].Mark:=mmOpened; Repeat Comp:=True; For i:=1 to NR Do For j:=1 to NC Do If not F[i,j].Mine And (F[i,j].Mark=mmOpened) And (F[i,j].Around=0) Then For ii:=-1 to 1 Do For jj:=-1 to 1 Do If (i+ii>=1) And (i+ii<=NR) And
(j+jj>=1) And (j+jj<=NC) Then If F[i+ii,j+jj].Mark<>mmOpened Then Begin F[i+ii,j+jj].Mark:=mmOpened; Comp:=False; End; Until Comp; End; {-----------------------------------------------------------------} Function GameResult(var F:TMineField):Integer; Var i,j,R:Integer; {надо ли заканчивать игру} Begin R:=1; For i:=1 to NR Do For j:=1 to NC Do If R>=0 Th
en Begin If (F[i,j].Mark=mmClosed) And Not F[i,j].Mine Then R:=0; {Игру следует продолжить} If (F[i,j].Mark=mmOpened) And F[i,j].Mine Then R:=-1; {Игра проиграна} End; GameResult:=R; End; {-----------------------------------------------------------------} Procedure ShowGameField(var F:TMineField; ShowMines:Boolean); Var i,j:Integer; Begin Writeln; For i:=1 to NR Do Begin Writeln; For j:=1 to NC Do Begin Case
F[i,j].Mark Of mmClosed: If Not ShowMines Or Not F[i,j].Mine Then Write('#') Else Write('*'); mmOpened: If F[i,j].Mine Then Write('*') Else Begin If F[i,j].Around=0 Then Write(#32) Else Write(F[i,j].Around); End; mmMarked: Write('P'); mmSuspicious: Write('?'); End;
End; End; Writeln; End; {-----------------------------------------------------------------} Begin {осн.пр.} Randomize; InitField(Field); FillMines(Field); CountAround(Field); ClrScr; ShowGameField(Field,False); X:=1; Y:=1; Repeat GotoXY(X,Y+2); pc:=ReadKey; sc:=#0; If pc=#0 Then sc:=ReadKey; If pc<>#0 Then Begin case pc of #13: OpenField(Field,Y,X); #32: Case Field[Y,X].Mark of mmClosed: Field[Y,X].Mark:=mmMarked;
mmMarked: Field[Y,X].Mark:=mmSuspicious; mmSuspicious: Field[Y,X].Mark:=mmClosed; End; End; ClrScr; ShowGameField(Field,false); End; Case sc Of #75: If X>1 Then X:=X-1; #77: If X<NC Then X:=X+1; #72: If Y>1 Then Y:=Y-1; #80: If Y<NR Then Y:=Y+1; End; R:=GameResult(Field); Until (R<>0) Or (pc=#27); GotoXY(1,20);
If R=1 Then Writeln(‘Вы выиграли’); If R=-1 Then Begin ClrScr; ShowGameField(Field,True); Writeln (‘Вы проиграли’); End; End.
* Стоимость одного СМС-сообщения от 7.15 руб. и зависит от оператора сотовой связи.
(полный список тарифов)
** При ошибочном вводе номера ответа или текста #thank услуга считается оказанной, денежные средства не возвращаются.
*** Сумма выплаты эксперту-автору ответа расчитывается из суммы перечислений на портал от биллинговой компании.
