Перейти к содержанию

Задачи на Pascal/Delphi (РЕШЕНИЕ)

-makos-

Автор -makos-
в Программирование

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

SaS Восходящая звезда

SaS

Опубликовано
Опубликовано


var
i, j: integer;
s1: string;
begin
Result := '';
while (s <> '') do
begin
i := Pos(' ', s);
if (i > 0) then
begin
s1 := Copy(s, 1, i - 1);
Delete(s, 1, i);
end
else
begin
s1 := s;
s := '';
end;
j := Length(s1);
if (j > 1) then
Result := Result + Copy(s1, j div 2 + 1, Length(s1)) + Copy(s1, 1, j div 2)
else
Result := s1;
if (i > 0) then
Result := Result + ' ';
end;
end;
function myF(s: string): string;

это для дельфи

Чот пробовал подогнать, под паскль, но что то видимо пропустил, не работает.

Спс bayarookie.

SxLvn Энтузиаст

SxLvn

Опубликовано
Опубликовано

Помогите плиз срочно решить задачку, матрицу вообще забыл(

Дана действительная матрица размера M*N. Определить числа Х1,Х2,...,Хm, равные соответственно суммам наибольших и наименьших значений элементов строк.

SxLvn Энтузиаст

SxLvn

Опубликовано
Опубликовано


var
i, j: integer;
s1: string;
begin
Result := '';
while (s <> '') do
begin
i := Pos(' ', s);
if (i > 0) then
begin
s1 := Copy(s, 1, i - 1);
Delete(s, 1, i);
end
else
begin
s1 := s;
s := '';
end;
j := Length(s1);
if (j > 1) then
Result := Result + Copy(s1, j div 2 + 1, Length(s1)) + Copy(s1, 1, j div 2)
else
Result := s1;
if (i > 0) then
Result := Result + ' ';
end;
end;
function myF(s: string): string;

это для дельфи

Чот пробовал подогнать, под паскль, но что то видимо пропустил, не работает.

Спс bayarookie.

Паскаль:

program stroka;
uses crt;
var
  i, j: integer;
  s1,s,result: string;
begin
  clrscr;
  writeln('vvedite stroky');
  readln(s);
  Result := '';
  while (s <> '') do
  begin
    i := Pos(' ', s);
    if (i > 0) then
    begin
      s1 := Copy(s, 1, i - 1);
      Delete(s, 1, i);
    end
    else
    begin
      s1 := s;
      s := '';
    end;
    j := Length(s1);
    if (j > 1) then
      Result := Result + Copy(s1, j div 2 + 1, Length(s1)) + Copy(s1, 1, j div 2)
    else
      Result := s1;
    if (i > 0) then
      Result := Result + ' ';
  end;
  writeln(result);
  readkey;
end.

Lakers Восходящая звезда

Lakers

Опубликовано
Опубликовано

SxLvn

uses crt;

var i,j,n,m:integer;

a:array[1..20,1..20]of integer;

function min(i:integer):integer;

var j,w:integer;

begin

w:=a[i,1];

for j:=2 to m do if a[i,j]

min:=w;

end;

function max(i:integer):integer;

var j,w:integer;

begin

w:=a[i,1];

for j:=2 to m do if a[i,j]>w then w:=a[i,j];

max:=w;

end;

begin

clrscr;

write('N= ');readln(n);

write('M= ');readln(m);

randomize;

for i:=1 to n do

for j:=1 to m do

a[i,j]:=random(100);

for i:=1 to n do begin

for j:=1 to m do

write(a[i,j]:4);

writeln;

end;

for i:=1 to n do begin

writeln(min(i)+max(i));

end;

readkey;

end.

Добавлено спустя 16 минут 20 секунд:

Скиф

program D_Andre;

type Pere=array [1..10] of byte;

var N,i,j:byte;

X:Pere;

Yes:boolean;

procedure Next(var X:Pere;var Yes:boolean);

var i:byte;

procedure Swap(var a,b:byte); {обмен переменных}

var c:byte;

begin c:=a;a:=b;b:=c end;

begin

i:=N-1;

while (i>0)and(X>X[i+1]) do dec(i);

if i>0 then

begin

j:=i+1;

while (jX) do inc(j);

Swap(X,X[j]);

for j:=i+1 to (N+i) div 2 do Swap(X[j],X[N-j+i+1]);

Yes:=true

end

else Yes:=false

end;

function pro:boolean;

var i:integer;

f:boolean;

begin

f:=true;

for i:=1 to n-1 do

begin

if i mod 2=1 then

begin

if x>x[i+1] then f:=false;

end

else

begin

if x

end;

end;

pro:=f;

end;

begin

assign(input,'p.txt');

reset(input);

assign(output,'p_OUT.txt');

rewrite(output);

readln(n);

for i:=1 to N do X:=i;

repeat

if pro then begin for i:=1 to N do write(X);writeln;end;

Next(X,Yes)

until not Yes;

close(output);

end.

создаш файл "p.txt" туда запишеш 7.

PapiruS Костяк

PapiruS

Опубликовано
Опубликовано


var
x, y, z: real;
i, j: integer;

begin
x := 0;
while x < 0.99998 do
begin
x := x + 0.00001;
y := x;
i := 1;
j := 1;
while true do
begin
i := i + 2;
j := j * -1;
z := Power(x, i) / i;
if z < 0.00001 then Break;
y := y + j * z;
end;
writeln(' x = ', x:1:5, ' y = ', y:6:4, ' = ', ArcTan(x):6:4);
end;
end.
может и нагнал чего-то, перепроверь
спс за решение но мне надо для блок схемы,мб переделаешь?



			
		


		

		
			

		
	


	
    



	




					
					
					
				

					

					
					







					
					
					
				

					

					
					







	

	

	

		

			

				


	
		PapiruS
	

				
				
					
						
Костяк
					
				
			

		

		

			

				


PapiruS
			

			

			    Опубликовано 
				
			

		

	

	
	

		




	

		

			

				
    
					
					
					
					
					
				

			

			
		


		

		   
		   Опубликовано 
		   
			
			
				
				
			
		

	


	

    

	

		
		

			

bayarookie
это кароче где в прямоугольничках да в овальчиках пишется алгоритм программы.
просто напиши решение мне на паскале но без функций там всяких и процедур. чтоб были простые условия да присваяивания



			
		


		

		
			

		
	


	
    



	




					
					
					
				

					

					
					







	

	

	

		

			

				


	
		Lakers
	

				
				
					
						
Восходящая звезда
					
				
			

		

		

			

				


Lakers
			

			

			    Опубликовано 
				
			

		

	

	
	

		




	

		

			

				
    
					
					
					
					
					
				

			

			
		


		

		   
		   Опубликовано 
		   
			
			
				
				
			
		

	


	

    

	

		
		

			

PapiruS
вообщето она вот так решается=)
uses crt;
const e=0.00001;
var x,y,m:real;
i,k,l:integer;
begin
clrscr;
write('vvedite x= ');readln(x);
k:=1;
y:=0;
l:=0;
m:=x;
while m>e do begin
inc(l);
m:=x;
for i:=1 to k-1 do m:=m*x;
m:=m/k;
if l mod 2 =0 then y:=y+m else y:=y-m;
k:=k+2;
end;
writeln('Y= ',y:0:5);
writeln('arctan= ',arctan(x):0:6);
readkey;
end.



			
		


		

		
			

		
	


	
    



	




					
					
					
				

					

					
					







					
					
					
				

					

					
					







					
					
					
				

					

					
					







	

	

	

		

			

				


	
		Rush-j
	

				
				
					
						
