Dla tych, co się nudzą...

0

Witam wszystkich, podczas pracy nad obecym projektem musiałem rozwiązać pewien problem, którego implementacja w Object Pascalu zajęła mi ok. 20 minut; Z racji tej, że temat problemu jest dość ciekawy - ogłaszam konkurs; Opis problemu poniżej:

Uwaga! Temat ten nie jest związany z żadnym wyłudzaniem kodu na jakieś zaliczenie! Nie chodzę ani do szkoły, nie studiuję ani nawet nie pracuję na stanowisku, które jest związane z programowaniem; W załączniku zamieszczam skompilowany moduł zawierający tylko i wyłącznie moją fukcję; Deklaracja funkcji to:
function AddBytesPhrase(sSize: ShortString): ShortString;

Napisać funkcję, która do podanej w parametrze liczby będzie dodawać słowo bajtów ale w taki sposób, by słowo było poprawnie odmieniane (jak to w polskiej mowie) przy każdej podanej liczbie, np:

Wejście Wyjście '1' '1 bajt' '2' '2 bajty' '4' '4 bajty' '5' '5 bajtów' ... '22' '22 bajty' ... '272734643' '272734643 bajty' ...

a także spełniać następujące warunki:

  • funkcja posiada jeden parametr - łańcuch znaków, który stanowi dowolną naturalną i nieujemną liczbę (typ ShortString), długość liczby max. 255 znaków
  • wartością zwracaną przez funkcję jest łańcuch, który stanowi podaną w parametrze liczbę + znak spacji + słowo bajów w odpowiedniej odmianie
  • funkcja nie może wykorzystywać gotowej funkcji realizującej zadanie (choć chyba takiej w kompilatorze nie ma :)) ani korzystać z żadnego dodatkowego modułu prócz System (brak bloku uses)
  • funkcja może wykorzystywać jedynie systemowe funkcje Ord i Length
  • funkcja nie może posiadać żadnych lokalnych stałych, zmiennych, typów itd. i nie może korzystać z globalnych
  • w ciele funkcji każda instrukcja musi być w osobnej linii, także po else
  • musi być jak najszybsza i posiadać jak najmniej instrukcji
  • funkcja nie może posiadać instrukcji inicjalizującej wartość początkową rezultatu, a pomimo tego kompilator nie wyświetla hint'a o jej braku (inicjalizacji)
  • długość kodu stanowi pełna definicja funkcji (nagłówek funkcji wraz z blokiem begin end w osobnych liniach)

To tyle, jeśli chodzi o warunki; Jeżeli chodzi o nazewnictwo - jest dowolne; Implementacja nie powinna zająć długo czasu, ale jest ciekawą zagadką;

Dodam, że moja funkcja posiada 24 linie bez linii pustych i spełnia wszystkie wyżej wypunktowane warunki;

Kod udostępnie po tym, jak ujżę kod szybszy od mojego i który spełnia wszystkie warunki;

Zachęcam do udziału; Do wygrania... nie wiem, dobre piwo postawię on-line :)
Czekam na kody, pozdrawiam;

EDIT: Poprawiłem wyjście, bo źle napisałem... :)

0

Nie ten poziom... To chyba powinieneś postnąć w dziale newbie...
Z drugiej strony byli tacy co fizzbuzza zrobić nie mogli...

Monku, chyba mamy algorytm na następny test..

Furious Programming napisał(a)

w Object Pascalu
Już widzę jak z widowni zrywają się tłumy

Furious Programming napisał(a)

zajęła mi ok. 20 minut; Z racji tej, że temat problemu jest dość ciekawy
lol

0
Kerai napisał(a)

Nie ten poziom... To chyba powinieneś postnąć w dziale newbie...

Poziom nie poziom, dla Ciebie to pewnie łatwe;

Kerai napisał(a)

Już widzę jak z widowni zrywają się tłumy

Nie musi być tłumów, chciałbym zobaczyć różne rozwiązania;

1

No dobra, to gdzie jest ten drugi programista Object Pascala? Wszyscy go chętnie poznamy.

