Challenge: A Self-Replicating App

William Lancee

Well-Known Member
Licensed User
Longtime User
@Sandman, I did not mean to make light of the situation, simply to entertain and inspire while we are stuck.

Although I am online most of the time, I did not respond earlier because over here, the day is just starting, and I was asleep.

@LucaMs, at least I got a reaction, so hard to get with all this social distancing. My version has only 2 Subs. I'll post it later today.
 

sorex

Expert
Licensed User
Longtime User
I didn't look at UDG's file yet so what is it supposed to do?
 

William Lancee

Well-Known Member
Licensed User
Longtime User
@sorex

Exactly what @Sandman says: It displays an exact copy of its own source code. If you then cut and paste it to another project, and run it, it will display another copy, etc.
 

William Lancee

Well-Known Member
Licensed User
Longtime User
@LucaMs

Like viruses, it does not do something useful (and much harm). It is simply ontologically evolved (or teleologically designed) to replicate itself.
 

sorex

Expert
Licensed User
Longtime User
so the text area should show the entire source so that you can copy it in an empty project that it will run and show the same thing again?
 

sorex

Expert
Licensed User
Longtime User
ok.

if it is

run project
copy source from text area to clipboard
paste source in new project
run
copy source from text area to clipboard *
clear project source window
paste clipboard in source window
run
repeat to *

then I got this working in 19 lines using a 1 line sub
 

William Lancee

Well-Known Member
Licensed User
Longtime User
Wow. I am impressed and love to see how you did it.

After a lot whittling away at my code, my total line count is still 47.

Maybe we can do a reveal at 3pm EST ( in 11 minutes).
 

sorex

Expert
Licensed User
Longtime User
sure no problem, I'll post it here when nobody goes lower
 

sorex

Expert
Licensed User
Longtime User
I'll pm you my project then you can see if I understood it right.

the difficulty is making it work right multiple times in a row.
 

William Lancee

Well-Known Member
Licensed User
Longtime User
@sorex

I tried it and after two iteration the source stabilizes and yields a 39 line module that does exactly what I was looking for.

(I was a little intimidated by the very long lines, but as the "Forged in Fire" guy says, it will Kill!)

Well done.
This is my best attempt.

B4X:
#Region Project Attributes
    #MainFormWidth: 800
    #MainFormHeight: 600
#End Region
Sub Process_Globals
    Private fx As JFX
    Public MainForm As Form
End Sub
Sub AppStart (Form1 As Form, Args() As String)
    MainForm = Form1
    Dim textArea1 As TextArea
    textArea1.Initialize("")
    MainForm.RootPane.AddNode(textArea1, 0, 0, MainForm.Width, MainForm.Height)
    MainForm.Title = "This is an exact replica of myself!"
    MainForm.Show
    Dim parts() As String = Array As String ("#Region Project Attributes~    #MainFormWidth: 800~    #MainFormHeight: 600~#End Region", _
    "~Sub Process_Globals~    Private fx As JFX~    Public MainForm As Form~End Sub", _
    "~Sub AppStart (Form1 As Form, Args() As String)~    MainForm = Form1~    Dim textArea1 As TextArea~    textArea1.Initialize('')", _
    "~    MainForm.RootPane.AddNode(textArea1, 0, 0, MainForm.Width, MainForm.Height)", _
    "~    MainForm.Title = 'This is an exact replica of myself!'~    MainForm.Show~    Dim parts() As String = Array As String (", _
    "~    Dim sb As StringBuilder~    sb.Initialize~    For j = 0 to 10~        sb.Append(parts(j))~    Next~    Dim v() As String = Regex.Split(Chr(126), sb.ToString)", _
    "~    sb.initialize~    For i = 0 To 15~        sb.Append(CRLF).Append(v(i).Replace(Chr(39), QUOTE))~    Next", _
    "~    sb.Append(CRLF).Append('    Dim parts() As String = Array As String (').Append(parts(0)).Append(', _')", _
    "~    For j = 1 To 10~        sb.Append(CRLF).Append(TAB).Append(QUOTE).Append(parts(j)).Append(QUOTE).Append(', _')~    Next", _
    "~    sb.Remove(sb.Length-3,sb.Length).Append(')')~    For i = 16 To v.length - 1~        sb.Append(CRLF).Append(v(i).Replace(Chr(39), QUOTE))~    Next", _
    "~    sb.Remove(0,1)~    textArea1.Text = sb.toString~End Sub")
    Dim sb As StringBuilder
    sb.initialize
    For j = 0 To 10
        sb.Append(parts(j))
    Next
    Dim v() As String = Regex.Split(Chr(126), sb.ToString)
    sb.Initialize
    For i = 0 To 15
        sb.Append(CRLF).Append(v(i).Replace(Chr(39), QUOTE))
    Next
    sb.Append(QUOTE).Append(parts(0)).Append(QUOTE).Append(", _")
    For j = 1 To 10
        sb.Append(CRLF).Append(TAB).Append(QUOTE).Append(parts(j)).Append(QUOTE).Append(", _")
    Next
    sb.Remove(sb.Length-3,sb.Length).Append(")")
    For i = 16 To v.Length - 1
        sb.Append(CRLF).Append(v(i).Replace(Chr(39), QUOTE))
    Next
    sb.Remove(0,1)
    textArea1.Text = sb.toString
