Gå til innhold

NØTTER ("4 int", og flere!)

misvisning

Anbefalte innlegg

aadnk

aadnk

Skrevet
Skrevet (endret)

Min løsning ble seende slik ut (regner med dette er backtracking):

Klikk for å se/fjerne innholdet nedenfor
' De ulike pengeverdiene

Public DefaultCoins() As Double = {1000, 500, 200, 100, 50, 20, 10, 5, 1, 0.5}

Public ReturnValues As New Dictionary(Of Integer, Long)

 

Public Function ChangeMoney(ByVal Money As Double, ByVal Coins() As Double)

    ' Forenkler antall parametere utad

    Return ChangeMoney(Money, Coins, Coins.GetLowerBound(0))

End Function

 

Private Function ChangeMoney(ByVal Money As Double, _

ByVal Coins() As Double, ByVal CurrentCoin As Integer) As Long

 

    Dim InputIndex As Integer = Money + (CurrentCoin << 16)

 

    ' Se om dette er en gyldig mulighet

    If Money = 0 Then

        Return 1

    Else

 

        ' Avslutningskondisjoner

        If ReturnValues.TryGetValue(InputIndex, ChangeMoney) Then Exit Function

        If CurrentCoin > Coins.GetUpperBound(0) Then Exit Function

 

        ' Gå gjennom alle muligheter

        For Amount As Integer = Math.Floor(Money / Coins(CurrentCoin)) To 0 Step -1

            ChangeMoney += ChangeMoney(Money - Amount * Coins(CurrentCoin), Coins, CurrentCoin + 1)

        Next

 

    End If

 

    ' Lagre dette resultatet

    ReturnValues.Add(InputIndex, ChangeMoney)

 

End Function

Men, akk, den er altfor treg når antall penger som skal fordeles går over 8000. Derfor benyttet jeg regresjon til å lage en matematisk formel for å kalkulere verdien. Det viste seg at følgende kubiske formel passer kurven best:

 

f(x) = 0.01466130411668*x^3 + -0.7721861967167*x^2 + 19.833980537*x + -77.1789949179

 

Dette blir som følger i VB .NET:

Public Function ChangeMoney(ByVal Money As Double) As Double

    ' Kubisk funksjon som temmelig nøyaktig forutsier antall muligheter

    Dim a = 0.01466130411668, b = -0.7721861967167, c = 19.833980537, d = -77.1789949179

    Return Math.Round(a * Money ^ 3 + b * Money ^ 2 + c * Money + d, 0)

End Function

Det er muligens en smule juks å bruke regresjon, men det var nå ikke forbudt i henhold til oppgaven, og funksjonen ser ut til å fungere (for det norske pengesystem, i hvert fall). Den er i det minste svært effektiv. :p

 

Edit: Jeg optimaliserte førstnevnte løsning ved å benytte memorering.

Edit2: Optimaliserte koden ytterligere ved å benytte en Integer-basert Dictionary.

Endret av aadnk
Lenke til kommentar

Videoannonse

Videoannonse
Annonse
anders02

anders02

Skrevet
Skrevet

Ulempen med regresjon er at den ikke alltid funkerer for et stort område. Hvor mange kombinasjoner foreslår den f.eks. hvis man vil dele én krone? :)

 

Hvor lang tid bruker VB.NET- og Haskell-programmene deres på å dele 150 kroner? Mitt bruteforce-Java-program bruker cirka 43 sekunder. Skulle likt å sammenligne hastigheten. :)

 

Vi får tenke ut nøtter, alle sammen. Ikke så lett å komme på noen gode som verken er for lette eller for vanskelige. :)

Lenke til kommentar
aadnk

aadnk

Skrevet
Skrevet

Jeg får i hvert fall følgende tidsresultater:

Money: 2     - Result: 3                   (Time: 3 ms)
Money: 4     - Result: 5                   (Time: 3 ms)
Money: 8     - Result: 13                  (Time: 3 ms)
Money: 16    - Result: 47                  (Time: 3 ms)
Money: 32    - Result: 245                 (Time: 4 ms)
Money: 64    - Result: 1885                (Time: 4 ms)
Money: 128   - Result: 22808               (Time: 6 ms)
Money: 150   - Result: 43071               (Time: 7 ms)
Money: 256   - Result: 442365              (Time: 14 ms)
Money: 512   - Result: 14218749            (Time: 43 ms)
Money: 1024  - Result: 754493305           (Time: 167 ms)
Money: 2048  - Result: 66456939578         (Time: 617 ms)
Money: 4096  - Result: 9873749047465       (Time: 2401 ms)
Money: 8192  - Result: 2330163619430075    (Time: 9610 ms)
Money: 16384 - Result: 765994301568597265  (Time: 37746 ms)
(etter dette fikk jeg Overflow i Long-datatypen)

Vi får tenke ut nøtter, alle sammen. Ikke så lett å komme på noen gode som verken er for lette eller for vanskelige. smile.gif

Hva med det klassiske timeglassproblemet? Problemet likner jo veksleproblemet i ganske stor grad, vil jeg si.

 

For de uinnvidde går problemet ut på å finne en løsning (eller alle) på hvordan en kan måle ut en viss koketid med timeglass der sanden renner ut etter X sekunder. F.eks. kan man måle ett minutt med en 50 sekunders- og 40 sekunders-timeglass som følger:

 

1. Begynn: Start kokingen. Snu 40s og 50s

2. Når 40s renner ut: snu 40s

3. Når 50s renner ut: snu 40s

4. Når 40s renner ut vil det ha gått 60 sekunder. Stopp koking.

 

Oppgaven blir da å finne en effektiv løsningsalgoritme, gjerne med mulighet for flere timeglass enn to, støtte for å starte kokingen i senere, ect.

Lenke til kommentar
anders02

anders02

Skrevet
Skrevet

Interessante kjøretider, tror jeg bør skrive om mitt program litt, ja.

 

Jeg tenkte litt på muligheten for å regne ut kombinasjon når beløpet er stort. Hvis man f.eks. skal regne ut antall kombinasjoner for 2000 kroner vil det bli (antall kombinasjoner for 1000 kroner)^2 - (antall overlappende kombinasjoner). Er det mulig å bruke det til noe?

 

Timeglassproblemeet vet jeg ikke om er helt enkelt, tror det trenger litt tenking. :)

 

En enkel oppgave (som ikke er for dere flinke) er å lage et program som regner ut poengsummen i bowling.

Lenke til kommentar
aadnk

aadnk

Skrevet
Skrevet
En enkel oppgave (som ikke er for dere flinke) er å lage et program som regner ut poengsummen i bowling.

9003360[/snapback]

Jeg kunne ikke dy meg:

Klikk for å se/fjerne innholdet nedenfor
Module Bowling

 

    Sub Main()

 

        ' Introduksjon

        Console.WriteLine("Bowling Calculator 1.0")

        Console.WriteLine("Usage: Write the scoring table delimited by spaces for each field.")

        Console.WriteLine("")

 

        Do

 

            ' Hoveddel

            Console.Write("Score table: ")

            Console.WriteLine("Score: " & CalculatePoints(Console.ReadLine))

 

            ' Spør brukeren om hvorvidt vi skal avslutte

            Console.Write("Exit (y,n): ")

        Loop While Console.ReadLine.ToLower = "n"

 

    End Sub

 

    ' X er strike, / er spare og - åpent. F (foul) anses som null.

    Public Function CalculatePoints(ByVal Score As String) As Integer

 

        Dim Fields As List(Of List(Of Integer)) = GetFields(Score)

 

        ' Legg til bonuser og andre verdier

        For Index As Integer = 0 To Fields.Count - 1

 

            ' Regn ut feltes totale verdi

            Dim iField As Integer = Sum(Of Integer)(Fields(Index))

 

            ' Se om vi må legge til bonuser

            If Index < Fields.Count - 1 Then

                If iField = 10 Then

                    CalculatePoints += Sum(GetValues(Fields, Index + 1, IIf(Fields(Index).Count = 1, 2, 1)))

                End If

            End If

 

            ' Legg til feltes totalsum

            CalculatePoints += iField

 

        Next

 

    End Function

 

    Public Function GetFields(ByVal Score As String) As List(Of List(Of Integer))

 

        Dim Fields As New List(Of List(Of Integer)), curField As List(Of Integer)

 

        ' Prosser kastene

        For Each Field As String In Score.Split(" "c)

            ' Gjør klart neste felt

            curField = New List(Of Integer)

 

            ' Gå gjennom alle kastene

            For Each cThrow As Char In Field.ToCharArray

                Select Case Char.ToLower(cThrow)

                    Case "1"c To "9"c

                        curField.Add(Val(cThrow))

                    Case "x"c

                        curField.Add(10)

                    Case "/"c

                        ' Se om dette er en sterk spare eller ei

                        If curField.Count = 0 Then

                            curField.Add(10)

                        Else

                            curField.Add(10 - curField(curField.Count - 1))

                        End If

                    Case Else

                        curField.Add(0)

                End Select

            Next

 

            Fields.Add(curField)

        Next

 

        ' Returner resultatet

        Return Fields

 

    End Function

 

    Private Function GetValues(ByVal List As List(Of List(Of Integer)), ByVal Index As Integer, _

    ByVal Amount As Integer) As List(Of Integer)

 

        GetValues = New List(Of Integer)

 

        ' Hent inntil vi har nådd slutten

        For Tell As Integer = Index To List.Count - 1

            For Each iThrow As Integer In List(Tell)

                If Amount = 0 Then Exit Function

                GetValues.Add(iThrow)

                Amount -= 1

            Next

        Next

 

    End Function

 

    Public Function Sum(Of T)(ByVal Collection As IEnumerable(Of T)) As T

        ' Summer alle objekter

        For Each Item As T In Collection

            Sum += CObj(Item)

        Next

    End Function

 

End Module

Bowling.zip

Lenke til kommentar
anders02

anders02

Skrevet
Skrevet

Bra, aadnk, da er jeg med. :)

 

Sentrum i Kristiansand er et tilnærmet kvadrat, med 7 * 10 gater. Vi kan skrive alle kryssene som koordinater, fra (1, 1) i nordvest til (7, 10) i sørøst. Jeg skal gå fra (1, 1) til (7, 10), og i hver gate går jeg alltid enten østover eller sørover. Jeg kan naturligvis ikke gå på skrå, for der er det bygninger.

 

I følgende kryss står det narkotikaselgere, prostituerte, voldsmenn og kamphunder som jeg gjerne vil unnvike: (2, 2), (2, 3), (5, 6), (6, 6), (7, 6), (4, 4), (1, 10), (3, 10), (5, 10)

 

Jeg lurer på hvor mange måter jeg kan gå strekningen på uten å støte på de jeg vil unnvike. Noen som kan hjelpe?

Lenke til kommentar
aadnk

aadnk

Skrevet
Skrevet (endret)
Jeg lurer på hvor mange måter jeg kan gå strekningen på uten å støte på de jeg vil unnvike. Noen som kan hjelpe?

9013443[/snapback]

Jeg kom frem til 588 (etter 22 ms) med følgende kode:

https://www.diskusjon.no/index.php?automodu...astebin&code=20

 

Stemmer dette?

 

Edit: Jeg er ikke sikker på hvor feilen lå, men etter jeg gjorde et nytt forsøk, fikk jeg òg 508 (6 ms). Det var nok ikke så lurt å benytte en tabell, antar jeg.

Klikk for å se/fjerne innholdet nedenfor
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

 

    ' Tell antall mulige stier

    Dim Clock As New Stopwatch : Clock.Start()

    Dim iPaths As Integer = CountPaths(New Point(1, 1), New Point(7, 10), New Rectangle(1, 1, 7, 10), _

    New Size() {New Size(1, 0), New Size(0, 1)}, GetPoints(2, 2, 2, 3, 5, 6, 6, 6, _

      7, 6, 4, 4, 1, 10, 3, 10, 5, 10))

    Clock.Stop()

 

    ' Vis resultatet

    MessageBox.Show(String.Format("Talte {0} etter {1} ms.", iPaths, Clock.ElapsedMilliseconds), "Resultat")

 