0

Jakiś argument za tym żeby nie używać zmiennych lokalnych? Jak będzie ich mało to i tak kompilator je upchnie w rejestrach procesora. Zresztą owe rejestry i tak będą czymś tam zapchane, obojętne jaki kod sklecisz. Poza tym czy przewidziałeś np taką sytuację:

funkcja(input: string) {
chytrafunkcja(string, 0, 0, 0)
}
chytrafunkcja(input: string, a: int, b: int, c: int)

Czy parametry funkcji wliczasz do zmiennych lokalnych?

0

Em...
Chodzi o takie coś (to jest akurat cały program):
Wersja 1:

Function C(A:String):String;
Var I: Integer;
Begin
 I := Length(A);
 if (I = 1) And (A[I] = '1') Then
  C := 'bajt' else
 if (A[I]='1') or (A[I] = '5') or (A[I] = '6') or (A[I] = '7') or (A[I] = '8') or (A[I] = '9') or (A[I] = '0') Then
  C := 'bajt˘w';
 if (A[I]='2') or (A[I]='3') or (A[I]='4') Then
  C := 'bajty';
End;
Begin
 WriteLn(C('1024'));
 ReadLn;
End.

Wersja 2:

Function C(A:String):String;
Begin
 if (Length(A) = 1) And (A[Length(A)] = '1') Then
  C := 'bajt' else
 if (A[Length(A)]='1') or (A[Length(A)] = '5') or (A[Length(A)] = '6') or (A[Length(A)] = '7') or (A[Length(A)] = '8') or (A[Length(A)] = '9') or (A[Length(A)] = '0') Then
  C := 'bajtów';
 if (A[Length(A)]='2') or (A[Length(A)]='3') or (A[Length(A)]='4') Then
  C := 'bajty';
End;
Begin
 WriteLn(C('1024'));
 ReadLn;
End.

?

0

Imo to nie jest ciekawy problem. Ciekawe to może być np. napisanie protokołu sieciowego do wymiany informacji korzystając jedynie z TCP lub XML. Albo np. efektywny algorytm znajdowania liczb pierwszych.

EDIT:
Albo mam ciekawszy pomysł. Napisać funkcję odwracania bajtów (konwersja z Little Endian na Big Endian). To jest coś na Twój poziom ;)

4
somekind napisał(a)

No dobra, to gdzie jest ten drugi programista Object Pascala? Wszyscy go chętnie poznamy.

4 lata temu nauczyłem się c++

0
Sarrus napisał(a)

Albo mam ciekawszy pomysł. Napisać funkcję odwracania bajtów (konwersja z Little Endian na Big Endian). To jest coś na Twój poziom

Zadanie jest proste, owszem, aleto nie znaczy, że jest dla mnie trudne, wręcz zprzeciwnie, takie zadania rozwiązywałem na pierwszym roku w TI, więc 6 lat później tym bardziej jest to pryszcz;

Wibowit napisał(a)

Jakiś argument za tym żeby nie używać zmiennych lokalnych?

Nie potrzeba; Świat się nie zawali jak się ich użyje;

Wibowit napisał(a)

Czy parametry funkcji wliczasz do zmiennych lokalnych?

Nie wliczam, parametry to osobna sprawa;

Patryk27 napisał(a)

Chodzi o takie coś (to jest akurat cały program):

Druga wersja była by, ale masz zbyt dużo instrukcji warunkowych, wystarczą 4 (bez instrukcji przypisania Length do zmiennej);

EDIT dla tych oburzonych:
Napisałem go w Off bo rozwiązanie znam i nie czekam na czyjś kod, by go chytrze wykorzystać w swoim programie;
A czy to zadanie to nie jest jak z głupiego FizzBuzz? Przecież, że tak; Jak szanowny kolega @Demonical Monk w maju taki zrobił, to też tak mu pisaliście..? Chyba, że na nim poruszane były problemy milenijne, to zamykam gębę; W szkołach na zaliczenie jest pełno głupszych do niczego nie przydatnych programików, ten - nie jest do rysowania trójkątów w konsoli, może się nada;

