Pomocte – Pascal – Fórum – Programujte.com

Ahojky.Mám udělat jeden program podle zadání a tabulke,ale vůbec nevím jak na to,hlavně jak kodem to napsat.Potřebuju poradit.Díky
Tady je zadání:
1.Zašifrovaný text naleznete zde.
2.Použita je jednoduchá substituční šifra. Každý znak původní zprávy je nahrazen jiným (ale stále stejným) znakem.
3.Původní zpráva obsahuje znaky 'A' .. 'Z' a mezeru. Tyto znaky jsou nahrazovány. Tečky a čárky zůstaly na místech beze změny.
4.Pomoci vám může tabulka četnosti znaků v průměrném českém textu (bez diakritiky).
5.Šifra by se dala určitě vyřešit i bez programování, ale s programem by to mohlo být rychlejší .

Ten zašifrovaný kod a tabulku četnosti najdete v příloze.

Máš alespon zkušenost se základem Pascalu?

To pc_manik : no.trochu jo.Já programuju v pascalu teprve ani ne rok.Já to mám jako předmět ve škole.Pomůžeš mi teda?

To Anonymní uživatel : Budu se snažit.I když úkol zrovna není tak jednoduchý ja dělal v Pascalu asi před 2lety,ale nedávno jsem v něm zase něco zkoušel no zkusím to i když to zrovna není jednoduchý ukol.

To pc_manik : Tak moc děkuju.Potřebuju to nejdéle do neděle....

Nejcastejsi znak bude urcite mezera, tzn podle nejcastejsiho znaku to rozsekeja jdi od nejkratsich slov tj a, i, u, o, k, s, v, z, pak postupne kratke predlozky, zajmena... Doporucuju kombinovat hlavu a program pro prohazovani pismen. A pokud chces byt jo programator tak si stahni nejaky seznam ceskych slov treba pro scrabble nebo kontrolu chyb pro open office a pokazde si vytvor nahodnou sifru a porovnej vysledek se seznamem slov.

To Anonymní uživatel : Nejdéle do neděle???Hmm tak to srry ale to asi nesthnu!

To pc_manik : to neva...stačí to teda nejdéle do úterý

Tady jsem něco vytvořil,ale nejde to tak jak by mělo.Pomocte mi to nějak upravit...

Uses crt;


procedure serad(var vyskyty: array of integer; var znaky: array of char);
var i: integer;
tmp_i: integer;
tmp_c: char;
swapped: boolean;
begin
repeat
swapped:= false;
i := 0;
for i := 0 to High(vyskyty) - 1 do begin
if vyskyty[i] < vyskyty[i+1] then begin
tmp_i := vyskyty[i];
vyskyty[i] := vyskyty[i+1];
vyskyty[i+1] := tmp_i;
tmp_c:=znaky[i];
znaky[i] := znaky[i+1];
znaky[i+1] := tmp_c;
swapped := true;
end;
end;
until swapped = false;
end;


function najdiznak(znak: char; pole: array of char): integer;
var i: integer;
begin
for i:=0 to High(pole)-1 do
if (pole[i] = znak) then begin
najdiZnak := i;
exit;
end;
end;

var soubor_sifra: file of char;
vyskyty: array[0..255] of integer;
znaky: array[0..255] of char;
znak: char;
i: integer;
const klic: array[0..25] of char = ('E','A','O','I','N','T','S','L','R','K','V','D','M','U',
'C','P','Z','Y','H','J','B','G','F','X','Q','W');
begin

assign(soubor_sifra,'C:\Pascal\sifra.txt');
reset(soubor_sifra);

for i := 0 to 255 do begin
vyskyty[i] := 0;
znaky[i] := chr(i);
end;

while not eof(soubor_sifra) do begin
read(soubor_sifra,znak);
if (ord(znak) >= 32) AND (ord(znak) <= 90) then
vyskyty[ord(znak)]:= vyskyty[ord(znak)] + 1;
end;

reset(soubor_sifra);
while not eof(soubor_sifra) do begin
read(soubor_sifra,znak);
if (ord(znak) >= 65) AND (ord(znak) <= 90) then
write(klic[najdiZnak(znak,znaky)])
else
if (ord(znak) >= 32) AND (ord(znak) <= 47) then
write(znak);
end;
writeLn;
close(soubor_sifra);
readLn;
end.

To Anonymní uživatel : Funguje ti to?

To pc_manik : pojď na icq....nefunguje

