Перейти к содержанию
Old Phone Forum
  • Вход

    Вы сейчас не залогинены на форуме.

    Для возможности комментариев, загрузки файлов, подписок на ответы - вам надо войти.

Пожалуйста помогите с информатикой!


BALTASITY

Рекомендуемые сообщения

Надо составить прогу помогите очень прошу!

Дано шестизначное число.Проверить является ли данное число перевертышем.

Заранее благодарен

Не завидуй,не упрекай и не жалуйся - и ты станешь хорошим человеком,поверь мне!

Ссылка на комментарий
Поделиться на другие сайты

Pascal

Не завидуй,не упрекай и не жалуйся - и ты станешь хорошим человеком,поверь мне!

Ссылка на комментарий
Поделиться на другие сайты

пусть число у нас в X, тогда пишем так:

 

X1:=int(X/1E5);
X2:=int(X/1E4) mod 10;
X3:=int(X/1E3) mod 10;
X4:=int(X/100) mod 10;
X5:=int(X/10) mod 10;
X6:=X mod 10;

if (X1=X6) and (X2=X5) and (X3=X4) then
<Условие выполняется>
else
<Условие не выполняется>

  • Like 3
Ссылка на комментарий
Поделиться на другие сайты

  • 1 месяц спустя...

Предыстория, кому интересно, о женской "дружбе" :44:Вот и будущему инженеру-механику самолетов и двигателей пришлось столкнуться с программированием на языке Pascal.

Но знания мои заканчиваются на школьном курсе информатике языка Basic и VisualBasik, которые я не жаловал то очень, хоть и пятерку получил в свое время.

А теперь к делу: моей девочке в институте на 4м курсе задали решить пять задач по программированию на языке Pascal. Я обращался к Alternative, который любезно помог мне и решил одну задачу. Он решил бы и остальные, я уверен, он начал даже изучать литературу в гугле, чтобы все вспомнить :) Но тут вмешалось оно - безответственность, я бы сказал: "Уже ничего не надо, спасибо твоему товарищу за задачу с шахматной доской, мне подруга остальные задачи решит и принесет". Ну и, естесственно, женская дружба не то, что мужская :67: Подруга подвела, моя просит помощи, а я как на зло, задуренный своими проблемами с учебой работой и морем факторов X, все забываю по объявлениям позвонить. А сдавать уже в пятницу. Т.е. до вечера четверга все должно быть готово. А кто так дела делает в спешке (кроме дорогих дам)? Сроки назвать точные, тоже кстати, не мог добиться от нее до вчерашнего дня, когда меня уже не на что не хватало и я в итоге я погрузился в сон за рабочим столом.

Нужно решить 4ре задачки по программированию на Pascal'е (задачу под номером 10, с расстановкой ферзей, любезно помог решить Alternative, за что ему огромное спасибо! :33: )

150292-20-05-10)1274299264_thumb.jpg

Эм a.k.a. m019m1

"Ничто не обходится нам так дёшево и не ценится другими так дорого, как вежливость." (с) Мигель де Сервантес Сааведра

"Побороть дурные привычки сегодня легче, чем завтра." (с) Конфуций

Ссылка на комментарий
Поделиться на другие сайты

FRAER, Ога, олимпиадные :arrow: Писал не сам, а нагуглил.. времени для собственного размышления нет.

11 задача:

Эта задача предлагалась не только на международной олимпиаде, но и на областной в Самаре,
несколько лет назад.
Первое решение, которое приходит в голову - рекурсия - неправильное. Здесь есть решение проще.
Для хранения треугольника заведем массив 100*100 (из элементов word, а почему не byte вы поймете позже), 
часть элементов которого останутся нулевыми. Начнем анализировать треугольник, двигаясь от предпоследней 
строки к первой (такой тип движения избавит нас от части частных случаев). Итак, смотрим на предпоследнюю
строку. У нее по диагонали снизу есть два соседа (в треугольном массиве это число которое находится на 1 
клетку ниже и число, на 1 клетку ниже и правее данного) - выберем из них наибольший и прибавим к значению 
элемента значение наибольшего из нижних соседей. Повторяя эту операцию для каждой строки до вершины и
для самой вершины, в вершине (элемент (1;1)) получим искомую сумму. Если бы мы двигались сверху вниз, то
возникал бы случай для крайних элементов, у которых всего один сосед.
Вот если бы нам надо было вывести маршрут, то было бы несколько сложнее, а так задача очень проста 
в реализации и несложна в понимании 