End Sub
 

aeric

Expert
Licensed User
Longtime User
My attempt
B4X:
#Region Project Attributes
    #MainFormWidth: 600
    #MainFormHeight: 600
#End Region
Sub Process_Globals
    Private fx As JFX
    Public MainForm As Form
End Sub
Sub AppStart (Form1 As Form, Args() As String)
    Dim Q As Char = Chr(34)
    Dim Line() As String = Array As String( _
    "#Region Project Attributes", _
    "    #MainFormWidth: 600", _
    "    #MainFormHeight: 600", _
    "#End Region", _
    "Sub Process_Globals", _
    "    Private fx As JFX", _
    "    Public MainForm As Form", _
    "End Sub", _
    "Sub AppStart (Form1 As Form, Args() As String)", _
    "    Dim Q As Char = Chr(34)", _
    "    Dim Line() As String = Array As String( _", _
    "    ", _
    ")", _
    "    MainForm = Form1", _
    "    Dim textArea1 As TextArea: textArea1.Initialize(Chr(47) & Chr(47) & Chr(47) & Chr(47))", _
    "    MainForm.RootPane.AddNode(textArea1, 0, 0, MainForm.Width, MainForm.Height)", _
    "    MainForm.Title = ////This Is an exact replica of myself!////", _
    "    MainForm.Show", _
    "    'textArea1.Text =  ??              'In how many lines can you do this?   My best shot is 66 lines, including this preamble.", _
    "    Dim SB1 As StringBuilder : SB1.Initialize : Dim SB2 As StringBuilder : SB2.Initialize", _
    "    For i = 0 To 10", _
    "        SB1.Append(Line(i) & Chr(10))", _
    "    Next", _
    "    For i = 0 To Line.Length - 1", _
    "        SB1.Append(Line(11)).Append(Q).Append(Line(i)).Append(Q)", _
    "        If i < Line.Length - 1 Then SB1.Append(Chr(44)).Append(Chr(32)).Append(Chr(95)).Append(Chr(10))", _
    "    Next", _
    "    For i = 12 To Line.Length - 1", _
    "        SB2.Append(Line(i) & Chr(10))", _
    "    Next", _
    "    textArea1.Text = SB1.ToString.Replace(Chr(47)&Chr(47), Q) & SB2.ToString.Replace(Chr(47)&Chr(47)&Chr(47)&Chr(47), Q)", _
    "End Sub")
    MainForm = Form1
    Dim textArea1 As TextArea: textArea1.Initialize(Chr(47) & Chr(47) & Chr(47) & Chr(47))
    MainForm.RootPane.AddNode(textArea1, 0, 0, MainForm.Width, MainForm.Height)
    MainForm.Title = "This is an exact replica of myself!"
    MainForm.Show
    'textArea1.Text =  ??              'In how many lines can you do this?   My best shot is 66 lines, including this preamble.
    Dim SB1 As StringBuilder : SB1.Initialize : Dim SB2 As StringBuilder : SB2.Initialize
    For i = 0 To 10
        SB1.Append(Line(i)).Append(Chr(10))
    Next
    For i = 0 To Line.Length - 1
        SB1.Append(Line(11)).Append(Q).Append(Line(i)).Append(Q).ToString.Replace(Chr(47)&Chr(47), Q)
        If i < Line.Length - 1 Then SB1.Append(Chr(44)).Append(Chr(32)).Append(Chr(95)).Append(Chr(10))
    Next
    For i = 12 To Line.Length - 1
        SB2.Append(Line(i)).Append(Chr(10))
    Next
    textArea1.Text = SB1.ToString.Replace(Chr(47)&Chr(47), Q) & SB2.ToString.Replace(Chr(47)&Chr(47)&Chr(47)&Chr(47), Q)