Tady máš nejnovější kod,ale enní stále funkční.Když se to spustí tak by se měl zobrazit nějakej smysluplnej text,ale zobrazujou se mi tam hovadiny.Můžete se na to někdo mrknout...

Uses crt;

procedure serad(var vyskyty: array of integer; var znaky: array of char);
var i: integer;
tmp_i: integer;
tmp_c: char;
swapped: boolean;

begin
repeat
swapped := false;
i := 0;
for i := 0 to High(vyskyty) - 1 do

begin
if vyskyty[i] < vyskyty[i+1] then
begin

tmp_i := vyskyty[i];
vyskyty[i] := vyskyty[i+1];
vyskyty[i+1] := tmp_i;
tmp_c:=znaky[i];
znaky[i] := znaky[i+1];
znaky[i+1] := tmp_c;
swapped := true;
end;
end;
until swapped = false;
end;

function najdiznak(znak: char; pole: array of char): integer;
var i: integer;
begin

for i:=0 to High(pole)-1 do
if (pole[i] = znak) then
begin
najdiZnak := i;
exit;
end;
end;

var soubor_sifra: file of char;
vyskyty: array[0..255] of integer;
znaky: array[0..255] of char;
znak: char;
i: integer;
const klic: array[0..26] of char = (' ','E','A','O','I','N','T','S','L','R','K','V','D','M','U',
'C','P','Z','Y','H','J','B','G','F','X','Q','W');

begin
assign(soubor_sifra,'sifra.txt');
reset(soubor_sifra);
for i := 0 to 255 do
begin
vyskyty[i] := 0;
znaky[i] := chr(i);
end;

while not eof(soubor_sifra) do
begin
read(soubor_sifra,znak);
if (ord(znak) = 32) OR
((ord(znak) >= 48) AND (ord(znak) <= 57)) OR
((ord(znak) >= 65) AND (ord(znak) <= 90)) then

vyskyty[ord(znak)] := vyskyty[ord(znak)] + 1;
end;
serad(vyskyty, znaky);

{debug tracing}
{for i:=0 to 255 do writeLn(znaky[i],'(',ord(znaky[i]),') ',vyskyty[i]); }

reset(soubor_sifra);
while not eof(soubor_sifra) do
begin
read(soubor_sifra,znak);
if (ord(znak) = 32) OR
((ord(znak) >= 48) AND (ord(znak) <= 57)) OR
((ord(znak) >= 65) AND (ord(znak) <= 90)) then

write(klic[najdiZnak(znak,znaky)])
else
if (ord(znak) >= 33) AND (ord(znak) <= 47) then
write(znak);
end;
writeLn;
close(soubor_sifra);
readLn;
end.

Koukam ze malirka zmenila pohlavi na martina....
Tady porad nekdo nechape, ze to ten program sam neudela...
Pokud vim tak v zadani je neco jako "sifra se da rozlustit i bez programu,ale s programem by to mohlo byt rychlejsi...."
Z toho jsem vyvodil, ze program nebude ve stylu zadani vstupniho souboru a vyplivnuti spravneho textu....
Jak jiz napsal krychlik, je nutne kombinovat hlavu a programovani.
Dalsi jeho pripominka je, ze nejcastejsi znak bude mezera, coz je taky spravne... Pozn. Pokud je text v souboru podle ceske typografie, tak si troufam tvrdit, ze mezera je na 99% 'velke i', jelikoz nasleduje za teckami a carkami, ktere nejsou sifrovany. A i pokud se podivate na rozlozeni textu, tak by to tak i mohlo odpovidat... Ja jsem se samozrejme vydal stejnou cestou...spocital jsem si vyskyty a zjistil histogram pismen, ktere jsem se pokusil nahradit z tabulky cetnosti... ouha, oni vychazeji nesmysly....jenze chyba neni v programu...

Dalsi muj postup: vychazim z toho, ze mezera je velke i, takze si najdu celkem kratke slovo (cca 4 znaky) s vyskytem pismen v horni casti histogramu (nejlepe prvniho). Toto pismeno(a) nahradim znaky z tabulky a zbyla pismena se pokusim vygenerovat... pokud vygenerovane slovo dava smysl, zkusim dosadit vygenerovana do jineho slova.... Pokud ne, zkusim dosadi pismeno ktere je v cetnosti vedle apod....