Интересующийся
					
				
			

		

		

			

				


Rush-j
			

			

			    Опубликовано 
				
			

		

	

	
	

		




	

		

			

				
    
					
					
					
					
					
				

			

			
		


		

		   
		   Опубликовано 
		   
			
			
				
				
			
		

	


	

    

	

		
		

			

Пожалуйста помогите мне решить задачу на паскале
Задача. День рождения.
заданы день и месяц рождения, а также текущие день, месяц и год. Определите, сколько дней осталось до дня рождения.
Примечание. Високосные годы - это те, которые делятся на 400, а также те, номер которых делится на 4, но не делится на 100.
Ограничения: год от 1920 до 3000, месяц - от 1 до 12, день - от 1 до числа дней в месяце.



			
		


		

		
	


	
    



	




					
					
					
				

					

					
					







	

	

	

		

			

				


	
		bayarookie
	

				
				
					
						
Костяк
					
				
			

		

		

			

				


bayarookie
			

			

			    Опубликовано 
				
			

		

	

	
	

		




	

		

			

				
    
					
					
					
					
					
				

			

			
		


		

		   
		   Опубликовано 
		   
			
			
				
				
			
		

	


	

    

	

		
		

			

для дельфи просто:
var
  y, m, d: word;
begin
  DecodeDate(Now, y, m, d);
  writeln('enter day and month');
  readln(d, m);
  writeln(Trunc(EncodeDate(y, m, d)) - Trunc(Now));