Имеется треугольник из чисел. Напишите программу, которая вычисляет наибольшую сумму чисел, 
расположенных на пути, начинающемся в верхней точке треугольника и заканчивающемся в основании
треугольника. (4 балла) 
Примечание: 
1. Каждый шаг на пути может осуществляться вниз по диагонали влево или вниз по диагонали вправо. 
2. Число строк в тругольнике > 1 и <= 100. 
3. Треугольник составлен из целых чисел от 0 до 99.

Входные данные: 
Вводятся с консоли. Сначала количество строк треугольника, а затем элементы каждой строки. 
Выходные данные: 
Выводятся на экран.
Пример: 
Исходные данные	Результат
Количество строк треугольника: 3	18
Элементы 1 -й строки: 7
Элементы 2 -й строки: 3
8
Элементы 3 -й строки: 8
1
0

Программный код 
Program Triangle;
const MaxRows = 100; {Максимальное количество строк и элементов}
type
TMatrix = array [1..MaxRows,1..MaxRows] of byte;
var
T: TMatrix;
Rows : byte;
Max: integer; 
{Ввод элементов массива} 
procedure Input(var Rows : byte; var T : TMatrix);
var i, j : byte;
begin
write('Введите количество строк треугольника:'); readln(Rows);
for i:=1 to Rows do begin
writeln('Введите элементы ',i,' -й строки:'); 
for j:=1 to i do readln(T[i,j]);
end;
end; 
{Максимальная сумма элементов, начиная с Т[r,c]}
function Summa(r, c : byte) : integer;
var
S1, S2 : integer;
begin
if r = Rows then {Если T[r,c] - последний элемент,}
Summa:=T[r,c] {то сумма равна этому элементу,}
else begin { иначе выбрать из сумм левой }
S1:=Summa(r+1,c); { и правой подчастей наибольшую }
S2:=Summa(r+1,c+1); { и сложить с этим элементом }
if S1>S2 then Summa:=T[r,c]+S1
else Summa:=T[r,c]+S2;
end;
end; 
begin
Input(Rows,T); 
Max:=Summa(1,1);
writeln('Максимальная сумма =',Max); readln;
end. 

9 задача:

{Quantity of Max Length Strictly Increasing Subchains}
{by Lapp for Olga}
const
 n=8;

var
 a,e:array[1..n]of integer;
 i,j,k,l,m,x:integer;
 Gr:boolean;

begin
 //Randomize;
 for i:=1 to n do begin
   a[i]:=Random(n);
   e[i]:=0;
   Write(a[i]:5)
 end;
 WriteLn;
 m:=1;
 k:=1;
 repeat
   i:=1;
   while e[i]=1 do if i<n then begin
     e[i]:=0;
     Inc(i)
   end
   else begin
     WriteLn('Max Length is ',m,',   total of ',k);
     ReadLn;
     Exit
   end;
   e[i]:=1;
   l:=1;
   Gr:=true;
   x:=i;
   for j:=i+1 to n do if e[j]=1 then begin
     Inc(l);
     if a[x]>=a[j] then Gr:=false else x:=j
   end;
   if Gr then if l>m then begin
     m:=l;
     k:=1
   end
   else if l=m then Inc(k)
 until false
end.

Комментарий модератора bboyshock
Немного отредактировал
Изменено пользователем bboyshock
  • Like 1

Обожаю свою жену Анюточку! =)

Ссылка на комментарий
Поделиться на другие сайты

7 задача:

Это переборная задача. Обратите внимание, что стороны квадрата могут 
и не быть параллельны осям координат! Каждую из N точек мы последовательно рассматриваем 
в качестве верхнего левого угла квадрата, каждую из оставшихся N-1 - как нижнюю правую 
вершины и смотрим, есть ли для них в этом множестве из N точек точки, с
оответствующие верхнему правому и нижнему левому углу. Если да, то подсчитываем, 
сколько точек лежат в данном квадрате.

Пусть координата левого верхнего угла (x1,y1), нижнего правого (x2,y2), 
тогда координата пересечения диагоналей четырехугольника ((x1+x2)/2,(y1+y2)/2); 
координата верхнего правого угла 

