Cezar poprawka

Przepraszam za tamten temat

Mógłby ktos sprawdzic czy procedura menu jest dobra albo jeszcze podtuningowac to menu

program cezar1;

{$APPTYPE CONSOLE}

uses
SysUtils,classes;
type
chars=set of char;
const
ileliter = 26;

function readfrontfile(filename:string):tstringlist;
var list:tstringlist;
plik:text;
line:string;
begin
list:=tstringlist.create;
assign(plik,filename);
reset(plik);
while not EOF(plik) do
begin
readln(plik,line);
list.add(line);
end;
close(plik);
result:=list;
end;

procedure print(source:tstringlist);
var i:integer;
begin
for i:=0 to source.count -1 do
writeln(source[i]);
end;

procedure writetofile(filename:string; source:tstringlist);
var plik:text;
i:integer;
begin
assign(plik,filename);
rewrite(plik);
for i:=0 to source.count -1 do
writeln(plik,source[i]);
close(plik);
end;

function isalpha(znak:char):boolean;
var litery:chars;
begin
litery := ['A'..'Z'];
if upcase(znak) in litery then isalpha := true
else isalpha:=false
end;

function kodujznak(znak:char;klucz:integer):char;
var wynik:char;
begin
klucz:=klucz mod ileliter;
if isalpha(znak) then
begin
wynik:=chr(ord(znak)+klucz);
if not isalpha(wynik) then wynik:=chr(ord(wynik)-ileliter);
end
else wynik:= znak;
kodujznak:=wynik;
end;

function kodujstring(linia:string;klucz:integer):string;
var wynik:string;
i:integer;
begin
wynik:='';
for i := 1 to length(linia) do
wynik:=wynik+kodujznak(linia[i],klucz);
kodujstring:=wynik;
end;

function cezar(source:tstringlist; klucz:integer):tstringlist;
var wynik:tstringlist;
i:integer;
begin
wynik:=tstringlist.create;
for i := 0 to source.count -1 do
wynik.add(kodujstring(source[i],klucz));
cezar:=wynik;
end;

procedure menu;
begin
writeln('1- Wyswietl niezakodowany plik');
writeln('2- Wyswietl zakodowany');
writeln('3- Zapis do pliku');
writeln('4- Zakoncz program');
end;
procedure cezarmenu;
var zakod,list:tstringlist;
begin
list:=tstringlist.create;
zakod:= tstringlist.create;
list:=readfrontfile('1.txt');
zakod:=cezar(list,3);
writeln('zapisano plik');
end;
var i,wybor:integer;
list,zakod:tstringlist;
begin

menu;
repeat
readln(wybor);
if wybor>4 then
writeln('niepoprawna opcja ');
case wybor of
1 : print(list);
2 : print(zakod);
3 : cezarmenu;

end;
until wybor=4;
writetofile('zakodowane.txt',zakod);

end.

prosze pomoze ktos ???

kubcio1906 napisał(a):

prosze pomoze ktos ???

1.Sformatuj normalnie kod.
2.Popraw literówki w nazwach.
3.Wrzuć go do pastebin bądź w odpowiednie znaczniki
5.A najlepiej przepisz go od nowa; ale tak, aby był on normalny, a nie to dziwactwo, które dajesz nam do sprawdzenia :|
6.Zauważ, iż brakło pkt.4.

Perełka:

function readfrontfile(filename:string):tstringlist;
 var list:tstringlist;
 plik:text;
 line:string;
 begin
  list:=tstringlist.create;
  assign(plik,filename);
  reset(plik);
  while not EOF(plik) do
  begin
   readln(plik,line);
   list.add(line);
  end;
  close(plik);
  result:=list;
 end;

[rotfl]
A o czymś takim, jak TStringList.loadFromFile się słyszało?

miałem na zadanie zrobic do tego menu jako funkcja i procedura i kolega mi to podeslal bo jestem zielony z programowania. Mógłbyś to ogarnąc i napisac jak ma byc ?? prosze :)

za 100 zł :D

babubabu napisał(a):

za 100 zł :D

Ja dzisiaj mam nawet dobry humor. Za 98 :P

Czemu wszystko tak komplikować, przecież da się to wszystko zrobić znacznie mniejszym kosztem:

program cesar;

{$APPTYPE CONSOLE}

uses
  Sysutils,
  Classes;

procedure ReadFile(const FileName:String;var Data:String);
var FS:TFileStream;
begin
  FS:=TFileStream.Create('plik.txt',fmOpenRead);
  SetLength(Data,FS.Size);
  FS.Read(Data[1],Length(Data));
  FS.Free;
  WriteLn(Data);
end;