Predpokladam,ze rychle reseni ulohy bude v tomto smeru.... a v tomto smeru je napsane i zadani... neni v nem napsat program, ktery by to rozlustil, ale program, ktery by POMOHL rozlustit.....
Napsat program do dvou mesicu, ktery by toto dokazal sam, nestihne student 3 rocniku SPS, ktery ma pascal prvni rok ani kdyby se rozkrajel.....muj nazor...

To joudicek : To zni jako velice jednoduse proveditelny napad, a pritom docela efektni a ucinny:

- Program spocita cetnosti znaku v sifrovanem textu a zobrazi je formou tabulky nebo histogramu.
- K tomu pro porovnani stejnym zpusobem zobrazi "oficialni" tabulku cetnosti pismen v ceskem textu.
- K tomu zobrazi zacatek zasifrovaneho textu (kolik se vejde na obrazovku).
- Uzivatel se na to podiva a zkusi priradit nejaky znak sifry k nejakemu pismenu. Program mu vypise sifru (nebo aspon zacatek) s tim jednim dosazenym znakem (nejlepe zvyraznenym) a oznaci ho i v tabulkach.
- Kdyz se to uzivateli nelibi, dosazeni znaku muze zrusit.
- Tak postupne dosazuje dalsi a dalsi znaky, dokud mu to nevyjde.

Cili: program nemysli; mysli uzivatel a program mu jenom nazorne predvadi, co vymyslel :-).

V textovem rezimu by to melo jit bez problemu, dosazena pismenka se daji pohodlne zvyraznovat Textcolorem (v grafice by byl efektnejsi ten histogram, ale to by zase bylo o hodne pracnejsi). Cely vstupni text se da ulozit do pole znaku (array[1..hodne] of char), aby se nemusel porad cist ten soubor. Dale dosazovaci pole: za indexy se budou dosazovat znaky ze sifry a budou se do nej ukladat pismena, ktera za ty znaky dosazujeme (pripadne nejaky specialni znak, ktery rekne "tady jeste neni dosazeno nic", treba #0). V grafice by se daly obe tabulky znaku propojovat carami, aby bylo na prvni pohled jasne, kam je ktery znak dosazeny; v textaku by to slo resit bud ruznymi barvami zvyrazneni nebo nejakou pohyblivou znackou.

Ukoly k vyreseni:
1) Nacteni vstupniho textu do pole.
2) Spocitani cetnosti jednotlivych znaku ve vstupnim textu, jejich ulozeni do pole (stejny format jako konstanta Klic v minulem zdrojaku) a serazeni podle velikosti.
3) Vypsani obou tabulek cetnosti na obrazovku se zvyraznenim dosud dosazenych znaku.
4) Zobrazeni kusu sifrovaneho textu na obrazovku s nahrazenim a zvyraznenim dosazenych znaku.
5) Precteni vstupu od uzivatele (povely k dosazeni a zruseni znaku) a prislusna akce v dosazovacim poli.

Takhle nakouskovane uz to vypada jako celkem trivialni zalezitost :-).

To Mircosoft : V jednoduchosti je sila...... kdyby to mel delat program automaticky bez pomoci, trvalo by to strasne dlouho..... Ja uz to celkem mam hotovy, je to sice dost bojova verze (nejak se mi nedari ukoncit jednu podminku cyklu:) ) ale zkouseni pismenek uz mi funguje....takze jen nebejt linej a projit to... :)

Noční šichta, má to někdo hotové?? (jak to mate rychly, na kolik kroku vysledek..?)
Mám tam pár bugů.
Chce to - zív - soubor sifra.txt jako zdroj
http://olox.chytrak.cz/download/SIFRA.TXT
slovnik2.txt pro rychly prevod
http://olox.chytrak.cz/download/SLOVNIK2.TXT
davam sem vlastni ale klidne funguje i s jakymkoliv kompaktnim
jen se dele ceka... (samozrejme cestina, diakritika NE)

Vychazim z toho ze slovnik neni nikdy dost presny a 10MB bych
do Pascalu ani neladoval takze to obcas vyjede obrazovku a chce
potvrdit prubezny vysledek.

Vytvari to toho casu nejakej OUTPUT soubor toho jmena s dekryptem.
Klavesy ovladani neprilis uzivatelsky privetive:
Po zobrazeni listu Prvni STISK klavesy je ZNAK na zmenu
a druhy STISK je nahrazovane pismeno (pr. DS udela zmenu nejen v tomto slove DMRT - > SMRT)
Kdyz se misto znaku zada 00 tak program pokracuje v iteraci slov
ze slovniku pro presnejsi prevod. Tozn. ze se uz nemusi znova
bohuzel zobrazit list adiooos.
Enter Ulozi do vyse zmineneho Output souboru prubezny vysledek
a dale to doplni znaky ktere nebyly ve slovniku treba WQX atd.
http://olox.chytrak.cz/download/FORUM6.EXE
Jdu spat.