или нужно разработать код низкоуровневый?



			
		


		

		
			

		
	


	
    



	




					
					
					
				

					

					
					







					
					
					
				

					

					
					







	

	

	

		

			

				


	
		bayarookie
	

				
				
					
						
Костяк
					
				
			

		

		

			

				


bayarookie
			

			

			    Опубликовано 
				
			

		

	

	
	

		




	

		

			

				
    
					
					
					
					
					
				

			

			
		


		

		   
		   Опубликовано 
		   
			
			
				
				
			
		

	


	

    

	

		
		

			

вот фигня же этот паскаль:


uses WinCrt;

var
  d1, m1, y1, d2, m2, i, j, d3: word;
  m3: array [1..12] of word;

begin
  writeln('Enter current day month year');
  readln(d1, m1, y1);
  writeln('enter day and month of birthday');
  readln(d2, m2);
  m3[1] := 31;
  if (m1 > m2) or ((m1 = m2) and (d1 > d2)) then
    y1 := y1 + 1;
  if (y1 div 4) = (y1 / 4) then
    m3[2] := 29
  else
    m3[2] := 28;
  m3[3] := 31;
  m3[4] := 30;
  m3[5] := 31;
  m3[6] := 30;
  m3[7] := 31;
  m3[8] := 31;
  m3[9] := 30;
  m3[10] := 31;
  m3[11] := 30;
  m3[12] := 31;
  if (m1 = m2) and (d1 <= d2) then
    d3 := d2 - d1
  else
  begin
    d3 := m3[m1] - d1;
    for i := 1 to 12 do
    begin
      j := m1 + i;
      if (j > 12) then
        j := j - 12;
      if (j = m2) then Break;
      d3 := d3 + m3[j];
    end;
    d3 := d3 + d2;
  end;
  writeln('remaining days: ', d3);
end.
program den_r;
Добавлено спустя 4 минуты 55 секунд:
и не забудь проверить, так как материально не заинтересован, то могу и неправильно сделать



			
		


		

		
			

		
	


	
    



	




					
					
					
				

					

					
					







					
					
					
				

					

					
					







	

	

	

		

			

				


	
		SaS
	

				
				
					
						
Восходящая звезда
					
				
			

		

		

			

				


SaS
			

			

			    Опубликовано 
				
			

		

	

	
	

		




	

		

			

				
    
					
					
					
					
					
				

			

			
		


		

		   
		   Опубликовано 
		   
			
			
				
				
			
		

	


	

    

	

		
		

			


var
  i, j: integer;
  s1: string;
begin
  Result := '';
  while (s <> '') do
  begin
    i := Pos(' ', s);
    if (i > 0) then
    begin
      s1 := Copy(s, 1, i - 1);
      Delete(s, 1, i);
    end
    else
    begin
      s1 := s;
      s := '';
    end;
    j := Length(s1);
    if (j > 1) then
      Result := Result + Copy(s1, j div 2 + 1, Length(s1)) + Copy(s1, 1, j div 2)
    else
      Result := s1;
    if (i > 0) then
      Result := Result + ' ';
  end;
end;
function myF(s: string): string;
это для дельфи
А в паскале тоже можеш, если нетрудно???



			
		


		

		
	


	
    



	




					
					
					
				

					

					
					







	

	

	

		

			

				


	
		bayarookie
	

				
				
					
						
Костяк
					
				
			

		

		

			

				


