SP w Piotrowicach Strona Główna SP w Piotrowicach
Forum Szkoły Podstawowej nr 3 w Piotrowicach

FAQFAQ  SzukajSzukaj  UżytkownicyUżytkownicy  GrupyGrupy
RejestracjaRejestracja  ZalogujZaloguj  AlbumAlbum

Poprzedni temat «» Następny temat
Sortowanie
Autor Wiadomość
Greif 



Pomógł: 2 razy
Wiek: 44
Dołączył: 02 Paź 2007
Posty: 1577
Skąd: Piotrowice
Wysłany: 2007-11-08, 00:28   Sortowanie

Witam,

mój temat to:

Temat nr 6: Uporządkuj ciąg łańcuchów znaków w porządku alfabetycznym.
Zastosuj metodę sortowania przez wybór.

Już mam to napisane, jeżeli ktoś chce rady, może spokojnie pisać, może ja odpowiem, a może ktoś bardziej oblatany w pascalu...

Mój program:
Kod:
program sortowanie_przez_wybor;
uses crt;
const N=30;
var
  lista:array[1..N] of string;
  l,i,ilosc,j,pmin:integer;
  x:string;
begin
  clrscr;
         writeln('|"""""""""""""""""""""""""|');
         writeln('| AP Kraków SP EFS gr.2   |');
         writeln('| (C)2006 Tomasz Milowski |');
         writeln('| Sortowanie przez wybór  |');
         writeln('|                         |');
         writeln(' """""""""""""""""""""""""');
         writeln;
                        { Wczytanie ilości elementów listy (łańcuchów) }
         write('Podaj ilość elementów listy: ');
         readln(ilosc);
         writeln;
                        { Uzupełniam tablicę lista[] ciągami znaków }
  for l:=1 to ilosc do
      begin
          write ('Prosz© poda† element ',l,' --> ');
          readln(lista[l]);
      end;
  writeln;
                        { Wypisanie danych nieposortowanych }
  write('Wpisane zostaˆy nast©pujĄce ciĄgi znak˘w -> ');
  for l:=1 to ilosc do write(lista[l],' ');writeln;
                        { Sortowanie }
  for j:=1 to ilosc-1 do
    begin
      pmin:=j;
      for i:=j+1 to ilosc do
          if lista[i]<lista[pmin] then
             pmin:=i;
             x:=lista[pmin];
             lista[pmin]:=lista[j];
             lista[j]:=x;
    end;
                        { Wypisanie wyniku sortowania }
  writeln;
  writeln('Lista posortowana:');
  writeln;
  for i:=1 to ilosc do writeln(i:10,'> ',lista[i]);
  writeln;
  writeln('Nacisnij Enter...');
  readln;
end.

Oczywiście w programie polskie znaki są, po prostu kodowanie się nie zgadza przy przeklejaniu, sorry...

===
20 stycznia 2007

Cześć,
dziś zaliczaliśmy, trochę się zdziwiłem, bo musiałem przerobić mój program, tak aby sortował nie łańcuchy znaków, ale liczby rzeczywiste.
Udało się, poniżej listing:
Kod:
program sortowanie_przez_wybor;
uses crt;

var

  lista:array[1..30] of real;

  l,i,ilosc,j,pmin:integer;
 x:real;
 begin

    clrscr;
         writeln('|"""""""""""""""""""""""""|');
         writeln('| AP Kraków SP EFS gr.2   |');
         writeln('| (C)2006 Tomasz Milowski |');
         writeln('| Sortowanie przez wybór  |');
         writeln('|                         |');
         writeln(' """""""""""""""""""""""""');
         writeln;
                        { Wczytanie ilości elementów listy (łańcuchów) }
         write('Podaj ilość elementów listy: ');
         readln(ilosc);
         writeln;
                        { Uzupełniam tablicę "lista[]" ciągami znaków }
  for l:=1 to ilosc do
      begin
          write ('Proszę podać element ',l,' --> ');
          readln(lista[l]);
      end;
  writeln;
                        { Wypisanie danych nieposortowanych }
  write('Wpisane zostały następujące ciągi znaków -> ');
  for l:=1 to ilosc do write(lista[l],' ');writeln;
                        { Sortowanie }
  for j:=1 to ilosc-1 do
    begin
      pmin:=j;
      for i:=j+1 to ilosc do
          if lista[i]<lista[pmin] then
             pmin:=i;
             x:=lista[pmin];
             lista[pmin]:=lista[j];
             lista[j]:=x;
    end;
                        { Wypisanie wyniku sortowania }
  writeln;
  writeln('Lista posortowana:');
  writeln;
  for i:=1 to ilosc do writeln(i:10,'> ',lista[i]);
  writeln;
  writeln('Naciśnij Enter...');
  readln;
end.

Oczywiście na komentarze nie patrzcie, zmieniłem tylko to co konieczne, żeby program działał...

===
brakowało 2 ; teraz chodzi


Kod:
program USUWACZ;
uses crt;
var ciagwe, ciagwy:string;
i:integer
function USUN(zn:char):boolean;
begin
if((ord(zn)>=65)and(ord(zn)<=90))or((ord(zn)>=97)and(ord(zn)<=122))then
USUN:=true else;
USUN:=false;
end;
begin
clrscr;
ciagwe:='';
ciagwy:='';
writeln('Ten program usuwa wszystkie znaki nie będące literą z wprowadzonego ciągu znaków.');
writeln('Program kończy wpisanie słowa end.');
writeln;
writeln('Wprowadż ciąg znaków: ');
write('>');
readln(ciagwe);
while ciagwe<>'end' do
begin
i:=1;
while i<=length(ciagwe)do
begin;
if USUN(ciagwe[i]) then
ciagwy:=ciagwy+ciagwe[i];
i:=i+1;
end;
writeln;
writeln('Oto wynik: ');
writeln(ciagwy);
writeln;
ciagwy:='';
writeln('Wprowadź następny ciąg znaków:');
write('>');
readln(ciagwe);
end;
end.