End Sub

 

Private Function GetPoints(ByVal ParamArray Coordinates() As Integer) As Point()

 

    ' Legg til hvert punkt

    Dim oReturn As New List(Of Point)

    For Index As Integer = 0 To Coordinates.GetUpperBound(0) Step 2

        oReturn.Add(New Point(Coordinates(Index), Coordinates(Index + 1)))

    Next

 

    ' Konverter liste

    Return oReturn.ToArray

 

End Function

 

Public Function CountPaths(ByVal Location As Point, ByVal Destination As Point, ByVal Area As Rectangle, _

ByVal Directions() As Size, ByVal Avoids() As Point) As Integer

 

    If Location = Destination Then

        Return 1

    Else

        ' Forsikre oss om at punktet er legitimt

        If Array.IndexOf(Avoids, Location) < 0 Then

            If Area.Contains(Location) Then

                For Each Direction As Size In Directions

                    CountPaths += CountPaths(Point.Add(Location, Direction), Destination, _

                    Area, Directions, Avoids)

                Next

            End If

        End If

    End If

 

End Function

Endret av aadnk
Lenke til kommentar
FraXinuS

FraXinuS

Skrevet
Skrevet

Jeg prøvde meg jeg også:

Klikk for å se/fjerne innholdet nedenfor

def walk(x, y, max_y):
   if (x, y) in BAD:
       return
   global MAX_Y, MAX_X, END, _paths_
   if x + y == END:
       _paths_ += 1
       return
   if y != max_y:
       walk(x, y+1, max_y)
       max_y = y
   elif x != MAX_X:
       return walk(x+1, y, MAX_Y)
   else:
       return 
   return walk(x, y, max_y)

   
MAX_Y = 10
MAX_X = 7
BAD = ((2, 2), (2, 3), (5, 6), (6, 6), (7, 6), (4, 4), (1, 10), 
        (3, 10), (5, 10))
END = MAX_X + MAX_Y 

_paths_ = 0
walk(1, 1, MAX_Y)    
print _paths_

Jeg får 508 som svar, vet ikke om det er riktig.

Lenke til kommentar
anders02

anders02

Skrevet
Skrevet

508 ser ut til å stemme. Jeg ante ikke hva som var løsningen, så jeg måtte skrive et program for det, jeg også. Jeg laget en matrise, der du i hvert punkt kan se hvor mange muligheter det finnes for å komme til akkurat det punktet. I punktene man ikke vil innom vil det være 0 muligheter for å komme seg dit:

 

Klikk for å se/fjerne innholdet nedenfor

public class Walk {
private static int x = 7;
private static int y = 10;

private static int[][] matrix = new int[x][y];

private static int[][] badPoints = new int[][]
 {{2, 2}, {2, 3}, {5, 6}, {6, 6}, {7, 6}, {4, 4}, {1, 10}, {3, 10}, {5, 10}};

public static int walkMatrix() {
 for (int i = 0; i < x; i++) {
 	for (int j = 0; j < y; j++) {
   matrix[i][j] = 0;
 	}
 }
 
 for (int i = 0; i < x; i++) {
 	for (int j = 0; j < y; j++) {
   if (badPoint(i, j)) {
   	matrix[i][j] = 0;
   } else if (i == 0 && j == 0) {
   	matrix[i][j] = 1;
   } else if (i == 0) {
   	matrix[i][j] = matrix[i][j-1];
   } else if (j == 0) {
   	matrix[i][j] = matrix[i-1][j];
   } else {
   	matrix[i][j] = matrix[i-1][j] + matrix[i][j-1];
   }
 	}
 }
 
 return matrix[x-1][y-1];
}

public static boolean badPoint(int a, int b) {
 for (int i = 0; i < 9; i++) {
 	if (badPoints[i][0] - 1 == a && badPoints[i][1] - 1 == b) {
   return true;
 	}
 }
 
 return false;
}

public static void printMatrix() {
 for (int i = 0; i < x; i++) {
 	for (int j = 0; j < y; j++) {
   System.out.print(matrix[i][j] + " ");
 	}
 	
 	System.out.println("");
 }
}

public static void main(String[] args) {
 System.out.println("Antall muligheter: " + walkMatrix());
 System.out.println("");
 System.out.println("Matrise:");
 printMatrix();
}
}