bayarookie
			

			

			    Опубликовано 
				
			

		

	

	
	

		




	

		

			

				
    
					
					
					
					
					
				

			

			
		


		

		   
		   Опубликовано 
		   
			
			
				
				
			
		

	


	

    

	

		
		

			

SaS


uses WinCrt;

var
  i, j: integer;
  s, s1, Result: string;

begin
  writeln('enter string:');
  readln(s);
  Result := '';
  while (s <> '') do
  begin
    i := Pos(' ', s);
    if (i > 0) then
    begin
      s1 := Copy(s, 1, i - 1);
      Delete(s, 1, i);
    end
    else
    begin
      s1 := s;
      s := '';
    end;
    for j := 1 to Length(s1) do
    begin
      i := Pos(s1[j], s1);
      i := Pos(s1[j], Copy(s1, i + 1, Length(s1)));
      if (i = 0) then
        Break;
    end;
    if (i > 0) then
      Result := Result + s1 + ' ';
  end;
  writeln(Result);
end.
program two_char;

uses WinCrt;
var
  A: array [1..2] of word;
  X: array [1..2] of word;
  am, x1, x2, i, Y: word;
begin
  A[1] := 1;
  A[2] := 2;
  X[1] := 3;
  X[2] := 4;
  am := 0;
  for i := 1 to 2 do
    if am < A[i] then
      am := A[i];
  x1 := 0;
  x2 := 0;
  for i := 1 to 2 do
  if Odd(i) then
  begin
    if x1 < X[i] then
      x1 := X[i];
  end
  else
    if x2 < X[i] then
      x2 := X[i];
  Y := am + sqr(x1 - x2);
  writeln('Y=', Y);
end.
program max_1;



			
		


		

		
			

		
	


	
    



	




					
					
					
				

					

					
					







	

	

	

		

			

				


	
		PapiruS
	

				
				
					
						
Костяк
					
				
			

		

		

			

				


PapiruS
			

			

			    Опубликовано 
				
			

		

	

	
	

		




	

		

			

				
    
					
					
					
					
					
				

			

			
		


		

		   
		   Опубликовано 
		   
			
			
				
				
			
		

	


	

    

	

		
		

			
помогите решить задачи плз.Надо написать блок-схему или код на паскале чтобы можно было переделать под блок-схему
%C1%E5%E7%FB%EC%FF%ED%ED%FB%E9.71e81fe8384c01d4e92ba628ef42484c.JPG
Дано натуральное число k. Напечатать k-ую цифру последовательности: 12345678910111213..., в которой выписаны подряд все натуральные числа.
Дана последовательность из целых чисел, которые вводятся по одному. За последним числом вводится нуль. Найти два наименьших числа последовательности.


			
		


		

		
			

		
	


	
    



	




					
					
					
				

					

					
					







	

	

	

		

			

				


	
		SxLvn
	

				
				
					
						
Энтузиаст
					
				
			

		

		

			

				


SxLvn
			

			

			    Опубликовано 
				
			

		

	

	
	

		




	

		

			

				
    
					
					
					
					
					
				

			

			
		


		

		   
		   Опубликовано 
		   
			
			
				
				
			
		

	


	

    

	

		
		

			
Lakers Respect!
А можете такую задачку посмотреть:
Сказали через процедуру сделать, ваще не получатся:
Даны вещественные массивы А(16) В(20) вычислить:
у=((а1+а3+а5+...+а15)^2 - (b2+b4+b6+...+b20)^2)\((a2+a4+a6+...+a16)^2 + (b1+b3+b5+...+b10)^2)
:)


			
		


		

		
			

		
	


	
    



	




					
					
					
				

					

					
					







	

	

	

		

			

				


	
		Lakers
	

				
				
					
						
Восходящая звезда
					
				
			

		

		

			

				


Lakers
			

			

			    Опубликовано 
				
			

		

	

	
	

		




	

		

			

				
    
					
					
					
					
					
				

			

			
		


		

		   
		   Опубликовано 
		   
			
			
				
				
			
		

	


	

    

	

		
		

			