To o-lox : Tady mám jeden kod,ale nejde spustit a potřebovala bych ho nějak zjednodušit.

Uses crt;

const klic: array[0..26] of char = (' ','E','A','O','I','N','T','S','L','R','K','V','D','M','U',
'C','P','Z','Y','H','J','B','G','F','X','Q','W');
Label
znova1,znova2,nav1,nav2;

Type titer=record
a:integer;
i1:integer;
ok:boolean;
preskoc:boolean;
pru:integer;
presah:boolean;
end;
tt1=array[0..255]of char;
const
znaky:array[1..3]of char=(' ','.',',');

Var i,j,a,b:integer;
slova:array[1..450]of string[20];
slov:integer;
slovnik:array[1..1500]of string[20];
pslov:integer;
f:File;
prevod:tt1;
cele : array[1..3000]of char;
cteno:integer;
iter : array[1..1501]of titer;
z:char;
ret:string;
poslslovo:integer;
test1,test2:boolean;
ft:text;
nalezeno:integer;
pocetpism : array[0..55]of integer;
rezim:byte;
z1,z2:char;
pevne:tt1;
pouzite:array[0..255]of Byte;
pouzitepole:array[0..255] of byte;
poslpouz:Byte;
zbylo:integer;

procedure intro;
begin
while not(eof(ft)) do
begin readln(ft,ret);
i:=1;
repeat
a:=i;
test1:=true;
While (i<=length(ret))and(ret[i]<>' ') do begin
ret[i]:=upcase(ret[i]);
If (ret[i]>'Z')or(ret[i]<'A') then test1:=false;
inc(i);
end;
If (i<>a) and test1 then begin
slovnik[j]:=copy(ret,a,i-a);
inc(j);
end;
inc(i);
until i>length(ret);
end;
End;

Function najdiznak(a:char):byte;
Var i:integer;
Begin
i:=0;
while prevod[i]<>a do inc(i);
najdiznak:=i;
End;

BEGIN
clrscr;
writeln('Lusteni sifrovaneho souboru sifra.txt');
prevod[ord('I')]:=' ';
slovnik[1]:='NEBO';
slovnik[2]:='ZE';
slovnik[3]:='KDYZ';
slovnik[4]:='ALE';
slovnik[5]:='SE';
slovnik[6]:='TO';
slovnik[7]:='BYL';
slovnik[8]:='BUDE';
slovnik[9]:='RYCHLE';
slovnik[10]:='UDELA';
pslov:=10;
assign(ft,'C:Pascal\slovnik2.txt');
reset(ft);
j:=pslov;
intro;
pslov:=j-1;
close(ft);

Assign(f,'C:Pascal\sifra.txt');
Reset(f,1);
blockread(f,cele,3000,cteno);
pevne[ord('.')]:='.';
pevne[ord(',')]:=',';
pevne[ord('I')]:=' ';
pevne[ord('X')]:='A';
for i:=1 to cteno do
begin
test1:=true;
for j:=1 to poslpouz do
If pouzite[j]=ord(cele[i]) then test1:=false;
If pevne[ord(cele[i])]<>#0 then test1:=false;
If test1 then
begin
inc(poslpouz);
pouzite[poslpouz]:=ord(cele[i]);
end;
end;

i:=1; j:=1;
prevod[ord('.')]:='.';
prevod[ord(',')]:=',';
while i<cteno do begin
a:=i;
while not (prevod[ord(cele[i])] in [' ','.',',']) do
begin
slova[j]:=slova[j]+cele[i];
inc(i);
end;
inc(i);
If (cele[i]=',')or(cele[i]='.') then inc(i);
if slova[j]<>'' then inc(j);
end;
slov:=j;
For i:=1 to slov do
inc(pocetpism[length(slova[i])]);

a:=1;
{ iter[a].i1:=1;}
for i:=1 to 300 do iter[i].ok:=false;
test1:=false;
zbylo:=poslpouz;

Repeat
znova1:
for i:=0 to 255 do
If pevne[i]<>#0 then prevod[i]:=pevne[i];

a:=1;
while iter[a].ok or iter[a].preskoc do inc(a);