===

hej :)
ja miałem zrobić piłkę, która wędruje z dolnego lewego rogu ekranu na górę do środka i do prawego dolnego rogu ekranu..

a kod jest taki:

Kod:

program pilka;
uses crt, graph;
var a,b,x,y: integer;
          f: boolean;
          i: integer;
begin
ClrScr;
DetectGraph(a,b); {wykrycie parametrow grafiki}
InitGraph(a,b,'c:\TP\BGI'); {inicjacja bibliotek grafiki}

x:=10; {początkowe ustawienie środka koła - lewy dolny róg ekranu}
y:=GetMaxY-10;
f:=true;

repeat
ClearDevice;                    {wyczyszczenie ekranu}
circle(x,y,10);                 {narysowanie koła o środku (x,y) i promieniu 10}
for i:=1 to 50 do delay(60000); {opóźnienie}

 {zmiana pozycji środka koła: x zwiększamy najpierw o 1, potem o 2, y zmniejszamy najpierw o 2, potem o 3, i tak w kolko}
 {dzięki temu koło dąży do środka górnej krawędzi ekranu}

if f=true then

   begin
   f:=false;
   x:=x+1;
   y:=y-2;
   end
else
    begin
    x:=x+2;
    y:=y-3;
    f:=true;
    end;

until y<=10;

 {zmiana pozycji środka koła: x zwiększamy o 3, y zwiększamy najpierw o 3, potem o 1, i tak w kolko}
 {dzięki temu koło dąży do prawego dolnego rogu ekranu}

repeat
ClearDevice;
circle(x,y,10);
for i:=1 to 50 do delay(60000);

if f=true then

   begin
   f:=false;
   x:=x+3;
   y:=y+3;
   end
else
    begin
    y:=y+1;
    f:=true;
    end;

until x>=GetMaxX-10;

repeat until Keypressed;
CloseGraph;
end.


pozdr, mirek.

===
Cześc.
Ja miałem napisć program, który wczytuje dwa wyrazy i sprawdza, czy litery z pierwszego wyrazu powtarzają się w drugim.

Kod:

program dwa_slowa;
uses CRT;
type litery=array[1..20] of char;
var l:litery;s1,s2:string[20];i,j,m,n:integer;a:char;

procedure dane;
          BEGIN
          clrscr;
          gotoxy(17,4);
          writeln('Prosz&#169; poda&#8224; pierwsze s&#710;owo: '); gotoxy(17,6);readln(s1);
          clrscr;
          gotoxy(17,4);
          writeln('Prosz&#169; poda&#8224; drugie s&#710;owo: ');gotoxy(17,6); readln(s2);
          end;
Procedure zapis;
          begin
                       if m=1 then l[m]:=s1[i]
                       else
                       for n:=1 to m-1 do
                        begin
                           if s1[i]=l[n] then l[m]:='&';
                        end;
                           if l[m]<>'&' then l[m]:=s1[i];
                           if l[m]<>'&' then m:=m+1;
          l[m]:=#0;
          end;


procedure wypisz;
          begin
          CLRSCR;
          if m-1=0 then begin
             gotoxy(2,4);
              writeln('˝adna z liter pierwszego wyrazu NIESTETY nie powt˘rzy&#710;a si&#169; w drugim wyrazie');
              gotoxy(30,12);
              writeln('BARDZO MI PRZYKRO ;(');
              end
          else begin
               gotoxy(17,4);
               writeln('IstniejĄ ',m-1,' litery, kt˘re powtarzajĄ sie ');
               gotoxy(20,6);
               writeln('w s&#710;owach "',s1,'"  i w "',s2,'" a sĄ to:');
               gotoxy(25,8);
                            for i:=1 to m-1 do
                             begin
                             if s1[i]=' ' then write('SPACJA ,');
                             write(l[i],', ')
                             end;
               end;
          end;
procedure porownaj;
          begin
          m:=1;
                 for i:=1 to ord(s1[0]) do
                 begin
                       for j:=1 to ord(s2[0]) do
                       begin
                       if s1[i]=s2[j] then zapis
                       end;
                 end;
          end;

procedure wyjdz;
          begin
          CLRSCR;
          gotoxy(23,12);
          writeln('Dzi&#169;kuj&#169; za skorzystanie z programu');
          delay(3000);
          halt;
          end;
procedure witaj;
          begin
          clrscr;
          gotoxy(37,8);
          writeln('WITAM.');
          gotoxy(22,12);
          writeln('Program por˘wna dwa wyrazy i wypisze');
          gotoxy(22,14);
          writeln('powtarzajĄce si&#169; w nich litery.');
          gotoxy(10,22);
          writeln('Uruchomi&#8224; program? t/n :'); a:=readkey;
          if a<>'t' then wyjdz
          else
          end;
procedure pytaj;
          begin
          gotoxy(40,23);
          writeln('Czy chcesz wyj&#732;&#8224; z programu? t/n :'); a:=readkey;
          if a='t' then wyjdz
          else
          end;
{program g&#710;˘wny}
begin
witaj;
repeat
dane;
porownaj;
wypisz;
pytaj;
until l[20]='|';
end.
_________________
Pozdrawiam
----------------------------------
 
 
Wyświetl posty z ostatnich:   
Odpowiedz do tematu
Nie możesz pisać nowych tematów
Nie możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
Nie możesz załączać plików na tym forum
Możesz ściągać załączniki na tym forum
Dodaj temat do Ulubionych
Wersja do druku

Skocz do:  

Powered by phpBB modified by Przemo © 2003 phpBB Group