((x1+x2)/2+[y1-(y1+y2)/2],(y1+y2)/2+[x1-(x1+x2)/2])= =((x1+x2+y1-y2)/2, (x1-x2+y1+y2)/2),

нижнего левого - ((x1+x2-y1+y2)/2,(-x1+x2+y1+y2)/2)

(Постройте чертеж и проверьте !).

Для (x1,y2) и (x2,y2) должны выполняться следующие неравенства: 
x1<=x2, y1>=y2 (иначе это будут уже не левый верхний и правый нижний углы квадрата).

Проверка принадлежности точки фигуре - см. задачу 8.

Программа:
{В исходном множестве поочередно перебираются все пары точек.}
{Предполагая, что отрезок, соединяющий эти точки, является ребром}
{квадрата строим квадрат и смотрим, все ли его вершины имеются в}
{исходном множестве. Если все, то определяем, сколько точек из}
{исходного множества лежит внутри этого квадрата. Если это число}
{превосходит старый рекорд то запоминаем найденный квадрат.}
{ }
{$A-,B-,D-,E+,F-,I+,L-,N-,O-,R-,S-,V-}
{$M 65520,0,655360}
uses crt;
const
maxn = 100;{ Максимальное число точек }
type
xy = record x,y : real end; { Тип для записи координат точек }
var
m : array[1..maxn] of xy; { Координаты точек множества }
i,j,g,k,n,p : word; { вспомогательные переменные  }
num : word; { для записи числа точек в текущем квадрате }
rec : word; { для записи числа точек в лучшем квадрате }
a1,b1,c1 : real; { вспомогательные переменные  }
r,c : array[1..5] of xy;{ для записи вершин квадратов }
f1,f2 : boolean;
o : array[1..4] of shortint;
Function sign(a : real) : shortint;{ Функция signum }
begin
if a<0 then sign:=-1
else if a>0 then sign:=1
else sign:=0
end;
{ нахождение коэффициентов прямой, 
проходящей через точки x1,y1 и x2,y2 }
procedure getabc(x1,y1,x2,y2:real; var a,b,c:real);
begin
a:=y2-y1; b:=x1-x2; c:=-(a*x1+b*y1)
end;
begin
write('Введите число точек...'); readln(n);
for i:=1 to n do
begin
write('Введите координаты ',i,'-ой точки...');
readln(m[i].x,m[i].y); end;
rec:=0;{ Обнуление рекорда }
for i:=1 to n do
{ Перебор всех квадратов, для которых отрезок m[i]-m[j] }
for j:=1 to n do { является ребром }
if i<>j then
begin
c[1]:=m[i]; c[2]:=m[j];
{ Определение вершин квадрата } 
c[3].x:=c[2].x+(c[1].y-c[2].y);
c[3].y:=c[2].y+(c[2].x-c[1].x);
c[4].x:=c[1].x+(c[1].y-c[2].y);
c[4].y:=c[1].y+(c[2].x-c[1].x);
c[5]:=c[1];
num:=0;
{ Проверка на наличие всех вершин квадрата 
в исходном множестве точек }
f1:=false; f2:=false; 
for g:=1 to n do 
if (m[g].x=c[3].x) and (m[g].y=c[3].y) then f1:=true; 
for g:=1 to n do 
if (m[g].x=c[4].x) and (m[g].y=c[4].y) then f2:=true; 
if (c[1].x=c[2].x) and (c[1].y=c[2].y) then f1:=false;
if f1 and f2 then 
{Если все вершины квадрата есть в исходном множестве}
for k:=1 to n do { то определяем число точек в квадрате}
begin
for g:=1 to 4 do
begin
getabc(c[g].x,c[g].y,c[g+1].x,c[g+1].y,a1,b1,c1);
o[g]:=sign(a1*m[k].x+b1*m[k].y+c1);
end;
if ((o[1]=o[2]) and (o[2]=o[3]) and (o[3]=o[4])) or
((o[1]=o[2]) and (o[2]=o[3]) and (o[4]=0)) or 
((o[1]=o[2]) and (o[2]=o[4]) and (o[3]=0)) or 
((o[1]=o[3]) and (o[3]=o[4]) and (o[2]=0)) or 
((o[2]=o[3]) and (o[3]=o[4]) and (o[1]=0)) or 
((m[k].x=c[1].x) and (m[k].y=c[1].y)) or 
((m[k].x=c[2].x) and (m[k].y=c[2].y)) or ((m[k].x=c[3].x)
and (m[k].y=c[3].y)) or ((m[k].x=c[4].x) 
and (m[k].y=c[4].y)) then inc(num);
end;
if rec<num then begin r:=c; rec:=num end;
end;
if rec=0 then { Не найдено ни одного квадрата }
begin
writeln('Не найдено ни одного квадрата.'); halt
end;
{ Вывод результатов }
write('Лучший квадрат : ');
for i:=1 to 3 do write('(',r[i].x:2:2,')');