procedure WriteFile(const FileName:String;const Data:String);
var FS:TFileStream;
begin
  FS:=TFileStream.Create('plik.txt',fmCreate);
  FS.Write(Data[1],Length(Data));
  FS.Free;
end;

procedure ReadKey(var Key:Byte);
begin
  Write('Podaj klucz: ');
  ReadLn(Key);
end;

procedure Code(var Data:String;Key:Byte);
var I:Integer;
var Ch:Char;
begin
  for I:=1 to Length(Data) do
  begin
    Ch:=Data[I];
    if ('a'<=Ch)and(Ch<='z') then
    begin
      Data[I]:=Chr(Ord('a')+((Ord(Ch)-Ord('a')+Key)mod(26)));
    end
    else if ('A'<=Ch)and(Ch<='Z') then
    begin
      Data[I]:=Chr(Ord('A')+((Ord(Ch)-Ord('A')+Key)mod(26)));
    end
  end;
  WriteLn(Data);
end;

procedure go;
var x,Data:String;
var Key:Byte;
begin
  Key:=13;
  ReadFile('plik.txt',Data);
  Code(Data,Key);
  while true do
  begin
    WriteLn('1: Wczytaj plik');
    WriteLn('2: Ustaw klucz');
    WriteLn('3: Koduj');
    WriteLn('4: Dekoduj');
    WriteLn('5: Zapisz plik');
    WriteLn('0: Koniec');
    Write('wybierz: '); 
    ReadLn(x);
    x:=Trim(x);
    if x='1' then ReadFile('plik.txt',Data)
    else if x='2' then ReadKey(Key)
    else if x='3' then Code(Data,Key)
    else if x='4' then Code(Data,Key+25)
    else if x='5' then WriteFile('plik.txt',Data)
    else if x='0' then Exit
    else WriteLn('Niema takiej opcji');
    WriteLn;
  end;
end;

begin
  go;
end.

var x,Data:String;

{...}

ReadLn(x);
x:=Trim(x);
if x='1' then ReadFile('plik.txt',Data)
else if x='2' then ReadKey(Key)
else if x='3' then Code(Data,Key)
else if x='4' then Code(Data,Key+25)
else if x='5' then WriteFile('plik.txt',Data)
else if x='0' then Exit
else WriteLn('Niema takiej opcji');

@_13th_Dragon, dlaczego zmienna X jest typu łańcuchowego? Chcesz zabezpieczyć się przed wpisaniem wartości nieliczbowej? Można pobrać liczbę (np. Byte) i obsłużyć ją instrukcją wyboru case .. of .. end...?

var
  X: Byte;
begin
  {...}

  ReadLn(X);

  case X of
    0: Exit;
    1: ReadFile('Plik.txt', Data);
    2: ReadKey(Key);
    3: Code(Data,Key);
    4: Code(Data,Key+25);
    5: WriteFile('Plik.txt',Data);
  else
    WriteLn('Niema takiej opcji');
  end;

  {...}
end;

Poza tym procedura Go jest niepotrzebna - jej kod powinien znaleźć się w głównym bloku programu; Jeśli miałbym pobrać X jako łańcuch - i tak wpakowałbym ją w ww. blok warunkowy:

var
  X: String;
begin
  {...}

  ReadLn(X);
  Trim(X);

  if (not (Length(X) in [1])) or (not (X[1] in ['0' .. '5'])) then
    WriteLn('Niema takiej opcji')
  else
    case X[1] of
      '0': Exit;
      '1': ReadFile('Plik.txt', Data);
      '2': ReadKey(Key);
      '3': Code(Data, Key);
      '4': Code(Data, Key + 25);
      '5': WriteFile('Plik.txt', Data);
    end;

  {...}
end;

Poza tym w zdaniu Niema takiej opcji jest błąd - nie ma pisze się osobno;

_13th_Dragon napisał(a)

więc albo brak idioto-odporności albo dużo dodatkowych instrukcji.

Tak? Dużo? A porównałeś sobie Twój kod z moim? Bo różnica jakbyś zauważył jest w jednej linijce, między tą (Twoją):

else WriteLn('Niema takiej opcji');

a tą (moją):

if (not (Length(X) in [1])) or (not (X[1] in ['0' .. '5'])) then

którą w sumie można skrócić do:

if (Length(X) <> 1) or (not (X[1] in ['0' .. '5'])) then

Dużo instrukcji? Trzba umieć posługiwać się łączeniem warunków - tyle dodatkowych instrukcji;

Poza tym, jeśli by sformatować po ludzku ten warunek:

