fork download
copy 
  1. Program beadando;
  2. Uses crt;
  3. type TMatrix=array[1..1000] of array[1..1000] of integer;
  4.  
  5. var N:         integer;
  6.     M:         integer;
  7. 	matrix:    TMatrix;
  8.     fN,hogyan:  String;
  9.     f:            Text;
  10.     hiba:      Boolean;
  11.     megoldas:  integer;
  12.  
  13. Function olvnyit (var f:Text; Const fN:String):Boolean;
  14. 	Begin
  15. 		Assign(f,fN);
  16. 		{$i-} 
  17. 		Reset(f); 
  18. 		{$i+}
  19. 		olvnyit:=IOresult=0;
  20. 	End;
  21.  
  22. Procedure fajlbeolv (var N, M:integer; var matrix:TMatrix);
  23. 	var i,j:Integer;
  24. 		van:Boolean;
  25. 	Begin
  26. 	  Repeat
  27. 		write(StdErr,'Kerem a bemeneti fajl nevet: ');
  28. 		readln(fN);
  29. 		van:=olvnyit(f, fN);
  30. 		if not van then writeln(StdErr, 'Hibas fajlnev, add meg ujra!');
  31. 	  Until van;
  32. 	  read(f, N);
  33. 	  read(f, M);
  34. 	  for i:=1 to N do
  35. 		Begin
  36. 			readln(f);
  37. 			for j:=1 to M do		
  38. 				read(f, matrix[i,j]);    
  39. 		End;
  40. 	  close(f);
  41. 	End;
  42.  
  43. Procedure billbeolv (var N, M:integer; var matrix:TMatrix);
  44. var i, j: integer;
  45. Begin
  46.   Repeat
  47.     writeln(StdErr,'Add meg a telepulesek szamat: ');
  48.     {$i-}
  49.     read(N);
  50.     hiba:=ioresult<>0;
  51.     {$i+}
  52.   Until (N>=1) and (N<=1000) and (not hiba);
  53.  
  54.   Repeat
  55.     writeln(StdErr,'Add meg a napok szamat: ');
  56.     {$i-}
  57.     read(M);
  58.     hiba:=ioresult<>0;
  59.     {$i+}
  60.   Until (M>=1) and (M<=1000) and (not hiba);
  61.  
  62.   for i:=1 to N do
  63. 	Begin
  64. 		for j:=1 to M do
  65. 		  Begin
  66. 		   Repeat
  67. 		    write(StdErr,'A(z) ',j,'. nap homerseklete a(z) ',i,'. telepulesen: ');			
  68. 		    {$i-}
  69. 		    read(matrix[i,j]);
  70. 		    hiba:=ioresult<>0;
  71. 		    {$i+}
  72. 		    writeln;
  73. 		   Until (matrix[i,j]<=50) and (matrix[i,j]>=-50) and (not hiba);
  74. 		  End;
  75. 	End;
  76.  
  77. End;
  78.  
  79. Procedure mibol(var hiba:boolean; var hogyan:string);
  80. Begin
  81.   hiba:=true;
  82.   Repeat
  83.     writeln('Fajlbol(f) vagy billentyuzetrol(b) olvassuk be az adatokat?');
  84.     readln(hogyan);
  85.     if (hogyan='f') or (hogyan='b') then hiba:=false;
  86.   Until not hiba;
  87.   if hogyan='f' then fajlbeolv(N,M,matrix) else billbeolv(N,M,matrix);
  88. End;
  89.  
  90. Procedure Hidegebbkeres(var matrix: TMatrix; var megoldas: integer);
  91.  Var i: integer;
  92.  Var j,k: integer;
  93.  
  94. Begin 
  95. megoldas:=-1;
  96. 	i:=1;
  97.     while (i<=M) and (megoldas=-1) do
  98. 	 Begin
  99. 		k:=M;
  100. 		while (k>=1) and (megoldas=-1) do
  101. 		Begin
  102. 			j:=1;
  103. 			while (j<=N) and (matrix[j,i]>matrix[j,k]) do
  104. 			Begin
  105. 				j:=j+1;
  106. 			End;
  107.  
  108. 			if (j>N) then
  109. 			Begin
  110. 				megoldas:=i;
  111. 			End;
  112. 			k:=k-1;
  113. 		End;
  114. 		i:=i+1;
  115. 	End;
  116. End;
  117.  
  118. Procedure kiir(megoldas:integer);
  119.    Begin
  120. 		write(megoldas);
  121. 		readln;
  122.    End;
  123.  
  124. Begin
  125.  mibol(hiba,hogyan);
  126.  Hidegebbkeres(matrix,megoldas);
  127.  kiir(megoldas);
  128.  readln;
  129. End.
  130.  
  131.  
  132.  
Compilation error #stdin compilation error #stdout 0s 0KB
comments (?)
stdin
copy 
Standard input is empty
compilation info 
prog.pas:2: error: module/unit interface `crt' could not be imported
stdout
copy 
Standard output is empty
https://ideone.com/HLKxpw
language:
Pascal (gpc 20070904)
created:
7 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!