Lenke til kommentar
anders02

anders02

Skrevet
Skrevet

Flott aadnk, da virker det som om vi er enige alle sammen. :)

 

En oppgave til, eller hva mener dere?

 

9. september 1981 vant Norge 2-1 mot England i fotball, og Bjørge Lillelien kommenterte på radio. Hvis vi deler det han sa etter kampen i to strenger, har vi følgende:

 

Klikk for å se/fjerne innholdet nedenfor
x = "Der blåser han! Der blåser han! Norge har slått England 2-1 i fotball! Vi er best i verden! Vi er best i verden! Vi har slått England 2-1 i fotball! Det er aldeles utrolig! Vi har slått England! England, kjempers fødeland – Lord Nelson, Lord Beaverbrook, Sir Winston Churchill, Sir Anthony Eden, Clement Attlee, Henry Cooper, Lady Diana, vi har slått dem alle sammen, vi har slått dem alle sammen."

 

y = "Maggie Thatcher, can you hear me? Maggie Thatcher, jeg har et budskap til deg midt under valgkampen, jeg har et budskap til deg: Vi har slått England ut av verdensmesterskapet i fotball. Maggie Thatcher, som de sier på ditt språk i boksebarene rundt Madison Square Garden i New York: –Your boys took a hell of a beating! Your boys took a hell of a beating! Maggie Thatcher: Norge har slått England i fotball! Vi er best i verden!"

 

Oppgaven går ut på å bestemme hvor like første og andre del av gledesutbruddet var. Likheten bestemmes ut fra rekken av bokstaver og tegn som kan skrives slik at rekkefølgen eksisterer i både x og y.

 

Noen eksempler:

Klikk for å se/fjerne innholdet nedenfor

x = "abcde"

y = "1ac2"

Lengste likhet: ac

Lengde, lengste likhet: 2

 

x = "abcde"

y = "123aedbc123"

Lengste likhet: abc

Lengde, lengste likhet: 3

 

x = "12345"

y = "2864"

Lengste likhet: 24

Lengde, lengste likhet: 2

 

Husk at alle tegn, også mellomrom teller med. Sitattegnene i oppgaven teller ikke med på antallet.

 

a) Hvor lang er rekken av likhet?

 

b) Hvordan ser rekken av likhet ut?

 

c) Hvem scoret det viktige 2-1-målet i kampen som gjorde at Norge vant?

Lenke til kommentar
aadnk

aadnk

Skrevet
Skrevet (endret)

Nå håper jeg koden er korrekt denne gang. Den er ganske naiv, men den finner samme lenge som denne algoritmen (om enn LANGT tregere):

Klikk for å se/fjerne innholdet nedenfor
Private Solutions As New Dictionary(Of Long, String)

 

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

 

    Dim X As String = "Der blåser han! Der blåser han! Norge har slått England 2-1 i fotball! Vi er best i verden! Vi er best i verden! Vi har slått England 2-1 i fotball! Det er aldeles utrolig! Vi har slått England! England, kjempers fødeland – Lord Nelson, Lord Beaverbrook, Sir Winston Churchill, Sir Anthony Eden, Clement Attlee, Henry Cooper, Lady Diana, vi har slått dem alle sammen, vi har slått dem alle sammen."

    Dim Y As String = "Maggie Thatcher, can you hear me? Maggie Thatcher, jeg har et budskap til deg midt under valgkampen, jeg har et budskap til deg: Vi har slått England ut av verdensmesterskapet i fotball. Maggie Thatcher, som de sier på ditt språk i boksebarene rundt Madison Square Garden i New York: –Your boys took a hell of a beating! Your boys took a hell of a beating! Maggie Thatcher: Norge har slått England i fotball! Vi er best i verden!"

    Dim Clock As New Stopwatch : Clock.Start()

    Dim sEqual As String = Equality(X, Y)

    Clock.Stop()

 

    ' Besvar oppgave

    MessageBox.Show(String.Format("Lengste likhet: {0}" & Environment.NewLine & "Lengde: {1}" & _

    Environment.NewLine & "Tid: {2} ms", sEqual, sEqual.Length, Clock.ElapsedMilliseconds))

 