End Sub
 

Attachments

  • quine.zip
    1.1 KB · Views: 181

William Lancee

Well-Known Member
Licensed User
Longtime User
@aeric

I like it better than mine. You included the comment line with the "??"
You also avoided combining multiple statements on one line. It is much more readable.
It works!

Well done.
 

sorex

Expert
Licensed User
Longtime User
forgot to show mine

B4X:
#Region Project Attributes
    #MainFormWidth: 600
    #MainFormHeight: 600
#End Region
Sub Process_Globals
End Sub
Sub AppStart (Form1 As Form, Args() As String)
    Dim textArea1 As TextArea: textArea1.Initialize("")
    Form1.RootPane.AddNode(textArea1, 0, 0, Form1.Width, Form1.Height)
    Form1.Title = "This is an exact replica of myself!"
    Form1.Show
    textArea1.Text =  getSource($"#Region Project Attributes${CRLF}    #MainFormWidth: 600${CRLF}    #MainFormHeight: 600${CRLF}#End Region${CRLF}Sb Process_Globals${CRLF}End Sb${CRLF}Sb AppStart (Form1 As Form, Args() As String)${CRLF}    Dim textArea1 As TextArea: textArea1.Initialize("")${CRLF}    Form1.RootPane.AddNode(textArea1, 0, 0, Form1.Width, Form1.Height)${CRLF}    Form1.Title = 'This is an exact replica of myself!'${CRLF}    Form1.Show${CRLF}    textArea1.Text =  getSource(SC1)${CRLF}End Sb${CRLF}Sr getSource(source As String) as string${CRLF}    Return source.SubString2(0,source.IndexOf('S'&'r')).Replace('Sb','Sub').Replace(chr(0x27),QUOTE).replace('SC1','$' & QUOTE & source & QUOTE & '$') & source.SubString(source.IndexOf('S'&'r')).Replace('S'&'r','Sub').Replace(chr(0x27),QUOTE)${CRLF}End Sr"$)
End Sub
Sub getSource(source As String) As String
    Return source.SubString2(0,source.IndexOf("S"&"r")).Replace("Sb","Sub").Replace(Chr(0x27),QUOTE).replace("SC1","$" & QUOTE & source & QUOTE & "$") & source.SubString(source.Indexof("S"&"r")).Replace("S"&"r","Sub").Replace(Chr(0x27),QUOTE)
End Sub


you can cut 4 lines at the beginning as they are not really needed either.

some of the weirdness is to get around a possible bug with the smart strings as it seems to break when they contain sub or end sub in it.
 

Attachments

  • copyself.zip
    1 KB · Views: 167
Last edited:

aeric

Expert
Licensed User
Longtime User
My attempt
B4X:
#Region Project Attributes
    #MainFormWidth: 600
    #MainFormHeight: 600
#End Region
Sub Process_Globals
    Private fx As JFX
    Public MainForm As Form
