Kirjautuminen

Haku

Tehtävät

Keskustelu: Koodit: QB: Advent of Code 2024 (QBasic)

Sivun loppuun

Antti Laaksonen [01.12.2024 13:32:43]

#

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ä.

Antti Laaksonen [02.12.2024 14:51:59]

#

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.

Antti Laaksonen [03.12.2024 11:11:00]

#

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 FUNCTION

Etsin 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 FUNCTION

Muuttuja 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.

Antti Laaksonen [04.12.2024 10:15:11]

#

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.

Antti Laaksonen [05.12.2024 10:21:04]

#

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.

Antti Laaksonen [05.12.2024 10:44:49]

#

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 SUB

Aliohjelmaa 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
' cembalo

QBasicissa 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.

Antti Laaksonen [06.12.2024 12:12:25]

#

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ä.

Antti Laaksonen [07.12.2024 11:19:26]

#

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 SUB

Tä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 SUB

Tä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.

Antti Laaksonen [07.12.2024 18:00:49]

#

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#).

Antti Laaksonen [08.12.2024 09:21:22]

#

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 FUNCTION

Nyt 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.

Antti Laaksonen [09.12.2024 09:13:00]

#

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.

Antti Laaksonen [10.12.2024 09:45:48]

#

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 SUB

Koodi 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 SUB

Tä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.

TapaniS [10.12.2024 10:29:37]

#

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 ..

Antti Laaksonen [10.12.2024 12:59:24]

#

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.

Antti Laaksonen [11.12.2024 10:18:43]

#

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 FUNCTION

Hallitseva 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.

Metabolix [11.12.2024 22:18:16]

#

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ä).

Antti Laaksonen [12.12.2024 10:12:55]

#

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.

Antti Laaksonen [12.12.2024 10:25:34]

#

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.

Metabolix [12.12.2024 19:11:42]

#

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)

Antti Laaksonen [13.12.2024 15:37:11]

#

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.

Antti Laaksonen [13.12.2024 15:43:44]

#

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.

Antti Laaksonen [14.12.2024 09:51:28]

#

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
NEXT

Komento 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.

Metabolix [14.12.2024 11:36:13]

#

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.

Antti Laaksonen [15.12.2024 09:11:35]

#

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.

Antti Laaksonen [16.12.2024 12:09:58]

#

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?

jlaire [16.12.2024 12:25:41]

#

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.................#
######################

Antti Laaksonen [16.12.2024 14:38:56]

#

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.

Antti Laaksonen [17.12.2024 10:22:11]

#

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.

Grez [17.12.2024 12:39:36]

#

Antti Laaksonen kirjoitti:

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.

Sinänsä ihan näppärä ratkaisu tilanteeseen, jossa 31/32 bittiä ei riitä mutta 52 bittiä riittää.

Antti Laaksonen [17.12.2024 14:07:58]

#

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.

jlaire [17.12.2024 20:40:09]

#

Jos 52 bittiäkään ei riitä, ehkä vanha kikka auttaa: https://www.ohjelmointiputka.net/keskustelu/27760-c-cpp-millaisia-kikkoja-tiedätte#v221512

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#
NEXT

Testasin DOSBoxissa qb45:llä ja viimeinen luku 218922995834555169026 on oikein. Taitaa olla melkein 20 vuotta siitä kun viimeksi koodasin QBasicillä.

Antti Laaksonen [17.12.2024 20:47:08]

#

Olen miettinyt, että tuotakin kikkaa voi käyttää tarvittaessa. Saa nähdä tuleeko tarvetta, vielä viikon verran tehtäviä tulossa.

Antti Laaksonen [18.12.2024 10:07:11]

#

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
NEXT

Raa'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.


Sivun alkuun

Vastaus

Muista lukea kirjoitusohjeet.
Tietoa sivustosta