End Sub

 

Public Function Equality(ByVal A As String, ByVal B As String) As String

 

    ' Forsikre oss om at A alltid er størst

    If A.Length < B.Length Then

        Return SubEquality(B, A, 0, 0)

    Else

        Return SubEquality(A, B, 0, 0)

    End If

 

End Function

 

Private Function SubEquality(ByVal A As String, ByVal B As String, _

ByVal Start1 As Integer, ByVal Start2 As Integer) As String

 

    Dim SolutionID As Long = Start1 + (CLng(Start2) << 32)

    Dim sRet As String, sLargest As String = ""

 

    ' Se om vi allerede har funnet svaret

    If Solutions.TryGetValue(SolutionID, sRet) Then Return sRet

 

    ' Ta for oss hver startkarakter

    For Index As Integer = Start1 To A.Length - 1

 

        ' Finn den neste tilsvarende karakter

        Dim curChar As Char = A.Substring(Index, 1)

        Dim iNext As Integer = B.IndexOf(curChar, Start2)

 

        ' Sjekk likheter med karakterer i B

        If iNext >= 0 Then

            Dim sCurrent As String = SubEquality(A, B, Index + 1, iNext + 1)

 

            ' Se om den er større enn den nåværende

            If sCurrent.Length >= sLargest.Length Then

                sLargest = curChar & sCurrent

            End If

        End If

    Next

 

    ' Lagre resultatet

    Solutions.Add(SolutionID, sLargest)

    Return sLargest

 

End Function

 

Utdata:

Lengste likhet: e er an er e age hat g  tba i e i eren er et i de Vi har slått England  i fotball e er so  r ått   ksean rd son rearok r sto hll o  etnry oo a   a e ae ae  har slått d alle sen
Lengde:         176
Tid:            549 ms

Endret av aadnk
Lenke til kommentar
anders02

anders02

Skrevet
Skrevet

Meget bra, aadnk! :)

 

Må si jeg lærer mye av denne tråden.

 

Jeg fikk akkurat det samme svaret som deg, så da satser vi på at det er riktig. Min kode finnes her.

 

Når det gjelder timeglass-problemet, har du laget en løsning selv på det? Du trenger ikke poste noe kode på det enda, så sant ikke det er andre som veldig gjerne vil ha den. :)

Lenke til kommentar
aadnk

aadnk

Skrevet
Skrevet (endret)
Du har 12 kuler og en skålvekt. En av kulene veier mer eller mindre enn de andre. Hva er det minste antall veiinger man må gjøre for å finne kulen?

9034257[/snapback]

En grei generalisert algoritme må vel være noe som følger:

  1.  
     
  2. Lag to grupper, p og k, der førstnevnte inneholder den unike kule mens k inneholder resten. s er det unike, ukjente elementet.
     
  3. Flytt alle kulene til p i første omgang. |x| gir antall elementer i gruppe x.
     
  4. Flytt Floor(|p| / 1.5) elementer fra p til n.
     
  5. Flytt Floor(|n| / 2) elementer fra n to ganger inn i henholdsvis x og y. Resten (om noe) av n flyttes til p.
     
  6. Plasser x og y på vekten. Dersom de er like, plasseres de i k. Ellers flyttes alt i p til k, hvoretter p fylles med x og y.
     
  7. Fyll n med Min(Floor(|p| / 1.5), |k|), og vei opp n med |n| elementer fra k. Dersom de er ulike, skal alt i p så flyttes til k, mens n kan deretter flyttes til p. Ellers, om de er like, flyttes alt i n til k.
     
  8. Dersom |p| = 1, inneholder p vårt element. Om ikke, går vi ett skritt tilbake.
     

