String Collapse Function - Rosetta Code

[bplus]

Code: QB64: [Select]

1. _Title "Collapse String Function - Rosetta Code" 'b+ 2021-07-28
2. ' ref: http://rosettacode.org/wiki/Determine_if_a_string_is_collapsible
3. t$(1) = "" ' a null string  (length zero)
4. t$(2) = Chr$(34) + "If I were two-faced, would I be wearing this one?" + Chr$(34) + " --- Abraham Lincoln "
5. t$(3) = "..1111111111111111111111111111111111111111111111111111111111111117777888"
6. t$(4) = "I never give 'em hell, I just tell the truth, and they think it's hell. "
7. t$(5) = "                                                    --- Harry S Truman  "
8. For i = 1 To 5
9.     Print t$(i); Len(t$(i))
10.     Print collapse$(t$(i)); Len(collapse$(t$(i)))
11. Next
12.  
13. Function collapse$ (s$)
14.     If Len(s$) < 2 Then collapse$ = s$: Exit Function
15.     c$ = Mid$(s$, 1, 1)
16.     collapse$ = c$
17.     For i = 2 To Len(s$)
18.         If Mid$(s$, i, 1) <> c$ Then c$ = Mid$(s$, i, 1): collapse$ = collapse$ + c$
19.     Next
20. End Function
21.  

Hey, about 10 lines less than FreeBASIC's entry. ;-))

[DANILIN]

register there and supplement
it and I assume: variables there will be unnecessary

in meantime: perhaps a similar humor topic

Shuffling Letters

https://qb64.org/forum/index.php?topic=3982.0

[Ashish]

@bplus
Nice! Since you have used two colons ( : ), here is my version using amount of colons. :)

Code: QB64: [Select]

1. 'Ashish attempt to do collapse$ function
2. Function collapse$ (s$)
3.     If Len(s$) = 0 Then Exit Function Else a0 = Asc(Mid$(s$, 1, 1)): collapse$ = Chr$(a0)
4.     For i = 2 To Len(s$)
5.         If Asc(Mid$(s$, i, 1)) Xor a0 Then a0 = Asc(Mid$(s$, i, 1)): collapse$ = collapse$ + Chr$(a0)
6.     Next
7. End Function
8.  

[bplus]

@DANILIN I tried a spinning letters in middle too!

OK! @Ashish

[bplus]

Wait, @Ashish, wouldn't it be simpler to avoid ASC function because you just have to reverse it back with Chr$()?

Update: Oh you wanted to be fancy pants with the XOR ;-))

[euklides]

An other way:

Function collapse$ (s$)
    collapse$ = Left$(s$ + Chr$(1), 1): For x = 2 To Len(s$): If Mid$(s$, x, 1) <> Mid$(s$, x - 1, 1) Then collapse$ = collapse$ + Mid$(s$, x, 1)
    Next x: If collapse$ = Chr$(1) Then collapse$ = ""
End Function

[bplus]

Oh ha! mine works without the first line in function. Ashish is not working for me. Euklides is same amount of lines as mine when I drop first line and don't allow colons:

Code: QB64: [Select]

1. _Title "Collapse String Function - Rosetta Code" 'b+ 2021-07-28
2. ' ref: http://rosettacode.org/wiki/Determine_if_a_string_is_collapsible
3. t$(1) = "" ' a null string  (length zero)
4. t$(2) = Chr$(34) + "If I were two-faced, would I be wearing this one?" + Chr$(34) + " --- Abraham Lincoln "
5. t$(3) = "..1111111111111111111111111111111111111111111111111111111111111117777888"
6. t$(4) = "I never give 'em hell, I just tell the truth, and they think it's hell. "
7. t$(5) = "                                                    --- Harry S Truman  "
8.  
9. t$(6) = "A"
10. t$(7) = "AA"
11. t$(8) = " AA"
12.  
13. For i = 1 To 8
14.     Print t$(i); Len(t$(i))
15.     Print collapse$(t$(i)); Len(collapse$(t$(i)))
16. Next
17.  
18. Function collapse$ (s$)
19.     'If Len(s$) < 2 Then collapse$ = s$ ' : Exit Function
20.     c$ = Mid$(s$, 1, 1)
21.     collapse$ = c$
22.     For i = 2 To Len(s$)
23.         If Mid$(s$, i, 1) <> c$ Then c$ = Mid$(s$, i, 1): collapse$ = collapse$ + c$
24.     Next
25. End Function
26.  
27. 'Function collapse$ (s$) ' euklides
28. '    collapse$ = Left$(s$ + Chr$(1), 1)
29. '    For x = 2 To Len(s$)
30. '        If Mid$(s$, x, 1) <> Mid$(s$, x - 1, 1) Then collapse$ = collapse$ + Mid$(s$, x, 1)
31. '    Next x
32. '    If collapse$ = Chr$(1) Then collapse$ = ""
33. 'End Function
34.  
35. 'Ashish attempt to do collapse$ function
36. 'Function collapse$ (s$)
37. '    If Len(s$) = 0 Then Exit Function Else a0 = Asc(Mid$(s$, 1, 1))
38. '    collapse$ = Chr$(a0)
39. '    For i = 2 To Len(s$)
40. '        If Asc(Mid$(s$, i, 1)) Xor a0 Then a0 = Asc(Mid$(s$, i, 1))
41. '        collapse$ = collapse$ + Chr$(a0)
42. '    Next
43. 'End Function
44.  
45.  
46.  