End Sub
Sub AppStart (Form1 As Form, Args() As String)
    Dim Q As Char = Chr(34)
    Dim Line() As String = Array As String( _
    "#Region Project Attributes", _
    "    #MainFormWidth: 600", _
    "    #MainFormHeight: 600", _
    "#End Region", _
    "Sub Process_Globals", _
    "    Private fx As JFX", _
    "    Public MainForm As Form", _
    "End Sub", _
    "Sub AppStart (Form1 As Form, Args() As String)", _
    "    Dim Q As Char = Chr(34)", _
    "    Dim Line() As String = Array As String( _", _
    "    ", _
    ")", _
    "    MainForm = Form1", _
    "    Dim textArea1 As TextArea: textArea1.Initialize(Chr(47) & Chr(47) & Chr(47) & Chr(47))", _
    "    MainForm.RootPane.AddNode(textArea1, 0, 0, MainForm.Width, MainForm.Height)", _
    "    MainForm.Title = ////This Is an exact replica of myself!////", _
    "    MainForm.Show", _
    "    'textArea1.Text =  ??              'In how many lines can you do this?   My best shot is 66 lines, including this preamble.", _
    "    Dim SB1 As StringBuilder : SB1.Initialize : Dim SB2 As StringBuilder : SB2.Initialize", _
    "    For i = 0 To 10", _
    "        SB1.Append(Line(i) & Chr(10))", _
    "    Next", _
    "    For i = 0 To Line.Length - 1", _
    "        SB1.Append(Line(11)).Append(Q).Append(Line(i)).Append(Q)", _
    "        If i < Line.Length - 1 Then SB1.Append(Chr(44)).Append(Chr(32)).Append(Chr(95)).Append(Chr(10))", _
    "    Next", _
    "    For i = 12 To Line.Length - 1", _
    "        SB2.Append(Line(i) & Chr(10))", _
    "    Next", _
    "    textArea1.Text = SB1.ToString.Replace(Chr(47)&Chr(47), Q) & SB2.ToString.Replace(Chr(47)&Chr(47)&Chr(47)&Chr(47), Q)", _
    "End Sub")
    MainForm = Form1
    Dim textArea1 As TextArea: textArea1.Initialize(Chr(47) & Chr(47) & Chr(47) & Chr(47))
    MainForm.RootPane.AddNode(textArea1, 0, 0, MainForm.Width, MainForm.Height)
    MainForm.Title = "This is an exact replica of myself!"
    MainForm.Show
    'textArea1.Text =  ??              'In how many lines can you do this?   My best shot is 66 lines, including this preamble.
    Dim SB1 As StringBuilder : SB1.Initialize : Dim SB2 As StringBuilder : SB2.Initialize
    For i = 0 To 10
        SB1.Append(Line(i)).Append(Chr(10))
    Next
    For i = 0 To Line.Length - 1
        SB1.Append(Line(11)).Append(Q).Append(Line(i)).Append(Q).ToString.Replace(Chr(47)&Chr(47), Q)
        If i < Line.Length - 1 Then SB1.Append(Chr(44)).Append(Chr(32)).Append(Chr(95)).Append(Chr(10))
    Next
    For i = 12 To Line.Length - 1
        SB2.Append(Line(i)).Append(Chr(10))
    Next
    textArea1.Text = SB1.ToString.Replace(Chr(47)&Chr(47), Q) & SB2.ToString.Replace(Chr(47)&Chr(47)&Chr(47)&Chr(47), Q)
End Sub
I handled the double quote in inelegant way by using Replace.

Based on idea in Wikipedia example:
 

aeric

Expert
Licensed User
Longtime User
forgot to show mine

B4X:
#Region Project Attributes
    #MainFormWidth: 600
    #MainFormHeight: 600
#End Region
Sub Process_Globals
End Sub
Sub AppStart (Form1 As Form, Args() As String)
    Dim textArea1 As TextArea: textArea1.Initialize("")
    Form1.RootPane.AddNode(textArea1, 0, 0, Form1.Width, Form1.Height)
    Form1.Title = "This is an exact replica of myself!"
    Form1.Show
    textArea1.Text =  getSource($"#Region Project Attributes${CRLF}    #MainFormWidth: 600${CRLF}    #MainFormHeight: 600${CRLF}#End Region${CRLF}Sb Process_Globals${CRLF}End Sb${CRLF}Sb AppStart (Form1 As Form, Args() As String)${CRLF}    Dim textArea1 As TextArea: textArea1.Initialize("")${CRLF}    Form1.RootPane.AddNode(textArea1, 0, 0, Form1.Width, Form1.Height)${CRLF}    Form1.Title = 'This is an exact replica of myself!'${CRLF}    Form1.Show${CRLF}    textArea1.Text =  getSource(SC1)${CRLF}End Sb${CRLF}Sr getSource(source As String) as string${CRLF}    Return source.SubString2(0,source.IndexOf('S'&'r')).Replace('Sb','Sub').Replace(chr(0x27),QUOTE).replace('SC1','$' & QUOTE & source & QUOTE & '$') & source.SubString(source.IndexOf('S'&'r')).Replace('S'&'r','Sub').Replace(chr(0x27),QUOTE)${CRLF}End Sr"$)
End Sub
Sub getSource(source As String) As String
    Return source.SubString2(0,source.IndexOf("S"&"r")).Replace("Sb","Sub").Replace(Chr(0x27),QUOTE).replace("SC1","$" & QUOTE & source & QUOTE & "$") & source.SubString(source.Indexof("S"&"r")).Replace("S"&"r","Sub").Replace(Chr(0x27),QUOTE)
End Sub


you can cut 4 lines at the beginning as they are not really needed either.

some of the weirdness is to get around a possible bug with the smart strings as it seems to break when they contain sub or end sub in it.
Impressive. Very few lines of code.
 
Top