If slovnik[a]='' then
begin
If (nalezeno>10)and(zbylo<11{9}) then begin
Repeat
clrscr; if keypressed then readkey;
for i:=1 to 80*23 do
If prevod[ord(cele[i])]>#0 then
write(prevod[ord(cele[i])])
else write('_');
Writeln; write('zadej potvrzeni / 0 = konec');
z1:=readkey;
z2:=readkey;
z1:=upcase(z1);
z2:=upcase(z2); write(z1,z2); delay(600);
If z1=#13 then
begin
for z1:='A' to 'Z' do
begin
test1:=false;
for a:=0 to 255 do
If prevod[a]=z1 then test1:=true;
If not test1 then begin
a:=1;
while pouzitepole[a]>0 do inc(a);
pouzitepole[a]:=1;
prevod[pouzite[a]]:=z1;
end;
end;
end else begin
If (z1='0')or(z2='0') then break;
If z2<>'*' then
pevne[Najdiznak(z1)]:=z2 else
pevne[Najdiznak(z1)]:=#0;
for i:=0 to 255 do
If pevne[i]<>#0 then prevod[i]:=pevne[i];
end;
Until false;
writeln('bezim...');
delay(800);
{ If nalezeno>16 then begin textcolor(RED); write(' ENTER'); textcolor(7); readkey; end;}
end;
nalezeno:=1;
for i:=1 to pslov do
begin iter[i].ok:=false;
iter[i].preskoc:=false;
iter[i].i1:=0;
end;
i:=1;
{ If iter[i].presah then begin
iter[i].presah:=false;
iter[i].pru:=0;
inc(i);
end;}
repeat
inc(iter[i].pru);
If pocetpism[length(slovnik[i])]<=iter[i].pru
then begin
iter[i].pru:=0;
inc(i);
end else break;
until false;

for i:=0 to 255 do prevod[i]:=#0;
for i:=0 to 255 do pouzitepole[i]:=0;
zbylo:=poslpouz;
goto znova1;
end;

For j:=0 to iter[a].pru do
begin
Repeat
inc(iter[a].i1);
while (iter[a].i1<slov)and(length(slova[iter[a].i1])<>length(slovnik[a])) do inc(iter[a].i1);
i:=1;
While prevod[ord(slova[iter[a].i1,i])]<>#0 do inc(i);
Until i<=length(slovnik[a]);
If iter[a].i1=slov then break;
end;

If iter[a].i1=slov then begin
iter[a].presah:=true;
iter[a].i1:=1;
poslslovo:=a;
If rezim=1 then begin
slovnik[a]:=slovnik[pslov];
dec(pslov);
end else
begin
test1:=true;
{ for j:=1 to length(slovnik[a]) do
chyba[ord(slovnik[a,j])]:=1;}
{ a:=poslslovo;}
{ slovnik[a]:=slovnik[pslov];
dec(pslov); }
iter[a].preskoc:=true;
test1:=false;
end;
{ dec(a);
goto znova1;}
end else begin
iter[a].ok:=true;
for j:=1 to length(slova[iter[a].i1]) do
begin
z1:=slova[iter[a].i1,j];
For b:=32 to 96 do
If (ord(z1)<>b)and(prevod=slovnik[a,j]) then begin
iter[a].ok:=false;
goto znova1;
end;
If (prevod[ord(slova[iter[a].i1,j])]<>#0)and
(prevod[ord(slova[iter[a].i1,j])]<>slovnik[a,j])
then begin
iter[a].ok:=false;
goto znova1;
end;
for b:=j+1 to length(slova[iter[a].i1]) do
If (((slova[iter[a].i1,j]=slova[iter[a].i1,b])
and(slovnik[a,j]<>slovnik[a,b]))
or
((slovnik[a,j]=slovnik[a,b])
and(slova[iter[a].i1,j]<>slova[iter[a].i1,b])))
then begin
iter[a].ok:=false;
goto znova1;
end;
end;
for j:=1 to length(slova[iter[a].i1]) do
begin
prevod[ord(slova[iter[a].i1,j])]:=slovnik[a,j];
for b:=1 to poslpouz do
If pouzite=ord(slova[iter[a].i1,j]) then
begin
{ pouzite:=pouzite[poslpouz];
dec(poslpouz);}
If pouzitepole=0 then dec(zbylo);
pouzitepole:=1;
break;
end;
end;
end;
If iter[a].ok then inc(nalezeno);
Until false;
close(f);
END.