@Wibowit zapytał, Patryk27 dał kod; Zdaje się, że jest dwóch zainteresowanych;

0
Furious Programming napisał(a)

Jak szanowny kolega @Demonical Monk w maju taki zrobił, to też tak mu pisaliście..? Chyba, że na nim poruszane były problemy milenijne, to zamykam gębę; W szkołach na zaliczenie jest pełno głupszych do niczego nie przydatnych programików, ten - nie jest do rysowania trójkątów w konsoli, może się nada;

Ale to był dobrze zorganizowany eksperyment który miał konkretny cel - udowodnić że nawet programista-ekspert może czasami nie dać rady z tak prostym zadaniem przy pierwszym podejściu ;)

0
Function C(A:String):String;
Var I: Integer;
Begin
 I := Length(A);
 if (A = '1') Then
  C := 'bajt' else
 if (A[I] in ['0', '1', '5'..'9']) or ((A[I-1] = '1') and (A[I] in ['2'..'4'])) Then
  C := 'bajtów' else
  C := 'bajty';
End;

To już jest absolutnie minimalna, działająca wersja:

function c(a:string):string;var i:byte;begin c:='bajt';i:=length(a);if a<>'1'then if(a[i]in['0','1','5'..'9'])or((a[i-1]='1')and(a[i]in['2'..'4']))then c:=c+'ów'else c:=c+'y';end;

179 znaków ^^
Ktoś da mniej?

0

Poprawny kod:

{ ADD BYTES PHRASE }
function AddBytesPhrase(sSize: ShortString): ShortString;
begin
  case sSize = '1' of
    True: Result := sSize + ' bajt';
  else
    case (sSize[Length(sSize)] in ['0', '1', '5' .. '9']) or
         ((sSize[Length(sSize) - 1] = '1') and (sSize[Length(sSize)] in ['2' .. '4'])) of
      True: Result := sSize + ' bajtów';
    else
      Result := sSize + ' bajty';
    end;
  end;
end;

Niby takie gówienko, nie problem a @Patryk27 już chyba trzeci raz poprawia kod... :P

0

Porównanie szybkości kodów dla 10 milionów iteracji:
comp.png
(wynik oczywiście jest w milisekundach).
Niby takie gówienko, a mój kod działa szybciej :P

{$APPTYPE CONSOLE}
Program Porownanie;
Uses SysUtils, Windows;

Function C(A:String):String; (* Patryk27 *)
Var I: Integer;
Begin
 I := Length(A);
 if (A = '1') Then
  C := 'bajt' else
 if (A[I] in ['0', '1', '5'..'9']) or ((A[I-1] = '1') and (A[I] in ['2'..'4'])) Then
  C := 'bajtów' else
  C := 'bajty';
End;

function AddBytesPhrase(sSize: ShortString): ShortString; (* Furious Programming *)
begin
  case sSize = '1' of
    True: Result := sSize + ' bajt';
  else
    case (sSize[Length(sSize)] in ['0', '1', '5' .. '9']) or
         ((sSize[Length(sSize) - 1] = '1') and (sSize[Length(sSize)] in ['2' .. '4'])) of
      True: Result := sSize + ' bajtów';
    else
      Result := sSize + ' bajty';
    end;
  end;
end;

Const Iter = 10000000;
Var Time: Cardinal;
    I   : Integer;
Begin
 Time := GetTickCount;
 For I := 0 To Iter Do
  AddBytesPhrase(IntToStr(I));
 Time := GetTickCount-Time;
 WriteLn('Furious Programming: ', Time);
 Time := GetTickCount;
 For I := 0 To Iter Do
  C(IntToStr(I));
 Time := GetTickCount-Time;
 WriteLn('Patryk27: ', Time);
 ReadLn;
End.

Testowane pod Intel Core 2 Duo 1.83, Delphi 7 Prof.

0

O Ty cholero, faktycznie działa szybciej :)