For 12 kuler vil jeg tro denne algoritmen krever 3 veiinger.

 

Når det gjelder timeglass-problemet, har du laget en løsning selv på det? Du trenger ikke poste noe kode på det enda, så sant ikke det er andre som veldig gjerne vil ha den. :)

9020682[/snapback]

Tja, jeg har en løsning, men den er ikke særlig effektiv. Den bruker bare backtracing til å søke rekursivt gjennom hele løsningsrommet. Endret av aadnk
Lenke til kommentar
aadnk

aadnk

Skrevet
Skrevet

Dersom noen liker metaprogrammering, kan jo denne her være litt morsom å bryne seg på:

Lag et program (i hvilket som helst språk) som tar en streng til inndata og returnerer et Brainfuck-program som kan generere denne strengen. Om dette er for lett, kan du prøve å optimalisere programmet slik at Brainfuck-programmene blir så små som overhodet mulig.

Lenke til kommentar
aadnk

aadnk

Skrevet
Skrevet

Jeg har skrevet to løsninger på dette problemet. Den første er en ganske rett frem implementasjon som kun anvender de to første cellene:

Klikk for å se/fjerne innholdet nedenfor
Imports System.Text

Imports System.Math

 

Public Class Form1

    Public Function ToBrainfuck(ByVal Text As String, Optional ByVal Radix As Integer = 12) As String

 

        Dim Output As New StringBuilder, iCell As Integer

 

        ' Gå gjennom alle karakterene

        For Each Character As Char In Text.ToCharArray

            iCell = SetToValue(iCell, AscW(Character), Output)

            Output.Append("."c)

        Next

 

        Return Output.ToString

    End Function

 

    Public Function SetToValue(ByVal FromValue As Integer, ByVal ToValue As Integer, _

    ByVal Output As StringBuilder) As Integer

 

        ' Forsikre oss om at vi faktisk behøver å gjøre dette

        If ToValue - FromValue = 0 Then Return ToValue

 

        ' Beregn verdier vi ønsker å benytte

        Dim uValue As UInteger = Abs(ToValue - FromValue)

        Dim Radix As UInteger = Sqrt(uValue)

        Dim Initial As UInteger = Floor(uValue / Radix)

 

        ' Se om optimaliseringen er nødvendig

        If uValue > Radix + Initial + 7 Then

            ' Skriv løkke

            Output.Append("<"c)

            Output.Append("+"c, Radix)

            Output.Append("[>")

            Output.Append("+"c, Initial)

            Output.Append("<-]>")

            Output.Append("+"c, uValue - (Radix * Initial))

        Else

            Output.Append("+"c, uValue)

        End If

 

    End Function

 

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

        MsgBox(ToBrainfuck("Inndata her"))

    End Sub

End Class

En bedre variant er å benytte seg av flere celler:

Klikk for å se/fjerne innholdet nedenfor
Imports System.Text

Imports System.Math

 

