- Hálózati / IP kamera
- Facebook és Messenger
- Mikrotik routerek
- Milyen NAS-t vegyek?
- Kínában túl sok az EV, fokozódik az árháború
- Van, amit nehéz lett megtalálni a Google keresőjével
- Kodi és kiegészítői magyar nyelvű online tartalmakhoz (Linux, Windows)
- Telekom otthoni szolgáltatások (TV, internet, telefon)
- Crypto Trade
- OpenWRT topic
Aktív témák
-
heihachi
addikt
Íme:
program Projectphc;
{$APPTYPE CONSOLE}
uses
SysUtils;
const
n = 6;
var
a : array[1..n] of integer;
b : array[1..n] of integer;
k,j,t,s,max,bol : integer;
begin
a[1] := 12;
a[2] := 2;
a[3] := 11;
a[4] := 4;
a[5] := 10;
a[6] := 7;
b[1] := 0;
b[2] := 0;
b[3] := 0;
b[4] := 0;
b[5] := 0;
b[6] := 0;
for t:= 1 to n-1 do begin
k := a[t];
for j := t+1 to n do begin
if k <= a[j] then begin
inc(b[t]);
end;
end;
end;
b[n] := 0;
max := b[1];
s := 1;
for t := 2 to n do begin
if max < b[t] then begin
max := b[t];
s := t;
end;
end;
k := a[s];
write(s, ' ');
if s <> n then begin
for j := s+1 to n do begin
if a[j] >= k then begin
bol := 0;
if j+1 > n then
write(j, ' ')
else
for t := j+1 to n do begin
if (a[t] < a[j]) and (a[t] >= k) then else bol := 1;
end;
if bol = 1 then begin
k := a[j];
write(j, ' ');
end;
end;
end;
end;
readln;
end."Lehet a Shift 2 már realisztikusabb mint a valóság" by NOD
-
Sihto_
tag
Szia
Tehat a peldadat nezve:
veszi az elso elemet 4
megjegyezzuk a 4 indexet az 1
majd megnezzuk, hogy negytol mekkora a leghosszabb novekvo sorozat : 2
azaz ha kisebb az elozonel akkor kiesik
tehat a 4 eseten a hossz 2 ezt letarolo, meg azt is, hogy ez az elso elemhez tartozik
veszem a kovetkezo elemet ez a 11
vegig megyek a sorozaton es kiesik az elem ha az elozonel kisebb azaz mind, igy itt a hossz 1, tehat a hossz marad a 2 es marad az elso elem
aztan veszem a kovetkezo elemet es igy tovabb majd eljutok a az 1 es elemhez
es akkor az lesz a leghosszab sorozat
remelem igy mar erthetobbA példa minidg erősebb az utasításnál
-
gabesz82
senior tag
Hát még így sem teljesen jó, mert (nem kukacoskodni akarok,csak...):
bemenet:
5 5 1 6 6 5 4 4 6 8
erre kimenetnek ezt adja:
3 7 8 9 10
ami ugye nem jó, mert van hosszabb
1 2 4 5 9 10
De egyébként az összes többi inputra legalábbis amikre leellenőriztem helyes volt a progi, csak erre az egyre nem ad jó eredményt... Valami ötlet??PSN: Morfologus82
-
heihachi
addikt
Nos, átgondoltam az egészet, és teljesen más koncepcióval álltam elő.
Egyszerűbb lett, gyorsabb, rövidebb. Meg szerintem jó is, de még tesztelem...
Ezt TP7-alá írtam, hátha nincs mindenkinek Delphije
program phv2;
uses
crt;
const
n = 10;
var
t, j, maxsorhossz : byte;
a,b : array[1..n] of integer;
aktualisa : integer;
maxsorhosszb, maxhozindexb : byte;
begin
clrscr;
a[1] := 5;
a[2] := 5;
a[3] := 1;
a[4] := 6;
a[5] := 6;
a[6] := 5;
a[7] := 4;
a[8] := 4;
a[9] := 6;
a[10] := 8;
b[1] := 0;
b[2] := 0;
b[3] := 0;
b[4] := 0;
b[1] := 0;
b[1] := 0;
b[1] := 0;
b[1] := 0;
b[1] := 0;
b[1] := 0;
for t := n downto 1 do begin
aktualisa := a[t];
maxsorhossz := 0;
for j := t to n do begin
if a[j] >= aktualisa then begin
if b[j]+1 > maxsorhossz then maxsorhossz := b[j]+1;
end;
end;
b[t] := maxsorhossz;
end;
maxsorhosszb := 0;
maxhozindexb := 0;
for t := 1 to n do begin
if b[t] >= maxsorhosszb then begin
maxhozindexb := t;
maxsorhosszb := b[t];
end;
end;
aktualisa := 0;
for t := maxhozindexb to n do begin
if a[t] >= aktualisa then begin
aktualisa := a[t];
write(' ',t,' ');
end;
end;
readln;
end."Lehet a Shift 2 már realisztikusabb mint a valóság" by NOD
-
heihachi
addikt
Ez majdnem jó, de a kiíratásnál hibáztam . Mostmár végigpróbáltam a topik összes példájára és műxik. Ha ez is hibás, akkor akkor jön a v3
Tehát helyesen:
program phv21;
uses
crt;
const
n = 10;
var
t, j, maxsorhossz : byte;
a,b : array[1..n] of integer;
aktualisa : integer;
maxsorhosszb, maxhozindexb, aktualisindexa : byte;
begin
clrscr;
a[1] := 5;
a[2] := 5;
a[3] := 1;
a[4] := 6;
a[5] := 6;
a[6] := 5;
a[7] := 4;
a[8] := 4;
a[9] := 6;
a[10] := 8;
for t := n downto 1 do begin
aktualisa := a[t];
maxsorhossz := 0;
for j := t to n do begin
if a[j] >= aktualisa then begin
if b[j]+1 > maxsorhossz then maxsorhossz := b[j]+1;
end;
end;
b[t] := maxsorhossz;
end;
maxsorhosszb := 0;
maxhozindexb := 0;
for t := 1 to n do begin
if b[t] >= maxsorhosszb then begin
maxhozindexb := t;
maxsorhosszb := b[t];
end;
end;
aktualisa := a[maxhozindexb];
aktualisindexa := maxhozindexb;
for t := aktualisindexa to n do begin
if (a[t] >= aktualisa) and ((b[t] = b[aktualisindexa]-1) or (b[t] = b[aktualisindexa])) then begin
aktualisa := a[t];
aktualisindexa := t;
write(' ',t,' ');
end;
end;
readln;
end."Lehet a Shift 2 már realisztikusabb mint a valóság" by NOD
-
Szsolt
tag
Mér nem tanulsz meg C-ül?
Eleinte én is Pascallal nyomultam, és mikor C-t kezdtem el tanulni, még undorom volt..., de mára szvsz a C a legjobb eljárás-orientált nyelv, és azt szeretem benne, hogy kib@szott rövid kódokat lehet vele írni.
(pl. ami Pascalban 10 sor az C-ben 3-4 sorba össze lehet zsúfolni) -
Szsolt
tag
Elemeztem 1 kicsit a kódodat...vérprofi
Különösen ez a részlet tetszett:
for t := n downto 1 do begin
aktualisa := a[t];
maxsorhossz := 0;
for j := t to n do begin
if a[j] >= aktualisa then begin
if b[j]+1 > maxsorhossz then maxsorhossz := b[j]+1;
end;
end;
b[t] := maxsorhossz;
end;
Amilyen eccerű, olyan nehezen jöttem volna rá. (ha persze egyáltalán rájöttem volna ) -
gabesz82
senior tag
Tényleg rettentő ötletes és profi az algoritmus... eddig még nem sikerült kifogni rajta, kb 120-130 inputra néztem meg és mindre jó volt... Szóval tényleg nagyon frankó kis algoritmus... Köszönöm szépen Heihachi és Szsolt... vagy Szsolt és Heihachi... mindegy melyik sorrendet írom, mert mindketten rengeteget segítettetek...
[Szerkesztve]PSN: Morfologus82
Aktív témák
- exHWSW - Értünk mindenhez IS
- Samsung Galaxy S22 Ultra - na, kinél van toll?
- Kamionok, fuvarozás, logisztika topik
- A Watch7-tel debütálhat a Samsung vércukormérője
- Hálózati / IP kamera
- Honor Magic5 Pro - kamerák bűvöletében
- Kerékpárosok, bringások ide!
- Rendkívül ütőképesnek tűnik az újragondolt Apple tv
- Házi barkács, gányolás, tákolás, megdöbbentő gépek!
- Android szakmai topik
- További aktív témák...
- APPLE MacBook Air 2020 13" Retina - M1 / 8GB / 256 GB SSD / MAGYAR / 96% akku, 81 ciklus / Garancia
- LG NanoCell 55NANO766QA Halvány píxel csík
- Philips 58PUS8545/12 1 ÉV GARANCIA Játék üzemmód
- Tyű-ha! HP EliteBook 850 G7 Fémházas Szuper Strapabíró Laptop 15,6" -65% i7-10610U 32/512 FHD HUN
- Bomba ár! HP EliteBook 840 G5 - i5-8G I 8GB I 128GB SSD I 14" FHD I HDMI I Cam I W10 I Gari!