Napisałem na case of, bo kiedyś nawet tu na forum przeczytałem w jakimś poście, że zagnieżdżone case of działają szybciej niż 'if then else` (widać ktoś chyba na odwrót napisał);

Pierwsza moja wersja miała sześć warunków właśnie if then else else jakoś wolałem na case of napisać;

EDIT: Sprawdzałem u mnie, IBM R31 ma procesor: Mobile Intel Celeron-S, 1133 MHz (8.5 x 133), wynik:

BinTest.png

PS: @Demonical Monk, znalazł się sens zadania - teraz już wiem, że nie opłaca się zamieniać if then else instrukcją case of jeśli nie ma takiej potrzeby :) Z tego testu wynika, że case of działa mniej więcej dłużej o 50% (konkretnie w tym przypadku);

0

Panowie to nie case Furious Programming tracisz czas na Length za każdym razem (Patryk27 stosuje zmienną) a druga sprawa to co zwraca funkcja Furious Programming a co Patryk27 łączenie stringów to też strata czasu. Powinno się porównywać funkcję Patryk27 z funkcją Furious Programming ale w takiej postaci:

function AddBytesPhrase(sSize: ShortString): ShortString; (* Furious Programming *)
var
  I: Integer;
begin
  I:= Length(sSize);
  case sSize = '1' of
    True: Result := ' bajt';
  else
    case (sSize[I] in ['0', '1', '5' .. '9']) or
         ((sSize[I - 1] = '1') and (sSize[I] in ['2' .. '4'])) of
      True: Result := ' bajtów';
    else
      Result := ' bajty';
    end;
  end;
end;
0

To nie jest funkcja warta ostrej optymalizacji…

0

Wyniki drugiego testu (

function AddBytesPhrase(sSize: ShortString): ShortString; (* Furious Programming *)
var
  I: Integer;
begin
  I:= Length(sSize);
  case sSize = '1' of
    True: Result := ' bajt';
  else
    case (sSize[I] in ['0', '1', '5' .. '9']) or
         ((sSize[I - 1] = '1') and (sSize[I] in ['2' .. '4'])) of
      True: Result := ' bajtów';
    else
      Result := ' bajty';
    end;
  end;
end;

) są zadziwiające:
test.png
Szczerze przyznam, iż jestem zaskoczony ;)
Lecz nie poddam się!

0

No, udało się :]
Wyniki:
test.png
I aktualny kod źródłowy:

{$APPTYPE CONSOLE}
Program bin;
uses
  SysUtils,
  Windows;

Function F(A: ShortString): ShortString; (* Patryk27 *)
Var I: Integer;
    C: Char;
Begin
 I := Length(A);
 C := A[I];
 if (C = '1') Then
  F := 'bajt' else
 if (C in ['0', '1', '5'..'9']) or ((A[I-1] = '1') and (C in ['2'..'4'])) Then
  F := 'bajtów' else
  F := 'bajty';
End;

function AddBytesPhrase(sSize: ShortString): ShortString; (* Furious Programming *)
var
  I: Integer;
begin
  I:= Length(sSize);
  case sSize = '1' of
    True: Result := ' bajt';
  else
    case (sSize[I] in ['0', '1', '5' .. '9']) or
         ((sSize[I - 1] = '1') and (sSize[I] in ['2' .. '4'])) of
      True: Result := ' bajtów';
    else
      Result := ' bajty';
    end;
  end;
end;

Var Time: Cardinal;
    I   : Integer;
    Iter: Integer;
Begin
 WriteLn('Podaj liczbe iteracji do wykonania:');
 ReadLn(Iter);
 WriteLn('...');
 Time := GetTickCount;
 For I := 0 To Iter Do
  AddBytesPhrase('25131422134124');
 Time := GetTickCount-Time;
 WriteLn('Furious Programming: ', Time);
 Time := GetTickCount;
 For I := 0 To Iter Do
  F('25131422134124');
 Time := GetTickCount-Time;
 WriteLn('Patryk27: ', Time);
 ReadLn;
End.

Z kodu wywaliłem IntToStr, ponieważ tylko spowalniało całość.
Póki co ja prowadzę :D