А вот 8-ю я найти не могу.. может кто напишет...

P.S. mk16-mag, в конце 7й задачи нужно добавить скорее всего end., просто на ресурсе, где я её нашел, было урезано так решение.

Изменено пользователем SantaX
  • Like 1

Обожаю свою жену Анюточку! =)

Ссылка на комментарий
Поделиться на другие сайты

7 задача

SantaX, огромное человеческое спасибо, за потраченное на помощь время. :arrow: Я тоже поищу, нашел интересный ресурс.

Удачи тебе на защите дипломного проекта!

  • Like 1

Эм a.k.a. m019m1

"Ничто не обходится нам так дёшево и не ценится другими так дорого, как вежливость." (с) Мигель де Сервантес Сааведра

"Побороть дурные привычки сегодня легче, чем завтра." (с) Конфуций

Ссылка на комментарий
Поделиться на другие сайты

ну, в принципе, как сделать восьмую, я себе представляю, если ничего не найдете, вечером может уделю чуть времени... :arrow:

  • Like 1
Ссылка на комментарий
Поделиться на другие сайты

ну, в принципе, как сделать восьмую, я себе представляю, если ничего не найдете, вечером может уделю чуть времени... :arrow:

Буду премного благодарен. Пока ничего толкового не нахожу, но набрел на объемный ресурс с задачами, которые встречаются в ЕГЭ.

P.s.: ну что, час-полтора поисков ничего не дал по последней задаче. Что-то я вообще себя глупым стал чувствовать, после начального уровня знакомства с программированием вновь.

FRAER, если у Вас будет время, то помогите, пожалуйста. :)

Изменено пользователем mk16-mag

Эм a.k.a. m019m1

"Ничто не обходится нам так дёшево и не ценится другими так дорого, как вежливость." (с) Мигель де Сервантес Сааведра

"Побороть дурные привычки сегодня легче, чем завтра." (с) Конфуций

Ссылка на комментарий
Поделиться на другие сайты

Задача оказалась и не такой уж сложной :arrow: :

program Project1;

{$APPTYPE CONSOLE}

var
 N:Longword;
 i,j,K,C:Byte;
 ND:array[1..8] of Byte;
 T,fact:Word;

begin
 Write('Input N=');
 ReadLn(N);

 K:=0;
 while N>0 do begin
   inc(K);
   ND[K]:=N mod 10;
   N:=N div 10
 end;

 T:=0;
 fact:=1;
 for i := 2 to K do begin
   C:=0;
   for j := 1 to i-1 do
     if ND[i]<ND[j] then
       inc©;
   fact:=fact*(i-1);
   T:=T+C*fact
 end;

 WriteLn('Total = ',T);

 ReadLn
end.

  • Like 1
Ссылка на комментарий
Поделиться на другие сайты

Ребята, спасибо за помощь и поддержку 8)

Очень рад, что вы согласились мне помочь. Не забуду вашей доброты! Еще раз спасибо. :)

Эм a.k.a. m019m1

"Ничто не обходится нам так дёшево и не ценится другими так дорого, как вежливость." (с) Мигель де Сервантес Сааведра

"Побороть дурные привычки сегодня легче, чем завтра." (с) Конфуций

Ссылка на комментарий
Поделиться на другие сайты

Для публикации сообщений создайте учётную запись или авторизуйтесь

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

Создать аккаунт

Зарегистрируйте новый аккаунт в нашем сообществе. Это очень просто!

Регистрация нового пользователя

Войти

Уже есть аккаунт? Войти в систему.

Войти


×
×
  • Создать...