Pascal-ban miként lehet olyan programot írni, amely nagyobb számrendszerekbe is képes váltani? Gondolok itt akár háromjegyű számrendszerbe történő váltásra is.
Olyan módon lenne jó, hogy az oda-vissza váltás is működjön.
Ebben a kérdésben:
http://www.gyakorikerdesek.hu/szamitastechnika__programozas_..
SimkoL válaszában ismertetett nagyszerű programot lehet bővíteni, akkor 70-es számrendszerbe tud váltani (ASCII 126 fölé nem hiszem hogy szerencsés menni, azért csak ennyivel tud számolni, ha bővítem), de már a visszaalakítást ekkor sem tudom megoldani...
Milyen megközelítést kell alkalmazni és hogyan kell nekiállni, hogy háromjegyű számrendszerekbe váltson oda-vissza?
Tessék, ez 2 - 36 közötti számrendszerből vált decimálisra, nem mondom, hogy bolondbiztos, de igyekeztem. ['0'..'9', 'A'..'Z'] a 'számjegykészlet'. El tudod készíteni a decimálisból tetszőlegesbe (2-36) váltást a 'Melyikre' függvényem alapján ?
program Project2;
{$APPTYPE CONSOLE} //Delphi miatt, jobban 'kézreáll mint a Lazarus :)
uses SysUtils, Math;
function Tizesre(szamrendszer : byte; szam : string) : int64;
var i, ertek : byte;
tomb : set of char;
begin
Result := 0;
tomb := [];
if (szamrendszer > 36) or (szamrendszer < 2) then
begin
//Csak 2 - 36 közötti számrendszerben működik
WriteLn('Hiba ! A számrendszer 2 és 36 között lehet !');
Exit;
end;
for i := 0 to szamrendszer - 1 do
begin
//Bepakoljuk egy halmazba az érvényes karaktereket
if i < 10 then Include(tomb, Chr(i + 48));
if i > 9 then Include(tomb, Chr(i + 55));
end;
szam := UpperCase(szam);
for i := 1 to Length(szam) do
begin
if not (szam[i] in tomb) then
begin
//Érvénytelen karakter esetén kilépünk
WriteLn('Hiba ! Érvénytelen karakter ! --> ', szam[i]);
Exit;
end;
end;
for i := Length(szam) downto 1 do
begin
//Elvileg már csak az elfogadható számrendszer és az abban érvényes karakterek vannak
ertek := Ord(szam[i]) - 48;
if Ord(szam[i]) > 64 then ertek := Ord(szam[i]) - 55;
Result := Result + Trunc(ertek * (Power(szamrendszer, Length(szam) - i)));
end;
end;
begin
WriteLn(Tizesre(36, '11'));
ReadLn
end.
Igen, elkészítettem.
Egyszerűsíthettem volna, mert most tulajdonképpen két külön módon dolgozik a két függvény, egyik lokálisan, másik pedig globálisan definiált tömbbel.
program Project2;
{$APPTYPE CONSOLE} //Delphi miatt, jobban 'kézreáll mint a Lazarus :)
{$MODE OBJFPC}
uses SysUtils, Math;
var
jegyek : array[0..35] of char;
szam : longint;
szams : string;
function Tizesre(szamrendszer : byte; szam : string) : int64;
var i, ertek : byte;
tomb : set of char;
begin
Result := 0;
tomb := [];
if (szamrendszer > 36) or (szamrendszer < 2) then
begin
//Csak 2 - 36 közötti számrendszerben működik
WriteLn('Hiba ! A számrendszer 2 és 36 között lehet !');
Exit;
end;
for i := 0 to szamrendszer - 1 do
begin
//Bepakoljuk egy halmazba az érvényes karaktereket
if i < 10 then Include(tomb, Chr(i + 48));
if i > 9 then Include(tomb, Chr(i + 55));
end;
szam := UpperCase(szam);
for i := 1 to Length(szam) do
begin
if not (szam[i] in tomb) then
begin
//Érvénytelen karakter esetén kilépünk
WriteLn('Hiba ! Érvénytelen karakter ! --> ', szam[i]);
Exit;
end;
end;
for i := Length(szam) downto 1 do
begin
//Elvileg már csak az elfogadható számrendszer és az abban érvényes karakterek vannak
ertek := Ord(szam[i]) - 48;
if Ord(szam[i]) > 64 then ertek := Ord(szam[i]) - 55;
Result := Result + Trunc(ertek * (Power(szamrendszer, Length(szam) - i)));
end;
end;
function Melyikre(szamrendszer : byte; szam : int64) : string;
var i, vm : byte;
verem : array of byte;
begin
if szam = 0 then Exit;
Result := '';
SetLength(verem, 0);
while szam <> 0 do
begin
vm := Length(verem);
SetLength(verem, vm + 1);
verem[vm] := szam mod szamrendszer;
szam := szam div szamrendszer;
end;
for i := Length(verem) - 1 downto 0 do
Result := Result + jegyek[verem[i]];
SetLength(verem, 0);
end;
procedure Feltoltes;
var i : byte;
begin
for i := 0 to 9 do jegyek[i] := chr(48 + i);
for i := 10 to 35 do jegyek[i] := chr(55 + i);
end;
begin
Write('Kerem a szamot : ');
ReadLn(szam);
Feltoltes;
szams := (Melyikre(36, szam));
WriteLn('36. szamrendszerben: ',szams);
WriteLn('tizesben:',Tizesre(36, szams));
ReadLn
end.
program Project2;
{$APPTYPE CONSOLE} //Delphi miatt, jobban 'kézreáll mint a Lazarus :)
{$MODE OBJFPC}
uses SysUtils, Math;
var
szam : longint;
szams : string;
function Tizesre(szamrendszer : byte; szam : string) : int64;
var i, ertek : byte;
tomb : set of char;
begin
Result := 0;
tomb := [];
if (szamrendszer > 36) or (szamrendszer < 2) then
begin
//Csak 2 - 36 közötti számrendszerben működik
WriteLn('Hiba ! A számrendszer 2 és 36 között lehet !');
Exit;
end;
for i := 0 to szamrendszer - 1 do
begin
//Bepakoljuk egy halmazba az érvényes karaktereket
if i < 10 then Include(tomb, Chr(i + 48));
if i > 9 then Include(tomb, Chr(i + 55));
end;
szam := UpperCase(szam);
for i := 1 to Length(szam) do
begin
if not (szam[i] in tomb) then
begin
//Érvénytelen karakter esetén kilépünk
WriteLn('Hiba ! Érvénytelen karakter ! --> ', szam[i]);
Exit;
end;
end;
for i := Length(szam) downto 1 do
begin
//Elvileg már csak az elfogadható számrendszer és az abban érvényes karakterek vannak
ertek := Ord(szam[i]) - 48;
if Ord(szam[i]) > 64 then ertek := Ord(szam[i]) - 55;
Result := Result + Trunc(ertek * (Power(szamrendszer, Length(szam) - i)));
end;
end;
function Melyikre(szamrendszer : byte; szam : int64) : string;
var
jegyek : array[0..35] of char;
i, vm : byte;
verem : array of byte;
begin
if szam = 0 then Exit;
Result := '';
SetLength(verem, 0);
while szam <> 0 do
begin
vm := Length(verem);
SetLength(verem, vm + 1);
verem[vm] := szam mod szamrendszer;
szam := szam div szamrendszer;
end;
for i := 0 to 9 do jegyek[i] := chr(48 + i);
for i := 10 to 35 do jegyek[i] := chr(55 + i);
for i := Length(verem) - 1 downto 0 do
Result := Result + jegyek[verem[i]];
SetLength(verem, 0);
end;
begin
Write('Kerem a szamot : ');
ReadLn(szam);
szams := (Melyikre(36, szam));
WriteLn('36. szamrendszerben: ',szams);
WriteLn('tizesben:',Tizesre(36, szams));
ReadLn
end.
Akkor ha működik - meg nem néztem -, jön az optimalizálás, az a hibakezelés ami netán kimaradt :) A jegyek tömbből készítünk egy konstans tömböt, esetünkben egy stringet kilőve két for ciklust - nem jutott eszembe kapásból az ABC :) -. Ebből a felindulásból már könnyen fel tudjuk a halmazunkat is tölteni if-ek nélkül is az éppen szükséges mértékig. Persze ekkor már globális dolgokról beszélünk.
.. és ha így folyik tovább.... még akármi is történhet.
Gondoltam, beteszem a hibakezelést függvénybe, csak nem sikerült, mert ezt az újfajta result-os metódust nem ismerem, így nem mertem belevágni, valamint nem tudom hogy itt is ki lehetne -e lépni "exit" parancssal, ezt eddig nem ismertem.
Nem tudom, konstans tömb a szebb megoldás, vagy - ez utólag jutottt eszembe - a pred, succ segítségével feltölteni...
program Project2;
{$APPTYPE CONSOLE} //Delphi miatt, jobban 'kézreáll mint a Lazarus :)
{$MODE OBJFPC}
uses SysUtils, Math;
const
jegyek : array [0..35] of char =('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F','G','H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V','W','X','Y','Z');
var
szam : longint;
szams : string;
function Tizesre(szamrendszer : byte; szam : string) : int64;
var i, ertek : byte;
tomb : set of char;
begin
Result := 0;
tomb := [];
if (szamrendszer > 36) or (szamrendszer < 2) then
begin
//Csak 2 - 36 közötti számrendszerben működik
WriteLn('Hiba ! A számrendszer 2 és 36 között lehet !');
Exit;
end;
for i := 0 to szamrendszer - 1 do
begin
//Bepakoljuk egy halmazba az érvényes karaktereket
include(tomb,jegyek[i]);
end;
szam := UpperCase(szam);
for i := 1 to Length(szam) do
begin
if not (szam[i] in tomb) then
begin
//Érvénytelen karakter esetén kilépünk
WriteLn('Hiba ! Érvénytelen karakter ! --> ', szam[i]);
Exit;
end;
end;
for i := Length(szam) downto 1 do
begin
//Elvileg már csak az elfogadható számrendszer és az abban érvényes karakterek vannak
ertek := Ord(szam[i]) - 48;
if Ord(szam[i]) > 64 then ertek := Ord(szam[i]) - 55;
Result := Result + Trunc(ertek * (Power(szamrendszer, Length(szam) - i)));
end;
end;
function Melyikre(szamrendszer : byte; szam : int64) : string;
var
i, vm : byte;
verem : array of byte;
begin
if szam = 0 then Exit;
Result := '';
if (szamrendszer > 36) or (szamrendszer < 2) then
begin
//Csak 2 - 36 közötti számrendszerben működik
WriteLn('Hiba ! A számrendszer 2 és 36 között lehet !');
Exit;
end;
SetLength(verem, 0);
while szam <> 0 do
begin
vm := Length(verem);
SetLength(verem, vm + 1);
verem[vm] := szam mod szamrendszer;
szam := szam div szamrendszer;
end;
for i := Length(verem) - 1 downto 0 do
Result := Result + jegyek[verem[i]];
SetLength(verem, 0);
end;
begin
Write('Kerem a szamot : ');
ReadLn(szam);
szams := (Melyikre(36, szam));
WriteLn('36. szamrendszerben: ',szams);
WriteLn('tizesben:',Tizesre(36, szams));
ReadLn
end.
Én valahogy így gondoltam volna:
program project1;
{$MODE OBJFPC}
uses SysUtils, Math;
const jegyek: string[36] = ('0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ');
var
szam: longint;
szams: string;
function Valid(szamrendszer: byte; szamstr: string): boolean;
var i: integer;
tomb: set of char;
begin
tomb := [];
for i := 1 to szamrendszer do Include(tomb, jegyek[i]);
Result := (szamrendszer < 37) and (szamrendszer > 1);
if not Result then
begin
WriteLn('Hiba ! A számrendszer 2 és 36 között lehet !');
Exit;
end;
for i := 1 to Length(szamstr) do
if not (szamstr[i] in tomb) then
begin
Result := False;
WriteLn('Hiba ! Érvénytelen karakter ! --> ', szamstr[i]);
Exit;
end;
end;
function Tizesre(szamrendszer: byte; szam: string): int64;
var i: byte;
begin
Result := 0;
szam := UpperCase(szam);
if Valid(szamrendszer, szam) then
for i := Length(szam) downto 1 do
Result := Result + Trunc((Pos(szam[i], jegyek) - 1) * (Power(szamrendszer, Length(szam) - i)));
end;
function Melyikre(szamrendszer: byte; szam: int64): string;
begin
if szam = 0 then
begin
Result := '0';
Exit;
end;
Result := '';
if Valid(szamrendszer, '') then
while szam <> 0 do
begin
Result := jegyek[(szam mod szamrendszer) + 1] + Result;
szam := szam div szamrendszer;
end;
end;
begin
Write('Kerem a szamot : ');
ReadLn(szam);
szams := (Melyikre(36, szam));
WriteLn('36-os szamrendszerben: ', szams);
WriteLn('tizesben:', Tizesre(36, szams));
ReadLn;
end.
Szerintem Delphiben is van erre beépített függvény, ami 2-36 -ig vált, C -ben van.
char buffer[50];
itoa(5000, buffer, 36);
long result = strtol(buffer, NULL, 36);
Kapcsolódó kérdések:
Minden jog fenntartva © 2024, www.gyakorikerdesek.hu
GYIK | Szabályzat | Jogi nyilatkozat | Adatvédelem | Cookie beállítások | WebMinute Kft. | Facebook | Kapcsolat: info(kukac)gyakorikerdesek.hu
Ha kifogással szeretne élni valamely tartalommal kapcsolatban, kérjük jelezze e-mailes elérhetőségünkön!