0

Sprawdź mój:

{ ADD BYTES PHRASE }
function AddBytesPhrase(sSize: ShortString): ShortString;
var
  iLen: Integer;
begin
  iLen := Length(sSize);

  case sSize = '1' of
    True: Result := sSize + ' bajt';
  else
    case (sSize[iLen] in ['0', '1', '5' .. '9']) or
         ((sSize[iLen) - 1] = '1') and (sSize[iLen] in ['2' .. '4'])) of
      True: Result := sSize + ' bajtów';
    else
      Result := sSize + ' bajty';
    end;
  end;
end;

i Twój:

Function F(A: ShortString): ShortString; (* Patryk27 *)
Var I: Integer;
    C: Char;
Begin
 I := Length(A);
 C := A[I];
 if (C = '1') Then
  F := A + ' bajt' else
 if (C in ['0', '1', '5'..'9']) or ((A[I-1] = '1') and (C in ['2'..'4'])) Then
  F := A + ' bajtów' else
  F := A + ' bajty';
End;

Funkcja ma zwracać liczbę + słowo ' bajtów' (dodałem tylko Result := A + ' bajtów') :P

0

Proszę:
test.png
Ciągle szybszy, choć przy mniejszej ilości iteracji wyniki były prawie identyczne.

0

Czemu jako input jest string a nie integer?

Poza tym sprawdźcie czy wasze funkcje dają dobry output (a przynajmniej taki sam we wszystkich wersjach) dla jakiegoś zakresu, bo widzę że patryk podaje wadliwy kod.

0

U mnie w kodzie faktycznie był błąd; już naprawiony.
Nowe wyniki:
test.png
Wyniki są właściwie takie same.
Nowy kod:

{$APPTYPE CONSOLE}
Program bin;
Uses SysUtils, Windows;

Function F(A: ShortString): ShortString; (* Patryk27 *)
Var I: Integer;
    C: Char;
Begin
 I := Length(A);
 C := A[I];
 if (A = '1') Then
  F := A + ' bajt' else
 if (C in ['0', '1', '5'..'9']) or ((A[I-1] = '1') and (C in ['2'..'4'])) Then
  F := A + ' bajtów' else
  F := A + ' bajty';
End;

function AddBytesPhrase(sSize: ShortString): ShortString;
var
  iLen: Integer;
begin
  iLen := Length(sSize);
 
  case sSize = '1' of
    True: Result := sSize + ' bajt';
  else
    case (sSize[iLen] in ['0', '1', '5' .. '9']) or
         ((sSize[iLen-1] = '1') and (sSize[iLen] in ['2' .. '4'])) of
      True: Result := sSize + ' bajtów';
    else
      Result := sSize + ' bajty';
    end;
  end;
end;

Const L = '25131422134124';
Var Time: Cardinal;
    I   : Integer;
    Iter: Integer;
Begin
 WriteLn('Podaj liczbe iteracji do wykonania:');
 ReadLn(Iter);
 WriteLn('...');
 Time := GetTickCount;
 For I := 0 To Iter Do
  AddBytesPhrase(L);
 Time := GetTickCount-Time;
 WriteLn('Furious Programming: ', Time);
 Time := GetTickCount;
 For I := 0 To Iter Do
  F(L);
 Time := GetTickCount-Time;
 WriteLn('Patryk27: ', Time);
 WriteLn('Sprawdzanie poprawnosci funkcji...');
 For I := 1 To Iter Do
  if (AddBytesPhrase(IntToStr(I)) <> F(IntToStr(I))) Then
  Begin
   WriteLn('Rozny dla liczby ',I,':');
   WriteLn('->AddBytesPhrase = ', AddBytesPhrase(IntToStr(I)));
   WriteLn('->F              = ', F(IntToStr(I)));
  End;
 WriteLn('--- END ---');
 ReadLn;
End.

(przy 100 000 000 iteracji całość u mnie trwała ~8 minut)

0

Test z przedostatniego postu @Patryk27:

BinTest.png

Test z ostatniego postu @Patryk27:

BinTest2.png

Na małej ilości iteracji mój wygrywa, na dużej - przegrywa (ale niewiele); :P

Różnica jest mniejsza, niż 1% (ale jest) tak jak pisał ktoś wcześniej;

0

I na co to programować w pascalu... ani to przyjemne, ani szybkie...

edit: mały update, c++ poprawiłem

Java -server
java.lang.String: 1391
char[]: 532

C++ -o3
std::string: 8078
cstring: 453

Pascal:
Furious Programming: 3515
Patryk27: 3422
0
Furious Programming napisał(a)

Różnica jest mniejsza, niż 1% (ale jest) tak jak pisał ktoś wcześniej;

Jest pomijalna, czyli jej nie ma, nawet jeśli liczba, którą podałeś jest średnią ze 100 uruchomień obu wersji programu. Ale nie sądzę byś tak zrobił.

0

ani to przyjemne, ani szybkie...

Cicho, bo znowu zaczniesz kolejny flejm o tym, jaki to Pascal jest zły.
Jak już kiedyś wspomniałem: każdy lubi co innego, każdy język programowania ma swoje wady i zalety. Ja lubię Pascala, ty Javę, ktoś inny Befunge, czy C++.
Jak dla mnie temat wyczerpany, EOT.

1

Naprawdę nie rozumiem, jak wy możecie się tak z tą Javą i Pascalem męczyć.
Moja propozycja:

    
 
	 
    	
	  	
	  	
 
  	  		
	      	 
	  				   		   	
	  	
	  	 

   	
 
  	  		
	      	
	  				 
    		   	
	  	
	  		
   		  	 
	  	 
 
	  	  
   	
	  	 
 
	  	  
   	
	  	 
 
	  	  
 


 
 	 

   	 	
 

 
    		   	 
		    	
	    
    		    	
		    	
	    
    		 	 	 
		    	
	    
    			 	  
		    	
	   
	

   	 

 	 	 	
 
    		 				
		    	
	    
    			 			
		  

 

   		 

	

   	  
 


 	 	 	
 
    				  	
		  

 

   	 	

	

   		
 


 	 	 	
 

 

   	  

	

Wywołanie:

 	 	

Niestety, funkcja nie do końca spełnia wymagania (nazwa + argumenty) ze względu na niewielkie ograniczenia składni. Przyjmuje adres łańcucha, jego długość i adres docelowy łańcucha z odmianą, a zwraca długość łańcucha z odmianą.
http://ideone.com/vcWDJ

0

Czekamy jeszcze tylko na wersję w Malbolge :]

0
Patryk27 napisał(a)

Czekamy jeszcze tylko na wersję w Malbolge :]

Jak znajdę moją VMkę do Brainfucka to zaraz w BF dostaniesz ;D

0

@iooi - podziwiam chęci :] Napisałbym w beunge ale nie mam interpretera przy sobie...

@Kerai pokazał, że języki pochodne od C są o wiele szybsze niż Pascal; Lubie Pascala i wolnym czasie zawsze się rozerwę przy pisaniu jakiegoś narzędzia

Mam manię na ten temat, więc napiszę to co zwykle - nie ma czegoś takiego jak szybkość języka programowania - może najwyżej istnieć implementacja języka (kompilator) tworząca szybki kod. Dziękuję za uwagę.

Tak jest, ale co mi z tego, jestem pasjonatem a nie pracownikiem NASA, gdzie za wolniejszy kod niż było to przewidziane stracę premię;

W NASA wolny kod wcale nie byłby takim problemem, biorąc pod uwagę ich fundusze to dwa razy wolniejszy nie byłby sporym problemem bo wystarczyłoby zwiększyć moc obliczeniową (zresztą pierwsze 'superkomputery' NASA miały moc obliczeniową dzisiejszych lodówek).
Gorzej gdyby przez ciebie warta miliardy dolarów rakieta wybuchła podczas startowania bo nie przewidziałeś jakiegoś przypadku brzegowego w kodzie...

1 użytkowników online, w tym zalogowanych: 0, gości: 1