Programlama | Programlama Dilleri | C Programlama Dili |C++

Anasayfa Programlama Pascal N Basamaklı Bir Sayıdan K Tane Rakam Silindiğinde Kalabilecek En Büyük Sayı


N Basamaklı Bir Sayıdan K Tane Rakam Silindiğinde Kalabilecek En Büyük Sayı

Pascal programlama dilinde yazılmış bu programda kullanıcıdan alınan N basamaklı bir sayıdan k tane rakamı silersek kalabilecek en büyük sayıyı bulan program yapılmıştır.

Örnek : Sayı -> 2 4 5 2 6
K=1  -> En büyük sayı = 6542

K=2 -> En büyük sayı =  654

K=3 -> En büyük sayı =  65

K=4 -> En büyük sayı =  6


Not : Sayı dizi olarak programa verilmelidir ve k sayısı dizinin eleman sayısının 1 eksiğinden büyük olmamalıdır.

Program Kodu:

Ör:

Sayının Uzunluğunu Giriniz: 5

3

5

6

2

1

Silinmesini İstediğiniz Rakam Sayısını Giriniz:2

Sayiniz : 653

  1.  
  2.  
  3. uses crt;
  4. var
  5. a:array[1..100] of integer;
  6. z:array[1..100] of integer;
  7. i,j,k,b,c,max:integer;
  8. Tus:char;
  9. bl:boolean;
  10.  
  11.  
  12. begin
  13. clrscr;
  14. repeat
  15. writeln('Sayi uzunlugunu giriniz...: [1..100])');
  16. readln(b);
  17. writeln('Sayi degerlerini giriniz..');
  18.  
  19. for i:=1 to b do
  20.  begin
  21.  readln(c);
  22.  a[i]:=c;
  23.  
  24. write('Sayiniz : ');for i:= 1 to b do write(a[i]);
  25. writeln('');
  26. writeln('Silinmesini istediginiz rakam sayisini giriniz.. : ');
  27. readln(c);
  28.  
  29. c:=b-c; (*kalan eleman sayısı*)
  30. bl:=false;
  31.  
  32. for j:=1 to c do
  33. begin
  34. bl:=false;
  35. max:=a[1];
  36. k:=1;
  37. for i:=2 to b do
  38.  begin if max < a[i] then begin max:=a[i]; k:=i; bl:=true; end;
  39.  end;
  40.  
  41. if not bl then begin
  42. for i:=2 to b do
  43.  begin if max = a[i] then k:=i;
  44.  end;
  45.  
  46. a[k]:=-1;
  47. z[j]:=max;
  48. (*write('Sayiniz : ');for i:= 1 to b do write(a[i]);
  49. writeln('');*)
  50.  
  51.  
  52. write('Sayiniz : ');for i:= 1 to c do write(z[i]);
  53. writeln('');
  54. writeln('Cikmak icin * karakterine basiniz..');
  55.  
  56. Tus:=readkey;
  57. Until Tus='*';
  58.      
  59. readln;
  60.  
  61.  
  62.  

Yorumlar (0)
Sadece kayıtlı kullanıcılar yorum yazabilir!