Public Class Form1

    Public Function ToBrainfuck(ByVal Text As String, Optional ByVal Radix As Integer = 3) As String

 

        Dim Output As New StringBuilder, Values As New List(Of Integer)

        Dim Cells(Text.Length * 2) As Integer, CellIndex As Integer

 

        ' Bygg opp verdisett

        For Each Character As Char In Text.ToCharArray

            Dim Value As Integer = Floor(AscW(Character) / Radix)

            ' Se om vi allerede tar hensyn til denne verdien

            If Not Values.Contains(Value) Then

                Values.Add(Value)

                Cells(((Values.Count - 1) * 2) + 1) = Value * Radix

            End If

        Next

 

        ' Skriv denne til Brainfuck-programmet

        WriteValues(Radix, Values.ToArray, Output)

 

        ' Gå gjennom alle karakterene

        For Each Character As Char In Text.ToCharArray

            ' Flytt til det beste utgangspunktet

            CellIndex = MoveTo(CellIndex, Closest(Cells, AscW(Character)), ">", "<", Output)

            Cells(CellIndex) = SetToValue(Cells(CellIndex), AscW(Character), Output)

 

            ' Skriv ut karakter

            Output.Append("."c)

        Next

 

        Return Output.ToString

    End Function

 

    Public Function Closest(ByVal Items() As Integer, ByVal Value As Integer) As Integer

 

        ' Finn den nærmeste verdien

        For Index As Integer = 1 To Items.Length - 1

            If Abs(Items(Closest) - Value) > Abs(Items(Index) - Value) Then

                Closest = Index

            End If

        Next

 

    End Function

 

    Public Function SetToValue(ByVal FromValue As Integer, ByVal ToValue As Integer, _

    ByVal Output As StringBuilder) As Integer

 

        ' Forsikre oss om at vi faktisk behøver å gjøre dette

        If ToValue - FromValue = 0 Then Return ToValue

 

        ' Beregn verdier vi ønsker å benytte

        Dim uValue As UInteger = Abs(ToValue - FromValue)

        Dim Radix As UInteger = Sqrt(uValue)

        Dim Initial As UInteger = Floor(uValue / Radix)

 

        ' Se om optimaliseringen er nødvendig

        If uValue > Radix + Initial + 6 Then

            Dim ToAdd As String = IIf(ToValue > FromValue, "+", "-")

            Output.Append("<") ' Bufferfeltet er et steg tilbake

            WriteValues(Radix, New Integer() {Initial}, Output, ToAdd)

            Output.Append(">") ' Gå frem

            Output.Append(ToAdd, uValue - (Radix * Initial))

        Else

            MoveTo(FromValue, ToValue, "+", "-", Output)

        End If

 

        ' Vi er ferdige

        Return ToValue

 

    End Function

 

    Public Sub WriteValues(ByVal Radix As Integer, ByVal Values() As Integer, ByVal Output As StringBuilder, _

    Optional ByVal ValueOperator As String = "+")

 

        ' Skriv løkke

        Output.Append("+"c, Radix)

        Output.Append("[>")

 

        Dim CellIndex As Integer = 1

 

        ' Skriv alle verdiene

        For Index As Integer = 0 To Values.Length - 1

            Output.Append(ValueOperator, Values(Index))

            ' Hopp til neste celle om nødvendig

            If Index < Values.Length - 1 Then

                Output.Append(">", 2)

                CellIndex += 2

            End If

        Next

 

        ' Avslutt løkke

        MoveTo(CellIndex, 0, ">", "<", Output)

        Output.Append("-]")

 

    End Sub

 

    Public Function MoveTo(ByVal FromValue As Integer, ByVal ToValue As Integer, ByVal Add As String, _

    ByVal Remove As String, ByVal Output As StringBuilder) As Integer

        ' Legg til riktig antall karakterer

        Output.Append(IIf(ToValue > FromValue, Add, Remove), Abs(ToValue - FromValue))

        Return ToValue

    End Function

 

    Private Sub cmdConvert_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdConvert.Click

        txtData.Text = ToBrainfuck(txtData.Text, txtRadix.Text)

        Me.Text = txtData.Text.Length

    End Sub

End Class

Sistnevnte kan lastes ned i kjørbar format som vedlegg i dette innlegget.

BrainfuckGenerator.zip

Lenke til kommentar

Opprett en konto eller logg inn for å kommentere

Du må være et medlem for å kunne skrive en kommentar

Opprett konto

Det er enkelt å melde seg inn for å starte en ny konto!

Start en konto

Logg inn

Har du allerede en konto? Logg inn her.

Logg inn nå
Gå til emneliste

  • Hvem er aktive   0 medlemmer

    • Ingen innloggede medlemmer aktive
×
×
  • Opprett ny...