Oops! nope I still have a colon, euklides wins! so far :)

[bplus]

OK following euklides example, I whittled off another line:

Code: QB64: [Select]

1. _Title "Collapse String Function - Rosetta Code" 'b+ 2021-07-28
2. ' ref: http://rosettacode.org/wiki/Determine_if_a_string_is_collapsible
3. t$(1) = "" ' a null string  (length zero)
4. t$(2) = Chr$(34) + "If I were two-faced, would I be wearing this one?" + Chr$(34) + " --- Abraham Lincoln "
5. t$(3) = "..1111111111111111111111111111111111111111111111111111111111111117777888"
6. t$(4) = "I never give 'em hell, I just tell the truth, and they think it's hell. "
7. t$(5) = "                                                    --- Harry S Truman  "
8.  
9. t$(6) = "A"
10. t$(7) = "AA"
11. t$(8) = " AA"
12.  
13. For i = 1 To 8
14.     Print t$(i); Len(t$(i))
15.     Print collapse$(t$(i)); Len(collapse$(t$(i)))
16. Next
17.  
18. Function collapse$ (s$) ' bplus fixed by euklides example
19.     collapse$ = Mid$(s$, 1, 1)
20.     For i = 2 To Len(s$)
21.         If Mid$(s$, i, 1) <> Mid$(s$, i - 1, 1) Then collapse$ = collapse$ + Mid$(s$, i, 1)
22.     Next
23. End Function
24.  
25. 'Function collapse$ (s$) ' euklides
26. '    collapse$ = Left$(s$ + Chr$(1), 1)
27. '    For x = 2 To Len(s$)
28. '        If Mid$(s$, x, 1) <> Mid$(s$, x - 1, 1) Then collapse$ = collapse$ + Mid$(s$, x, 1)
29. '    Next x
30. '    If collapse$ = Chr$(1) Then collapse$ = ""
31. 'End Function
32.  
33. 'Ashish attempt to do collapse$ function
34. 'Function collapse$ (s$)
35. '    If Len(s$) = 0 Then Exit Function Else a0 = Asc(Mid$(s$, 1, 1))
36. '    collapse$ = Chr$(a0)
37. '    For i = 2 To Len(s$)
38. '        If Asc(Mid$(s$, i, 1)) Xor a0 Then a0 = Asc(Mid$(s$, i, 1))
39. '        collapse$ = collapse$ + Chr$(a0)
40. '    Next
41. 'End Function
42.  
43.  

[Ashish]

@bplus you edited my code in incorrect way -
This is how it must be -

Code: QB64: [Select]

1. 'Ashish attempt to do collapse$ function
2. Function collapse$ (s$)
3.     If Len(s$) = 0 Then Exit Function Else a0 = Asc(Mid$(s$, 1, 1))
4.     collapse$ = Chr$(a0)
5.     For i = 2 To Len(s$)
6.         If Asc(Mid$(s$, i, 1)) Xor a0 Then
7.             a0 = Asc(Mid$(s$, i, 1))
8.             collapse$ = collapse$ + Chr$(a0)
9.         End If
10.     Next
11. End Function
12.  
13.  

[bplus]

Sorry @Ashish

I see what I did wrong now, will try to be more careful with colons on IF lines.