if x='1' then ReadFile('plik.txt',Data)
else if x='2' then ReadKey(Key)
else if x='3' then Code(Data,Key)
else if x='4' then Code(Data,Key+25)
else if x='5' then WriteFile('plik.txt',Data)
else if x='0' then Exit
else WriteLn('Niema takiej opcji');

powstanie to:

if x='1' then
  ReadFile('plik.txt',Data)
else
  if x='2' then
    ReadKey(Key)
  else
    if x='3' then
      Code(Data,Key)
    else
      if x='4' then
        Code(Data,Key+25)
      else
        if x='5' then
          WriteFile('plik.txt',Data)
        else
          if x='0' then
            Exit
          else
            WriteLn('Niema takiej opcji');

co jest o wiele mniej czytelne, niż ten:

if (Length(X) <> 1) or (not (X[1] in ['0' .. '5'])) then
  WriteLn('Niema takiej opcji')
else
  case X[1] of
    '0': Exit;
    '1': ReadFile('Plik.txt', Data);
    '2': ReadKey(Key);
    '3': Code(Data, Key);
    '4': Code(Data, Key + 25);
    '5': WriteFile('Plik.txt', Data);
  end;

z zastosowaniem odpowiedniego bloku wyboru, którego nie potrzeba i nie ma możliwości skrócić;

_13th_Dragon napisał(a)

Więc radzę ci pozostać przy czepianiu się do literówek, bo twoje "usprawnienia" są bez sensu.

Czym się denerwujesz? Dobrze wiesz, że mam rację i co do długości i do przejrzystości kodu, więc jak nie umiesz znieść krytyki to nie odgryzaj się w ten sposób; Nic Ci nie zrobiłem, więc nie rozumiem Twojej nieuzasadnionej zgryźliwości;

Więc radzę ci pozostać [...]

Ci pisze się dużą literą, tak samo jak Tobie, Twój itd.. Kultury trochę i poszanowania prosiłbym;

Patryk27, przy takim podejściu jak u ciebie to mogę udowodnić że 2*2=5

Popełniłeś kilka błędów w pisaniu testu sprawdzającego.

1. Użyłeś składni akceptowalnej przez niewiele kompilatorów pascala (mam na myśli połączenie String z Case).
2. Dałeś bardzo małą ilość kroków te 5 mln to nieprawda, włącz i poczytaj ostrzeżenia kompilatora (przy standardowych ustawieniach - błąd).
3. Odpalasz najpierw ten który chcesz aby wypadł gorzej (pierwsze kilka instrukcji zawsze są wolniejsze, mogę wyjaśnić czemu).
4. Drastycznie zmniejszyłeś ilość opcji (do 3-ch).
5. Wywaliłeś else które tu jest bardzo istotne.
6. Testujesz tylko dla jednej konkretnej wartości X.

Po naprawieniu przynajmniej kilku z tych błędów wynik jest zupełnie odwrotny:
http://4programmers.net/Pastebin/1751

Poszczególne testy dla:
Pierwsze trzy - integer
Następne trzy - char
Ostatnie trzy - string

Kompilowane pod FPC 2.6.0.

Kod (w tym wypadku dla typu string dla testu trzeciego; dla char kod jest taki sam, dla integer jest X := Random(4)):
http://4programmers.net/Pastebin/1752

Różnica pomiędzy pierwszym,drugim a trzecim testem jest taka, iż za trzecim podejściem zmieniałem zakres losowania (np.z random(4) na random(50)).

Bez dłuższego przeciągania - screenshoty (testowane na Intel Core 2 Duo i 2 GB ramu):

INTEGER

CHAR

STRING

@13th_Dragon, @Furious Programming

Dlaczego do obsługi prostego menu w aplikacji konsolowej używacie zmiennej typu string ewentualnie Byte?
Przecież do tego idealnie nadaje się typ Char i proste sprawdzenie warunków instrukcją case, nie martwiąc się długością stringa i sprawdzaniem czy wprowadzono cyfrę czy literę.

Mam FPC bez lazarusa. 2.6.0 widać wynik kompilacji.

Z małego czasu wnioskują że nie dochodzi do podanej przez ciebie wartości Count - więc mało kroków jest wykonywanych.
Zmieniłeś zakres losowanych liczb do 30 owszem else w case jest szybsze niż ostatnie else w łańcuchu if, z tym że musiałeś zrobić proporcję 1:9 aby pojawiła się jakaś przewaga case'a. Przeważnie to w "żadne z powyższych" programy wpadają rzadko, przynajmniej ten program o którym dyskutujemy w tym temacie.
Dla innych wariantów niż string kodu nie przedstawiłeś.

Dobierając dane w specjalny sposób łatwo udowodnić że quick-sort jest wolniejszy od bąbelkowego.