через функцию наверно а не процедуру.
Добавлено спустя 2 минуты 23 секунды:
ет че такое?
у=((а1+а3+а5+...+а15)^2 - (b2+b4+b6+...+b20)^2)\((a2+a4+a6+...+a20)^2 + (b1+b3+b5+...+b10)^2)
в то время как А(16)
Добавлено спустя 10 минут 23 секунды:
uses crt;
var  a,b:array[1..20]of real;
i:integer;
function f:real;
var i:integer;
    s1,s2,s3,s4:real;
begin
s1:=0;
for i:=1 to 15 do s1:=s1+a;
s2:=0;
for i:=1 to 20 do s2:=s2+b;
s3:=0;
for i:=2 to 16 do s3:=s3+a;
s4:=0;
for i:=1 to 10 do s4:=s4+b;
f:=(s1*s1-s2*s2)/(s3*s3+s4*s4);
end;
begin
clrscr;
randomize;
for i:=1 to 16 do a:=random(10);
for i:=1 to 20 do b:=random(10);
writeln(f:0:3);
readkey;
end.
Добавлено спустя 21 минуту 33 секунды:
PapiruS
uses crt;
var x,y,p,k:integer;
s:longint;
begin
clrscr;
write('N= ');readln(k);
x:=1;
y:=1;
p:=1;
s:=0;
while x<=k do
 begin
  s:=s+x;
  x:=y+p;
  p:=y;
  y:=x;
 end;
writeln('SUM= ',s);
readkey;
end.
uses crt;
var k,i,j,n,c:integer;
a:array[1..10]of byte;
begin
clrscr;
write('K= ');readln(k);
j:=0;
while k>0 do
 begin
  j:=j+1;
  i:=j;
  n:=0;
  while i>0 do
   begin
   n:=n+1;
   a[n]:=i mod 10;
   i:=i div 10;
   end;
  if k-n>0 then
   begin
     k:=k-n
   end
     else
   begin
     c:=a[n-k+1];
     k:=-1;
   end;
 end;
writeln©;
readkey;
end.
uses crt;
var x,m1,m2:integer;
begin
clrscr;
read(x);
m1:=x;
m2:=x;
while x<>0 do
 begin
  if (xm1) then m2:=x;
  if (x
    begin
      m2:=m1;
      m1:=x;
    end;
 read(x);
 end;
writeln('MIN1: ',m1);
writeln('MIN2: ',m2);
readkey;
end.



			
		


		

		
			

		
	


	
    



	




					
					
					
				

					

					
					







					
					
					
				

					

					
					







	

	

	

		

			

				


	
		PapiruS
	

				
				
					
						
Костяк
					
				
			

		

		

			

				


PapiruS
			

			

			    Опубликовано 
				
			

		

	

	
	

		




	

		

			

				
    
					
					
					
					
					
				

			

			
		


		

		   
		   Опубликовано 
		   
			
			
				
				
			
		

	


	

    

	

		
		

			

Lakers
спс за решение , но 2-ую нужно без масива, для блок-схемы
а в первой почему та там на единицу ошибается
Добавлено спустя 6 минут 28 секунд:
uses crt;
var x,y,p,k:integer;
s:longint;
begin
clrscr;
write('N= ');readln(k);
x:=2; 
y:=1;
p:=1;
s:=0;
while x<=k do
begin
s:=s+x;
x:=y+p;
p:=y;
y:=x;
end;
writeln('SUM= ',s);
readkey;
end. 



			
		


		

		
			

		
	


	
    



	




					
					
					
				

					

					
					







					
					
					
				
			
			



		

	


	
		

			


	
	

		

	
	
	
	
	
		
	

			
				
				



	
	
		

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

			
Вы сможете оставить комментарий после входа в

			

			

			Войти
		

	


			
		

	

	
		

			

				
					


				
				
                

                


				
			

		

	







	

		
			
				Перейти к списку тем
			
		
	

	




						


	

		
    
			
				
					
					
  • 
				
					
					
  • 


    
	
	
		
    
	

    • 
				
					
					
  • 

    
    
    
        
            Последние посетители
        
        
          0 пользователей онлайн
        
    
    
    
    
        
      
            
                
    • Ни одного зарегистрированного пользователя не просматривает данную страницу
      • 
            
        
    
        
    
    

    • 
				
			
		

	


					

					
					

				

			

			
		

		
		


	

		×
		

			
				

					
				

			

			

			

			
		

	






	

		×
		

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