witam, moglby mi ktos napisac program w turbo pascalu ? Program ma wygladac jak lotek. Losujemy 6 liczb z 49, a komp wyswietla wynik. liczby nie moga sie powtarzac. podczas pisania nie moga byc uzyte tablice tylko same petle. z gory dzieki za pomoc. Dotad poznalem petle for, wyrazenie then, do, repeat, randomize, until i najlepiej zeby tylko tego uzywac ,nic nowego.
Sądzę, że ten kto wam takie zadania wymyśla nie bardzo was lubi ;) Albo z drugiej strony lubi zagłębiać się w kod posiadający znaczne ilości nikomu niepotrzebnych warunków i zmiennych.
Tak czy siak powodzenia. Masochistą nie jestem więc nawet nie będę próbował :D
kumpel napisal i mowil ze mu ponad 120 linijek wyszlo. moze jednak ktos sprobuje ? bede bardzo wdzieczny.
Podstawę już masz...
var
i: byte;
begin
Randomize;
for i := 1 to 6 do Writeln(IntToStr(Random(49)+1));
Readln;
end;
ale żeby było bez powtórzeń... pomyśl ;)
120 [rotfl] [rotfl]
Mam dzisiaj dobry humor ;]
program hahaha;
uses
crt;
var
l1, l2, l3, l4, l5, l6, i: integer;
begin
{ HARDKOR START }
clrscr;
randomize();
for i:=1 to 6 do
if i = 1 then
l1:=random(49)+1
else if i = 2 then
repeat
l2:=random(49)+1;
until l2 <> l1
else if i = 3 then
repeat
l3:=random(49)+1;
until (l3 <> l1) and (l3 <> l2)
else if i = 4 then
repeat
l4:=random(49)+1;
until (l4 <> l1) and (l4 <> l2) and (l4 <> l3)
else if i = 5 then
repeat
l5:=random(49)+1;
until (l5 <> l1) and (l5 <> l2) and (l5 <> l3) and (l5 <> l4)
else if i = 6 then
repeat
l6:=random(49)+1;
until (l6 <> l1) and (l6 <> l2) and (l6 <> l3) and (l6 <> l4) and (l6 <> l5);
writeln(l1,' ',l2,' ',l3,' ',l4,' ',l5,' ',l6) ;
readln;
{ HARDKOR END }
end.
@up a dlaczego random(49-1)+1, przecie to będzie zakres 1-48 :d
Loloki napisał(a)
@up a dlaczego random(49-1)+1, przecie to będzie zakres 1-48 :d
Pomyliłem się, już poprawiłem.
poza tym lepiej: l1, l2, l3, l4, l5, l6, i: byte, a jeszcze lepiej aby zmienna była od 1..49.
Skoro ktoś wymaga takiego masochistycznego podejścia żeby taki program pisać bez użycia tablic to na
pewno na wykładach czy tam ćwiczeniach musiał pokazać jak to zrobić, a nie w ciemno kazał samemu
kombinować bez konkretnych wskazówek. Poniżej masz kod, który kiedyś znalazłem na sieci, dodałem
formatowanie kodu i odstępy miedzy znakami oraz zmienne z wielkiej litery. Kod korzysta z tablic, ale Ci
może pomóc wykombinowanie jak to zrobić bez nich, chyba jedyne co mi przychodzi do głowy to dodać
sześć zmiennych integer dla kazdej liczby osobno, a póżniej w petli repeat until dać losowanie liczby z
zakresu od 1 do 49 until i tutaj lista warunków Liczba1 <> Liczba2 and Liczba1 <> Liczba3 and Liczba...
i tak dalej, ale to istne samobójstwo taki kod. Powinniście utopić swojego wykładowcę jak Marzanne :P
program los49;
uses
Crt;
const
N = 49;
type
Zbior = set of 0..N;
var
X, A : Zbior;
I, J, K : integer;
Z : Char;
B : array [1..6] of integer;
begin
repeat
X := [1..n];
A := [];
A := X;
ClrScr;
Randomize;
for I := 1 to 6 do
begin
J := 0;
B[I] := Random(N) + 1;
repeat
if (B[I] in A) then
begin
A:= A - [B[I]];
J := 1;
end
else
B[I] := Random(N) + 1
until J = 1;
end;
for J := 1 to 5 do
for i:= J + 1 to 6 do
begin
if B[J]> B[I] then
begin
K := B[J];
B[J] := B[I];
B[I] := K;
end;
end;
for I := 1 to 6 do
Write(B[I] : 3);
Writeln;
Writeln('Nacisnij dowolny klawisz zeby kontynuowac albo "k" zeby zakonczyc');
Z:= ReadKey;
until Z = 'k';
end.
to ktory jest najlepszy ? lolokiego czy opiego ? poza tym ktos sie pytal czy koles nam mowil jak to mniej wiecej zrobic ? ODP. NIE. Mielismy tylko wprowadzenie do petli if, zaczelismy randomize a poza tym dwa proste programy np. pole kwadratu czy 1 proste zeby pokazac na czym polega petla. ja nawet nie wiem co to tablica jest (moze mi ktos powiedzciec jak chce). PoZdrawiam ogromne dzieki mam nadzieje ze wasze katusze kiedys wam wynagrodze ;)
kurcze nie wiem czy to o to bedzie mu chodzilo. owszem program lolokiego dziala, ale chyba tutaj chodzi o to ze czlowiek podaje 6 liczb i potem komp losuje je, czyli chyba musza byc te writeln'y itd. (nie wiem, zielony w tym jestem)
wata napisał(a)
kurcze nie wiem czy to o to bedzie mu chodzilo. owszem program lolokiego dziala, ale chyba tutaj chodzi o to ze czlowiek podaje 6 liczb i potem komp losuje je, czyli chyba musza byc te writeln'y itd. (nie wiem, zielony w tym jestem)
Skoro jestes za tępy zeby pojąc co wykladowca mówii zadaje do zrobienia to juz nie wspomne ze nie masz szans zeby to zrobic, koledzy sie troche 'nameczyli' a ty nie szanujesz ich czasu///
olesio zrobił mimo wszystko na tablicach.
co do kodu lolokiego, to algorytm jest inny, ale sposób działania dla użytkownika jest identyczny. nigdzie nie masz wczytania liczb od usera i porównania z wynikami.
btw. loloki, po wuja wacława ta pierwsza pętla? tylko dwukrotnie wydłuża kod. zobacz swoje rozwiązanie w skompresowanej wersji:
var
l1,l2,l3,l4,l5,l6 : byte;
begin
randomize();
l1:=random(49)+1;
repeat l2:=random(49)+1; until l2 <> l1;
repeat l3:=random(49)+1; until not (l3 in [l1,l2]);
repeat l4:=random(49)+1; until not (l4 in [l1,l2,l3]);
repeat l5:=random(49)+1; until not (l5 in [l1,l2,l3,l4]);
repeat l6:=random(49)+1; until not (l6 in [l1,l2,l3,l4,l5]);
writeln(l1,' ',l2,' ',l3,' ',l4,' ',l5,' ',l6) ;
readln;
end.
mam pomysł, bo problem jest całkiem ciekawy (trzeba trochę pogimnastykować szare komorki):
<font size="3">ZRÓBMY KONKURS</span>.
zasady: napisać najkrótszy i najszybszy (najmniej pętli z najsłabszym losowym warunkiem zakończenia) algorytm, który wylosuje 6 z 49 bez powtórzeń i bez użycia tablic (czy zbiorów). założenie jest takie, że random(n) <> 0 może trwać i milion iteracji (oczywiście czysto teoretycznie), nie mówiąc już o (random(n) <> 0) and (random(n) <> 0) and ... Oczywiście wyniki muszą być całkowicie losowe, więc nie bawimy się w random(7), 7+random(7),14+random(7) itp
do wygrania: uśmiech Adama (bezcenny), splendor, zazdrość zaglądających do tego wątku i zachwyt wszystkich pań z forum ;]
na razie prowadzi loloki :-) (ale zaraz wkleję moje wypociny)
ktoś chętny do zabawy?
teraz moje rozwiązanie:
const
MAX = 49;
function RangeModuloRand(a:byte; b:byte; max:byte):byte;
begin
if a < b then result := a + 1 + random(b-a-1) else result := (a + random(MAX+b-a-1)) mod MAX + 1;
end;
var
a,b,c,d,e,f : byte;
begin
randomize();
a := random(MAX)+1;
b := (a+2+random(MAX-5)) mod MAX + 1;
c := RangeModuloRand(a, b, MAX);
d := RangeModuloRand(b, a, MAX);
repeat e := RangeModuloRand(a, b, MAX); until e <> c;
repeat f := RangeModuloRand(b, a, MAX); until f <> d;
writeln(a:3,b:3,c:3,d:3,e:3,f:3);
readln;
end.
na pewno bardziej zakręcone od strony matematyki, ale chyba ładniejsze i na pewno szybsze niż oba rozwiązania prezentowane wyżej. w razie kłopotów z załapaniem idei wrzucę wersję z komentarzami.
jak widać można bez problemu wylosować cztery liczby bez powtórzeń, bez pętli w pięciu-sześciu linijkach kodu. z piątą i szóstą liczbą miałem już problem (można bez pętli, za to z kupą if'ów i ciut mniej losowo). kto da więcej? :>
wata napisał(a)
chyba tutaj chodzi o to ze czlowiek podaje 6 liczb i potem komp losuje je,
Fajny totolotek :)
Człowiek podaje jakie liczby chce wylosować to mu komp je wylosuje ;]
LF: Twój kod z tymi until ...in ... jest tak banalny, że aż na niego nie wpadłem :) Gratulacje. A wie
ktoś z Was może, czy jest w ogóle możliwosć posortowania wyników losowania rosnąco bez użycia
tablicy i jakiejś fukncji typu Sort_Shell? Bo do ideału brakuje żeby te wartości jakoś tam posortować.
W konkursie ten kod nie ma szans, ale przynajmniej pokaże jak jeszcze inaczej można...
var
a1, a2, a3, a4, a5, a6: byte;
begin
randomize;
repeat
a1 := Random(49)+1;
a2 := Random(49)+1;
a3 := Random(49)+1;
a4 := Random(49)+1;
a5 := Random(49)+1;
a6 := Random(49)+1;
until (a1 <> a2) and (a1 <> a3) and (a1 <> a4) and (a1 <> a5) and (a1 <> a6) and (a2 <> a3) and (a2 <> a4) and (a2 <> a5) and (a2 <> a6) and (a3 <> a4) and (a3 <> a5) and (a3 <> a6) and (a4 <> a5) and (a4 <> a6) and (a5 <> a6);
writeln(a1:3,a2:3,a3:3,a4:3,a5:3,a6:3);
readln;
end.
olesio napisał(a)
do ideału brakuje żeby te wartości jakoś tam posortować.
var
a1, a2, a3, a4, a5, a6, i: byte;
s: string;
begin
randomize;
repeat
a1 := Random(49)+1;
a2 := Random(49)+1;
a3 := Random(49)+1;
a4 := Random(49)+1;
a5 := Random(49)+1;
a6 := Random(49)+1;
until (a1 <> a2) and (a1 <> a3) and (a1 <> a4) and (a1 <> a5) and (a1 <> a6) and (a2 <> a3) and (a2 <> a4) and (a2 <> a5) and (a2 <> a6) and (a3 <> a4) and (a3 <> a5) and (a3 <> a6) and (a4 <> a5) and (a4 <> a6) and (a5 <> a6);
{Sortowanie}
for i := 1 to 49 do
begin
if i = a1 then s := s + IntToStr(a1) + ' ';
if i = a2 then s := s + IntToStr(a2) + ' ';
if i = a3 then s := s + IntToStr(a3) + ' ';
if i = a4 then s := s + IntToStr(a4) + ' ';
if i = a5 then s := s + IntToStr(a5) + ' ';
if i = a6 then s := s + IntToStr(a6) + ' ';
end;
writeln(s);
readln;
end.
Dzięki Opi, w sumie łatwy i ciekawy sposób na posortowanie liczb. Poniżej podaje chyba najlepszy kod do
rozwiązania zadania, bez tablic, kompiluje się pod Turbo Pascalem i działa optymalnie, myślę że jakbym go
oceniał to dał bym za niego spokojnie piątkę :) Mozna oczywiście zmienić zmienną integer na Byte, ale z
integerem jest bardziej uniwersalny, gdybyśmy losowali przypadkiem też większe liczby. Można też zrobić
tak aby zakres liczb do wylosowania był jako stałe (na przykłąd n = 49), ale to już jest raczej kosmetyka :)
program los_49_b;
uses
Crt;
var
L1, L2, L3, L4, L5, L6, I : integer;
S : string;
Z : Char;
function IntToStr(I: integer): string;
var
S : string[11];
begin
Str(I, S);
IntToStr := S;
end;
begin
repeat
ClrScr;
Randomize;
L1:=random(49)+1;
repeat L2 := Random(49)+1; until L2 <> l1;
repeat L3 := Random(49)+1; until not (L3 in [L1, L2]);
repeat L4 := Random(49)+1; until not (L4 in [L1, L2, L3]);
repeat L5 := Random(49)+1; until not (L5 in [L1, L2, L3, L4]);
repeat L6 := Random(49)+1; until not (L6 in [L1, L2, L3, L4, L5]);
S := '';
for i := 1 to 49 do
begin
if i = L1 then S := S + IntToStr(L1) + ' ';
if i = L2 then S := S + IntToStr(L2) + ' ';
if i = L3 then S := S + IntToStr(L3) + ' ';
if i = L4 then S := S + IntToStr(L4) + ' ';
if i = L5 then S := S + IntToStr(L5) + ' ';
if i = L6 then S := S + IntToStr(L6) + ' ';
end;
Writeln(S);
Writeln;
Writeln('Nacisnij dowolny klawisz zeby kontynuowac albo "k" zeby zakonczyc');
Z := ReadKey;
until Z in ['k', 'K'];
end.
Powyższy kod nie spełnia niestety warunków konkursu - używa zbiorów.
@Opi:
(a1 <> a2) and (a1 <> a3) and (a1 <> a4) and (a1 <> a5) and (a1 <> a6) and (a2 <> a3) and (a2 <> a4) and (a2 <> a5) and (a2 <> a6) and (a3 <> a4) and (a3 <> a5) and (a3 <> a6) and (a4 <> a5) and (a4 <> a6) and (a5 <> a6);
to kompletna masakra - masz 14 warunków, z których każdy może być (teoretycznie) dowolnie długo niespełniony. za to fajny pomysł na wypisanie posortowanych (tylko else'ów brakuje).
@olesio - to samo. 14 losowych warunków, aby program się skończył.
do pobicia macie DWA. to rząd wielkości niżej, więc trochę więcej wysiłku :P
ŁF napisał(a)
@Opi:
(a1 <> a2) and (a1 <> a3) and (a1 <> a4) and (a1 <> a5) and (a1 <> a6) and (a2 <> a3) and (a2 <> a4) and (a2 <> a5) and (a2 <> a6) and (a3 <> a4) and (a3 <> a5) and (a3 <> a6) and (a4 <> a5) and (a4 <> a6) and (a5 <> a6);
to kompletna masakra - masz 14 warunków, z których każdy może być (teoretycznie) dowolnie długo niespełniony. za to fajny pomysł na wypisanie posortowanych (tylko else'ów brakuje).
15 warunków :d
I wiem o tym, że to masakra, ale tak też można i co ważne działa.
Co do tych ELSE, to ciągle o nich zapominam, a jednak kilka warunków wtedy wyjdzie mniej do spełnienia.
@LF: ja z Twoim kodem nie mam szans :) Podaje tylko gotowe rozwiązanie dla autora tego tematu.
@wata: poniższy kod kompiluje sie w Pascalu poprawnie i działą, no i ma dużo mniej niż 120 linijek.
program los_49_c;
uses
Crt;
var
A1, A2, A3, A4, A5, A6, I : Byte;
S : string;
Z : Char;
function IntToStr(I: integer): string;
var
S : string[11];
begin
Str(I, S);
IntToStr := S;
end;
begin
repeat
Randomize;
repeat
A1 := Random(49)+1;
A2 := Random(49)+1;
A3 := Random(49)+1;
A4 := Random(49)+1;
A5 := Random(49)+1;
A6 := Random(49)+1;
until (A1 <> A2) and (A1 <> A3) and (A1 <> A4) and (A1 <> A5) and (A1 <> A6) and (A2 <> A3) and (A2 <> A4) and (A2 <> A5)
and (A2 <> A6) and (A3 <> A4) and (A3 <> A5) and (A3 <> A6) and (A4 <> A5) and (A4 <> A6) and (A5 <> A6);
S := '';
for I := 1 to 49 do
begin
if I = A1 then S := S + IntToStr(A1) + ' ';
if I = A2 then S := S + IntToStr(A2) + ' ';
if I = A3 then S := S + IntToStr(A3) + ' ';
if I = A4 then S := S + IntToStr(A4) + ' ';
if I = A5 then S := s + IntToStr(A5) + ' ';
if I = A6 then S := S + IntToStr(A6) + ' ';
end;
ClrScr;
Writeln(S);
Writeln;
Writeln('Nacisnij dowolny klawisz zeby kontynuowac albo "k" zeby zakonczyc');
Z := ReadKey;
until (Z = 'k') or (Z = 'K');
end.
Nie używa tablic, zbiorów ani żadnych nieznanych komend (mam nadzieję). Odpisz czy może być?
To jest ostateczny zlepek z tego co stworzyli Opi oraz LF. Podkreślam kod poza tym konkursem :)
To już chyba parodia... ale tak też można ;-)
var
i: byte = 0;
a: byte;
s: string;
c: char;
begin
randomize;
repeat
a := Random(49)+1;
writeln('Wylosowano liczbe: ', IntToStr(a), ' Czy liczba juz byla wylosowana ? t=TAK, Enter=NIE');
Readln(c);
if (c = 't') or (c = 'T') then Continue; {lub if c in ['t','T'] then Continue;}
Inc(i);
s := s + IntToStr(a) + ' ';
until (i = 6);
writeln(s);
readln;
end.
// hehehe, dobre ;] - Ł
Olesio napisał
for I := 1 to 49 do
begin
if I = A1 then S := S + IntToStr(A1) + ' ';
if I = A2 then S := S + IntToStr(A2) + ' ';
if I = A3 then S := S + IntToStr(A3) + ' ';
if I = A4 then S := S + IntToStr(A4) + ' ';
if I = A5 then S := s + IntToStr(A5) + ' ';
if I = A6 then S := S + IntToStr(A6) + ' ';
end;
Dodaj ELSE, tj.:
for I := 1 to 49 do
begin
if I = A1 then S := S + IntToStr(A1) + ' ' else
if I = A2 then S := S + IntToStr(A2) + ' ' else
if I = A3 then S := S + IntToStr(A3) + ' ' else
if I = A4 then S := S + IntToStr(A4) + ' ' else
if I = A5 then S := s + IntToStr(A5) + ' ' else
if I = A6 then S := S + IntToStr(A6) + ' ';
end;
ktoś jeszcze się spróbuje z problemem?
na razie mamy trzy algorytmy losowania i jeden (imho bardzo sprytny) sortowania.
Coraz mniej pomysłów mi przychodzi do głowy ;-)
var
j: byte = 0;
i, a1, a2, a3, a4, a5, a6: byte;
s: string;
begin
Randomize;
repeat
if j > 6 then
begin
s := '';
j := 0;
end;
a1 := Random(49)+1;
a2 := Random(49)+1;
a3 := Random(49)+1;
a4 := Random(49)+1;
a5 := Random(49)+1;
a6 := Random(49)+1;
for i := 1 to 49 do
begin
if i = a1 then
begin
Inc(j);
s := s + IntToStr(a1) + ' ';
end
else
if i = a2 then
begin
Inc(j);
s := s + IntToStr(a2) + ' ';
end
else
if i = a3 then
begin
Inc(j);
s := s + IntToStr(a3) + ' ';
end
else
if i = a4 then
begin
Inc(j);
s := s + IntToStr(a4) + ' ';
end
else
if i = a5 then
begin
Inc(j);
s := s + IntToStr(a5) + ' ';
end
else
if i = a6 then
begin
Inc(j);
s := s + IntToStr(a6) + ' ';
end;
end;
until j = 6;
writeln(s);
readln;
end.
Jeśli j > 6 to znaczy, że wystąpiła duplikacja liczby. Przy okazji jest sortowanie.
mamaimija napisał(a)
wata napisał(a)
kurcze nie wiem czy to o to bedzie mu chodzilo. owszem program lolokiego dziala, ale chyba tutaj chodzi o to ze czlowiek podaje 6 liczb i potem komp losuje je, czyli chyba musza byc te writeln'y itd. (nie wiem, zielony w tym jestem)
Skoro jestes za tępy zeby pojąc co wykladowca mówii zadaje do zrobienia to juz nie wspomne ze nie masz szans zeby to zrobic, koledzy sie troche 'nameczyli' a ty nie szanujesz ich czasu///
dzieki kolego za cieple slowa, ale pozostawie to bez komentarza. Fajnie ze z mojego zadania zrobiliscie sobie konkurs :) Milej zabawy i jeszcze raz wszystkim bardzo dziekuje.
olesio w twoim programie sa komendy ktore sa mi nie znane a zatem nie bylo ich na lekcji: np. S : string;
Char;
function IntToStr
string
Str(I, S);
IntToStr := S
czy programy pozostalych dzialaja na tej samej zasadzie co lolokiego ? w programie lolokiego byly zawarte te komendy ktore mialem na lekcji a wiec jak na razie to jego program napisalem tzn. przepisalem.
wata napisał(a)
olesio w twoim programie sa komendy ktore sa mi nie znane a zatem nie bylo ich na lekcji: np. S : string;
Char;function IntToStr
string
Str(I, S);
IntToStr := S
No wiesz, zawsze możesz zabłysnąć i powiedzieć wykładowcy, że czytałeś w intrnecie o fukncji
StrToInt, a później szukałeś jej w pomocy do Turbo Pascala i trafiłeś na hasło "Str", a w nim był
właśnie przykład tej funcji, taki jak Tobie podałem, tylko parametrem wejściowym była zmienna
typu Longint. A jeżeli nie chcesz dodawać tej funkcji (czy nie możesz) to trudno najwyżej będzie
program bez sortowania. Z sortowaniem powinna byc moim zdaniem wyższa ocena - za inwencję.
program lotto;
uses crt;
const MAX = 49;
var
x1, x2, x3, x4, x5, x6 : byte;
function NewX(x, x1, x2, x3, x4, x5, x6: byte) : byte;
begin
if x >= x1 then inc(x);
if x >= x2 then inc(x);
if x >= x3 then inc(x);
if x >= x4 then inc(x);
if x >= x5 then inc(x);
if x >= x6 then inc(x);
NewX:=x-1;
end;
begin
x3:=MAX;
x4:=MAX;
x5:=MAX;
x6:=MAX;
randomize;
x1 := random(MAX)+1;
x2 := random(MAX-1)+1;
x2:=NewX(x2,x1,x2,x3,x4,x5,x6); { alternatywnie: if x2>=x1 then inc(x2); poniżej można podobnie }
x3 := random(MAX-2)+1;
x3:=NewX(x3,x1,x2,x3,x4,x5,x6);
x4 := random(MAX-3)+1;
x4:=NewX(x4,x1,x2,x3,x4,x5,x6);
x5 := random(MAX-4)+1;
x5:=NewX(x5,x1,x2,x3,x4,x5,x6);
x6 := random(MAX-5)+1;
x6:=NewX(x6,x1,x2,x3,x4,x5,x6);
writeln(x1:3,x2:3,x3:3,x4:4,x5:5,x6:6);
repeat until keypressed;
end.
No to ja zaprezentuję program bez żadnej pętli xD Co prawda nie porównywałem jego złożoności z algorytmem ŁF, gdyż przyznam się nie przeanalizowałem go dokładnie (dość zagmatwany), ale od tych pierwszych propozycji będzie bardziej wydajny, gdyż każde losowanie odbywa się tylko raz. Po każdym losowaniu "odrzucam" wylosowaną liczbę i losuję w mniejszym zakresie. Oczywiście może być w tym jakiś błąd - nie testowałem, ale chodzi chyba o samą ideę :) Oczywiście przydałoby się ten algorytm jeszcze zoptymalizować...
a co daje to sortowanie liczb dokladnie ?
Sortowanie w tym przypadku oznacza wypisanie wylosowanych liczb na ekran w kolejności rosnącej.