Koetan ratkoa tänä vuonna Advent of Coden tehtävät QBasicilla ja raportoin tässä keskustelussa kokeilun tulokset. En ole aiemmin osallistunut Advent of Codeen, eikä minulla ole tarkkaa käsitystä tehtävien tyylistä.
QBasicin ainoa valmiina oleva tietorakenne on kiinteän kokoinen taulukko. Myös esimerkiksi taulukon järjestäminen täytyy toteuttaa itse. Koetan löytää yksinkertaisia tapoja tehtävien ratkaisemiseen ja välttää muita tietorakenteita kuin taulukkoa.
Toinen haaste on, että QBasicin suurin kokonaislukutyyppi (LONG) on 32-bittinen. Tästä voi tulla ongelmia, jos tehtävissä tulee käsitellä suurempia lukuja.
Nimestään ("quick basic") huolimatta QBasic ei ole kovin nopea kieli. Tämän takia toivon, että tehtävissä ei tarvitse käsitellä suurta määrtä dataa tai tehdä raskasta laskentaa, jotta ratkaisuni toimivat riittävän nopeasti.
Käytössäni on QBasicin versio 1.1 vuodelta 1992. Käytän QBasicia DOSBoxin kautta.
Päivä 1
Tehtävän ensimmäisestä osasta tulee mieleen tehtävä Differences HIIT Open 2019:sta. Tässä tehtävässä ei kuitenkaan tarvitse valita itse listojen järjestystä, vaan riittää käsitellä alkiot pienimmästä suurimpaan.
Tehtävän ratkaiseminen alkoi hieman hitaasti, koska tiedoston lukemisessa oli ongelmia. Syyksi osoittautui, että Advent of Coden tiedostossa on unix-rivinvaihdot, kun taas QBasic pystyy käsittelemään vain dos-rivinvaihtoja. Muutin rivinvaihdot ja tiedoston lukeminen alkoi toimia.
Ratkaisin ensimmäisen osan seuraavalla koodilla:
N% = 1000
DIM A&(N%)
DIM B&(N%)
OPEN "DAY1.TXT" FOR INPUT AS #1
FOR I% = 1 TO N%
INPUT #1, A&(I%), B&(I%)
NEXT
CLOSE #1
FOR I% = 1 TO N%
FOR J% = 1 TO N% - 1
IF A&(J%) > A&(J% + 1) THEN SWAP A&(J%), A&(J% + 1)
IF B&(J%) > B&(J% + 1) THEN SWAP B&(J%), B&(J% + 1)
NEXT
NEXT
TOTAL& = 0
FOR I% = 1 TO N%
TOTAL& = TOTAL& + ABS(A&(I%) - B&(I%))
NEXT
PRINT TOTAL&Koodi lukee ensin listoilla olevat luvut taulukoihin A& ja B&. Listoissa on vain 1000 lukua, mikä on mukavan pieni määrä.
Muuttujissa merkki % tarkoittaa INTEGER-tyyppiä (16-bittinen) ja & tarkoittaa LONG-tyyppiä (32-bittinen). Tehtävän luvut ovat sen verran suuria, että niiden käsittelyyn tarvitaan LONG-tyyppiä.
Järjestän taulukot kuplajärjestämisen avulla, mikä on helppo toteuttaa. Tässä on kätevä QBasicissa oleva komento SWAP, joka vaihtaa kahden muuttujan sisällön. Tämän jälkeen riittää käydä läpi taulukot ja laskea yhteen etäisyydet.
Tehtävän toinen osa on mukavampi ratkaista, koska siinä ei tarvitse järjestämistä. Ratkaisin toisen osan näin:
N% = 1000
DIM A&(N%)
DIM B&(N%)
OPEN "DAY1.TXT" FOR INPUT AS #1
FOR I% = 1 TO N%
INPUT #1, A&(I%), B&(I%)
NEXT
CLOSE #1
TOTAL& = 0
FOR I% = 1 TO N%
COUNT% = 0
FOR J% = 1 TO N%
IF A&(I%) = B&(J%) THEN COUNT% = COUNT% + 1
NEXT
TOTAL& = TOTAL& + A&(I%) * COUNT%
NEXT
PRINT TOTAL&Tässä ensimmäinen silmukka käy läpi vasemman listan luvut ja toinen silmukka käy läpi jokaisen luvun kohdalla oikean listan luvut. Näin saadaan laskettua, montako kertaa vasemman listan luku esiintyy oikealla listalla.
Vaikka tässä tehtävässä on melko pieni syöte, kummankin koodin suoritus vei aikaa useita minuutteja. Tämä on hieman huolestuttavaa tulevien tehtävien kannalta. Täytyy tosiaan toivoa, että syötteet pysyvät riittävän pieninä.
Päivä 2
Tehtävän ratkaisemista vaikeutti, että tiedoston riveillä on vaihteleva määrä lukuja. Muuten tehtävän pystyi ratkaisemaan melko suoraviivaisesti QBasicilla.
Ratkaisin ensimmäisen osan näin:
TOTAL% = 0
OPEN "DAY2.TXT" FOR INPUT AS #1
FOR I% = 1 TO 1000
LINE INPUT #1, LINE$
LINE$ = LINE$ + " "
POS1% = 1
PREV% = 0
FAIL1% = 0: FAIL2% = 0
DO
POS2% = INSTR(POS1%, LINE$, " ")
IF POS2% = 0 THEN EXIT DO
CUR% = VAL(MID$(LINE$, POS1%, POS2% - POS1%))
IF PREV% <> 0 THEN
DIFF% = CUR% - PREV%
IF DIFF% < 1 OR DIFF% > 3 THEN FAIL1% = 1
IF -DIFF% < 1 OR -DIFF% > 3 THEN FAIL2% = 1
END IF
PREV% = CUR%
POS1% = POS2% + 1
LOOP
IF FAIL1% = 0 OR FAIL2% = 0 THEN TOTAL% = TOTAL% + 1
NEXT
CLOSE #1
PRINT TOTAL%Koodi lukee rivin muuttujaan LINE$ ja etsii sitten rivillä olevat luvut funktion INSTR avulla. Ideana on etsiä riviltä kohdat, joissa on välilyönti. Funktion syntaksi on kiinnostava, koska siinä on valinnainen parametri ensimmäisenä parametrina. INSTR(A$, B$) etsii ensimmäisen kohdan, jossa B$ esiintyy A$:ssa. INSTR(P%, A$, B$) etsii puolestaan ensimmäisen kohdan, joka on aikaisintaan kohdassa P%.
Havaitsin koodatessa, että seuraava koodi ei toimi odotetulla tavalla:
FAIL1% = FAIL2% = 0
Tavoitteena oli asettaa kummankin muuttujan arvoksi 0, mutta koodi ei tee tätä. QBasicissa merkki = on sekä sijoitus että vertailu, ja koodi sijoittaa muuttujaan FAIL1% vertailun FAIL2% = 0 totuusarvon (tosi on -1 ja epätosi on 0).
Tehtävän toinen osa ratkesi laajentamalla ensimmäisen osan koodia:
TOTAL% = 0
DIM LEVEL%(10)
OPEN "DAY2.TXT" FOR INPUT AS #1
FOR I% = 1 TO 1000
LINE INPUT #1, LINE$
LINE$ = LINE$ + " "
POS1% = 1
COUNT% = 0
DO
POS2% = INSTR(POS1%, LINE$, " ")
IF POS2% = 0 THEN EXIT DO
COUNT% = COUNT% + 1
LEVEL%(COUNT%) = VAL(MID$(LINE$, POS1%, POS2% - POS1%))
POS1% = POS2% + 1
LOOP
FOR SKIP% = 0 TO COUNT%
PREV% = 0
FAIL1% = 0: FAIL2% = 0
FOR J% = 1 TO COUNT%
IF J% <> SKIP% THEN
CUR% = LEVEL%(J%)
IF PREV% <> 0 THEN
DIFF% = CUR% - PREV%
IF DIFF% < 1 OR DIFF% > 3 THEN FAIL1% = 1
IF -DIFF% < 1 OR -DIFF% > 3 THEN FAIL2% = 1
END IF
PREV% = CUR%
END IF
NEXT
IF FAIL1% = 0 OR FAIL2% = 0 THEN
TOTAL% = TOTAL% + 1
EXIT FOR
END IF
NEXT
NEXT
CLOSE #1
PRINT TOTAL%Päädyin tässä lukemaan aluksi rivin luvut taulukkoon, jotta olisi helpompaa käydä läpi eri tavat valita poistettava luku. Tämän olisi voinut toteuttaa myös ilman taulukkoa, mutta toteutus vaikutti melko monimutkaiselta eikä sille ollut tarvetta tässä tapauksessa.
Tässä koodissa ongelmana oli aluksi, että olin käyttänyt samaa muuttujaa I% sisäkkäisissä silmukoissa. Tämän seurauksena sisempi silmukka sekoitti ulomman silmukan toiminnan ja koodi yritti lukea liikaa rivejä tiedostosta. Ongelma ratkesi, kun otin käyttöön toisen muuttujan J% sisemmässä silmukassa.
Päivä 3
Eilen käyttämäni funktio INSTR soveltuu hyvin myös tähän tehtävään. Ratkaisin ensimmäisen osan näin:
TOTAL& = 0
OPEN "DAY3.TXT" FOR INPUT AS #1
WHILE NOT EOF(1)
LINE INPUT #1, LINE$
START% = 1
DO
POS1% = INSTR(START%, LINE$, "mul(")
IF POS1% = 0 THEN EXIT DO
POS2% = INSTR(POS1%, LINE$, ",")
POS3% = INSTR(POS2%, LINE$, ")")
IF POS2% > 0 AND POS3% > 0 THEN
NUM1$ = MID$(LINE$, POS1% + 4, POS2% - POS1% - 4)
NUM2$ = MID$(LINE$, POS2% + 1, POS3% - POS2% - 1)
IF VALID%(NUM1$) AND VALID%(NUM2$) THEN
TOTAL& = TOTAL& + VAL(NUM1$) * VAL(NUM2$)
END IF
END IF
START% = POS1% + 1
LOOP
WEND
CLOSE #1
PRINT TOTAL&
FUNCTION VALID% (NUM$)
N% = LEN(NUM$)
VALID% = 1
IF N% < 1 OR N% > 3 THEN
VALID% = 0
ELSE
FOR I% = 1 TO N%
DIGIT$ = MID$(NUM$, I%, 1)
IF DIGIT$ < "0" OR DIGIT$ > "9" THEN VALID% = 0
NEXT
END IF
END FUNCTIONEtsin funktion INSTR avulla seuraavan kohdan, jossa on merkkijono mul(. Lisäksi etsin seuraavat kohdat, joissa on merkkijonot , ja ). Näiden kohtien avulla voidaan löytää seuraava mul-komento ja sen parametrit.
Tässä tehtävässä käytin ensimmäistä kertaa funktiota. Funktio VALID% tarkastaa, onko mul-komennon parametri kelvollinen luku (muodostuu numeroista ja pituus 1–3 numeroa). QBasicissa funktion palautusarvo määritellään antamalla arvo funktion nimiselle muuttujalle.
Tehtävän toinen osa on melko samanlainen mutta hieman vaikeampi. Ratkaisin toisen osan näin:
TOTAL& = 0
MODE% = 1
OPEN "DAY3.TXT" FOR INPUT AS #1
WHILE NOT EOF(1)
LINE INPUT #1, LINE$
START% = 1
DO
POS1% = INSTR(START%, LINE$, "mul(")
IF POS1% = 0 THEN EXIT DO
POSX% = INSTR(START%, LINE$, "do()")
POSY% = INSTR(START%, LINE$, "don't()")
FIRSTX% = 0: FIRSTY% = 0
IF POSX% <> 0 AND POSX% < POS1% THEN FIRSTX% = 1
IF POSY% <> 0 AND POSY% < POS1% THEN FIRSTY% = 1
IF FIRSTX% = 1 OR FIRSTY% = 1 THEN
IF FIRSTY% = 0 OR (FIRSTX% = 1 AND POSX% < POSY%) THEN
MODE% = 1
START% = POSX% + 1
ELSE
MODE% = 0
START% = POSY% + 1
END IF
ELSE
POS2% = INSTR(POS1%, LINE$, ",")
POS3% = INSTR(POS2%, LINE$, ")")
IF POS2% > 0 AND POS3% > 0 THEN
NUM1$ = MID$(LINE$, POS1% + 4, POS2% - POS1% - 4)
NUM2$ = MID$(LINE$, POS2% + 1, POS3% - POS2% - 1)
IF MODE% = 1 AND VALID%(NUM1$) AND VALID%(NUM2$) THEN
TOTAL& = TOTAL& + VAL(NUM1$) * VAL(NUM2$)
END IF
END IF
START% = POS1% + 1
END IF
LOOP
WEND
CLOSE #1
PRINT TOTAL&
FUNCTION VALID% (NUM$)
N% = LEN(NUM$)
VALID% = 1
IF N% < 1 OR N% > 3 THEN
VALID% = 0
ELSE
FOR I% = 1 TO N%
DIGIT$ = MID$(NUM$, I%, 1)
IF DIGIT$ < "0" OR DIGIT$ > "9" THEN VALID% = 0
NEXT
END IF
END FUNCTIONMuuttuja MODE% pitää yllä tietoa tilasta eli tuleeko mul-komennot käsitellä vai ei. Koodi antoi ensin väärän vastauksen, koska oletin, että tila nollautuisi joka rivin alussa.
Käytin jälleen funktiota INSTR, jonka avulla etsitään nyt myös tilaa muuttavia komentoja do() ja don't(). Jos jompikumpi näistä esiintyy ennen seuraavaa mul-komentoa, tilaa muuttava komento käsitellään ensin.
Päivä 4
Päivän tehtävässä tulee etsiä sanoja ruudukosta. Ratkaisin ensimmäisen osan seuraavasti:
N% = 140
WORD$ = "XMAS"
DIM GRID$(N%)
OPEN "DAY4.TXT" FOR INPUT AS #1
FOR I% = 1 TO N%
LINE INPUT #1, GRID$(I%)
NEXT
CLOSE #1
DIM DY%(8), DX%(8)
DATA 0, 1, 0, -1, 1, 0, -1, 0, 1, 1, 1, -1, -1, 1, -1, -1
FOR I% = 1 TO 8
READ DY%(I%), DX%(I%)
NEXT
TOTAL& = 0
FOR I% = 1 TO N%
FOR J% = 1 TO N%
FOR D% = 1 TO 8
FAIL% = 0
FOR K% = 1 TO 4
Y% = I% + DY%(D%) * (K% - 1)
X% = J% + DX%(D%) * (K% - 1)
IF Y% < 1 OR Y% > N% OR X% < 1 OR X% > N% THEN
FAIL% = 1
EXIT FOR
END IF
IF MID$(GRID$(Y%), X%, 1) <> MID$(WORD$, K%, 1) THEN
FAIL% = 1
EXIT FOR
END IF
NEXT
IF FAIL% = 0 THEN TOTAL& = TOTAL& + 1
NEXT
NEXT
NEXT
PRINT TOTAL&Tässä ideana on käydä läpi kaikki ruudukon kohdat ja laskea joka kohdasta alkavat sanat eri suuntiin. Suuntia on 8, koska sana voi kulkea pysty-, vaaka- tai vinosuuntaan.
Taulukot DY% ja DX% sisältävät siirtymät eri suuntiin liikuttaessa. Käytin taulukoiden alustamiseen DATA-riviä. Komento READ lukee luvut DATA-riviltä samassa järjestyksessä kuin luvut on annettu. Esimerkiksi DY%(1) saa arvon 0 ja DX%(1) saa arvon 1.
Tehtävän toisen osan ratkaisin seuraavasti:
N% = 140
DIM GRID$(N%)
OPEN "DAY4.TXT" FOR INPUT AS #1
FOR I% = 1 TO N%
LINE INPUT #1, GRID$(I%)
NEXT
CLOSE #1
DEF FNC$ (Y%, X%) = MID$(GRID$(Y%), X%, 1)
TOTAL& = 0
FOR I% = 1 TO N% - 2
FOR J% = 1 TO N% - 2
WORD1$ = FNC$(I%, J%) + FNC$(I% + 1, J% + 1) + FNC$(I% + 2, J% + 2)
WORD2$ = FNC$(I%, J% + 2) + FNC$(I% + 1, J% + 1) + FNC$(I% + 2, J%)
FAIL% = 0
IF WORD1$ <> "MAS" AND WORD1$ <> "SAM" THEN FAIL% = 1
IF WORD2$ <> "MAS" AND WORD2$ <> "SAM" THEN FAIL% = 1
IF FAIL% = 0 THEN TOTAL& = TOTAL& + 1
NEXT
NEXT
PRINT TOTAL&Koska koodissa täytyy viitata useita kertoja ruudukon kohtiin, määrittelin tätä varten apufunktion FNC$ käyttäen DEF FN -syntaksia. Tämä kevyt tapa määritellä funktio muistuttaa lambda-syntaksia moderneissa ohjelmointikielissä. Erikoisuutena funktion nimen tulee alkaa merkeillä FN.
Päivä 5
Tämän päivän tehtävä tuntui jotenkin epämääräiseltä, koska tehtävänanto ei tuonut esille sääntöihin liittyviä oletuksia. Tehtävää ratkoessa kävi ilmi, että joka rivillä jokaiseen sivupariin liittyy jokin sääntö eikä säännöissä ole ristiriitoja.
Ratkaisin ensimmäisen osan seuraavasti:
DIM RULE%(100, 100)
OPEN "DAY5.TXT" FOR INPUT AS #1
DO
LINE INPUT #1, LINE$
IF LEN(LINE$) = 0 THEN EXIT DO
PAGE1% = VAL(LEFT$(LINE$, 2))
PAGE2% = VAL(RIGHT$(LINE$, 2))
RULE%(PAGE1%, PAGE2%) = 1
LOOP
DIM UPD%(30)
TOTAL& = 0
DO UNTIL EOF(1)
LINE INPUT #1, LINE$
LINE$ = LINE$ + ","
COUNT% = 0
POS1% = 1
DO
POS2% = INSTR(POS1%, LINE$, ",")
IF POS2% = 0 THEN EXIT DO
COUNT% = COUNT% + 1
UPD%(COUNT%) = VAL(MID$(LINE$, POS1%, POS2% - POS1%))
POS1% = POS2% + 1
LOOP
FAIL% = 0
FOR I% = 1 TO COUNT% - 1
IF RULE%(UPD%(I% + 1), UPD%(I%)) THEN FAIL% = 1
NEXT
IF FAIL% = 0 THEN TOTAL& = TOTAL& + UPD%(COUNT% \ 2 + 1)
LOOP
CLOSE #1
PRINT TOTAL&Työläin osa tehtävässä oli rivillä olevien lukujen erottaminen, mihin käytin INSTR-funktiota samaan tapaan kuin aiemmassa tehtävässä.
QBasicin DO-silmukka on varsin monipuolinen rakenne. Silmukan ehto voidaan antaa WHILE- tai UNTIL-muodossa, ja ehto voidaan laittaa joko silmukan alkuun tai loppuun. Tässä tehtävässä päädyin käyttämään muotoa DO UNTIL EOF(1) eli ehto tarkastetaan silmukan alussa ja silmukka jatkuu, kunnes EOF(1) on tosi eli tiedosto on luettu loppuun.
Tässä tehtävässä tuli käyttöön myös QBasicin operaattori \, joka tarkoittaa jakolaskua pyöristäen alaspäin kokonaisluvuksi.
Ratkaisin toisen osan seuraavasti:
DIM RULE%(100, 100)
OPEN "DAY5.TXT" FOR INPUT AS #1
DO
LINE INPUT #1, LINE$
IF LEN(LINE$) = 0 THEN EXIT DO
PAGE1% = VAL(LEFT$(LINE$, 2))
PAGE2% = VAL(RIGHT$(LINE$, 2))
RULE%(PAGE1%, PAGE2%) = 1
LOOP
DIM UPD%(30)
TOTAL& = 0
DO UNTIL EOF(1)
LINE INPUT #1, LINE$
LINE$ = LINE$ + ","
COUNT% = 0
POS1% = 1
DO
POS2% = INSTR(POS1%, LINE$, ",")
IF POS2% = 0 THEN EXIT DO
COUNT% = COUNT% + 1
UPD%(COUNT%) = VAL(MID$(LINE$, POS1%, POS2% - POS1%))
POS1% = POS2% + 1
LOOP
FAIL% = 0
FOR I% = 1 TO COUNT% - 1
IF RULE%(UPD%(I% + 1), UPD%(I%)) THEN FAIL% = 1
NEXT
IF FAIL% = 1 THEN
FOR I% = 1 TO COUNT%
FOR J% = 1 TO COUNT% - 1
IF RULE%(UPD%(J% + 1), UPD%(J%)) THEN
SWAP UPD%(J%), UPD%(J% + 1)
END IF
NEXT
NEXT
TOTAL& = TOTAL& + UPD%(COUNT% \ 2 + 1)
END IF
LOOP
CLOSE #1
PRINT TOTAL&Koodi on melkein samanlainen kuin ensimmäisessä osassa, mutta siinä on lisänä osa, joka järjestää rivin. Käytin tässä kuplajärjestämistä, jossa vertailu tehdään säännöissä olevan tiedon perusteella.
Advent of Coden tehtävissä tuntuu olevan usein tarvetta jakaa rivin sisältö osiin erotinmerkkien perusteella. Tein tulevaisuutta varten seuraavan aliohjelman SPLIT:
SUB SPLIT (TEXT$, DELIM$, RES$(), COUNT%)
TEXT$ = TEXT$ + DELIM$
COUNT% = 0
POS1% = 1
DO
POS2% = INSTR(POS1%, TEXT$, DELIM$)
IF POS2% = 0 THEN EXIT DO
COUNT% = COUNT% + 1
RES$(COUNT%) = MID$(TEXT$, POS1%, POS2% - POS1%)
POS1% = POS2% + 1
LOOP
END SUBAliohjelmaa voi käyttää näin:
TEXT$ = "apina,banaani,cembalo"
DIM RES$(10)
SPLIT (TEXT$), ",", RES$(), COUNT%
FOR I% = 1 TO COUNT%
PRINT RES$(I%)
NEXT
' Tulostus:
' apina
' banaani
' cembaloQBasicissa oletuksena aliohjelman tekemä muutos parametriin vaikuttaa kutsukohtaan, minkä ansiosta aliohjelma SPLIT välittää tietoa takaisin parametrien RES$ ja COUNT% kautta.
Kuitenkin jos aliohjelmaa kutsuttaessa parametrin ympärillä on sulut, aliohjelman tekemä muutos on paikallinen. Yllä olevassa koodissa näin on parametrissa TEXT$, koska ei haluta, että sen loppuun tulee erotinmerkki.
Tein aliohjelman enkä funktiota, koska tietääkseni QBasicissa funktio ei voi palauttaa taulukkoa.
Päivä 6
Tehtävässä annettuna on ruudukko, jossa on liikkuva hahmo sekä esteitä. Kun hahmo osuu esteeseen, se kääntyy oikealle. Hahmo liikkuu, kunnes se siirtyy ruudukon ulkopuolelle.
Tehtävän ensimmäisessä osassa tuli laskea, monessako eri ruudussa hahmo käy yhteensä. Tämä onnistui melko helposti simuloimalla hahmon liikettä askel kerrallaan:
N% = 130
DIM GRID%(N%, N%)
OPEN "DAY6.TXT" FOR INPUT AS #1
FOR I% = 1 TO N%
LINE INPUT #1, LINE$
FOR J% = 1 TO N%
WHAT$ = MID$(LINE$, J%, 1)
IF WHAT$ = "#" THEN GRID%(I%, J%) = 1
IF WHAT$ = "^" THEN
Y% = I%: X% = J%
END IF
NEXT
NEXT
CLOSE #1
DATA -1, 0, 0, 1, 1, 0, 0, -1
DIM DY%(4), DX%(4)
FOR I% = 1 TO 4
READ DY%(I%), DX%(I%)
NEXT
TOTAL& = 0
DIR% = 1
DO
IF GRID%(Y%, X%) = 0 THEN
GRID%(Y%, X%) = 2
TOTAL& = TOTAL& + 1
END IF
NY% = Y% + DY%(DIR%)
NX% = X% + DX%(DIR%)
IF NY% < 1 OR NY% > N% OR NX% < 1 OR NX% > N% THEN
EXIT DO
END IF
IF GRID%(NY%, NX%) = 1 THEN
DIR% = DIR% + 1
IF DIR% = 5 THEN DIR% = 1
ELSE
Y% = NY%: X% = NX%
END IF
LOOP
PRINT TOTAL&Koodissa taulukko GRID% sisältää tietoa ruudukosta. Jokainen ruutu on joko tyhjä ruutu (0), este (1) tai tyhjä vierailtu ruutu (2). Muuttuja DIR% puolestaan ilmaisee hahmon liikkumissuunnan (1 = ylös, 2 = oikea, 3 = alas, 4 = vasen).
Tehtävän todelliset haasteet tulivat esille toisessa osassa. Nyt tehtävänä on laskea mahdolliset paikat uudelle esteelle, jonka lisääminen ruudukkoon saa hahmon liikkumaan ikuisesti syklissä.
Vastauksen voi laskea sinänsä yksinkertaisella idealla: käydään läpi kaikki tavat valita uuden esteen paikka ja tarkastetaan, missä tapauksissa hahmo päätyy sykliin. Mahdolliset paikat uudelle esteelle ovat ruudut, joissa hahmo on käynyt ensimmäisen osan reitin aikana. Ongelmana on kuitenkin, että tällaisen ratkaisun suoraviivainen toteutus QBasicilla olisi liian hidas.
Päädyin tehostamaan ratkaisua neljällä aputaulukolla (SKIP1..SKIP4), joiden avulla pystyy selvittämään nopeasti, missä on seuraava hahmon vastaan tuleva este. Esimerkiksi SKIP1(y, x) ilmaisee esteen y-koordinaatin, kun hahmo liikkuu ylöspäin ja on kohdassa (y, x). Näiden taulukoiden avulla hahmon liikettä ruudukossa pystyy simuloimaan tehokkaammin.
Aputaulukoiden tallentamisessa ongelmaksi tuli QBasicin pieni muistin määrä. Taulukot eivät mahtuneet muistiin INTEGER-tyyppisinä, mutta muuttamalla tyypiksi STRING * 1 (yksi merkki) muistin sai riittämään. Tämän tallennustavan takia koordinaatit tallennetaan taulukoissa merkkeinä (esimerkiksi koordinaatti 65 vastaa ASCII-merkkiä 65 eli merkkiä A).
Toinen käyttämäni tehostus liittyy syklin tunnistamiseen. Tavallinen tehokas tapa tunnistaa sykli olisi tallentaa jokaisesta ruudusta ja jokaisesta hahmon suunnasta tieto, onko hahmo tullut ruutuun kyseiseen suuntaan liikkuessaan. Jos hahmo tulee uudestaan samaan ruutuun samasta suunnasta, sykli on löytynyt. Muistia ei kuitenkaan ollut riittävästi tällaisen tiedon tallentamiseen.
Päädyin ratkaisuun, jossa lisätyn esteen kohdalla lasketaan, montako kertaa hahmo on osunut kyseiseen ruutuun. Jos kertoja on enemmän kuin neljä, sykli on löytynyt, koska silloin hahmo on tullut varmasti ruutuun useita kertoja samasta suunnasta. Lisäksi täytyy ottaa huomioon tilanne, jossa hahmo ei osu lisättyyn esteeseen syklin aikana. Tätä varten lisäsin vielä toisen ehdon, joka tunnistaa syklin siitä, että hahmon ohittamien ruutujen määrä on yli neljä kertaa suurempi kuin ruudukon kaikkien ruutujen määrä.
Toisen osan koodista tuli seuraavanlainen:
N% = 130
DIM GRID%(N%, N%)
DIM SKIP1(N%, N%) AS STRING * 1
DIM SKIP2(N%, N%) AS STRING * 1
DIM SKIP3(N%, N%) AS STRING * 1
DIM SKIP4(N%, N%) AS STRING * 1
OPEN "DAY6.TXT" FOR INPUT AS #1
FOR I% = 1 TO N%
LINE INPUT #1, LINE$
FOR J% = 1 TO N%
WHAT$ = MID$(LINE$, J%, 1)
IF WHAT$ = "#" THEN GRID%(I%, J%) = 1
IF WHAT$ = "^" THEN
SY% = I%: SX% = J%
END IF
NEXT
NEXT
CLOSE #1
DATA -1, 0, 0, 1, 1, 0, 0, -1
DIM DY%(4), DX%(4)
FOR I% = 1 TO 4
READ DY%(I%), DX%(I%)
NEXT
DIR% = 1
Y% = SY%: X% = SX%
DO
IF GRID%(Y%, X%) = 0 THEN
GRID%(Y%, X%) = 2
END IF
NY% = Y% + DY%(DIR%)
NX% = X% + DX%(DIR%)
IF NY% < 1 OR NY% > N% OR NX% < 1 OR NX% > N% THEN
EXIT DO
END IF
IF GRID%(NY%, NX%) = 1 THEN
DIR% = DIR% + 1
IF DIR% = 5 THEN DIR% = 1
ELSE
Y% = NY%: X% = NX%
END IF
LOOP
FOR I% = 1 TO N%
S% = 0
FOR J% = 1 TO N%
IF GRID%(J%, I%) = 1 THEN S% = J% + 1
SKIP1(J%, I%) = CHR$(S%)
NEXT
S% = N% + 1
FOR J% = N% TO 1 STEP -1
IF GRID%(I%, J%) = 1 THEN S% = J% - 1
SKIP2(I%, J%) = CHR$(S%)
NEXT
S% = N% + 1
FOR J% = N% TO 1 STEP -1
IF GRID%(J%, I%) = 1 THEN S% = J% - 1
SKIP3(J%, I%) = CHR$(S%)
NEXT
S% = 0
FOR J% = 1 TO N%
IF GRID%(I%, J%) = 1 THEN S% = J% + 1
SKIP4(I%, J%) = CHR$(S%)
NEXT
NEXT
TOTAL& = 0
FOR AY% = 1 TO N%
FOR AX% = 1 TO N%
FAIL% = 0
IF AY% = SY% AND AX% = SX% THEN FAIL% = 1
IF GRID%(AY%, AX%) <> 2 THEN FAIL% = 1
IF FAIL% = 0 THEN
GRID%(AY%, AX%) = 1
DIR% = 1
Y% = SY%: X% = SX%
COUNT& = 0
AC% = 0
DO
NY% = Y%: NX% = X%
IF NY% <> AY% AND NX% <> AX% THEN
IF DIR% = 1 THEN NY% = ASC(SKIP1(Y%, X%))
IF DIR% = 2 THEN NX% = ASC(SKIP2(Y%, X%))
IF DIR% = 3 THEN NY% = ASC(SKIP3(Y%, X%))
IF DIR% = 4 THEN NX% = ASC(SKIP4(Y%, X%))
END IF
IF NY% = Y% AND NX% = X% THEN
NY% = Y% + DY%(DIR%)
NX% = X% + DX%(DIR%)
END IF
IF NY% < 1 OR NY% > N% OR NX% < 1 OR NX% > N% THEN
EXIT DO
END IF
COUNT& = COUNT& + ABS(Y% - NY%) + ABS(X% - NX%)
IF NY% = AY% AND NX% = AX% THEN AC% = AC% + 1
IF AC% > 4 OR COUNT& > 4& * N% * N% THEN
TOTAL& = TOTAL& + 1
EXIT DO
END IF
IF GRID%(NY%, NX%) = 1 THEN
DIR% = DIR% + 1
IF DIR% = 5 THEN DIR% = 1
ELSE
Y% = NY%: X% = NX%
END IF
LOOP
GRID%(AY%, AX%) = 2
END IF
NEXT
NEXT
PRINT TOTAL&Koodin tehostuksista huolimatta ratkaisun laskeminen vei aikaa joitakin tunteja. Tämä oli tähän mennessä selvästi hankalin tehtävä.
Päivä 7
Tässä tehtävässä käsiteltävät luvut ovat ensimmäistä kertaa niin suuria, että QBasicin suurin kokonaislukutyyppi 32-bittinen LONG ei riitä. Päädyin käyttämään sen sijasta 64-bittistä liukulukutyyppiä DOUBLE, joka onneksi riittää tällä kertaa.
Mukava ominaisuus DOUBLE-tyypissä on, että sen avulla voidaan esittää tarkasti kokonaisluvut lukuun 253 asti. Koska tehtävässä tarvittavat luvut ovat tätä pienempiä, niitä voidaan käsitellä tarkasti liukulukuina.
Ratkaisin tehtävän ensimmäisen osan raa'alla voimalla käymällä läpi kaikki mahdolliset tavat valita operaattorit + ja * laskutoimitukseen:
OPEN "DAY7.TXT" FOR INPUT AS #1
DIM RES$(15)
DIM PARTS#(15)
TOTAL# = 0
WHILE NOT EOF(1)
LINE INPUT #1, LINE$
SPLIT LINE$, " ", RES$(), COUNT%
GOAL# = VAL(LEFT$(RES$(1), LEN(RES$(1)) - 1))
COUNT% = COUNT% - 1
FOR I% = 1 TO COUNT%
PARTS#(I%) = VAL(RES$(I% + 1))
NEXT
GOOD% = 0
FOR MASK% = 0 TO 2 ^ (COUNT% - 1) - 1
NUM# = PARTS#(1)
FOR I% = 2 TO COUNT%
IF (MASK% AND 2 ^ (I% - 2)) = 0 THEN
NUM# = NUM# + PARTS#(I%)
ELSE
NUM# = NUM# * PARTS#(I%)
END IF
NEXT
IF NUM# = GOAL# THEN
GOOD% = 1
EXIT FOR
END IF
NEXT
IF GOOD% = 1 THEN TOTAL# = TOTAL# + GOAL#
WEND
CLOSE #1
PRINT TOTAL#
SUB SPLIT (TEXT$, DELIM$, RES$(), COUNT%)
TEXT$ = TEXT$ + DELIM$
COUNT% = 0
POS1% = 1
DO
POS2% = INSTR(POS1%, TEXT$, DELIM$)
IF POS2% = 0 THEN EXIT DO
COUNT% = COUNT% + 1
RES$(COUNT%) = MID$(TEXT$, POS1%, POS2% - POS1%)
POS1% = POS2% + 1
LOOP
END SUBTässä ideana on esittää merkkien valintatavat bittimaskeina, jossa bitti 0 tarkoittaa operaattoria + ja bitti 1 tarkoittaa operaattoria *. Koodi käy läpi tällaiset maskit silmukalla ja tarkastaa bitit AND-operaattorin avulla.
Tehtävän toisessa osassa mukaan tulee kolmas operaattori ||, joka yhdistää luvut peräkkäin. Tämänkin osan voisi ratkaista raa'alla voimalla, mutta QBasicia käyttäessä siihen menisi luultavasti ikävän kauan aikaa. Tämän takia päädyin tekemään tehokkaamman ratkaisun.
Hyvä tehostus tehtävään on tutkia laskutoimituksen muodostumista lopusta alkuun. Tämän avulla hausta voidaan rajata pois monia tapauksia. Esimerkiksi jos luku on 12345 ja laskutoimituksen viimeinen luku on 42, ainoa mahdollisuus on, että viimeinen operaattori on +. Viimeinen operaattori ei voi olla *, koska 12345 ei ole jaollinen 42:lla. Viimeinen operaattori ei myöskään voi olla ||, koska 12345 ei pääty 42.
Ratkaisin toisen osan seuraavasti:
OPEN "DAY7.TXT" FOR INPUT AS #1
DIM RES$(15)
DIM PARTS#(15)
TOTAL# = 0
WHILE NOT EOF(1)
LINE INPUT #1, LINE$
SPLIT LINE$, " ", RES$(), COUNT%
GOAL# = VAL(LEFT$(RES$(1), LEN(RES$(1)) - 1))
COUNT% = COUNT% - 1
FOR I% = 1 TO COUNT%
PARTS#(I%) = VAL(RES$(I% + 1))
NEXT
GOOD% = CHECK%(GOAL#, COUNT%, PARTS#())
IF GOOD% = 1 THEN TOTAL# = TOTAL# + GOAL#
WEND
CLOSE #1
PRINT TOTAL#
FUNCTION CHECK% (NUM#, I%, PARTS#())
CHECK% = 0
IF I% = 1 THEN
CHECK% = PARTS#(1) = NUM#
ELSE
REST# = NUM# - PARTS#(I%)
IF REST# >= 0 AND CHECK%(REST#, I% - 1, PARTS#()) THEN
CHECK% = 1
EXIT FUNCTION
END IF
REST# = NUM# / PARTS#(I%)
IF INSTR(STR$(REST#), ".") = 0 AND CHECK%(REST#, I% - 1, PARTS#()) THEN
CHECK% = 1
EXIT FUNCTION
END IF
NUM$ = LTRIM$(STR$(NUM#))
PART$ = LTRIM$(STR$(PARTS#(I%)))
IF RIGHT$(NUM$, LEN(PART$)) = PART$ THEN
REST# = VAL(LEFT$(NUM$, LEN(NUM$) - LEN(PART$)))
IF CHECK%(REST#, I% - 1, PARTS#()) THEN
CHECK% = 1
EXIT FUNCTION
END IF
END IF
END IF
END FUNCTION
SUB SPLIT (TEXT$, DELIM$, RES$(), COUNT%)
TEXT$ = TEXT$ + DELIM$
COUNT% = 0
POS1% = 1
DO
POS2% = INSTR(POS1%, TEXT$, DELIM$)
IF POS2% = 0 THEN EXIT DO
COUNT% = COUNT% + 1
RES$(COUNT%) = MID$(TEXT$, POS1%, POS2% - POS1%)
POS1% = POS2% + 1
LOOP
END SUBTässä rekursiivinen funktio CHECK% tarkastaa, voiko laskutoimituksen muodostaa annetuista osista. Funktiolle annetaan muodostettava luku NUM#, laskutoimituksen loppuun lisättävän luvun indeksi I% sekä laskutoimituksen osat PARTS#.
Operaattorin * tapauksessa tulee tarkastaa lukujen jaollisuus. Tämä osoittautui yllättävän hankalaksi DOUBLE-luvuilla, koska en löytänyt FLOOR-funktiota tai vastaavaa. Päädyin lopulta muuttamaan jakolaskun tuloksen merkkijonoksi ja tarkastamaan funktiolla INSTR, onko luvussa desimaalipistettä.
Operaattorin || tapauksessa törmäsin erikoiseen ilmiöön: kun luku muutetaan merkkijonoksi funktiolla STR$, sen eteen tulee ylimääräinen välilyönti. Tämän takia käytin funktiota LTRIM$, joka poistaa välilyönnit merkkijonon alusta. Ilmeisesti kyse on siitä, että ensimmäinen merkki on luvun etumerkki: positiivisessa luvussa tyhjä ja negatiivisessa luvussa -.
Rekursiivinen funktio oli hieman hankala toteuttaa, mutta hyvänä puolena sen avulla tehtävän toinen osa ratkesi varsin nopeasti.
Tutkittuani asiaa tarkemmin havaitsin, että QBasicissa on funktio FIX, joka pyöristää liukuluvun alaspäin ja jota voi käyttää tämän päivän tehtävässä. Ehdon INSTR(STR$(REST#), ".") = 0 voi siis korvata ehdolla REST# = FIX(REST#).
Päivä 8
Tehtävän molemmat osat ratkesivat raa'alla voimalla käymällä läpi ruudukossa olevat antenniparit ja laskemalla niiden vaikutuskohdat.
Ratkaisin tehtävän ensimmäisen osan näin:
N% = 50
DIM GRID%(N%, N%)
DIM ANTI%(N%, N%)
OPEN "DAY8.TXT" FOR INPUT AS #1
FOR I% = 1 TO N%
LINE INPUT #1, LINE$
FOR J% = 1 TO N%
WHAT$ = MID$(LINE$, J%, 1)
IF WHAT$ <> "." THEN GRID%(I%, J%) = ASC(WHAT$)
NEXT
NEXT
CLOSE #1
FOR Y1% = 1 TO N%
FOR X1% = 1 TO N%
FOR Y2% = Y1% TO N%
FOR X2% = 1 TO N%
FAIL% = 0
IF Y1% = Y2% AND X1% = X2% THEN FAIL% = 1
IF GRID%(Y1%, X1%) = 0 THEN FAIL% = 1
IF GRID%(Y1%, X1%) <> GRID%(Y2%, X2%) THEN FAIL% = 1
IF FAIL% = 0 THEN
DY% = Y2% - Y1%: DX% = X2% - X1%
AY1% = Y2% + DY%: AX1% = X2% + DX%
AY2% = Y1% - DY%: AX2% = X1% - DX%
IF AY1% >= 1 AND AY1% <= N% AND AX1% >= 1 AND AX1% <= N% THEN
ANTI%(AY1%, AX1%) = 1
END IF
IF AY2% >= 1 AND AY2% <= N% AND AX2% >= 1 AND AX2% <= N% THEN
ANTI%(AY2%, AX2%) = 1
END IF
END IF
NEXT
NEXT
NEXT
NEXT
TOTAL% = 0
FOR I% = 1 TO N%
FOR J% = 1 TO N%
IF ANTI%(I%, J%) = 1 THEN TOTAL% = TOTAL% + 1
NEXT
NEXT
PRINT TOTAL%Kun antennit ovat kohdissa (Y1%, X1%) ja (Y2%, X2%), niiden pysty- ja vaakasuuntaiset erot ovat DY% = Y2% - Y1% ja DX% = X2% - X1%. Tämän perusteella voidaan laskea, että vaikutuskohdat ovat (Y2% + DY%, X2% + DX%) sekä (Y1% - DY%, X1% - DX%).
Ratkaisin tehtävän toisen osan näin:
N% = 50
DIM GRID%(N%, N%)
DIM ANTI%(N%, N%)
OPEN "DAY8.TXT" FOR INPUT AS #1
FOR I% = 1 TO N%
LINE INPUT #1, LINE$
FOR J% = 1 TO N%
WHAT$ = MID$(LINE$, J%, 1)
IF WHAT$ <> "." THEN GRID%(I%, J%) = ASC(WHAT$)
NEXT
NEXT
CLOSE #1
FOR Y1% = 1 TO N%
FOR X1% = 1 TO N%
FOR Y2% = Y1% TO N%
FOR X2% = 1 TO N%
FAIL% = 0
IF Y1% = Y2% AND X1% = X2% THEN FAIL% = 1
IF GRID%(Y1%, X1%) = 0 THEN FAIL% = 1
IF GRID%(Y1%, X1%) <> GRID%(Y2%, X2%) THEN FAIL% = 1
IF FAIL% = 0 THEN
DY% = Y2% - Y1%: DX% = X2% - X1%
G% = GCD%(DY%, DX%)
DY% = DY% \ G%: DX% = DX% \ G%
Y% = Y1%: X% = X1%
DO WHILE Y% >= 1 AND Y% <= N% AND X% >= 1 AND X% <= N%
ANTI%(Y%, X%) = 1
Y% = Y% + DY%
X% = X% + DX%
LOOP
Y% = Y1%: X% = X1%
DO WHILE Y% >= 1 AND Y% <= N% AND X% >= 1 AND X% <= N%
ANTI%(Y%, X%) = 1
Y% = Y% - DY%
X% = X% - DX%
LOOP
END IF
NEXT
NEXT
NEXT
NEXT
TOTAL% = 0
FOR I% = 1 TO N%
FOR J% = 1 TO N%
IF ANTI%(I%, J%) = 1 THEN TOTAL% = TOTAL% + 1
NEXT
NEXT
PRINT TOTAL%
FUNCTION GCD% (A%, B%)
IF B% = 0 THEN
GCD% = A%
ELSE
GCD% = GCD%(B%, A% MOD B%)
END IF
END FUNCTIONNyt täytyy etsiä ruudukosta kaikki ruudut, jotka ovat samalla suoralla kahden antennin kanssa. Tein tätä varten GCD%-funktion, joka laskee kahden luvun suurimman yhteisen tekijän. Tämän avulla saadaan laskettua kahden vaikutuskohdan välinen etäisyys suoralla. Kun G% = GCD%(DY%, DX%), etäisyys on pystysuunnassa DY% \ G% ja vaakasuunnassa DX% \ G%. Tämän avulla voidaan käydä läpi kaikki vaikutuskohdat aloittaen toisesta antennista.
Päivä 9
Tehtävän syötteenä on pitkä merkkijono, joka on liian pitkä mahtuakseen QBasicin STRING-tyyppiin. Tämän takia päädyin lukemaan tiedostosta tietoa merkki kerrallaan BINARY-tilassa.
Ratkaisin ensimmäisen osan seuraavasti:
N% = 10000
DIM FILE%(N%)
DIM SPACE%(N%)
COUNT& = 0
OPEN "DAY9.TXT" FOR BINARY AS #1
FOR I% = 1 TO N%
DIM BYTE AS STRING * 1
GET #1, 2 * I% - 1, BYTE
FILE%(I%) = VAL(BYTE)
COUNT& = COUNT& + FILE%(I%)
GET #1, 2 * I%, BYTE
SPACE%(I%) = VAL(BYTE)
NEXT
CLOSE #1
LAST% = N%
CUR& = 0
TOTAL# = 0
FOR I% = 1 TO N%
FOR J% = 1 TO FILE%(I%)
TOTAL# = TOTAL# + CUR& * (I% - 1)
CUR& = CUR& + 1
NEXT
FILE%(I%) = 0
FOR J% = 1 TO SPACE%(I%)
IF CUR& >= COUNT& THEN EXIT FOR
IF LAST% > 1 AND FILE%(LAST%) = 0 THEN LAST% = LAST% - 1
TOTAL# = TOTAL# + CUR& * (LAST% - 1)
CUR& = CUR& + 1
FILE%(LAST%) = FILE%(LAST%) - 1
NEXT
NEXT
PRINT TOTAL#Koodi käy läpi muistissa olevat lohkot vasemmalta oikealle ja koettaa siirtää lopusta alkaen lohkoja tyhjiin kohtiin. Muuttuja LAST% osoittaa viimeiseen lohkoon, jota ei ole vielä siirretty tyhjään lohkoon.
Tarkastussumma on sen verran suuri, että se ei mahdu LONG-tyyppiin, mutta onneksi sen verran pieni, että sen voi esittää tarkasti DOUBLE-tyypin avulla.
Ratkaisin toisen osan seuraavasti:
N% = 10000
DIM FILE%(N%)
DIM SPACE%(N%)
DIM FSTART&(N%)
DIM SSTART&(N%)
START& = 0
OPEN "DAY9.TXT" FOR BINARY AS #1
FOR I% = 1 TO N%
DIM BYTE AS STRING * 1
GET #1, 2 * I% - 1, BYTE
FILE%(I%) = VAL(BYTE)
FSTART&(I%) = START&
START& = START& + FILE%(I%)
GET #1, 2 * I%, BYTE
SPACE%(I%) = VAL(BYTE)
SSTART&(I%) = START&
START& = START& + SPACE%(I%)
NEXT
CLOSE #1
TOTAL# = 0
FOR I% = N% TO 1 STEP -1
FOR J% = 1 TO I% - 1
IF SPACE%(J%) >= FILE%(I%) THEN
FOR K% = 1 TO FILE%(I%)
TOTAL# = TOTAL# + (SSTART&(J%) + K% - 1) * (I% - 1)
NEXT
SPACE%(J%) = SPACE%(J%) - FILE%(I%)
SSTART&(J%) = SSTART&(J%) + FILE%(I%)
FILE%(I%) = 0
EXIT FOR
END IF
NEXT
FOR K% = 1 TO FILE%(I%)
TOTAL# = TOTAL# + (FSTART&(I%) + K% - 1) * (I% - 1)
NEXT
NEXT
PRINT TOTAL#Päädyin tekemään tähän raa'an voiman ratkaisun, joka käy läpi tiedostot oikealta vasemmalle ja etsii jokaiselle tiedostolle ensimmäisen riittävän suuren tyhjän alueen vasemmalta oikealle. Tehokkaampi ratkaisu olisi käyttää jotain tietorakennetta tyhjän alueen etsimiseen, mikä on vaatimuksena esimerkiksi CSES-tehtävässä Hotel Queries. Tässä tapauksessa yksinkertainen toteutus kuitenkin riitti hyvin.
Päivä 10
Tehtävän molemmat osat pystyy ratkaisemaan lähes samanlaisella koodilla, joka etsii rekursiivisesti reittejä. Ratkaisin ensimmäisen osan näin:
N% = 49
DIM SHARED GRID%(N%, N%)
DIM SHARED REACH%(N%, N%)
OPEN "DAY10.TXT" FOR INPUT AS #1
FOR I% = 1 TO N%
LINE INPUT #1, LINE$
FOR J% = 1 TO N%
GRID%(I%, J%) = VAL(MID$(LINE$, J%, 1))
NEXT
NEXT
CLOSE #1
ID% = 0
TOTAL% = 0
FOR I% = 1 TO N%
FOR J% = 1 TO N%
IF GRID%(I%, J%) = 0 THEN
ID% = ID% + 1
SEARCH N%, I%, J%, 0, ID%, TOTAL%
END IF
NEXT
NEXT
PRINT TOTAL%
SUB SEARCH (N%, Y%, X%, LEVEL%, ID%, TOTAL%)
IF Y% < 1 OR Y% > N% OR X% < 1 OR X% > N% THEN EXIT SUB
IF GRID%(Y%, X%) <> LEVEL% THEN EXIT SUB
IF LEVEL% = 9 THEN
IF REACH%(Y%, X%) <> ID% THEN
REACH%(Y%, X%) = ID%
TOTAL% = TOTAL% + 1
END IF
ELSE
SEARCH N%, Y% + 1, X%, LEVEL% + 1, ID%, TOTAL%
SEARCH N%, Y% - 1, X%, LEVEL% + 1, ID%, TOTAL%
SEARCH N%, Y%, X% + 1, LEVEL% + 1, ID%, TOTAL%
SEARCH N%, Y%, X% - 1, LEVEL% + 1, ID%, TOTAL%
END IF
END SUBKoodi aloittaa haun jokaisesta tason 0 ruudusta. Haku etenee kaikkiin suuntiin ja muodostaa reittejä, joissa taso kasvaa yhdellä joka askeleella. Kun haku päätyy tason 9 ruutuun, laskuri kasvaa yhdellä, jos tässä ruudussa ei ole vielä käyty.
Yllättäen tehtävän toinen osa on helpompi, koska siinä tulee laskea kaikki reitit eikä huolehtia siitä, että jokainen loppuruutu lasketaan vain kerran. Ratkaisin toisen osan näin:
N% = 49
DIM SHARED GRID%(N%, N%)
OPEN "DAY10.TXT" FOR INPUT AS #1
FOR I% = 1 TO N%
LINE INPUT #1, LINE$
FOR J% = 1 TO N%
GRID%(I%, J%) = VAL(MID$(LINE$, J%, 1))
NEXT
NEXT
CLOSE #1
TOTAL% = 0
FOR I% = 1 TO N%
FOR J% = 1 TO N%
IF GRID%(I%, J%) = 0 THEN
SEARCH N%, I%, J%, 0, TOTAL%
END IF
NEXT
NEXT
PRINT TOTAL%
SUB SEARCH (N%, Y%, X%, LEVEL%, TOTAL%)
IF Y% < 1 OR Y% > N% OR X% < 1 OR X% > N% THEN EXIT SUB
IF GRID%(Y%, X%) <> LEVEL% THEN EXIT SUB
IF LEVEL% = 9 THEN
TOTAL% = TOTAL% + 1
ELSE
SEARCH N%, Y% + 1, X%, LEVEL% + 1, TOTAL%
SEARCH N%, Y% - 1, X%, LEVEL% + 1, TOTAL%
SEARCH N%, Y%, X% + 1, LEVEL% + 1, TOTAL%
SEARCH N%, Y%, X% - 1, LEVEL% + 1, TOTAL%
END IF
END SUBTässä tapauksessa rekursiivinen raa'an voiman ratkaisu on riittävä, koska ruudukko on melko pieni eikä reittien kokonaismäärä ole suuri. Tehokkaampi ratkaisu olisi mahdollinen dynaamisella ohjelmoinnilla.
Noi rekursiot on aina niin hankalia hahmottaa, että mitä oikein tapahtuu :(
Mitenkähän tuota puolta voisi saada paremmin haltuun?
Tuo EXIT SUB lienee sama kuin Return Javassa? Ja jos TOTAL% -arvo on vaikka 27 tasolla 7 ja edetään tasolle 9 asti, jolloin arvo on vaikka 38. Niin eikös se sitten kun palataan takaisin EXIT SUB:n kautta ole edelleen 27 tasolla 7? Nää on niin hankalia hahmottaa ..
QBasicin EXIT SUB on tosiaan sama kuin return Javassa. Muuttujan TOTAL% roolina on, että siihen lasketaan reittien yhteismäärä. Aina kun jokin reitti löytyy, muuttujan arvo kasvaa yhdellä.
QBasicissa aliohjelman parametrit ovat viittauksia, minkä ansiosta muuttujan TOTAL% muutokset välittyvät pääohjelmaan. Javassa näin ei olisi vaan laskuri pitäisi toteuttaa jollain muulla tavalla.
Päivä 11
Tehtävän aiheena on varsin erikoinen matemaattinen prosessi, joka voidaan esittää seuraavan funktion avulla:
Tässä left(x) ja right(x) ovat luvut, jotka saadaan erottamalla luvun x vasemman ja oikean puoliskon numerot. Esimerkiksi f(1234, 5) = f(12, 4) + f(34, 4).
Tehtävässä tulee laskea funktion arvoja annetuille parametreille x ja k.
Koetin ensin käyttää tehtävässä rekursiivista funktiota, mutta QBasic ilmoitti pinomuistin määrän ylityksestä. Tämän takia toteutin laskennan ilman rekursiota pinon avulla. Tämän avulla sain ratkaistua tehtävän ensimmäisen osan, jossa k = 25:
N% = 8
DIM STONES#(N%)
OPEN "DAY11.TXT" FOR INPUT AS #1
FOR I% = 1 TO N%
INPUT #1, STONES#(I%)
NEXT
CLOSE #1
DIM STACK#(100)
DIM TIMES%(100)
TOTAL& = 0
FOR I% = 1 TO N%
C% = 1
STACK#(1) = STONES#(I%)
TIMES%(1) = 25
WHILE C% >= 1
IF TIMES%(C%) = 0 THEN
TOTAL& = TOTAL& + 1
C% = C% - 1
ELSE
TOP# = STACK#(C%)
TOP$ = LTRIM$(STR$(TOP#))
IF TOP# = 0 THEN
STACK#(C%) = 1
TIMES%(C%) = TIMES%(C%) - 1
ELSEIF LEN(TOP$) MOD 2 = 0 THEN
STACK#(C%) = VAL(LEFT$(TOP$, LEN(TOP$) \ 2))
TIMES%(C%) = TIMES%(C%) - 1
STACK#(C% + 1) = VAL(RIGHT$(TOP$, LEN(TOP$) \ 2))
TIMES%(C% + 1) = TIMES%(C%)
C% = C% + 1
ELSE
STACK#(C%) = TOP# * 2024
TIMES%(C%) = TIMES%(C%) - 1
END IF
END IF
WEND
NEXT
PRINT TOTAL&Tässä STACK# sisältää pinossa olevat luvut ja TIMES% ilmoittaa kustakin luvusta, montako operaatiota siihen tulee vielä kohdistaa. Koodi käsittelee joka askeleella pinon ylimmän luvun, kunnes pino on tyhjä.
Ihmettelin ensin, miksi koodi toimii niin oudosti ja antaa vääriä vastauksia. Ongelmana oli jo toista kertaa joulukuun aikana se, että STR$ laittaa merkkijonon eteen tyhjän merkin enkä muistanut käyttää funktiota LTRIM$.
Tehtävän toisessa osassa k = 75 ja alkoi vaikuttaa siltä, että tulos voi olla varsin suuri. Tämän takia ei olisi luultavasti riittävää simuloida prosessia askel kerrallaan kuten ensimmäisessä osassa.
Päädyin käyttämään dynaamista ohjelmointia niin, että tallennan taulukkoon RESULT# muistiin tehtävän välitulosten vastauksia. Esimerkiksi RESULT#(42, 5) kertoo, montako lukua syntyy luvusta 42 aloittaen 5 askeleen jälkeen. Tämä tehostaa hakua paljon, koska samoja asioita ei tarvitse laskea uudestaan.
Dynaamisen ohjelmoinnin toteutusta haittasi jonkin verran QBasicin pieni muistin määrä, minkä takia välituloksia ei voi tallentaa muistiin kovin paljon. Päädyin laskemaan etukäteen kaikki tulokset, joissa x = 1..100 ja k = 1..50. Toisen osan koodista tuli seuraava:
N% = 8
DIM STONES#(N%)
OPEN "DAY11.TXT" FOR INPUT AS #1
FOR I% = 1 TO N%
INPUT #1, STONES#(I%)
NEXT
CLOSE #1
DIM SHARED RESULT#(100, 50)
FOR BOUND% = 1 TO 50
FOR NUM# = 1 TO 100
RESULT#(NUM#, BOUND%) = COUNT#(NUM#, BOUND%)
NEXT
NEXT
TOTAL# = 0
FOR I% = 1 TO N%
TOTAL# = TOTAL# + COUNT#(STONES#(I%), 75)
NEXT
PRINT TOTAL#
FUNCTION COUNT# (NUM#, BOUND%)
DIM STACK#(100)
DIM TIMES%(100)
TOTAL# = 0
C% = 1
STACK#(1) = NUM#
TIMES%(1) = BOUND%
WHILE C% >= 1
ADD# = 0
IF STACK#(C%) <= 100 AND TIMES%(C%) <= 50 THEN
ADD# = RESULT#(STACK#(C%), TIMES%(C%))
END IF
IF ADD# <> 0 THEN
TOTAL# = TOTAL# + ADD#
C% = C% - 1
ELSEIF TIMES%(C%) = 0 THEN
TOTAL# = TOTAL# + 1
C% = C% - 1
ELSE
TOP# = STACK#(C%)
TOP$ = LTRIM$(STR$(TOP#))
IF TOP# = 0 THEN
STACK#(C%) = 1
TIMES%(C%) = TIMES%(C%) - 1
ELSEIF LEN(TOP$) MOD 2 = 0 THEN
STACK#(C%) = VAL(LEFT$(TOP$, LEN(TOP$) \ 2))
TIMES%(C%) = TIMES%(C%) - 1
STACK#(C% + 1) = VAL(RIGHT$(TOP$, LEN(TOP$) \ 2))
TIMES%(C% + 1) = TIMES%(C%)
C% = C% + 1
ELSE
STACK#(C%) = TOP# * 2024
TIMES%(C%) = TIMES%(C%) - 1
END IF
END IF
WEND
COUNT# = TOTAL#
END FUNCTIONHallitseva tunne tämän tehtävän ratkaisemisessa oli epävarmuus, koska prosessista on vaikea sanoa päältä päin, miten se käyttäytyy. Oletin, että DOUBLE-tyyppi riittää tässäkin tehtävässä ja dynaaminen ohjelmointi tehostaa laskentaa riittävästi, vaikka välituloksia ei voi tallentaa kovin paljon. Onneksi molemmat oletukset osoittautuivat oikeiksi.
Antti Laaksonen kirjoitti:
Tehtävän toisessa osassa k = 75 ja alkoi vaikuttaa siltä, että tulos voi olla varsin suuri. Tämän takia ei olisi luultavasti riittävää simuloida prosessia askel kerrallaan kuten ensimmäisessä osassa.
Prosessi tuottaa paljon samoja lukuja (puolituksen ansiosta), ja omasta syötteestäni tulee 75 askeleen jälkeen vain 3770 eri lukua. Ratkaisuun sopii siksi myös yksinkertainen prosessin simulointi, kunhan kaikkia toistuvia lukuja ei levitetä taulukkoon vaan käsitellään pareja (luku, määrä).
Päivä 12
Tehtävän ensimmäisessä osassa tulee etsiä ruudukosta yhtenäiset alueet ja laskea kunkin alueen pinta-ala ja reunan pituus.
Tavallisesti toteuttaisin tällaisen haun rekursiivisesti, mutta oletin taas, että pinomuisti ei riittäisi QBasicissa. Tämän takia toteutin haun ilman rekursiota keräämällä alueeseen kuuluvat ruudut taulukkoon, joka käydään läpi vasemmalta oikealle. Toteutin ratkaisun seuraavasti:
N% = 140
DIM GRID%(N% + 1, N% + 1)
OPEN "DAY12.TXT" FOR INPUT AS #1
FOR I% = 1 TO N%
LINE INPUT #1, LINE$
FOR J% = 1 TO N%
GRID%(I%, J%) = ASC(MID$(LINE$, J%, 1))
NEXT
NEXT
CLOSE #1
DIM SEEN%(N%, N%)
DIM PLACES%(N% * N% / 2, 2)
DATA 1, 0, -1, 0, 0, 1, 0, -1
DIM DY%(4), DX%(4)
FOR I% = 1 TO 4
READ DY%(I%), DX%(I%)
NEXT
TOTAL& = 0
FOR I% = 1 TO N%
FOR J% = 1 TO N%
IF SEEN%(I%, J%) = 0 THEN
SEEN%(I%, J%) = 1
FENCE% = 0
COUNT% = 1
PLACES%(1, 1) = I%
PLACES%(1, 2) = J%
CUR% = 1
WHILE CUR% <= COUNT%
Y% = PLACES%(CUR%, 1)
X% = PLACES%(CUR%, 2)
FOR D% = 1 TO 4
NY% = Y% + DY%(D%)
NX% = X% + DX%(D%)
IF GRID%(Y%, X%) <> GRID%(NY%, NX%) THEN
FENCE% = FENCE% + 1
ELSEIF SEEN%(NY%, NX%) = 0 THEN
SEEN%(NY%, NX%) = 1
COUNT% = COUNT% + 1
PLACES%(COUNT%, 1) = NY%
PLACES%(COUNT%, 2) = NX%
END IF
NEXT
CUR% = CUR% + 1
WEND
TOTAL& = TOTAL& + 1& * COUNT% * FENCE%
END IF
NEXT
NEXT
PRINT TOTAL&Käytin toteutuksessa trikkiä, jossa ruudukon ympärillä taulukossa on yksi kerros tyhjiä ruutuja. Tämän ansiosta koodissa ei tarvitse käsitellä erikseen tapauksia, joissa viereinen ruutu on ruudukon ulkopuolella. QBasicissa taulukon koko N% tarkoittaa, että taulukon alaraja on 0 ja yläraja on N%. Tämän ansiosta riittää asettaa taulukon kooksi N% + 1 ja käyttää taulukkoa 1-indeksoituna.
Muuttujaan FENCE% lasketaan alueen reunan pituus. Ideana on laskea tähän kaikki vierekkäiset ruutuparit, joissa toinen ruutu kuuluu alueeseen ja toinen ruutu on alueen ulkopuolella.
Taulukko PLACES% sisältää vuorollaan jokaiseen alueeseen kuuluvat ruudut. Taulukon kokona on N% * N% / 2, koska muistia ei ollut riittävästi täyteen kokoon N% * N%. Arvioin kuitenkin, että missään alueessa ei ole enempää ruutuja kuin puolet koko ruudukon ruuduista.
Tehtävän toisessa osassa reunan pituus tuleekin laskea niin, että jokainen alueen sivu lasketaan vain kerran. Käytin tähän melkein samanlaista koodia kuin ensimmäisessä osassa:
N% = 140
DIM GRID%(N% + 1, N% + 1)
OPEN "DAY12.TXT" FOR INPUT AS #1
FOR I% = 1 TO N%
LINE INPUT #1, LINE$
FOR J% = 1 TO N%
GRID%(I%, J%) = ASC(MID$(LINE$, J%, 1))
NEXT
NEXT
CLOSE #1
DIM SEEN%(N%, N%)
DIM PLACES%(N% * N% / 2, 2)
DATA 1, 0, -1, 0, 0, 1, 0, -1
DIM DY%(4), DX%(4)
FOR I% = 1 TO 4
READ DY%(I%), DX%(I%)
NEXT
TOTAL& = 0
FOR I% = 1 TO N%
FOR J% = 1 TO N%
IF SEEN%(I%, J%) = 0 THEN
SEEN%(I%, J%) = 1
FENCE% = 0
COUNT% = 1
PLACES%(1, 1) = I%
PLACES%(1, 2) = J%
CUR% = 1
WHILE CUR% <= COUNT%
Y% = PLACES%(CUR%, 1)
X% = PLACES%(CUR%, 2)
FOR D% = 1 TO 4
NY% = Y% + DY%(D%)
NX% = X% + DX%(D%)
IF GRID%(Y%, X%) <> GRID%(NY%, NX%) THEN
FAIL% = 0
IF DX%(D%) = 0 AND GRID%(Y%, X%) = GRID%(Y%, X% - 1) THEN
IF GRID%(Y%, X% - 1) <> GRID%(NY%, X% - 1) THEN FAIL% = 1
END IF
IF DY%(D%) = 0 AND GRID%(Y%, X%) = GRID%(Y% - 1, X%) THEN
IF GRID%(Y% - 1, X%) <> GRID%(Y% - 1, NX%) THEN FAIL% = 1
END IF
IF FAIL% = 0 THEN FENCE% = FENCE% + 1
ELSEIF SEEN%(NY%, NX%) = 0 THEN
SEEN%(NY%, NX%) = 1
COUNT% = COUNT% + 1
PLACES%(COUNT%, 1) = NY%
PLACES%(COUNT%, 2) = NX%
END IF
NEXT
CUR% = CUR% + 1
WEND
TOTAL& = TOTAL& + 1& * COUNT% * FENCE%
END IF
NEXT
NEXT
PRINT TOTAL&Erona ensimmäisen osan koodiin on, että muuttujan FENCE% laskutapa on erilainen. Nyt ruutupari lasketaan mukaan reunan pituuteen vain, jos sen vieressä (vasemmalla tai ylhäällä) ei ole toista vastaavanlaista ruutuparia.
Metabolix kirjoitti:
Prosessi tuottaa paljon samoja lukuja (puolituksen ansiosta), ja omasta syötteestäni tulee 75 askeleen jälkeen vain 3770 eri lukua. Ratkaisuun sopii siksi myös yksinkertainen prosessin simulointi, kunhan kaikkia toistuvia lukuja ei levitetä taulukkoon vaan käsitellään pareja (luku, määrä).
Tämä on kiinnostava tieto, tosin tällaisen ratkaisun toteuttaminen QBasicilla voisi olla yllättävän hankalaa.
Antti Laaksonen kirjoitti:
Metabolix kirjoitti:
Prosessi tuottaa paljon samoja lukuja (puolituksen ansiosta), ja omasta syötteestäni tulee 75 askeleen jälkeen vain 3770 eri lukua. Ratkaisuun sopii siksi myös yksinkertainen prosessin simulointi, kunhan kaikkia toistuvia lukuja ei levitetä taulukkoon vaan käsitellään pareja (luku, määrä).
Tämä on kiinnostava tieto, tosin tällaisen ratkaisun toteuttaminen QBasicilla voisi olla yllättävän hankalaa.
Ainakin FreeBASICilla nopeus riittää, vaikka käyttäisi vain selection sort -tyyppistä ratkaisua taulukon tiivistämiseen kierroksen lopussa. Sain tehtyä tällaisen QB-koodin (josta ei toki QB:n osalta kannata ottaa mallia, koska en oikeastaan osaa QB:tä):
DIM SHARED nums#(10000)
DIM SHARED counts#(10000)
DIM SHARED nums_n%
DIM SHARED nums2#(10000)
DIM SHARED counts2#(10000)
' Luetaan luvut.
OPEN "a.txt" FOR INPUT AS #1
nums_n% = 0
DO
INPUT #1, nums#(nums_n%)
counts#(nums_n%) = 1
nums_n% = nums_n% + 1
LOOP UNTIL EOF(1)
FUNCTION step#
' Tehdään uudet luvut.
nums2_n% = 0
FOR i% = 0 TO nums_n% - 1
IF nums#(i%) = 0 THEN
nums2#(nums2_n%) = 1
counts2#(nums2_n%) = counts#(i%)
nums2_n% = nums2_n% + 1
ELSE
n$ = LTRIM$(STR$(nums#(i%)))
numdigits% = LEN(n$)
IF numdigits% MOD 2 = 1 THEN
nums2#(nums2_n%) = nums#(i%) * 2024
counts2#(nums2_n%) = counts#(i%)
nums2_n% = nums2_n% + 1
ELSE
numdigits% = numdigits% \ 2
nums2#(nums2_n%) = VAL(LEFT$(n$, numdigits%))
counts2#(nums2_n%) = counts#(i%)
nums2_n% = nums2_n% + 1
nums2#(nums2_n%) = VAL(RIGHT$(n$, numdigits%))
counts2#(nums2_n%) = counts#(i%)
nums2_n% = nums2_n% + 1
END IF
END IF
NEXT
' Yhdistetään ja järjestetään, selection sort -tyyppinen ratkaisu.
nums_n% = 0
handled# = -1
total# = 0
done% = 0
WHILE done% = 0
min# = 1e+100
count# = 0
done% = 1
FOR i% = 0 TO nums2_n% - 1
IF nums2#(i%) <= handled# THEN
' pass
ELSEIF nums2#(i%) = min# THEN
count# = count# + counts2#(i%)
ELSEIF nums2#(i%) < min# THEN
done% = 0
min# = nums2#(i%)
count# = counts2#(i%)
END IF
NEXT
IF done% = 0 THEN
handled# = min#
nums#(nums_n%) = min#
counts#(nums_n%) = count#
total# = total# + count#
nums_n% = nums_n% + 1
END IF
WEND
step# = total#
END FUNCTION
DIM steps#(75)
FOR i% = 1 TO 75
steps#(i%) = step#
NEXT
PRINT steps#(25)
PRINT steps#(75)Päivä 13
Tehtävän aiheena on kone, jossa on kaksi nappia. Molemmat napit lisäävät x- ja y-koordinaattia tietyn verran ja tavoitteena on painaa nappeja niin, että lopulliset koordinaatit ovat oikeat.
Tehtävän ensimmäisessä osassa on luvattu, että kumpaakin nappia tarvitsee painaa enintään 100 kertaa. Käytin tätä tietoa hyväksi ja tein raa'an voiman ratkaisun:
OPEN "DAY13.TXT" FOR INPUT AS #1
TOTAL& = 0
WHILE NOT EOF(1)
LINE INPUT #1, BUTTONA$
POS1% = INSTR(BUTTONA$, "+")
POS2% = INSTR(BUTTONA$, ",")
AX& = VAL(MID$(BUTTONA$, POS1% + 1, POS2% - POS1% - 1))
POS3% = INSTR(POS2%, BUTTONA$, "+")
AY& = VAL(MID$(BUTTONA$, POS3% + 1))
LINE INPUT #1, BUTTONB$
POS1% = INSTR(BUTTONB$, "+")
POS2% = INSTR(BUTTONB$, ",")
BX& = VAL(MID$(BUTTONB$, POS1% + 1, POS2% - POS1% - 1))
POS3% = INSTR(POS2%, BUTTONB$, "+")
BY& = VAL(MID$(BUTTONB$, POS3% + 1))
LINE INPUT #1, PRIZE$
POS1% = INSTR(PRIZE$, "=")
POS2% = INSTR(PRIZE$, ",")
PX& = VAL(MID$(PRIZE$, POS1% + 1, POS2% - POS1% - 1))
POS3% = INSTR(POS2%, PRIZE$, "=")
PY& = VAL(MID$(PRIZE$, POS3% + 1))
IF NOT EOF(1) THEN LINE INPUT #1, EMPTY$
BEST% = 0
FOR A% = 0 TO 100
FOR B% = 0 TO 100
CX& = A% * AX& + B% * BX&
CY& = A% * AY& + B% * BY&
IF CX& = PX& AND CY& = PY& THEN
COST% = 3 * A% + B%
IF BEST% = 0 OR COST% < BEST% THEN BEST% = COST%
END IF
NEXT
NEXT
TOTAL& = TOTAL& + BEST%
WEND
CLOSE #1
PRINT TOTAL&Tehtävässä syöte on annettu hankalassa muodossa, ja syötteen käsittely viekin suuren osan koodista.
Toisessa osassa luvut ovat huomattavasti suurempia eikä raa'an voiman ratkaisu ole mahdollinen. Tehtävän voi ratkaista tehokkaasti muodostamalla seuraavan yhtälöparin:
Tässä (AX,AY) on napin A muutos, (BX,BY) on napin B muutos ja (PX,PY) on tavoitemuutos. A ja B ovat puolestaan nappien painokerrat, jotka haluamme selvittää.
Tässä on kolme vaihtoehtoa: yhtälöparilla on yksikäsitteinen ratkaisu, useita ratkaisuja tai ei ratkaisua. Aloitin tapauksesta, jossa ratkaisu on yksikäsitteinen, ja osoittautui, että tehtävässä riittää käsitellä tämä tapaus. Silloin A ja B voidaan laskea suoraan kaavoilla.
Ratkaisin tehtävän toisen osan näin:
OPEN "DAY13.TXT" FOR INPUT AS #1
TOTAL# = 0
WHILE NOT EOF(1)
LINE INPUT #1, BUTTONA$
POS1% = INSTR(BUTTONA$, "+")
POS2% = INSTR(BUTTONA$, ",")
AX# = VAL(MID$(BUTTONA$, POS1% + 1, POS2% - POS1% - 1))
POS3% = INSTR(POS2%, BUTTONA$, "+")
AY# = VAL(MID$(BUTTONA$, POS3% + 1))
LINE INPUT #1, BUTTONB$
POS1% = INSTR(BUTTONB$, "+")
POS2% = INSTR(BUTTONB$, ",")
BX# = VAL(MID$(BUTTONB$, POS1% + 1, POS2% - POS1% - 1))
POS3% = INSTR(POS2%, BUTTONB$, "+")
BY# = VAL(MID$(BUTTONB$, POS3% + 1))
LINE INPUT #1, PRIZE$
POS1% = INSTR(PRIZE$, "=")
POS2% = INSTR(PRIZE$, ",")
PX# = 10 ^ 13 + VAL(MID$(PRIZE$, POS1% + 1, POS2% - POS1% - 1))
POS3% = INSTR(POS2%, PRIZE$, "=")
PY# = 10 ^ 13 + VAL(MID$(PRIZE$, POS3% + 1))
IF NOT EOF(1) THEN LINE INPUT #1, EMPTY$
A# = (PY# - PX# * BY# / BX#) / (AY# - AX# * BY# / BX#)
B# = (PX# - A# * AX#) / BX#
IF A# = FIX(A#) AND B# = FIX(B#) THEN
TOTAL# = TOTAL# + 3 * A# + B#
END IF
WEND
CLOSE #1
PRINT TOTAL#Koska ratkaisu on yksikäsitteinen, tehtävässä ei ole oikeastaan merkitystä sillä, että napin A painaminen maksaa 3 kolikkoa ja napin B painaminen maksaa 1 kolikon. Tällä olisi kuitenkin merkitystä, jos ratkaisu ei olisi yksikäsitteinen. Esimerkiksi jos nappien siirtymät olisivat (2,2) ja (1,1), tulisi käyttää nappia B, koska se on halvempaa.
Pääsin käyttämään tehtävässä funktiota FIX, jonka olemassaolo selvisi minulle aiemmassa tehtävässä. Tässä oletin itse asiassa vielä yhden asian: jos ratkaisu on kokonaislukuratkaisu, se on kelvollinen ratkaisu. Kuitenkin ratkaisussa voisi olla negatiivinen kokonaisluku, jolloin se ei olisi kelvollinen.
Metabolix kirjoitti:
Ainakin FreeBASICilla nopeus riittää, vaikka käyttäisi vain selection sort -tyyppistä ratkaisua taulukon tiivistämiseen kierroksen lopussa. Sain tehtyä tällaisen QB-koodin (josta ei toki QB:n osalta kannata ottaa mallia, koska en oikeastaan osaa QB:tä):
Hyvä, että testasit tämän. En tarkoittanut niinkään koodin suoritusnopeutta vaan koodin toteuttamisen hankaluutta. Tässä koodi näyttää suunnilleen yhtä hankalalta kuin dynaamisen ohjelmoinnin toteutuksessa, koska QBasicissa ei ole valmiita keinoja järjestämiseen ja parien yhdistämiseen.
Sekä dynaamisessa ohjelmoinnissa että parien yhdistämisessä joutuu olettamaan, että prosessi käyttäytyy riittävän mukavasti. Dynaamisessa ohjelmoinnissa riittää tallentaa melko pieni määrä välituloksia, ja parien yhdistämisessä tarvittavien parien määrä on tarpeeksi pieni.
Päivä 14
Tehtävän ensimmäisessä osassa tulee simuloida robottien liikettä ruudukossa 100 kierroksen aikana. Ruudukon leveys on 101 ja korkeus on 103. Tässä riitti raa'an voiman ratkaisu, joka laskee kunkin robotin lopullisen sijainnin:
W% = 101: H% = 103
STEPS% = 100
C1& = 0: C2& = 0: C3& = 0: C4& = 0
OPEN "DAY14.TXT" FOR INPUT AS #1
WHILE NOT EOF(1)
LINE INPUT #1, LINE$
POS1% = INSTR(LINE$, ",")
POS2% = INSTR(LINE$, " ")
POS3% = INSTR(POS2%, LINE$, "=")
POS4% = INSTR(POS3%, LINE$, ",")
PX% = VAL(MID$(LINE$, 3, POS1% - 3))
PY% = VAL(MID$(LINE$, POS1% + 1, POS2% - POS1% - 1))
VX% = VAL(MID$(LINE$, POS3% + 1, POS4% - POS3% - 1))
VY% = VAL(MID$(LINE$, POS4% + 1))
FX% = ((PX% + VX% * STEPS%) MOD W% + W%) MOD W%
FY% = ((PY% + VY% * STEPS%) MOD H% + H%) MOD H%
IF FX% < W% \ 2 AND FY% < H% \ 2 THEN C1& = C1& + 1
IF FX% < W% \ 2 AND FY% > H% \ 2 THEN C2& = C2& + 1
IF FX% > W% \ 2 AND FY% < H% \ 2 THEN C3& = C3& + 1
IF FX% > W% \ 2 AND FY% > H% \ 2 THEN C4& = C4& + 1
WEND
CLOSE #1
TOTAL& = C1& * C2& * C3& * C4&
PRINT TOTAL&Käytin robottien sijaintien laskemiseen kaavoja ((PX% + VX% * STEPS%) MOD W% + W%) MOD W% ja ((PY% + VY% * STEPS%) MOD H% + H%) MOD H%. Näissä on modulo kahdesti, koska ensimmäinen modulo voi tuottaa negatiivisen arvon. Tämän takia tarvitaan lisäys ja toinen modulo, jotta saadaan todellinen sijainti ruudukossa.
Tehtävän toinen osa on tavallisesta poikkeava, koska siinä tulee tunnistaa, monenko kierroksen jälkeen robotit muodostavat joulukuusen kuvan. Tehtävänanto ei kerro tarkemmin, millainen joulukuusi on.
Aloitin toisen osan ratkaisun käymällä läpi robottien muodostamia kuvioita. Tässä oli kätevää, että QBasicissa pystyy helposti piirtämään pisteitä ruudulle. Tein silmukan, joka näyttää kierros kerrallaan robottien sijainnit.
Käydessäni läpi kuvioita havaitsin, että joillakin kierroksilla kuvio näyttää säännöllisemmältä kuin muilla kierroksilla. Huomasin, että näistä kierroksista muodostuu kaksi lukujonoa:
Ensimmäisessä lukujonossa lukujen etäisyys on 101 ja toisessa lukujonossa lukujen etäisyys on 103. Tämän havainnon jälkeen rajasin tutkinnan kierroksiin, jotka osuvat näihin lukujonoihin. Aloitin luvusta 28 alkavasta lukujonosta ja sen avulla sain selville, että joulukuusi tulee näkyviin kierroksella 7603. Tarkastin myöhemmin, että joulukuusi olisi löytynyt myös luvusta 84 alkavasta lukujonosta.
Tässä on lopullinen koodi, jonka avulla selvitin toisen osan ratkaisun:
N% = 500
W% = 101: H% = 103
DIM PX%(N%), PY%(N%), VX%(N%), VY%(N%)
OPEN "DAY14.TXT" FOR INPUT AS #1
FOR I% = 1 TO N%
LINE INPUT #1, LINE$
POS1% = INSTR(LINE$, ",")
POS2% = INSTR(LINE$, " ")
POS3% = INSTR(POS2%, LINE$, "=")
POS4% = INSTR(POS3%, LINE$, ",")
PX%(I%) = VAL(MID$(LINE$, 3, POS1% - 3))
PY%(I%) = VAL(MID$(LINE$, POS1% + 1, POS2% - POS1% - 1))
VX%(I%) = VAL(MID$(LINE$, POS3% + 1, POS4% - POS3% - 1))
VY%(I%) = VAL(MID$(LINE$, POS4% + 1))
NEXT
CLOSE #1
SCREEN 13
' pattern 1: 28, 129, 203, 331, 432, ...
' pattern 2: 84, 187, 290, 393, 496, ...
FOR I% = 28 TO 10000 STEP 101
CLS
LINE (0, 0)-(W%, H%), , B
FOR J% = 1 TO N%
FX% = ((PX%(J%) + 1& * VX%(J%) * I%) MOD W% + W%) MOD W%
FY% = ((PY%(J%) + 1& * VY%(J%) * I%) MOD H% + H%) MOD H%
PSET (FX%, FY%)
NEXT
LOCATE 20: PRINT "STEP"; I%
IF INKEY$ = CHR$(27) THEN END
SLEEP
NEXTKomento SCREEN 13 ottaa käyttöön 320x200-grafiikkatilan. Komento LINE piirtää kuvan kehyksen ja komento PSET piirtää pisteen. Komento LOCATE määrittää, mille riville teksti tulostetaan. Lisäsin myös mahdollisuuden pysäyttää koodi painamalla Esciä (INKEY$ = CHR$(27)).
Löytynyt joulukuusi näyttää tältä: https://pllk.kapsi.fi/aoc2024_14.png
Ihmettelin ensin tehtävässä, miksi ruudukon koko on 101x103 ruutua. Tässä on ehkä taustalla, että 101 ja 103 ovat alkulukuja, jolloin robottien liike muodostaa syklin, jossa sama tilanne toistuu 101*103 = 10403 kierroksen välein. Tämä on sopivan suuri määrä kuvioita käytäväksi läpi. Jos koko olisi esimerkiksi 100x100 ruutua, syklin pituus olisi enintään 100, jolloin tehtävä voisi olla liian helppo.
Tuo yläraja syklille on kyllä hyvä huomio. Itse löysin joulukuusen soveltamalla tehtävänannon ohjetta: kun ”suurin osa” on asettunut johonkin kuvioon, alle puolet on kuvion ulkopuolella, ja mihin tapauksessa riitti tarkistus, ettei ole yhtään naapuria. Tietysti tehtävässä olisi voinut olla jäynä, että joulukuusi ei muodostuisi vierekkäisistä pisteistä vaan joka toinen ruutu olisi tyhjä, jolloin ratkaisuni ei olisi toiminut.
Päivä 15
Päivän tehtävänä on simuloida robotin liikettä ruudukossa, jossa on laatikoita. Vaikeutena on, että robotti voi liikkuessaan työntää laatikoita kulkusuuntaan.
Ratkaisin tehtävän ensimmäisen osan näin:
N% = 50
DIM GRID%(N%, N%)
OPEN "DAY15.TXT" FOR INPUT AS #1
FOR I% = 1 TO N%
LINE INPUT #1, LINE$
FOR J% = 1 TO N%
WHAT$ = MID$(LINE$, J%, 1)
SELECT CASE WHAT$
CASE "."
GRID%(I%, J%) = 0
CASE "#"
GRID%(I%, J%) = 1
CASE "O"
GRID%(I%, J%) = 2
CASE "@"
GRID%(I%, J%) = 0
Y% = I%: X% = J%
END SELECT
NEXT
NEXT
LINE INPUT #1, EMPTY$
WHILE NOT EOF(1)
LINE INPUT #1, LINE$
FOR I% = 1 TO LEN(LINE$)
WHAT$ = MID$(LINE$, I%, 1)
SELECT CASE WHAT$
CASE "^"
DY% = -1: DX% = 0
CASE ">"
DY% = 0: DX% = 1
CASE "v"
DY% = 1: DX% = 0
CASE "<"
DY% = 0: DX% = -1
END SELECT
CY% = Y% + DY%: CX% = X% + DX%
DO WHILE GRID%(CY%, CX%) = 2
CY% = CY% + DY%
CX% = CX% + DX%
LOOP
IF GRID%(CY%, CX%) = 0 THEN
DO WHILE GRID%(CY% - DY%, CX% - DX%) = 2
GRID%(CY%, CX%) = 2
CY% = CY% - DY%
CX% = CX% - DX%
LOOP
Y% = CY%: X% = CX%
GRID%(Y%, X%) = 0
END IF
NEXT
WEND
CLOSE #1
TOTAL& = 0
FOR I% = 1 TO N%
FOR J% = 1 TO N%
IF GRID%(I%, J%) = 2 THEN
TOTAL& = TOTAL& + 100 * (I% - 1) + (J% - 1)
END IF
NEXT
NEXT
PRINT TOTAL&Käytin tässä koodissa ensimmäistä kertaa joulukuun aikana SELECT CASE -rakennetta, jonka avulla voi käydä läpi muuttujan mahdollisia arvoja. Rakenne oli tässä kätevä, koska ruudukossa ja robotin liikesarjassa on useita mahdollisia symboleja.
Tehtävän toisessa osassa jokainen alkuperäinen ruutu vastaa kahta vaakasuunnassa vierekkäistä ruutua. Tämä tekee tehtävästä selvästi vaikeamman, koska laatikot voivat liikuttaa toisiaan monimutkaisemmin robotin liikkuessa.
Ratkaisin tehtävän toisen osan näin:
N% = 50
DIM GRID%(N%, 2 * N%)
OPEN "DAY15.TXT" FOR INPUT AS #1
FOR I% = 1 TO N%
LINE INPUT #1, LINE$
FOR J% = 1 TO N%
WHAT$ = MID$(LINE$, J%, 1)
SELECT CASE WHAT$
CASE "."
GRID%(I%, 2 * J% - 1) = 0
GRID%(I%, 2 * J%) = 0
CASE "#"
GRID%(I%, 2 * J% - 1) = 1
GRID%(I%, 2 * J%) = 1
CASE "O"
GRID%(I%, 2 * J% - 1) = 2
GRID%(I%, 2 * J%) = 3
CASE "@"
GRID%(I%, 2 * J% - 1) = 0
GRID%(I%, 2 * J%) = 0
Y% = I%: X% = 2 * J% - 1
END SELECT
NEXT
NEXT
LINE INPUT #1, EMPTY$
DIM LAST%(N%, 2 * N%)
COUNT% = 0
WHILE NOT EOF(1)
LINE INPUT #1, LINE$
FOR I% = 1 TO LEN(LINE$)
WHAT$ = MID$(LINE$, I%, 1)
SELECT CASE WHAT$
CASE "^"
DY% = -1: DX% = 0
CASE ">"
DY% = 0: DX% = 1
CASE "v"
DY% = 1: DX% = 0
CASE "<"
DY% = 0: DX% = -1
END SELECT
IF DY% = 0 THEN
CY% = Y%: CX% = X% + DX%
DO WHILE GRID%(CY%, CX%) >= 2
CX% = CX% + DX%
LOOP
IF GRID%(CY%, CX%) = 0 THEN
DO WHILE GRID%(CY%, CX% - DX%) >= 2
GRID%(CY%, CX%) = GRID%(CY%, CX% - DX%)
CX% = CX% - DX%
LOOP
X% = CX%
GRID%(Y%, X%) = 0
END IF
END IF
IF DX% = 0 THEN
CY% = Y% + DY%: CX% = X%
SELECT CASE GRID%(CY%, CX%)
CASE 0
MOVE% = 1
CASE 2
LX% = CX%: RX% = CX% + 1
MOVE% = 2
CASE 3
LX% = CX% - 1: RX% = CX%
MOVE% = 2
CASE ELSE
MOVE% = 0
END SELECT
IF MOVE% = 1 THEN
Y% = CY%: X% = CX%
END IF
IF MOVE% = 2 THEN
COUNT% = COUNT% + 1
LAST%(CY%, LX%) = COUNT%
LAST%(CY%, RX%) = COUNT%
DO
CY% = CY% + DY%
FAIL% = 0
ADD% = 0
FOR MX% = LX% TO RX%
SELECT CASE GRID%(CY%, MX%)
CASE 1
IF LAST%(CY% - DY%, MX%) = COUNT% THEN
FAIL% = 1
END IF
CASE 2
IF LAST%(CY% - DY%, MX%) = COUNT% THEN
LAST%(CY%, MX%) = COUNT%
LAST%(CY%, MX% + 1) = COUNT%
ADD% = 1
END IF
CASE 3
IF LAST%(CY% - DY%, MX%) = COUNT% THEN
LAST%(CY%, MX%) = COUNT%
LAST%(CY%, MX% - 1) = COUNT%
ADD% = 1
END IF
END SELECT
NEXT
IF GRID%(CY%, LX%) = 3 THEN LX% = LX% - 1
IF GRID%(CY%, RX%) = 2 THEN RX% = RX% + 1
IF FAIL% = 1 THEN EXIT DO
IF ADD% = 0 THEN
FOR A% = CY% TO Y% STEP SGN(Y% - CY%)
FOR B% = LX% TO RX%
IF LAST%(A%, B%) = COUNT% THEN
GRID%(A% + DY%, B%) = GRID%(A%, B%)
GRID%(A%, B%) = 0
END IF
NEXT
NEXT
Y% = Y% + DY%
EXIT DO
END IF
LOOP
END IF
END IF
NEXT
WEND
CLOSE #1
TOTAL& = 0
FOR I% = 1 TO N%
FOR J% = 1 TO 2 * N%
IF GRID%(I%, J%) = 2 THEN
TOTAL& = TOTAL& + 100 * (I% - 1) + (J% - 1)
END IF
NEXT
NEXT
PRINT TOTAL&Tässä taulukko LAST% pitää kirjaa siitä, mitkä kaikki laatikot liikkuvat, kun robotti kulkee pystysuuntaan. Muuttuja COUNT% kasvaa yhdellä aina, kun robotti alkaa liikuttaa laatikoita pystysuunnassa, joten muuttujan avulla voidaan tunnistaa nykyisessä siirrossa liikkuvat laatikot.
Muuttujat LX% ja RX% ilmaisevat vasemman ja oikean reunan ruudukon alueella, jossa laatikot liikkuvat. Tässä täytyy kuitenkin ottaa huomioon, että laatikko liikkuu vain silloin, jos siihen koskeva edellisen rivin laatikko on myös liikkunut.
Koodi oli melko hankala toteuttaa ja siinä oli monia bugeja, ennen kuin sain sen toimimaan. Yksi bugeista oli silmukassa, jonka aloitusrivi oli ensin:
FOR A% = CY% TO Y%
Tässä kuitenkin ongelmaksi tuli, että CY% saattaa olla suurempi kuin Y%, kun taas silmukka etenee oletuksena vain askel kerrallaan ylemmäs. Ratkaisin ongelman näin:
FOR A% = CY% TO Y% STEP SGN(Y% - CY%)
Tähän tilanteeseen soveltuu hyvin funktio SGN, joka antaa luvun etumerkin. Funktio palauttaa 1 positiiviselle luvulle ja -1 negatiiviselle luvulle.
Päivä 16
Tehtävässä on annettu ruudukko ja ensimmäisessä osassa tulee selvittää, mikä on pienin kustannus reitillä lähtöruudusta maaliruutuun. Kustannus lasketaan kaavalla 1000*t+s, jossa t on käännösten määrä ja s on askelten määrä. Tehtävän toisessa osassa tulee lisäksi selvittää, moniko ruutu on jollain kustannukseltaan pienimmällä reitillä.
Koska tehtävän toinen osa nojautuu vahvasti ensimmäiseen osaan, seuraavassa on yhteinen koodi, joka ratkaisee molemmat osat. Koodi perustuu leveyshakuun, joka etsii kustannukseltaan pienimpiä reittejä lähtöruudusta alkaen.
N% = 141
DIM GRID%(N%, N%)
DIM TURNS%(N%, N%)
DIM STEPS%(N%, N%)
DIM PLACES%(3000, 4)
OPEN "DAY16.TXT" FOR INPUT AS #1
FOR I% = 1 TO N%
LINE INPUT #1, LINE$
FOR J% = 1 TO N%
TURNS%(I%, J%) = 1000
WHAT$ = MID$(LINE$, J%, 1)
SELECT CASE WHAT$
CASE "#"
GRID%(I%, J%) = 1
CASE "S":
SY% = I%: SX% = J%
TURNS%(I%, J%) = 0
CASE "E"
EY% = I%: EX% = J%
END SELECT
NEXT
NEXT
CLOSE #1
DATA 1, 0, -1, 0, 0, 1, 0, -1
DIM MOVEX%(4), MOVEY%(4)
FOR I% = 1 TO 4
READ MOVEX%(I%), MOVEY%(I%)
NEXT
PLACES%(1, 1) = SY%
PLACES%(1, 2) = SX%
PLACES%(1, 3) = 0
PLACES%(1, 4) = 1
CUR% = 0
COUNT% = 1
DO WHILE CUR% < COUNT%
CUR% = CUR% + 1
Y% = PLACES%(CUR%, 1)
X% = PLACES%(CUR%, 2)
IF Y% = EY% AND X% = EX% THEN EXIT DO
DY% = PLACES%(CUR%, 3)
DX% = PLACES%(CUR%, 4)
NEWT% = TURNS%(Y%, X%)
IF CUR% <> 1 THEN NEWT% = NEWT% + 1
NEWS% = STEPS%(Y%, X%)
FOR I% = 1 TO N%
Y% = Y% + DY%
X% = X% + DX%
IF Y% < 1 OR Y% > N% OR X% < 0 OR X% > N% THEN EXIT FOR
IF GRID%(Y%, X%) = 1 THEN EXIT FOR
NEWS% = NEWS% + 1
NEW& = 1000& * NEWT% + NEWS%
OLD& = 1000& * TURNS%(Y%, X%) + STEPS%(Y%, X%)
IF NEW& < OLD& THEN
TURNS%(Y%, X%) = NEWT%
STEPS%(Y%, X%) = NEWS%
FOR M% = 1 TO 4
MY% = MOVEY%(M%)
MX% = MOVEX%(M%)
IF (DY% = 0 AND MX% = 0) OR (DX% = 0 AND MY% = 0) THEN
IF GRID%(Y% + MY%, X% + MX%) = 0 THEN
COUNT% = COUNT% + 1
PLACES%(COUNT%, 1) = Y%
PLACES%(COUNT%, 2) = X%
PLACES%(COUNT%, 3) = MY%
PLACES%(COUNT%, 4) = MX%
END IF
END IF
NEXT
END IF
NEXT
LOOP
PRINT "TURNS:"; TURNS%(EY%, EX%)
PRINT "STEPS:"; STEPS%(EY%, EX%)
TOTAL& = 1000& * TURNS%(EY%, EX%) + STEPS%(EY%, EX%)
PRINT "TOTAL:"; TOTAL&
GRID%(EY%, EX%) = 2
DO WHILE CUR% >= 1
Y% = PLACES%(CUR%, 1)
X% = PLACES%(CUR%, 2)
DY% = PLACES%(CUR%, 3)
DX% = PLACES%(CUR%, 4)
NEWT% = TURNS%(Y%, X%)
IF CUR% <> 1 THEN NEWT% = NEWT% + 1
NEWS% = STEPS%(Y%, X%)
REACH% = 0
FOR I% = 1 TO N%
Y% = Y% + DY%
X% = X% + DX%
IF Y% < 1 OR Y% > N% OR X% < 0 OR X% > N% THEN EXIT FOR
IF GRID%(Y%, X%) = 1 THEN EXIT FOR
NEWS% = NEWS% + 1
IF NEWT% = TURNS%(Y%, X%) AND NEWS% = STEPS%(Y%, X%) THEN
IF GRID%(Y%, X%) = 2 THEN REACH% = I%
END IF
FOR M% = 1 TO 4
MY% = MOVEY%(M%)
MX% = MOVEX%(M%)
IF (DY% = 0 AND MX% = 0) OR (DX% = 0 AND MY% = 0) THEN
IF GRID%(Y% + MY%, X% + MX%) = 2 THEN
ADDT% = TURNS%(Y% + MY%, X% + MX%)
ADDS% = STEPS%(Y% + MY%, X% + MX%)
IF NEWT% + 1 = ADDT% AND NEWS% + 1 = ADDS% THEN
REACH% = I%
END IF
END IF
END IF
NEXT
NEXT
IF REACH% > 0 THEN
Y% = PLACES%(CUR%, 1)
X% = PLACES%(CUR%, 2)
FOR I% = 0 TO REACH%
GRID%(Y%, X%) = 2
Y% = Y% + DY%
X% = X% + DX%
NEXT
END IF
CUR% = CUR% - 1
LOOP
TILES% = 0
FOR I% = 1 TO N%
FOR J% = 1 TO N%
IF GRID%(I%, J%) = 2 THEN TILES% = TILES% + 1
NEXT
NEXT
PRINT "TILES:"; TILES%Tässä tehtävässä minulle tuli tavallista enemmän haasteita muistinkulutuksen kanssa. Koetin ensin tallentaa pienimmän kustannuksen jokaiselle ruudulle:
DIM SCORE&(N%, N%)
Tämä LONG-tyyppinen taulukko oli kuitenkin liian suuri mahtuakseen muistiin. Ratkaisin asian tallentamalla pienimmästä kustannuksesta erikseen käännösten ja askelten määrän:
DIM TURNS%(N%, N%) DIM STEPS%(N%, N%)
Vaikka yksi LONG-tyyppinen taulukko ei mahtunut muistiin, kaksi INTEGER-tyyppistä taulukkoa mahtui muistiin. Siis QBasicissa voi olla hyödyllistä jakaa taulukon sisältö useaan taulukkoon, vaikka muistin kokonaiskulutus on sama.
Vaikeudet eivät kuitenkaan päättyneet tähän, koska tarvitsin vielä yhden taulukon leveyshaun jonoa varten. Tallensin taulukkoon neljän arvon yhdistelmiä: missä ruudussa haku on menossa (y ja x) ja mihin suuntaan (dy ja dx). Kokeilemalla huomasin, että voin luoda vielä taulukon, jonka koko on 3000:
DIM PLACES%(3000, 4)
Tämä on selvästi vähemmän kuin kaikkien sijainti-suunta-yhdistelmien määrä (78400). Kuitenkin tämä taulukko riitti omassa ruudukossani nipin napin, kun toteutin leveyshaun niin, että haku päättyy heti maaliruudun löytyessä eikä haku käänny suuntiin, joissa on heti edessä seinää.
Toinen tapa vähentää muistin kulutusta olisi ollut toteuttaa jono syklisenä rakenteena niin, että sen alussa olevaa tilaa voidaan hyödyntää uudestaan. Tämä toteutus olisi kuitenkin ollut hankalampi, eikä siihen onneksi ollut tarvetta tässä tehtävässä.
Oletin ratkaisussa, että pienimmän kustannuksen reitissä on myös pienin mahdollinen käännösten määrä. Tämä oletus ei pätisi, jos esimerkiksi reitissä A on 10 käännöstä ja 20 askelta (kustannus 10020) ja reitissä B on 9 käännöstä ja 1025 askelta (kustannus 10025). Tällöin reitin A kustannus on pienempi, vaikka siinä on enemmän käännöksiä.
Lisäksi oletin, että pienin kustannus muodostuu aina yksikäsitteisellä tavalla käännösten ja askelten määrän yhdistelmänä. Tämä oletus ei pätisi, jos esimerkiksi reitissä A on 10 käännöstä ja 20 askelta (kustannus 10020) ja reitissä B on 9 käännöstä ja 1020 askelta (kustannus 10020). Tällöin kummankin reitin kustannus on sama mutta niissä on eri määrä käännöksiä ja askelia.
Yllä olevat oletukset pätivät omassa ruudukossani, tai sain ainakin oikean vastauksen tehtävän molemmissa osissa. Voisiko kuitenkin olla ruudukko, jossa oletukset eivät päde ja koodini toimisi väärin?
En lukenut tehtävänantoa tarkkaan, mutta tällaisessa rakennelmassa pitää valita joko lyhyt tai pitkä reitti ja pitkässä on yksi käännös vähemmän. Sopivalla ruudukon koolla reittien hinnaksi näyttäisi saavan saman luvun.
############### #.............# #.###########.# #.###########.# #.###########.# #.###########.# #.###########.# #.###########.# #.###########.# #....########.# #.##.########.# #.#..########.# #.#.#########.# #S#E..........# ###############
Lisäys: Suuren määrän askelia saa mahdutettua kohtalaisen tiiviiseen tilaan esim. näin: pidempi, N käännöksen reitti tekee isoa siksakkia ja lyhyempi N+1 käännöksen reitti tekee pientä siksakkia.
###################### #....................# #.##################.# #.#..................# #.#.################## #.#..................# #.##################.# #.#..................# #.#.################## #.#..................# #.##################.# #.#..................# #.#.################## #.#..................# #.##################.# #.#..................# #.#.################## #.#..................# #.##################.# #.#...#...#...#...##.# #...#...#...#...#..#.# #.################.#.# #.#................#.# #.#.################.# #S#E.................# ######################
jlaire kirjoitti:
Lisäys: Suuren määrän askelia saa mahdutettua kohtalaisen tiiviiseen tilaan esim. näin: pidempi, N käännöksen reitti tekee isoa siksakkia ja lyhyempi N+1 käännöksen reitti tekee pientä siksakkia.
Tämä vaikuttaisi hyvältä tavalta tehdä ruudukko, jossa ratkaisuni toimii väärin.
Advent of Coden tehtävissä tuntuu olevan toistuva ilmiö, että riittää tehdä vähän väärin toimiva ratkaisu, joka kuitenkin antaa oikean tuloksen testitiedostolle. Tässä tehtävässä tosin testitiedoston muodostamista voisi rajoittaa paljon, jos sen täytyisi varautua tällä tavalla väärin toimivaan ratkaisuun.
Päivä 17
Tehtävässä on kuvattu erikoinen konekieli, jossa on kahdeksan komentoa ja kolme rekisteriä (A, B, C). Komentojen avulla voi muuttaa rekisterien arvoja laskutoimituksilla, tulostaa rekisterien arvoja sekä toteuttaa silmukan. Tehtävän ensimmäisessä osassa riittää simuloida annetun ohjelman suoritusta. Toteutin tähän seuraavan ratkaisun:
OPEN "DAY17.TXT" FOR INPUT AS #1
LINE INPUT #1, REGA$
A& = VAL(MID$(REGA$, INSTR(REGA$, ": ") + 2))
LINE INPUT #1, REGB$
B& = VAL(MID$(REGB$, INSTR(REGB$, ": ") + 2))
LINE INPUT #1, REGC$
C& = VAL(MID$(REGC$, INSTR(REGC$, ": ") + 2))
LINE INPUT #1, EMPTY$
LINE INPUT #1, PROG$
N% = LEN(PROG$) \ 2 - 4
DIM P%(N%)
FOR I% = 1 TO N%
P%(I% - 1) = VAL(MID$(PROG$, 2 * I% + 8, 1))
NEXT
CLOSE #1
IP% = 0
OUT$ = ""
DO
LIT% = P%(IP% + 1)
SELECT CASE LIT%
CASE 0 TO 3
COMBO& = LIT%
CASE 4
COMBO& = A&
CASE 5
COMBO& = B&
CASE 6
COMBO& = C&
END SELECT
NIP% = IP% + 2
SELECT CASE P%(IP%)
CASE 0
A& = A& \ 2 ^ COMBO&
CASE 1
B& = B& XOR LIT%
CASE 2
B& = COMBO& MOD 8
CASE 3
IF A& <> 0 THEN NIP% = LIT%
CASE 4
B& = B& XOR C&
CASE 5
OUT$ = OUT$ + "," + LTRIM$(STR$(COMBO& MOD 8))
CASE 6
B& = A& \ 2 ^ COMBO&
CASE 7
C& = A& \ 2 ^ COMBO&
END SELECT
IP% = NIP%
LOOP WHILE IP% < N%
PRINT MID$(OUT$, 2)Tehtävän toisessa osassa tulee etsiä pienin rekisterin A arvo, jonka seurauksena ohjelman tulostus on sama kuin sen koodi (eli ohjelma on quine). Toinen osa on selkeästi ensimmäistä osaa vaikeampi, eikä sen ratkaiseminen vaikuta mahdolliselta raa'alla voimalla.
Halusin saada ensin paremman käsityksen ohjelman toiminnasta ja kävin läpi siinä olevat komennot. Minulle annetun ohjelman toiminta voidaan esittää selkeämmin seuraavalla koodilla:
START: B = A MOD 8 B = B XOR 1 C = A / 2 ^ B A = A / 8 B = B XOR 4 B = B XOR C PRINT B MOD 8 IF A > 0 THEN GOTO START
Ohjelma muodostuu silmukasta, jonka jokaisella kierroksella ohjelma tulostaa yhden luvun. Kierrosten määrä riippuu suoraan rekisterin A alkuarvosta, koska A jaetaan 8:lla joka kierroksella ja ohjelma päättyy, kun A saavuttaa arvon 0. Ohjelman tulostamat luvut määräytyvät sen perusteella, mikä on rekisterin A arvo kunkin kierroksen alussa.
Ohjelman toiminnan voi esittää tiiviimmin näin yhdistämällä rivejä ja muuttamalla niiden järjestystä:
START: C = A / 2 ^ ((A MOD 8) XOR 1) B = (A MOD 8) XOR 5 XOR C PRINT B MOD 8 A = A / 8 IF A > 0 THEN GOTO START
Kun testasin ohjelman toimintaa rekisterin A eri alkuarvoilla, havaitsin kiinnostavan ilmiön. Kun rekisterin A alkuarvo kasvaa, ohjelman tulosteen alussa olevat luvut muuttuvat jatkuvasti mutta lopussa olevat luvut muuttuvat vain harvoin. Kun tutkin asiaa lisää, havaitsin, että tulosteen kohdassa k oleva luku (0-indeksoituna) muuttuu 8k askeleen välein, kun rekisterin A alkuarvo kasvaa.
Tämän avulla pystyin tekemään tehokkaan hakuohjelman. Siinä on ideana etsiä tulosteen viimeinen luku, joka ei ole sama kuin ohjelman koodissa vastaavassa kohdassa oleva luku. Kun tällainen luku on kohdassa k, rekisterin A alkuarvo kasvaa 8k:lla. Näin jatketaan, kunnes kaikki luvut ovat samat kuin ohjelman koodissa, jolloin ratkaisu on löytynyt.
Toteutin toisen osan ratkaisun seuraavasti:
DIM PROG%(15)
DATA 2, 4, 1, 1, 7, 5, 0, 3, 1, 4, 4, 4, 5, 5, 3, 0
FOR I% = 0 TO 15
READ PROG%(I%)
NEXT
DEF FNMOD8% (X#) = (X# / 8 - FIX(X# / 8)) * 8
CUR# = 0
DIM RES%(15)
DO
A# = CUR#
FOR I% = 0 TO 15
C% = FNMOD8%(FIX(A# / 2 ^ (FNMOD8%(A#) XOR 1)))
B% = FNMOD8%(A#) XOR 5 XOR C%
RES%(I%) = B% MOD 8
A# = FIX(A# / 8)
NEXT
FAIL% = -1
FOR I% = 0 TO 15
IF RES%(I%) <> PROG%(I%) THEN FAIL% = I%
NEXT
IF FAIL% = -1 THEN EXIT DO
CUR# = CUR# + 8# ^ FAIL%
LOOP
PRINT CUR#Ratkaisun toteuttamisessa oli pienenä hankaluutena, että rekisterin A luku voi olla suuri ja vaatii DOUBLE-tyypin käyttämistä mutta operaatiot MOD ja XOR eivät toimi suurilla DOUBLE-luvuilla. Ratkaisin ongelman tekemällä funktion FNMOD8%, joka muuntaa DOUBLE-luvun INTEGER-luvuksi modulo 8.
Antti Laaksonen kirjoitti:
Ratkaisun toteuttamisessa oli pienenä hankaluutena, että rekisterin A luku voi olla suuri ja vaatii
DOUBLE-tyypin käyttämistä mutta operaatiotMODjaXOReivät toimi suurillaDOUBLE-luvuilla. Ratkaisin ongelman tekemällä funktionFNMOD8%, joka muuntaaDOUBLE-luvunINTEGER-luvuksi modulo 8.
Sinänsä ihan näppärä ratkaisu tilanteeseen, jossa 31/32 bittiä ei riitä mutta 52 bittiä riittää.
Grez kirjoitti:
Sinänsä ihan näppärä ratkaisu tilanteeseen, jossa 31/32 bittiä ei riitä mutta 52 bittiä riittää.
Joo, tästä on ollut hyötyä monessakin tehtävässä. Mietin ennen haasteen aloittamista, että suurten kokonaislukujen kanssa voi tulla ongelmia, mutta tähän mennessä DOUBLE on riittänyt aina.
Jos 52 bittiäkään ei riitä, ehkä vanha kikka auttaa: https://www.ohjelmointiputka.net/keskustelu/
Antti Laaksonen kirjoitti:
Idea: lasketaan tarkkuuden lisäämiseksi kaikki laskut sekä tyypillä long long että double. Nyt long long antaa luvusta tarkan loppuosan ja double antaa alkuosan
A& = 0: B& = 1
A# = 0: B# = 1
T& = 1000000000
FOR I& = 1 TO 100
C& = (A& + B&) MOD T&
C# = A# + B#
PRINT FIX((A# + .5) / T&); A&
A& = B&: B& = C&
A# = B#: B# = C#
NEXTTestasin DOSBoxissa qb45:llä ja viimeinen luku 218922995834555169026 on oikein. Taitaa olla melkein 20 vuotta siitä kun viimeksi koodasin QBasicillä.
Olen miettinyt, että tuotakin kikkaa voi käyttää tarvittaessa. Saa nähdä tuleeko tarvetta, vielä viikon verran tehtäviä tulossa.
Päivä 18
Tehtävänä on etsiä lyhin reitti ruudukossa vasemmasta yläkulmasta oikeaan alakulmaan. Tehtävän ensimmäisessä osassa ruudukossa on tietyt esteet ja riittää käyttää leveyshakua reitin etsimiseen. Toteutin ratkaisun näin:
N% = 70: K% = 1024
DIM GRID%(N%, N%)
DIM DIST&(N%, N%)
DIM PLACES%(N% * N% + N%, 2)
CONST INF = 999999999
OPEN "DAY18.TXT" FOR INPUT AS #1
FOR I% = 1 TO K%
LINE INPUT #1, LINE$
P% = INSTR(LINE$, ",")
X% = VAL(LEFT$(LINE$, P% - 1))
Y% = VAL(MID$(LINE$, P% + 1))
GRID%(Y%, X%) = 1
NEXT
CLOSE #1
DATA 1, 0, -1, 0, 0, 1, 0, -1
DIM DY%(4), DX%(4)
FOR I% = 1 TO 4
READ DY%(I%), DX%(I%)
NEXT
FOR I% = 0 TO N%
FOR J% = 0 TO N%
DIST&(I%, J%) = INF
NEXT
NEXT
PLACES%(1, 1) = 0
PLACES%(1, 2) = 0
DIST&(0, 0) = 0
CUR% = 0
COUNT% = 1
WHILE CUR% < COUNT%
CUR% = CUR% + 1
Y% = PLACES%(CUR%, 1)
X% = PLACES%(CUR%, 2)
FOR I% = 1 TO 4
NY% = Y% + DY%(I%)
NX% = X% + DX%(I%)
IF NY% >= 0 AND NY% <= N% AND NX% >= 0 AND NX% <= N% THEN
IF GRID%(NY%, NX%) = 0 THEN
IF DIST&(Y%, X%) + 1 < DIST&(NY%, NX%) THEN
DIST&(NY%, NX%) = DIST&(Y%, X%) + 1
COUNT% = COUNT% + 1
PLACES%(COUNT%, 1) = NY%
PLACES%(COUNT%, 2) = NX%
END IF
END IF
END IF
NEXT
WEND
PRINT DIST&(N%, N%)Tehtävän toisessa osassa ruudukkoon lisätään esteitä yksi kerrallaan. Nyt tehtävänä on selvittää, minkä esteen lisäämisen jälkeen ruudukossa ei ole enää reittiä vasemmasta yläkulmasta oikeaan alakulmaan.
Koska ruudukon koko ja esteiden määrä ovat melko pieniä, päädyin käyttämään raa'an voiman ratkaisua, joka lisää esteitä yksi kerrallaan ja suorittaa leveyshaun jokaisen esteen lisäämisen jälkeen.
N% = 70: K% = 3450
DIM GRID%(N%, N%)
DIM DIST&(N%, N%)
DIM PLACES%((N% + 1) * (N% + 1), 2)
CONST INF = 999999999
OPEN "DAY18.TXT" FOR INPUT AS #1
FOR I% = 1 TO K%
LINE INPUT #1, LINE$
P% = INSTR(LINE$, ",")
X% = VAL(LEFT$(LINE$, P% - 1))
Y% = VAL(MID$(LINE$, P% + 1))
GRID%(Y%, X%) = I%
NEXT
CLOSE #1
DATA 1, 0, -1, 0, 0, 1, 0, -1
DIM DY%(4), DX%(4)
FOR I% = 1 TO 4
READ DY%(I%), DX%(I%)
NEXT
FOR F% = 1 TO K%
FOR I% = 0 TO N%
FOR J% = 0 TO N%
DIST&(I%, J%) = INF
NEXT
NEXT
PLACES%(1, 1) = 0
PLACES%(1, 2) = 0
DIST&(0, 0) = 0
CUR% = 0
COUNT% = 1
WHILE CUR% < COUNT%
CUR% = CUR% + 1
Y% = PLACES%(CUR%, 1)
X% = PLACES%(CUR%, 2)
FOR I% = 1 TO 4
NY% = Y% + DY%(I%)
NX% = X% + DX%(I%)
IF NY% >= 0 AND NY% <= N% AND NX% >= 0 AND NX% <= N% THEN
IF GRID%(NY%, NX%) = 0 OR GRID%(NY%, NX%) > F% THEN
IF DIST&(Y%, X%) + 1 < DIST&(NY%, NX%) THEN
DIST&(NY%, NX%) = DIST&(Y%, X%) + 1
COUNT% = COUNT% + 1
PLACES%(COUNT%, 1) = NY%
PLACES%(COUNT%, 2) = NX%
END IF
END IF
END IF
NEXT
WEND
IF DIST&(N%, N%) = INF THEN
FOR I% = 0 TO N%
FOR J% = 0 TO N%
IF GRID%(I%, J%) = F% THEN
PRINT J%; I%
END
END IF
NEXT
NEXT
END IF
NEXTRaa'an voiman ratkaisu osoittautui hyväksi valinnaksi, koska vastaus löytyi sen avulla varsin nopeasti. Tehtävän voisi kuitenkin myös ratkaista tehokkaammin esimerkiksi binäärihaun tai union find -rakenteen avulla.
Tehtävä oli minulle pettymys, koska toisessa osassa olisi ollut monia mahdollisuuksia kiinnostavaan tehtävään. Nyt kuitenkin riitti suunnilleen ottaa ensimmäisen osan koodi ja lisätä siihen yksi silmukka.
Päivä 19
Tehtävän ensimmäisessä osassa tulee selvittää, voiko merkkijonon muodostaa annetuista sanoista. Toisessa osassa tulee puolestaan laskea, montako eri tapaa muodostamiseen on olemassa. Tavallinen tapa ratkaista nämä tehtävät on käyttää dynaamista ohjelmointia.
Toteutin ensimmäisen osan ratkaisun näin:
DIM WORD$(1000)
DIM CHECK%(1000)
OPEN "DAY19.TXT" FOR INPUT AS #1
LINE INPUT #1, LINE$
SPLIT LINE$, ", ", WORD$(), WC%
LINE INPUT #1, EMPTY$
TOTAL% = 0
DO UNTIL EOF(1)
LINE INPUT #1, TEXT$
N% = LEN(TEXT$)
FOR I% = 1 TO N% + 1
CHECK%(I%) = 0
NEXT
CHECK%(1) = 1
FOR I% = 1 TO N%
IF CHECK%(I%) = 1 THEN
FOR J% = 1 TO WC%
WL% = LEN(WORD$(J%))
IF MID$(TEXT$, I%, WL%) = WORD$(J%) THEN
CHECK%(I% + WL%) = 1
END IF
NEXT
END IF
NEXT
IF CHECK%(N% + 1) = 1 THEN TOTAL% = TOTAL% + 1
LOOP
PRINT TOTAL%
CLOSE #1
SUB SPLIT (TEXT$, DELIM$, RES$(), COUNT%)
TEXT$ = TEXT$ + DELIM$
COUNT% = 0
POS1% = 1
DO
POS2% = INSTR(POS1%, TEXT$, DELIM$)
IF POS2% = 0 THEN EXIT DO
COUNT% = COUNT% + 1
RES$(COUNT%) = MID$(TEXT$, POS1%, POS2% - POS1%)
POS1% = POS2% + LEN(DELIM$)
LOOP
END SUBIdeana on muodostaa taulukko CHECK%, joka kertoo jokaiselle merkkijonon alkuosalle, voidaanko se muodostaa sanoista. Dynaamisen ohjelmoinnin avulla taulukko saadaan rakennettua tehokkaasti vasemmalta oikealle.
Hyödynsin ratkaisussa MID$-funktion toimintaa tilanteessa, jossa erotettavan osan pituus ylittää merkkijonon pituuden. Tässä ei tule virhettä vaan erotettava osa päättyy merkkijonon loppuun. Esimerkiksi MID$("aybabtu", 4, 10) antaa tuloksen "abtu". Tämän ansiosta koodissani ei tarvitse tarkastaa sanan pituutta, kun sanaa verrataan merkkijonon osaan.
Tämä tehtävä toi esille bugin aiemmin toteuttamassani SPLIT-aliohjelmassa. Olin testannut aliohjelmaa vain yksimerkkisellä erottimella mutta tässä erotin on kaksimerkkinen. Tarvittava korjaus oli muuttaa siirtymä POS2% + 1 muotoon POS2% + LEN(DELIM$). Tämä on ehkä tyypillinen bugi, koska myös vuonna 2003 julkaistussa koodivinkissä on ollut samanlainen bugi.
Toteutin toisen osan ratkaisun näin:
DIM WORD$(1000)
DIM WAYS#(1000)
OPEN "DAY19.TXT" FOR INPUT AS #1
LINE INPUT #1, LINE$
SPLIT LINE$, ", ", WORD$(), WC%
LINE INPUT #1, EMPTY$
TOTAL# = 0
DO UNTIL EOF(1)
LINE INPUT #1, TEXT$
N% = LEN(TEXT$)
FOR I% = 1 TO N% + 1
WAYS#(I%) = 0
NEXT
WAYS#(1) = 1
FOR I% = 1 TO N%
FOR J% = 1 TO WC%
WL% = LEN(WORD$(J%))
IF MID$(TEXT$, I%, WL%) = WORD$(J%) THEN
WAYS#(I% + WL%) = WAYS#(I% + WL%) + WAYS#(I%)
END IF
NEXT
NEXT
TOTAL# = TOTAL# + WAYS#(N% + 1)
LOOP
PRINT TOTAL#
CLOSE #1
SUB SPLIT (TEXT$, DELIM$, RES$(), COUNT%)
TEXT$ = TEXT$ + DELIM$
COUNT% = 0
POS1% = 1
DO
POS2% = INSTR(POS1%, TEXT$, DELIM$)
IF POS2% = 0 THEN EXIT DO
COUNT% = COUNT% + 1
RES$(COUNT%) = MID$(TEXT$, POS1%, POS2% - POS1%)
POS1% = POS2% + LEN(DELIM$)
LOOP
END SUBRatkaisu on lähes sama kuin ensimmäisessä osassa, mutta taulukon CHECK% sijasta käytetään taulukkoa WAYS#, johon lasketaan ratkaisujen määrät. Itse asiassa toisen osan avulla voisi ratkaista myös ensimmäisen osan, koska ratkaisu on olemassa tarkalleen silloin, kun ratkaisujen määrä on yli nolla.
Tässä tehtävässä yksinkertainen dynaamisen ohjelmoinnin ratkaisu riitti hyvin, mutta tehtävän voi ratkaista myös tehokkaammin. Esimerkiksi CSES:ssä on tehtävä Word Combinations, joka vaatii tehokkaamman ratkaisun.
Päivä 20
Annettuna on ruudukko, jossa on yksikäsitteinen reitti alkuruudusta loppuruutuun. Tehtävänä on laskea, monellako tavalla reittiä pystyy lyhentämään oikotien avulla. Ensimmäisessä osassa sallittu oikotien pituus on tasan 2 askelta ja toisessa osassa enintään 20 askelta.
Ratkaisin tehtävän molemmat osat samalla koodilla:
N% = 141
LENGTH% = 20
BOUND% = 100
DIM GRID%(N%, N%)
DIM DIST%(N%, N%)
OPEN "DAY20.TXT" FOR INPUT AS #1
FOR I% = 1 TO N%
LINE INPUT #1, LINE$
FOR J% = 1 TO N%
WHAT$ = MID$(LINE$, J%, 1)
IF WHAT$ = "#" THEN GRID%(I%, J%) = 1
IF WHAT$ = "S" THEN Y% = I%: X% = J%
NEXT
NEXT
CLOSE #1
DIM DY%(4), DX%(4)
DATA 1, 0, -1, 0, 0, 1, 0, -1
FOR I% = 1 TO 4
READ DY%(I%), DX%(I%)
NEXT
COUNT% = 0
WHILE DIST%(Y%, X%) = 0
COUNT% = COUNT% + 1
DIST%(Y%, X%) = COUNT%
FOR D% = 1 TO 4
NY% = Y% + DY%(D%)
NX% = X% + DX%(D%)
IF NY% >= 1 AND NY% <= N% AND NX% >= 1 AND NX% <= N% THEN
IF GRID%(NY%, NX%) = 0 AND DIST%(NY%, NX%) = 0 THEN
Y% = NY%
X% = NX%
EXIT FOR
END IF
END IF
NEXT
WEND
TOTAL& = 0
FOR Y1% = 1 TO N%
FOR X1% = 1 TO N%
IF GRID%(Y1%, X1%) = 0 THEN
CY% = LENGTH%
FOR MY% = -CY% TO CY%
CX% = LENGTH% - ABS(MY%)
FOR MX% = -CX% TO CX%
Y2% = Y1% + MY%
X2% = X1% + MX%
IF Y2% >= 1 AND Y2% <= N% AND X2% >= 1 AND X2% <= N% THEN
IF GRID%(Y2%, X2%) = 0 THEN
OLD% = DIST%(Y2%, X2%) - DIST%(Y1%, X1%)
NEW% = ABS(Y1% - Y2%) + ABS(X1% - X2%)
IF OLD% - NEW% >= BOUND% THEN TOTAL& = TOTAL& + 1
END IF
END IF
NEXT
NEXT
END IF
NEXT
NEXT
PRINT TOTAL&Muuttuja LENGTH% määrittelee oikotien pituuden ylärajan. Ensimmäisessä osassa yläraja on 2 ja toisessa osassa 20. Muuttuja BOUND% antaa alarajan, miten pitkät reitin lyhennykset lasketaan mukaan tulokseen. Tämä alaraja on molemmissa osissa 100.
Koodi muodostaa ensin taulukon, jossa DIST%(Y%, X%) ilmaisee reitin pituuden alkuruudusta ruutuun (Y%, X%). Tässä voisi käyttää leveyshakua, mutta koska reitti on yksikäsitteinen, päädyin etsimään reitin helpommin aloittamalla alkuruudusta ja siirtymällä aina seuraavaan reitillä olevaan ruutuun.
Hieman yllättäen koodissa ei ole lainkaan tarvetta tiedolle, missä on reitin loppuruutu (merkki E syötteessä). Koska reitti on yksikäsitteinen, kaikki reitillä olevat ruudut löytyvät järjestyksessä alkuruudusta aloittaen.
Koodin loppuosa laskee reitin lyhennysten määrät. Koodi käy läpi kaikki tavat valita oikotien ensimmäinen ruutu (Y1%, X1%) ja viimeinen ruutu (Y2%, X2%). Sitten koodi tarkastaa, paljonko oikotie lyhentää reittiä. Reitin alkuperäinen pituus oikotien osuudella on DIST%(Y2%, X2%) - DIST%(Y1%, X1%) ja oikotien pituus on ABS(Y1% - Y2%) + ABS(X1% - X2%).
Ratkaisua tehdessäni ongelmaksi tuli, että koodi viittasi taulukon rajojen ulkopuolelle. En muistanut, että QBasic ei katkaise AND-muotoisen ehtolausekkeen läpikäyntiä ensimmäiseen epätoteen ehtoon. Esimerkiksi seuraava koodi ei toimi halutulla tavalla:
IF Y% >= 1 AND Y% <= N% AND X% >= 1 AND X% <= N% AND GRID%(Y%, X%) = 0 THEN
...
END IFOngelmana on, että viimeinen ehto GRID%(Y%, X%) = 0 tarkastetaan aina, vaikka Y% tai X% olisi rajojen ulkopuolella. Asian voi korjata käyttämällä kahta sisäkkäistä ehtolausetta näin:
IF Y% >= 1 AND Y% <= N% AND X% >= 1 AND X% <= N% THEN
IF GRID%(Y%, X%) = 0 THEN
...
END IF
END IFModerneissa kielissä ehdot käydään yleensä läpi vasemmalta oikealle ja läpikäynti päättyy ensimmäiseen epätoteen ehtoon. Tästä käytetään nimeä short-circuit evaluation.
Päivä 21
Tehtävässä tulee näppäillä annettu koodi numeronäppäimistöllä. Näppäimistöä käyttää robotti, jota ohjataan suuntanäppäimistöllä, jota käyttää toinen robotti, jota ohjataan toisella suuntanäppäimistöllä, jne., kunnes viimeistä suuntanäppäimistöä ohjaa ihminen. Tehtävänä on selvittää lyhin mahdollinen näppäilysarja viimeisellä näppäimistöllä.
Tehtävän ensimmäisessä osassa 2 robottia käyttää suuntanäppäimistöjä. Ratkaisin tämän osan epämääräisellä koodilla, joka ilmeisesti antoi sattumalta oikean vastauksen. Tämän takia siirryn suoraan toiseen osaan, jossa 25 robottia käyttää suuntanäppäimistöjä. Tähän osaan sain tehtyä (luultavasti) oikein toimivan koodin, joka toimii millä tahansa robottien määrällä.
Joka askeleella robottia tulee siirtää näppäimistöllä vaaka- ja pystysuunnassa. Tehtävän vaikeutena on, että joissain tilanteissa on merkitystä, kumpaan suuntaan robotti liikkuu ensin. Esimerkiksi jos robotti on numeronäppäimistöllä numeron 1 kohdalla ja se tulee siirtää numeron 8 kohdalle, mahdolliset näppäilysarjat ovat:
Vaihtoehto 1: ^^>A (ensin ylös, sitten oikealle)
Vaihtoehot 2: >^^A (ensin oikealle, sitten ylös)
Vaihtoehdossa 1 toinen robotti voi näppäillä <AA>vA^A ja kolmas robotti voi näppäillä v<<A>>^AAvA^A<A>A. Vaihtoehdossa 2 toinen robotti voi näppäillä vA^<AA>A ja kolmas robotti voi näppäillä <vA^>A<Av<A>>^AAvA^A. Vaihtoehdossa 2 kolmannen robotin näppäilysarja on pidempi. Tässä tilanteessa vaihtoehdon 1 etuna on, että toisen robotin näppäilysarjassa ovat peräkkäin suunnat > ja ^, jotka ovat lähellä näppäintä A suuntanäppäimistöllä, kun kolmas robotti näppäilee ne.
Tein tehtävään seuraavan dynaamisen ohjelmoinnin ratkaisun:
RC% = 25
DIM NUMY%(128), NUMX%(128)
DIM DIRY%(128), DIRX%(128)
DATA 7, 8, 9
DATA 4, 5, 6
DATA 1, 2, 3
DATA X, 0, A
FOR Y% = 1 TO 4
FOR X% = 1 TO 3
READ BUTTON$
WHAT% = ASC(BUTTON$)
NUMY%(WHAT%) = Y%
NUMX%(WHAT%) = X%
NEXT
NEXT
DATA X, ^, A
DATA <, v, >
FOR Y% = 1 TO 2
FOR X% = 1 TO 3
READ BUTTON$
WHAT% = ASC(BUTTON$)
DIRY%(WHAT%) = Y%
DIRX%(WHAT%) = X%
NEXT
NEXT
DIM COUNT#(2, 3, 2, 3, RC%)
FOR K% = 1 TO RC%
FOR Y1% = 1 TO 2
FOR X1% = 1 TO 3
FOR Y2% = 1 TO 2
FOR X2% = 1 TO 3
MINC# = 0
FOR O% = 1 TO 2
P$ = PATH$(Y1%, X1%, Y2%, X2%, 2, (O%))
C# = 0
IF K% = 1 THEN
C# = LEN(P$)
ELSE
Y% = 1: X% = 3
FOR I% = 1 TO LEN(P$)
WHAT% = ASC(MID$(P$, I%, 1))
NY% = DIRY%(WHAT%)
NX% = DIRX%(WHAT%)
C# = C# + COUNT#(Y%, X%, NY%, NX%, K% - 1)
Y% = NY%: X% = NX%
NEXT
END IF
IF O% = 1 OR C# < MINC# THEN MINC# = C#
NEXT
COUNT#(Y1%, X1%, Y2%, X2%, K%) = MINC#
NEXT
NEXT
NEXT
NEXT
NEXT
TOTAL# = 0
OPEN "DAY21.TXT" FOR INPUT AS #1
WHILE NOT EOF(1)
LINE INPUT #1, CODE$
Y% = 4: X% = 3
MOVES# = 0
FOR I% = 1 TO LEN(CODE$)
WHAT% = ASC(MID$(CODE$, I%, 1))
NY% = NUMY%(WHAT%)
NX% = NUMX%(WHAT%)
MINC# = 0
FOR O% = 1 TO 2
SEQ$ = PATH$(Y%, X%, NY%, NX%, 1, (O%))
SY% = 1: SX% = 3
C# = 0
FOR J% = 1 TO LEN(SEQ$)
WHAT% = ASC(MID$(SEQ$, J%, 1))
SNY% = DIRY%(WHAT%)
SNX% = DIRX%(WHAT%)
C# = C# + COUNT#(SY%, SX%, SNY%, SNX%, RC%)
SY% = SNY%: SX% = SNX%
NEXT
IF O% = 1 OR C# < MINC# THEN MINC# = C#
NEXT
MOVES# = MOVES# + MINC#
Y% = NY%: X% = NX%
NEXT
TOTAL# = TOTAL# + VAL(CODE$) * MOVES#
WEND
CLOSE #1
PRINT TOTAL#
FUNCTION PATH$ (Y1%, X1%, Y2%, X2%, M%, O%)
IF M% = 1 AND Y1% = 4 AND X2% = 1 THEN O% = 2
IF M% = 2 AND Y1% = 1 AND X2% = 1 THEN O% = 2
IF M% = 1 AND X1% = 1 AND Y2% = 4 THEN O% = 1
IF M% = 2 AND X1% = 1 AND Y2% = 1 THEN O% = 1
RES$ = ""
IF O% = 1 THEN
IF X1% < X2% THEN RES$ = RES$ + STRING$(X2% - X1%, ">")
IF X1% > X2% THEN RES$ = RES$ + STRING$(X1% - X2%, "<")
IF Y1% < Y2% THEN RES$ = RES$ + STRING$(Y2% - Y1%, "v")
IF Y1% > Y2% THEN RES$ = RES$ + STRING$(Y1% - Y2%, "^")
END IF
IF O% = 2 THEN
IF Y1% < Y2% THEN RES$ = RES$ + STRING$(Y2% - Y1%, "v")
IF Y1% > Y2% THEN RES$ = RES$ + STRING$(Y1% - Y2%, "^")
IF X1% < X2% THEN RES$ = RES$ + STRING$(X2% - X1%, ">")
IF X1% > X2% THEN RES$ = RES$ + STRING$(X1% - X2%, "<")
END IF
PATH$ = RES$ + "A"
END FUNCTIONMuuttuja RC% määrittelee suuntanäppäimistöjä käyttävien robottien määrän. Tehtävän osassa 1 määrä on 2 ja osassa 2 määrä on 25.
Taulukot NUMY% ja NUMX% ilmaisevat, missä kohdassa tietty merkki on numeronäppäimistöllä. Vastaavasti taulukot DIRY% ja DIRX% ilmaisevat, missä kohdassa tietty merkki on suuntanäppäimistöllä. Taulukoita indeksoidaan merkin ASCII-koodilla.
Taulukko COUNT# on dynaamisen ohjelmoinnin taulukko. Koodi laskee kohtaan COUNT#(Y1%, X1%, Y2%, X2%, K%), mikä on lyhin näppäilysarja suuntanäppäimistöllä kohdasta (Y1%, X1%) kohtaan (Y2%, X2%), kun peräkkäin on K% robottia. Pohjatapaus on K% = 1, jolloin yksittäinen robotti tekee näppäilyt. Muissa tapauksissa taulukosta saadaan haettua aiemmin laskettu paras tapa, jolla seuraava robotti voi tehdä näppäilyt.
Funktio PATH$ (Y1%, X1%, Y2%, X2%, M%, O%) muodostaa polun näppäimistön kohdasta (Y1%, X1%) kohtaan (Y2%, X2%). Parametri M% ilmaisee näppäimistön tyypin (1 = numero, 2 = suunta). Parametri O% puolestaan ilmaisee, liikutaanko ensin vaaka- vai pystysuunnassa. Parametria M% tarvitaan käsittelemään oikein muutama erikoistapaus, jossa robotti ei saa siirtyä näppäimistön tyhjälle alueelle. Pääsin käyttämään tässä QBasicin funktiota STRING$, joka muodostaa merkkijonon toistamalla haluttua merkkiä.
Koodi käy jokaisessa tilanteessa läpi molemmat vaihtoehdot, liikutaanko ensin vaaka- vai pystysuunnassa. Dynaamisen ohjelmoinnin ansiosta suuntanäppäimistöä käsittelevien robottien näppäilysarjat saadaan käytyä läpi tehokkaasti.
Koodissani oli yhdessä vaiheessa outo bugi, joka johtui siitä, että olin toteuttanut silmukan rungon ja funktion kutsumisen näin:
FOR O% = 1 TO 2
P$ = PATH$(Y1%, X1%, Y2%, X2%, 2, O%)
...
NEXTEn muistanut, että funktio PATH$ voi muuttaa parametria O% ja QBasicissa parametrit välitetään oletuksena viittauksena. Tämän takia muuttunut muuttujan O% arvo sekoitti silmukan. Korjasin bugin näin:
FOR O% = 1 TO 2
P$ = PATH$(Y1%, X1%, Y2%, X2%, 2, (O%))
...
NEXTNyt funktion kutsussa muuttujan O% ympärillä on sulut, mikä tarkoittaa, että muuttujaa ei välitetä viittauksena vaan kopiona.
Tutkin vielä tarkemmin päivän tehtävää ja havaitsin, että ainakin omassa syötteessäni ensisijaisen liikesuunnan pystyy päättelemään koordinaateista. Funktion PATH$ voi toteuttaa ilman parametria O$ niin, että funktio määrittää itse parametrin arvon:
FUNCTION PATH$ (Y1%, X1%, Y2%, X2%, M%)
O% = 2
IF X1% > X2% THEN
IF Y1% > Y2% OR (M% = 2 AND Y1% < Y2%) THEN O% = 1
END IF
IF M% = 1 AND Y1% = 4 AND X2% = 1 THEN O% = 2
IF M% = 2 AND Y1% = 1 AND X2% = 1 THEN O% = 2
IF M% = 1 AND X1% = 1 AND Y2% = 4 THEN O% = 1
IF M% = 2 AND X1% = 1 AND Y2% = 1 THEN O% = 1
...
END FUNCTIONTässä oletuksena ensisijainen liikesuunta on 2 (ensin pysty, sitten vaaka). Kuitenkin jos robotti liikkuu kummallakin näppäimistöllä vasemmalle ja ylöspäin tai suuntanäppäimistöllä vasemmalle ja alaspäin, ensisijainen liikesuunta on 1 (ensin vaaka, sitten pysty).
Tämän ansiosta koodia voi yksinkertaistaa niin, että siinä ei kokeilla joka vaiheessa kahta vaihtoehtoa ensisijaiselle liikesuunnalle vaan luotetaan siihen, että funktio PATH$ päättelee sen oikein. Minulla ei ole kuitenkaan todistusta sille, että tämä toimisi oikein kaikilla syötteillä.
Päivä 22
Päivän tehtävässä annettuna on satunnaislukuja tuottava prosessi, joka muodostuu bittisiirroista, xor-operaatioista ja moduloista. Ensimmäisessä osassa prosessia tulee suorittaa 2000 askelta jokaiselle syötteen luvulle.
Koska tehtävässä esiintyy suuria kokonaislukuja, koetin ensin tehdä ratkaisun, jossa lukuja käsitellään DOUBLE-lukuina. Operaattorit MOD ja XOR eivät toimi DOUBLE-luvuilla, minkä takia toteutin omat funktiot FMOD# ja FXOR#. Funktio FMOD# hyödyntää FIX-funktiota, ja funktio FXOR# jakaa luvut kahteen osaan ja käyttää XOR-operaattoria erikseen näille osille.
TOTAL# = 0
M# = 16777216
OPEN "DAY22.TXT" FOR INPUT AS #1
WHILE NOT EOF(1)
INPUT #1, X#
FOR I% = 1 TO 2000
X# = FMOD#(FXOR#(X#, X# * 64), M#)
X# = FMOD#(FXOR#(X#, FIX(X# / 32)), M#)
X# = FMOD#(FXOR#(X#, X# * 2048), M#)
NEXT
TOTAL# = TOTAL# + X#
WEND
CLOSE #1
PRINT TOTAL#
FUNCTION FMOD# (A#, M#)
R# = A# / M# - FIX(A# / M#)
FMOD# = R# * M#
END FUNCTION
FUNCTION FXOR# (A#, B#)
D# = 2 ^ 30
A1& = FIX(A# / D#)
A2& = FMOD(A#, D#)
B1& = FIX(B# / D#)
B2& = FMOD(B#, D#)
X1& = A1& XOR B1&
X2& = A2& XOR B2&
FXOR# = D# * X1& + X2&
END FUNCTIONTässä ratkaisussa ongelmaksi tuli kuitenkin, että se osoittautui harmillisen hitaaksi. Ainakin ensimmäisen osan vastauksen olisi saanut kyllä laskettua, mutta se olisi vienyt kauan aikaa.
Aloin miettiä, voisiko laskennan toteuttaa kuitenkin LONG-luvuilla, ja huomasin, että tämä on mahdollista ottamalla joka välissä modulo ja toteuttamalla 2048:llä kertominen kahdessa osassa (2048 = 64 * 32).
TOTAL# = 0
M& = 16777216
OPEN "DAY22.TXT" FOR INPUT AS #1
WHILE NOT EOF(1)
INPUT #1, X&
FOR I% = 1 TO 2000
X& = X& XOR (X& * 64 MOD M&) MOD M&
X& = X& XOR (X& \ 32) MOD M&
X& = X& XOR ((X& * 64 MOD M&) * 32 MOD M&) MOD M&
NEXT
TOTAL# = TOTAL# + X&
WEND
CLOSE #1
PRINT TOTAL#Tämä koodi on huomattavasti ensimmäistä versiota tehokkaampi, ja sain sen avulla laskettua nopeasti tehtävän ensimmäisen osan vastauksen.
Tehtävän toisessa osassa jokaisen satunnaisluvun viimeinen numero tulkitaan hinnaksi. Tehtävänä on etsiä neljän peräkkäisen hinnan muutoksen yhdistelmä niin, että kun jokaisesta lukujonosta valitaan ensimmäinen kyseisen yhdistelmän jälkeen tuleva hinta, näiden hintojen yhteissumma on mahdollisimman suuri.
Luonteva ratkaisu olisi käydä läpi kaikki lukujonot ja pitää yllä jokaisesta mahdollisesta yhdistelmästä tietoa, mikä on yhdistelmän tuottama yhteishinta. Kuitenkin vaikutti, että tällaista ratkaisua olisi hankalaa toteuttaa QBasicilla pienen muistin määrän takia. Koska hinnan muutos on vähintään -9 ja enintään 9, mahdollisia yhdistelmiä on 194 = 130321, mikä on liian paljon.
Päädyin vähemmän muistia käyttävään ratkaisuun, jossa kiinnitetään yksi kerrallaan yhdistelmän viimeinen muutos ja käydään läpi kaikki lukujonot olettaen, että yhdistelmä päättyy tähän muutokseen. Tämän ansiosta muistissa riittää pitää tietoa vain kolmen muutoksen yhdistelmistä, joiden määrä on 193 = 6859. Tämä on riittävän pieni määrä, jotta tarvittavat tiedot mahtuvat muistiin.
Toteutin toisen osan ratkaisun seuraavasti:
MAX% = 0
M& = 16777216
N% = 2008
DIM START&(N%)
DIM DIFF%(2000)
DIM SUM%(-9 TO 9, -9 TO 9, -9 TO 9)
DIM SEEN%(-9 TO 9, -9 TO 9, -9 TO 9)
OPEN "DAY22.TXT" FOR INPUT AS #1
FOR I% = 1 TO N%
INPUT #1, START&(I%)
NEXT
CLOSE #1
FOR F% = -9 TO 9
FOR D1% = -9 TO 9
FOR D2% = -9 TO 9
FOR D3% = -9 TO 9
SUM%(D1%, D2%, D3%) = 0
SEEN%(D1%, D2%, D3%) = 0
NEXT
NEXT
NEXT
FOR S% = 1 TO N%
X& = START&(S%)
FOR I% = 1 TO 2000
A& = X&
X& = X& XOR (X& * 64 MOD M&) MOD M&
X& = X& XOR (X& \ 32) MOD M&
X& = X& XOR ((X& * 64 MOD M&) * 32 MOD M&) MOD M&
DIFF%(I%) = X& MOD 10 - A& MOD 10
IF DIFF%(I%) = F% AND I% - 3 >= 1 THEN
D1% = DIFF%(I% - 3)
D2% = DIFF%(I% - 2)
D3% = DIFF%(I% - 1)
IF SEEN%(D1%, D2%, D3%) <> S% THEN
SEEN%(D1%, D2%, D3%) = S%
SUM%(D1%, D2%, D3%) = SUM%(D1%, D2%, D3%) + X& MOD 10
END IF
END IF
NEXT
NEXT
FOR D1% = -9 TO 9
FOR D2% = -9 TO 9
FOR D3% = -9 TO 9
IF SUM%(D1%, D2%, D3%) > MAX% THEN
MAX% = SUM%(D1%, D2%, D3%)
END IF
NEXT
NEXT
NEXT
NEXT
PRINT MAX%Taulukko SUM% pitää yllä jokaisen yhdistelmän yhteishintaa ja SEEN% ilmaisee, onko yhdistelmää tullut vastaan nykyisessä lukujonossa. Tässä on kätevää, että QBasicissa taulukossa voi valita sekä indeksin ala- että ylärajan. Tässä tapauksessa alaraja on -9 ja yläraja on 9.
Omassa syötetiedostossani suurimmat yhteishinnat ovat seuraavat ryhmiteltynä viimeisen muutoksen mukaan:
-9: 0 -8: 65 -7: 175 -6: 311 -5: 480 -4: 688 -3: 932 -2: 1211 -1: 1562 0: 1803 1: 1863 2: 1802 3: 1760 4: 1678 5: 1668 6: 1484 7: 1244 8: 939 9: 567
Koska pienet muutokset ovat yleisempiä kuin suuret muutokset satunnaisluvuissa, on odotettavaa, että suurin yhteishinta saadaan muutosten ollessa melko pieniä.
Kokeilin vielä tehostaa ensimmäisen osan ratkaisua käyttämällä MOD-operaattorin sijasta AND-operaattoria. Tämä on mahdollista, koska MOD M& ja AND (M& - 1) tarkoittavat samaa, kun M& on kakkosen potenssi. Tässä tehtävässä modulo on 16777216 eli 224.
TOTAL# = 0
M& = 16777216 - 1
OPEN "DAY22.TXT" FOR INPUT AS #1
WHILE NOT EOF(1)
INPUT #1, X&
FOR I% = 1 TO 2000
X& = X& XOR (X& * 64 AND M&) AND M&
X& = X& XOR (X& \ 32) AND M&
X& = X& XOR ((X& * 64 AND M&) * 32 AND M&) AND M&
NEXT
TOTAL# = TOTAL# + X&
WEND
CLOSE #1
PRINT TOTAL#Tietokoneen prosessorin kannalta AND on yksinkertaisempi operaatio kuin MOD. DOSBoxilla tämä tehostus suunnilleen puolitti koodin suoritusajan, mutta olisi kiinnostavaa mitata ero todellisella laitteistolla.
Päivä 23
Tehtävänä on etsiä verkosta klikkejä eli solmujen muodostamia ryhmiä, joissa jokainen solmupari on suoraan yhteydessä toisiinsa. Yleisessä tapauksessa klikkien etsiminen verkosta on vaikeaa, eikä suurimman klikin etsimiseen tunneta mitään tehokasta algoritmia.
Tehtävän ensimmäisessä osassa tulee laskea, monellako tavalla verkosta voidaan muodostaa kolmen solmun klikki. Lisäehtona klikissä tulee olla mukana solmu, jonka tunnuksen ensimmäinen merkki on "t". Toteutin ratkaisun käymällä läpi kaikki tavat valita alkusolmu, jonka ensimmäinen merkki on "t", ja etsimällä sen vieressä olevat solmut.
N% = 3380
DIM L1(N%) AS STRING * 2
DIM L2(N%) AS STRING * 2
OPEN "DAY23.TXT" FOR INPUT AS #1
FOR I% = 1 TO N%
LINE INPUT #1, LINE$
L1$(I%) = LEFT$(LINE$, 2)
L2$(I%) = RIGHT$(LINE$, 2)
NEXT
CLOSE #1
DIM GROUP$(N%)
TOTAL% = 0
FOR A% = ASC("a") TO ASC("z")
C1$ = "t" + CHR$(A%)
COUNT% = 0
FOR I% = 1 TO N%
C2$ = ""
IF L1$(I%) = C1$ THEN C2$ = L2$(I%)
IF L2$(I%) = C1$ THEN C2$ = L1$(I%)
IF C2$ <> "" THEN
COUNT% = COUNT% + 1
GROUP$(COUNT%) = C2$
END IF
NEXT
FOR I% = 1 TO N%
FAIL1% = 0: FAIL% = 0
IF LEFT$(L1$(I%), 1) = "t" AND L1$(I%) < C1$ THEN FAIL% = 1
IF LEFT$(L2$(I%), 1) = "t" AND L2$(I%) < C1$ THEN FAIL% = 1
IF FAIL% = 0 THEN
FOUND1% = 0: FOUND2% = 0
FOR J% = 1 TO COUNT%
IF GROUP$(J%) = L1$(I%) THEN FOUND1% = 1
IF GROUP$(J%) = L2$(I%) THEN FOUND2% = 1
NEXT
IF FOUND1% = 1 AND FOUND2% = 1 THEN
TOTAL% = TOTAL% + 1
END IF
END IF
NEXT
NEXT
PRINT TOTAL%Minulle annetussa verkossa on 520 solmua ja 3380 kaarta. Päädyin pitämään verkon muistissa samassa muodossa kuin syötteessä eli kaarien listana. Tämä on yksinkertainen ja vähän muistia vievä tapa, mutta on melko hidasta etsiä verkossa olevia kaaria. Yllä oleva koodi käy jokaisen alkusolmun kohdalla koko listan läpi löytääkseen sen vieressä olevat solmut.
Tehtävän toisessa osassa tulee selvittää verkon suurin klikki, mihin ei siis ole olemassa tehokasta algoritmia. Oletin kuitenkin, että verkon rakenne on sellainen, että suurimman klikin löytäminen ei ole liian vaikeaa. Ikävä kyllä nyt ei ole luvattu, että klikissä olisi solmua, jonka tunnus alkaa tietyllä merkillä.
Seuraava ratkaisu käy läpi kaikki tavat valita klikin alkusolmu. Tämän jälkeen se etsii kaikki alkusolmun vieressä olevat solmut ja käy läpi näiden solmujen osajoukot. Alkusolmu ja osajoukko muodostavat klikin, jos osajoukon kaikki solmuparit ovat suoraan yhteydessä toisiinsa.
N% = 3380
DIM L1(N%) AS STRING * 2
DIM L2(N%) AS STRING * 2
OPEN "DAY23.TXT" FOR INPUT AS #1
FOR I% = 1 TO N%
LINE INPUT #1, LINE$
L1$(I%) = LEFT$(LINE$, 2)
L2$(I%) = RIGHT$(LINE$, 2)
NEXT
CLOSE #1
G% = 50
DIM GROUP$(G%)
DIM ADJ%(G%, G%)
DIM RES$(G%)
BEST% = 0
FOR A% = ASC("a") TO ASC("z")
FOR B% = ASC("a") TO ASC("z")
C1$ = CHR$(A%) + CHR$(B%)
COUNT% = 0
FOR I% = 1 TO N%
C2$ = ""
IF L1$(I%) = C1$ THEN C2$ = L2$(I%)
IF L2$(I%) = C1$ THEN C2$ = L1$(I%)
IF C2$ <> "" THEN
COUNT% = COUNT% + 1
GROUP$(COUNT%) = C2$
END IF
NEXT
FOR I% = 1 TO COUNT%
FOR J% = 1 TO COUNT%
ADJ%(I%, J%) = 0
NEXT
NEXT
FOR I% = 1 TO N%
POS1% = 0: POS2% = 0
FOR J% = 1 TO COUNT%
IF L1$(I%) = GROUP$(J%) THEN POS1% = J%
IF L2$(I%) = GROUP$(J%) THEN POS2% = J%
NEXT
IF POS1% <> 0 AND POS2% <> 0 THEN
ADJ%(POS1%, POS2%) = 1
ADJ%(POS2%, POS1%) = 1
END IF
NEXT
FOR M% = 0 TO 2 ^ COUNT% - 1
FAIL% = 0
SIZE% = 1
FOR I% = 1 TO COUNT%
IF M% AND (2 ^ (I% - 1)) THEN
SIZE% = SIZE% + 1
FOR J% = I% + 1 TO COUNT%
IF M% AND (2 ^ (J% - 1)) THEN
IF ADJ%(I%, J%) = 0 THEN
FAIL% = 1
GOTO SKIP
END IF
END IF
NEXT
END IF
NEXT
SKIP: IF FAIL% = 0 AND SIZE% > BEST% THEN
BEST% = SIZE%
PRINT "BEST", BEST%
RC% = 1
RES$(RC%) = C1$
FOR I% = 1 TO COUNT%
IF M% AND (2 ^ (I% - 1)) THEN
RC% = RC% + 1
RES$(RC%) = GROUP$(I%)
END IF
NEXT
FOR R1% = 1 TO RC%
FOR R2% = 1 TO RC% - 1
IF RES$(R2%) > RES$(R2% + 1) THEN
SWAP RES$(R2%), RES$(R2% + 1)
END IF
NEXT
NEXT
FOR I% = 1 TO RC%
PRINT RES$(I%);
IF I% <> RC% THEN PRINT ",";
NEXT
PRINT
END IF
NEXT
NEXT
NEXTMinulla annetussa verkossa jokainen verkossa oleva solmu on yhteydessä 13 muuhun solmuun. Suurimmassa klikissä on 13 solmua, mikä tarkoittaa, että siihen kuuluu alkusolmun lisäksi kaikki siihen yhteydessä olevat solmut yhtä solmua lukuun ottamatta. Koska klikki on tämän kokoinen, sen pystyy löytämään kohtuullisessa ajassa yllä olevalla ratkaisulla.
Käytin koodissa ensimmäistä kertaa haasteen aikana vanhaa kunnon GOTO-komentoa. Se osoittautui hyödylliseksi, koska koodissa oli tarvetta hypätä pois kahden sisäkkäisen silmukan sisältä.