Text Only | Text with Attachments

QB64.org Forum

Active Forums => QB64 Discussion => Topic started by: bplus on September 19, 2020, 05:37:42 pm

Title: All Digits
Post by: bplus on September 19, 2020, 05:37:42 pm
Can anyone do this in 10 lines or less:
http://paulbourke.net/fun/digits.html

I am down to 11 lines, including printing the number, it's square and cube.

(Double parking with colons counts as more lines.)

Update: 10

Update: 9

Update: 7

Title: Re: All Digits
Post by: Richard Frost on September 19, 2020, 11:01:28 pm
9 lines, including printing the number, square, and cube.

Code: QB64: [Select]
  1. woof:
  2. n = n + 1
  3. n$ = LTRIM$(STR$(n * n)) + LTRIM$(STR$(n * n * n))
  4. PRINT n; n * n; n * n * n; " "; n$
  5. FOR i = 0 TO 9
  6.     p = INSTR(n$, CHR$(48 + i))
  7.     IF p THEN MID$(n$, p, 1) = "x" ELSE GOTO woof
  9. IF n$ <> "xxxxxxxxxx" THEN GOTO woof
  10.  
Title: Re: All Digits
Post by: bplus on September 19, 2020, 11:23:17 pm
Nice here it is at 9 with less sauce:
Code: QB64: [Select]
  1. woof:
  2. n = n + 1
  3. n$ = LTRIM$(STR$(n * n)) + LTRIM$(STR$(n * n * n))
  4. IF LEN(n$) > 10 THEN PRINT " no solution": END
  5. FOR i = 0 TO 9
  6.     p = INSTR(n$, CHR$(48 + i))
  7.     IF p THEN MID$(n$, p, 1) = "x" ELSE GOTO woof
  9. IF n$ = "xxxxxxxxxx" THEN PRINT n; n * n; n * n * n ELSE GOTO woof
  10.  
Title: Re: All Digits
Post by: bplus on September 19, 2020, 11:28:20 pm
I would give it 7 without the check for limit and dump the colon
Code: QB64: [Select]
  1. 1 n = n + 1
  2. n$ = LTRIM$(STR$(n * n)) + LTRIM$(STR$(n * n * n))
  3. FOR i = 0 TO 9
  4.     p = INSTR(n$, CHR$(48 + i))
  5.     IF p THEN MID$(n$, p, 1) = "x" ELSE GOTO 1
  7. IF n$ = "xxxxxxxxxx" THEN PRINT n; n * n; n * n * n ELSE GOTO 1
  8.  
  9.  
  10.  
Title: Re: All Digits
Post by: bplus on September 19, 2020, 11:37:25 pm
My 7 liner made use of fact that all 10 digits from squares and cubes were numbers from 47 to 99 learned in the 9 liner:

Here is how I worked mine down:
Code: QB64: [Select]
  1. ' all digits last one under easy
  2. _TITLE "A number whose digits from it's square and cube is 1 of all the digits" 'b+ 2020-09-19 from Paul Bourke
  3. 'FOR n = 1 TO 1000
  4. '    s$ = _TRIM$(STR$(n * n)) + _TRIM$(STR$(n * n * n))
  5. '    IF LEN(s$) = 10 THEN
  6. '        REDIM digits(9)
  7. '        FOR i = 1 TO 10
  8. '            digits(VAL(MID$(s$, i, 1))) = 1
  9. '        NEXT
  10. '        OK = -1
  11. '        FOR i = 0 TO 9
  12. '            IF digits(i) <> 1 THEN OK = 0: EXIT FOR
  13. '        NEXT
  14. '        IF OK THEN PRINT n: EXIT FOR
  15. '    END IF
  16. 'NEXT
  17. 'PRINT n ^ 2, n ^ 3
  18.  
  19. 'FOR n = 1 TO 1000
  20. '    s$ = _TRIM$(STR$(n * n)) + _TRIM$(STR$(n * n * n))
  21. '    IF LEN(s$) = 10 THEN
  22. '        test$ = SPACE$(10)
  23. '        FOR i = 1 TO 10
  24. '            MID$(test$, VAL(MID$(s$, i, 1)) + 1, 1) = "1"
  25. '        NEXT
  26. '        IF test$ = STRING$(10, "1") THEN EXIT FOR
  27. '    END IF
  28. 'NEXT
  29. 'IF n <> 1001 THEN PRINT n, n ^ 2, n ^ 3 ELSE PRINT "done"
  30.  
  31. 'FOR n = 1 TO 1000
  32. '    IF LEN(_TRIM$(STR$(n * n)) + _TRIM$(STR$(n * n * n))) = 10 THEN
  33. '        test$ = SPACE$(10)
  34. '        FOR i = 1 TO 10
  35. '            MID$(test$, VAL(MID$(_TRIM$(STR$(n * n)) + _TRIM$(STR$(n * n * n)), i, 1)) + 1, 1) = "1"
  36. '        NEXT
  37. '        IF test$ = STRING$(10, "1") THEN EXIT FOR
  38. '    END IF
  39. 'NEXT
  40. 'IF n <> 1001 THEN PRINT n, n ^ 2, n ^ 3 ELSE PRINT "done"
  41.  
  42. 'FOR n = 47 TO 1000 ' 10 digits for n^2 and n^3
  43. '    IF LEN(_TRIM$(STR$(n * n)) + _TRIM$(STR$(n * n * n))) = 10 THEN
  44. '        'PRINT n  '47 to 99 is the range for 10 digit numbers
  45. '        test$ = SPACE$(10)
  46. '        FOR i = 1 TO 10
  47. '            MID$(test$, VAL(MID$(_TRIM$(STR$(n * n)) + _TRIM$(STR$(n * n * n)), i, 1)) + 1, 1) = "1"
  48. '        NEXT
  49. '        IF test$ = STRING$(10, "1") THEN PRINT "n n^2 n^3:"; n; n ^ 2; n ^ 3
  50. '    END IF
  51. 'NEXT
  52.  
  53. FOR n = 47 TO 99 '<< 10 digit range for n^2 and n^3
  54.     test$ = SPACE$(10)
  55.     FOR i = 1 TO 10
  56.         MID$(test$, VAL(MID$(_TRIM$(STR$(n * n)) + _TRIM$(STR$(n * n * n)), i, 1)) + 1, 1) = "1"
  57.     NEXT
  58.     IF test$ = STRING$(10, "1") THEN PRINT "n n^2 n^3:"; n; n ^ 2; n ^ 3
  60.  
  61.  

EDIT: Paul Bourke's name corrected:
http://paulbourke.net/fun/
Title: Re: All Digits
Post by: Richard Frost on September 19, 2020, 11:49:19 pm
Maybe I shouldn't have posted code so soon, eh?  Give the beginners a good workout.

My first posting wasn't right - said there was no solution.  Duh. 

Puzzles are fun - unless they take months to solve!
Title: Re: All Digits
Post by: bplus on September 20, 2020, 12:00:36 am
Quote from: Richard Frost on September 19, 2020, 11:49:19 pm
Maybe I shouldn't have posted code so soon, eh?  Give the beginners a good workout.

My first posting wasn't right - said there was no solution.  Duh. 

Puzzles are fun - unless they take months to solve!

Ah but you would miss the bonus points for being the first poster.

I like seeing the MID$ SUB being used as opposed to the FUNCTION and work around from using arrays for the letters.
Title: Re: All Digits
Post by: johnno56 on September 20, 2020, 12:19:15 am
Way back when, there used to be competitions, to produce workable games/programs in 10 lines or less...

Do I sense a resurgence? lol
Title: Re: All Digits
Post by: bplus on September 20, 2020, 12:23:49 am
Quote from: johnno56 on September 20, 2020, 12:19:15 am
Way back when, there used to be competitions, to produce workable games/programs in 10 lines or less...

Do I sense a resurgence? lol

The occasional challenge is nice I think.

If anyone can beat 7 here, it will knock my socks off! Steve has done some clever things.
Title: Re: All Digits
Post by: bplus on September 20, 2020, 12:31:20 am
Wait... 6
Code: QB64: [Select]
  1. 1 n = n + 1
  2. test$ = SPACE$(10)
  3. FOR i = 1 TO 10
  4.     MID$(test$, VAL(MID$(_TRIM$(STR$(n * n)) + _TRIM$(STR$(n * n * n)), i, 1)) + 1, 1) = "1"
  6. IF test$ = STRING$(10, "1") THEN PRINT "n n^2 n^3:"; n; n ^ 2; n ^ 3 ELSE GOTO 1
  7.  
Title: Re: All Digits
Post by: luke on September 20, 2020, 01:52:14 am
I can't beat bplus's 6 lines, so I'm going to cheat and use Haskell instead:

Code: [Select]
head [x | x <- [1..], ['0'..'9'] == sort (show (x^2) ++ show (x^3))]
Title: Re: All Digits
Post by: Richard Frost on September 20, 2020, 02:17:00 am
That 6 line solution is very odd.  You'd probably fall UP if you jumped out of an airplane.

While super short, it's horrible for processing time, which is what I try to optimize for,  esp. lately.

Did you know that 2 nested DO-LOOPs is faster than 2 nested FOR-NEXT loops?  Not that I
understand why.
Title: Re: All Digits
Post by: bplus on September 20, 2020, 10:18:47 am
Quote from: luke on September 20, 2020, 01:52:14 am
I can't beat bplus's 6 lines, so I'm going to cheat and use Haskell instead:

Code: [Select]
head [x | x <- [1..], ['0'..'9'] == sort (show (x^2) ++ show (x^3))]

Oh man this brings back memories of BP.org. We'd have a little challenge and see all the master stuff done with different versions of Basic. Then someone comes in with a One-Liner (and as time went several PL's represented) from the real world of computing. ;-) Reality Check
Title: Re: All Digits
Post by: bplus on September 20, 2020, 10:35:34 am
Quote from: Richard Frost on September 20, 2020, 02:17:00 am
That 6 line solution is very odd.  You'd probably fall UP if you jumped out of an airplane.

While super short, it's horrible for processing time, which is what I try to optimize for,  esp. lately.

Did you know that 2 nested DO-LOOPs is faster than 2 nested FOR-NEXT loops?  Not that I
understand why.

Heh-heh yes as LOC (Lines Of Code) thins out it tends to get pretty desperate either in readability or efficient processing.

Long known by me and some others FOR loops are slowest by far, internally maintaining an index variable and a stepper and end of loop tests... DO LOOP is faster doing your own conditional testing for jumping out. Also (maybe taboo) but a goto like that used at end of 6 liner is fast too. FOR NEXT loops set a variable index and conditional exit in 2 lines which often makes them better for a LOC challenge.

What really sucks in 6 liner is this:
Code: QB64: [Select]
  1. MID$(test$, VAL(MID$(_TRIM$(STR$(n * n)) + _TRIM$(STR$(n * n * n)), i, 1)) + 1, 1) = "1"
the
Code: QB64: [Select]
  1.  _TRIM$(STR$(n * n)) + _TRIM$(STR$(n * n * n)
part. Look at those functions and math called over and over just to save one line of setting a variable
Code: QB64: [Select]
  1.  s$ = _TRIM$(STR$(n * n)) + _TRIM$(STR$(n * n * n)

Falling through to GOTO start of code not so unusual specially if you started out in spaghetti code world. :)
Title: Re: All Digits
Post by: Cobalt on September 20, 2020, 11:52:38 am
Think you could pull it off with no GOTO?
Title: Re: All Digits
Post by: luke on September 20, 2020, 12:01:04 pm
Quote from: Cobalt on September 20, 2020, 11:52:38 am
Think you could pull it off with no GOTO?

Oh hey, 5 lines.

Code: QB64: [Select]
  1. test$ = SPACE$(10)
  2. FOR i = 1 TO 10
  3.     MID$(test$, VAL(MID$(_TRIM$(STR$(VAL(COMMAND$(1)) ^ 2)) + _TRIM$(STR$(VAL(COMMAND$(1)) ^ 3)), i, 1)) + 1, 1) = "1"
  5. IF test$ = STRING$(10, "1") THEN PRINT "n n^2 n^3:"; VAL(COMMAND$(1)); VAL(COMMAND$(1)) ^ 2; VAL(COMMAND$(1)) ^ 3 ELSE SHELL _DONTWAIT COMMAND$(0) + STR$(VAL(COMMAND$(1))+1)

Not tested because I'm on mobile, but you get the idea.

Admittedly it would probably be nicer if you added a SYSTEM after the SHELL so you didn't get 70 windows cluttering your screen, but I don't want to use :
Title: Re: All Digits
Post by: bplus on September 20, 2020, 12:56:31 pm
Well this worked but if it didn't end on it's own! ;-( 

Pretty scary just the same: DON'T TRY THIS AT HOME!
Code: QB64: [Select]
  1. 1 test$ = SPACE$(10)
  2. FOR i = 1 TO 10
  3.     MID$(test$, VAL(MID$(_TRIM$(STR$(VAL(COMMAND$(1)) ^ 2)) + _TRIM$(STR$(VAL(COMMAND$(1)) ^ 3)), i, 1)) + 1, 1) = "1"
  5. IF test$ = STRING$(10, "1") THEN PRINT "n n^2 n^3:"; VAL(COMMAND$(1)); VAL(COMMAND$(1)) ^ 2; VAL(COMMAND$(1)) ^ 3 ELSE RUN "Untitled " + STR$(VAL(COMMAND$(1)) + 1)
  6.  

I thought I'd skip a few windows by adding 68 to command$(1), I skipped to wrong place I thought my computer was dead stuck with this going. I shut if off and turned it on and it picked up where it left off. Yikes!!!!!

Fortunately it quit at 107 * 68 = 7276

yeah 7276^2 = 52940176 and first 2 digits in cube are 38, what luck!
Title: Re: All Digits
Post by: SMcNeill on September 20, 2020, 02:47:53 pm
I think you could go shorter like:

a$ = “ 123456789 123456798...”
label: n = n + 1
IF  _INSTR(a$, STR$(n * n) + _TRIM$(STR$(n * n * n))) THEN PRINT n, n^2, n ^3 ELSE GOTO label

Of course a$ would need all the permutations of “123456789“, with a space in front to delimitate them.  I’m not at home to test it, but it seems to me that 3 lines would be all that’s needed with the program, with such a solution.
Title: Re: All Digits
Post by: bplus on September 20, 2020, 03:47:56 pm
Quote from: SMcNeill on September 20, 2020, 02:47:53 pm
I think you could go shorter like:

a$ = “ 123456789 123456798...”
label: n = n + 1
IF  _INSTR(a$, STR$(n * n) + _TRIM$(STR$(n * n * n))) THEN PRINT n, n^2, n ^3 ELSE GOTO label

Of course a$ would need all the permutations of “123456789“, with a space in front to delimitate them.  I’m not at home to test it, but it seems to me that 3 lines would be all that’s needed with the program, with such a solution.

Don't forget 0 for all 10 digits.
Title: Re: All Digits
Post by: luke on September 20, 2020, 06:39:17 pm
Quote from: SMcNeill on September 20, 2020, 02:47:53 pm
I think you could go shorter like:

a$ = “ 123456789 123456798...”
label: n = n + 1
IF  _INSTR(a$, STR$(n * n) + _TRIM$(STR$(n * n * n))) THEN PRINT n, n^2, n ^3 ELSE GOTO label

Of course a$ would need all the permutations of “123456789“, with a space in front to delimitate them.  I’m not at home to test it, but it seems to me that 3 lines would be all that’s needed with the program, with such a solution.
I think you might have a little bit of trouble posting the several megabytes of source code needed to the forum for that...

And of course, there's the obvious one-liner:
Code: [Select]
?69
Title: Re: All Digits
Post by: SMcNeill on September 20, 2020, 06:51:01 pm
Quote from: luke on September 20, 2020, 06:39:17 pm
I think you might have a little bit of trouble posting the several megabytes of source code needed to the forum for that...

And of course, there's the obvious one-liner:
Code: [Select]
?69

Just remember, I never promised it'd be the smallest file size...  It'd just be the fewest lines for a program, that I can think of.  From my poor math skills, the permutation would be about 38MB for that first search line, so a$ is one laaaaaaarge string, but the rest of the program is rather short and simple.  :)

It also helps highlight one of the glaring problems I tend to notice with "shortest program" contests.  Sure, somebody might be able to cram everything onto a single line of code, but their overall character count is much higher than some of the other folks out there...  Fewest lines does not necessarily equate smallest program, in my opinion, but one has to play by the rules of any contest (and their loopholes...).   ;)

Three lines, without compound statements on the same line, is the smallest number I think I can conceive for the problem at hand. 
Title: Re: All Digits
Post by: bplus on September 20, 2020, 07:53:59 pm
10! permutations = 720*210*24 = 3,628,800 * (10 digits + 1 space) = 11! digits 39,916,800

Can a line that long be compiled?
Title: Re: All Digits
Post by: Cobalt on September 20, 2020, 11:04:18 pm
Quote from: bplus on September 20, 2020, 07:53:59 pm
10! permutations = 720*210*24 = 3,628,800 * (10 digits + 1 space) = 11! digits 39,916,800

Can a line that long be compiled?
2 programs needed to find that out.

program 1:

FOR I&= 0 TO 39916800
 A$=A$+LTRIM$(STR$(INT(RND*10)))
NEXT I&
_CLIPBOARD A$
END

Program 2
A$ = 'PASTE CLIPBOARD HERE

and wait........
and wait.......
and wait.......

will the IDE ever actually process that? I image someday it will but mine never finished.
well to be honest I got tired of waiting. It might have actually crashed but I just force closed the IDE.
Title: Re: All Digits
Post by: luke on September 20, 2020, 11:31:51 pm
Quote from: SMcNeill on September 20, 2020, 06:51:01 pm
It also helps highlight one of the glaring problems I tend to notice with "shortest program" contests.  Sure, somebody might be able to cram everything onto a single line of code, but their overall character count is much higher than some of the other folks out there...  Fewest lines does not necessarily equate smallest program, in my opinion, but one has to play by the rules of any contest (and their loopholes...).   ;)
This is why code golf competitions are on number of characters, not number of lines.

https://codegolf.stackexchange.com/
Title: Re: All Digits
Post by: SMcNeill on September 20, 2020, 11:57:44 pm
Quote from: Cobalt on September 20, 2020, 11:04:18 pm
2 programs needed to find that out.

program 1:

FOR I&= 0 TO 39916800
 A$=A$+LTRIM$(STR$(INT(RND*10)))
NEXT I&
_CLIPBOARD A$
END

Program 2
A$ = 'PASTE CLIPBOARD HERE

and wait........
and wait.......
and wait.......

will the IDE ever actually process that? I image someday it will but mine never finished.
well to be honest I got tired of waiting. It might have actually crashed but I just force closed the IDE.

Why not generate the code as you go, so all you need to do is compile?

OPEN “test.bas” FOR OUTPUT AS #1
PRINT #1, “a$ = “; CHR$(34);
FOR I&= 0 TO 39916800
   PRINT #1, LTRIM$(STR$(INT(RND*10)));
NEXT I&
PRINT #1, CHR$(34)
PRINT #1, “PRINT a$”
CLOSE

Then just compile test.bas.  ;)
Title: Re: All Digits
Post by: bplus on September 21, 2020, 01:29:21 pm
OK byte count it is (to save Steve from hell proving theoretical idea), a re-evaluation then of contenders :)
I also better explicitly state that the QB64 IDE v 1.4 stable sets the bytes and judges the syntax.

Richard Frost (rewritten by me to optimize bytes) 7 lines 225 bytes:
Code: QB64: [Select]
  1. 1 n = n + 1
  2. n$ = LTRIM$(STR$(n * n)) + LTRIM$(STR$(n ^ 3))
  3. FOR i = 0 TO 9
  4.     p = INSTR(n$, CHR$(48 + i))
  5.     IF p THEN MID$(n$, p, 1) = "x" ELSE GOTO 1
  7. IF n$ = "xxxxxxxxxx" THEN PRINT n; n * n; n ^ 3 ELSE GOTO 1
  8.  

bplus 6 liner at 199 bytes:
Code: QB64: [Select]
  1. 1 n = n + 1
  2. t$ = SPACE$(10)
  3. FOR i = 1 TO 10
  4.     MID$(t$, VAL(MID$(_TRIM$(STR$(n * n)) + _TRIM$(STR$(n ^ 3)), i, 1)) + 1, 1) = "1"
  6. IF t$ = "1111111111" THEN PRINT n; n ^ 2; n ^ 3 ELSE GOTO 1
  7.  

Luke's 5 liner but 301 bytes (rewritten with same byte savings applied to bplus and Richard Frost but not tested again)
Code: QB64: [Select]
  1. 1 t$ = SPACE$(10)
  2. FOR i = 1 TO 10
  3.     MID$(t$, VAL(MID$(_TRIM$(STR$(VAL(COMMAND$(1)) ^ 2)) + _TRIM$(STR$(VAL(COMMAND$(1)) ^ 3)), i, 1)) + 1, 1) = "1"
  5. IF t$ = "1111111111" THEN PRINT VAL(COMMAND$(1)); VAL(COMMAND$(1)) ^ 2; VAL(COMMAND$(1)) ^ 3 ELSE RUN "Untitled " + STR$(VAL(COMMAND$(1)) + 1)
  6.  
Title: Re: All Digits
Post by: SMcNeill on September 21, 2020, 05:08:51 pm
Quote from: bplus on September 21, 2020, 01:29:21 pm
OK byte count it is (to save Steve from hell proving theoretical idea), a re-evaluation then of contenders :)

And I was just starting to test my idea, with this little program:

Code: QB64: [Select]
  1. OPEN “test.bas” FOR OUTPUT AS #1
  2. PRINT #1, “a$ = “; CHR$(34);
  3. FOR I&= 0 TO 39916800
  4.    PRINT #1, LTRIM$(STR$(INT(RND*10)));
  5. NEXT I&
  6. PRINT #1, CHR$(34)
  7. PRINT #1, “PRINT a$”

This gives us a single line with 39MB worth of data stored into a single string, and saves it as "test.bas".  Running the little program here takes about half a minute to finish generating our string for us, and saving it to disk...  Loading the file it creates into the IDE only takes about 2 seconds on my PC, and compilation into a working EXE only takes about 10 seconds or so.

Amazingly enough -- and I'm not certain how the hell this works -- but the EXE is *smaller* than the source code!!

Interestingly enough, neither QB64, nor the c-compiler we pack with QB64, had any issues whatsoever with the code.  It loaded, compiled, and executed just as simple as could be!

3 lines for the program (though incredibly loooooong lines of pre-generated data), is the fewest lines I think I'd call possible with this type of program in QB64.  (Of course, since we've decided to go by byte-count for "shortest program" and not "line-count", there's no reason for me to generate that data list and prove the concept valid any longer, so I'm not going to bother with any more testing than what I've did here.)

Regardless, it's always fun to try and think outside the box, to find a completely different solution than everyone else's.  I think my concept definitely does that, even if it does require a 39MB, 3-line program...  ;D
Title: Re: All Digits
Post by: bplus on September 21, 2020, 07:17:13 pm
Quote from: SMcNeill on September 21, 2020, 05:08:51 pm
And I was just starting to test my idea, with this little program:

Code: QB64: [Select]
  1. OPEN “test.bas” FOR OUTPUT AS #1
  2. PRINT #1, “a$ = “; CHR$(34);
  3. FOR I&= 0 TO 39916800
  4.    PRINT #1, LTRIM$(STR$(INT(RND*10)));
  5. NEXT I&
  6. PRINT #1, CHR$(34)
  7. PRINT #1, “PRINT a$”

This gives us a single line with 39MB worth of data stored into a single string, and saves it as "test.bas".  Running the little program here takes about half a minute to finish generating our string for us, and saving it to disk...  Loading the file it creates into the IDE only takes about 2 seconds on my PC, and compilation into a working EXE only takes about 10 seconds or so.

Amazingly enough -- and I'm not certain how the hell this works -- but the EXE is *smaller* than the source code!!

Interestingly enough, neither QB64, nor the c-compiler we pack with QB64, had any issues whatsoever with the code.  It loaded, compiled, and executed just as simple as could be!

3 lines for the program (though incredibly loooooong lines of pre-generated data), is the fewest lines I think I'd call possible with this type of program in QB64.  (Of course, since we've decided to go by byte-count for "shortest program" and not "line-count", there's no reason for me to generate that data list and prove the concept valid any longer, so I'm not going to bother with any more testing than what I've did here.)

Regardless, it's always fun to try and think outside the box, to find a completely different solution than everyone else's.  I think my concept definitely does that, even if it does require a 39MB, 3-line program...  ;D

Odd that you would quit now? Do you need the a$ = " part? 

working...

Hey what's with the weird quotes? i copied pasted your start code but yuck!
Title: Re: All Digits
Post by: bplus on September 21, 2020, 09:18:19 pm
It's impossible to edit the file when the first line is written.

And this is loaded with errors:
Code: QB64: [Select]
  1. a$ = “ 123456789 123456798...”
  2. label: n = n + 1
  3. IF  _INSTR(a$, STR$(n * n) + _TRIM$(STR$(n * n * n))) THEN PRINT n, n^2, n ^3 ELSE GOTO label
  4.  

Had to make a code example for line 2 and 3 to write with the first line.
Code: QB64: [Select]
  1. a$ = "4761328509 "
  2. 1 n = n + 1
  3. IF INSTR(a$, _TRIM$(STR$(n * n)) + _TRIM$(STR$(n ^ 3))) THEN PRINT n, n ^ 2, n ^ 3 ELSE GOTO 1

And run the first line maker again with all 3 lines written. Hopefully I can at least run the sucker.
Title: Re: All Digits
Post by: luke on September 21, 2020, 09:40:50 pm
When I copied the bplus six liner it was 201 bytes instead of 199, not too sure why.

Anyway, if we do away with insisting on proper formatting and take a few other tricks, you can get it down to 142 characters:
Code: QB64: [Select]
  1. 1n=n+1
  2. t$=SPC(10)
  3. FOR i=2TO 11
  4. MID$(t$,VAL(MID$(STR$(n*n)+_TRIM$(STR$(n^3)),i,1))+1,1)="1"
  6. IF t$="1111111111"THEN?n;n^2;n^3 ELSE 1
I was thinking to replace VAL(MID$(x$, i, 1)) + 1 with 49 + ASC(x$, i), but unfortunately ASC gives an error if you go past the end of the string :(
Title: Re: All Digits
Post by: bplus on September 21, 2020, 10:12:25 pm
Quote
When I copied the bplus six liner it was 201 bytes instead of 199, not too sure why.

Anyway, if we do away with insisting on proper formatting and take a few other tricks, you can get it down to 142 characters:

Hi Luke,

I already anticipated playing games with spaces and said this (above):
Quote
I also better explicitly state that the QB64 IDE v 1.4 stable sets the bytes and judges the syntax.

For byte count I copy and pasted QB64 IDE formatted code into Notepad++ and I bet Notepad++ removes final CR +LF that ends QB64 files so everyone's file has 2 more than I stated.

PS So you reduced SPACE$() to SPC() -AE$ nice! and got rid of a _TRIM$(), -8 very nice!


@Steve after reloading the long line 3 times and getting the dang file written and run it is done at n = 2, do you know why? because the string to compare needs to be 10 digits long plus a space not = "48" which can be found way too soon! BTW the EXE is longer than the bas file as expected.
Title: Re: All Digits
Post by: bplus on September 21, 2020, 11:04:24 pm
Test 3 Liner code revised to this for 11 character string match, see 3rd line changes

Code: QB64: [Select]
  1. a$ = " 4761328509"
  2. 1 n = n + 1
  3. IF INSTR(a$, LEFT$(STR$(n * n) + _TRIM$(STR$(n ^ 3)) + SPC(9), 11)) THEN PRINT n, n ^ 2, n ^ 3 ELSE GOTO 1
  4.  
  5.  

  [ This attachment cannot be displayed inline in 'Print Page' view ]  
Title: Re: All Digits
Post by: bplus on September 21, 2020, 11:10:57 pm
Here is the program that wrote the 3 lines, no human would want to!

Code: QB64: [Select]
  1. _TITLE "Permutations with value translator" 'B+ add value translator 2019-03-31
  2. 'from "Permutations wo recursion"  translate from SmallBasic to QB64 2019-03-31
  3. 'from "Permutations" translation from: PowerBASIC, tsh copy from Liberty link 2017-02-04
  4.  
  5. SCREEN _NEWIMAGE(800, 600, 32)
  6. _SCREENMOVE 300, 40
  7.  
  8. REDIM results$(0)
  9. loadPermsValues results$()
  10. 'display result$
  11.  
  12. OPEN "All Digit 3 liner by steve.bas" FOR OUTPUT AS #1
  13. PRINT #1, "a$ = "; CHR$(34);
  14.  
  15. FOR i = 0 TO UBOUND(results$)
  16.     PRINT i + 1, results$(i)
  17.     PRINT #1, results$(i) + " ";
  18.     'IF i MOD 30 = 29 THEN
  19.     '    PRINT "press any to continue..."
  20.     '    SLEEP
  21.     '    CLS
  22.     'END IF
  24. PRINT #1, CHR$(34)
  25. PRINT #1, "1 n = n + 1"
  26. PRINT #1, "IF INSTR(a$, LEFT$(STR$(n * n) + _TRIM$(STR$(n ^ 3)) + SPC(9), 11)) THEN PRINT n, n ^ 2, n ^ 3 ELSE GOTO 1"
  28.  
  29. ValuesData:
  30. DATA 0,1,2,3,4,5,6,7,8,9,"END"
  31.  
  32. 'this reads data from ValuesData line and translates Permutations to those values
  33. SUB loadPermsValues (r() AS STRING)
  34.     'load values array one way or another? read data
  35.     REDIM values(0) AS STRING
  36.     RESTORE ValuesData
  37.     DO
  38.         READ r$
  39.         IF r$ = "END" THEN
  40.             done = 1
  41.         ELSE
  42.             n = n + 1
  43.             REDIM _PRESERVE values(n) AS STRING
  44.             values(n) = r$
  45.         END IF
  46.     LOOP UNTIL done
  47.     n = UBOUND(values)
  48.     DIM a(0 TO n + 1) '+1 needed due to bug in LB that checks loop condition: until (i=0) or (a(i)<a(i+1))
  49.     FOR i = 0 TO n: a(i) = i: NEXT 'load a() with minimum values
  50.     DO
  51.         b$ = ""
  52.         FOR i = 1 TO n
  53.             b$ = b$ + values(a(i))
  54.         NEXT
  55.         REDIM _PRESERVE r(e)
  56.         r(e) = b$
  57.         e = e + 1
  58.  
  59.         i = n
  60.         DO
  61.             i = i - 1
  62.         LOOP UNTIL (i = 0) OR (a(i) < a(i + 1))
  63.         j = i + 1
  64.         k = n
  65.         WHILE j < k
  66.             SWAP a(j), a(k)
  67.             j = j + 1
  68.             k = k - 1
  69.         WEND
  70.         IF i > 0 THEN
  71.             j = i + 1
  72.             WHILE a(j) < a(i)
  73.                 j = j + 1
  74.             WEND
  75.             SWAP a(i), a(j)
  76.         END IF
  77.     LOOP UNTIL i = 0
  78.     EXIT SUB
  80.  

BTW I was halfway through the first run that I was expecting to take 3+ hours but only takes <20 mins, when I realized we didn't need any permutation that started with 0, that cuts out 1/10th of them? O well...

@SMcNeill
So Einstein your theory worked! :)
Title: Re: All Digits
Post by: SMcNeill on September 21, 2020, 11:31:48 pm
Quote from: bplus on September 21, 2020, 11:10:57 pm
Here is the program that wrote the 3 lines, no human would want to!

Code: QB64: [Select]
  1. _TITLE "Permutations with value translator" 'B+ add value translator 2019-03-31
  2. 'from "Permutations wo recursion"  translate from SmallBasic to QB64 2019-03-31
  3. 'from "Permutations" translation from: PowerBASIC, tsh copy from Liberty link 2017-02-04
  4.  
  5. SCREEN _NEWIMAGE(800, 600, 32)
  6. _SCREENMOVE 300, 40
  7.  
  8. REDIM results$(0)
  9. loadPermsValues results$()
  10. 'display result$
  11.  
  12. OPEN "All Digit 3 liner by steve.bas" FOR OUTPUT AS #1
  13. PRINT #1, "a$ = "; CHR$(34);
  14.  
  15. FOR i = 0 TO UBOUND(results$)
  16.     PRINT i + 1, results$(i)
  17.     PRINT #1, results$(i) + " ";
  18.     'IF i MOD 30 = 29 THEN
  19.     '    PRINT "press any to continue..."
  20.     '    SLEEP
  21.     '    CLS
  22.     'END IF
  24. PRINT #1, CHR$(34)
  25. PRINT #1, "1 n = n + 1"
  26. PRINT #1, "IF INSTR(a$, LEFT$(STR$(n * n) + _TRIM$(STR$(n ^ 3)) + SPC(9), 11)) THEN PRINT n, n ^ 2, n ^ 3 ELSE GOTO 1"
  28.  
  29. ValuesData:
  30. DATA 0,1,2,3,4,5,6,7,8,9,"END"
  31.  
  32. 'this reads data from ValuesData line and translates Permutations to those values
  33. SUB loadPermsValues (r() AS STRING)
  34.     'load values array one way or another? read data
  35.     REDIM values(0) AS STRING
  36.     RESTORE ValuesData
  37.     DO
  38.         READ r$
  39.         IF r$ = "END" THEN
  40.             done = 1
  41.         ELSE
  42.             n = n + 1
  43.             REDIM _PRESERVE values(n) AS STRING
  44.             values(n) = r$
  45.         END IF
  46.     LOOP UNTIL done
  47.     n = UBOUND(values)
  48.     DIM a(0 TO n + 1) '+1 needed due to bug in LB that checks loop condition: until (i=0) or (a(i)<a(i+1))
  49.     FOR i = 0 TO n: a(i) = i: NEXT 'load a() with minimum values
  50.     DO
  51.         b$ = ""
  52.         FOR i = 1 TO n
  53.             b$ = b$ + values(a(i))
  54.         NEXT
  55.         REDIM _PRESERVE r(e)
  56.         r(e) = b$
  57.         e = e + 1
  58.  
  59.         i = n
  60.         DO
  61.             i = i - 1
  62.         LOOP UNTIL (i = 0) OR (a(i) < a(i + 1))
  63.         j = i + 1
  64.         k = n
  65.         WHILE j < k
  66.             SWAP a(j), a(k)
  67.             j = j + 1
  68.             k = k - 1
  69.         WEND
  70.         IF i > 0 THEN
  71.             j = i + 1
  72.             WHILE a(j) < a(i)
  73.                 j = j + 1
  74.             WEND
  75.             SWAP a(i), a(j)
  76.         END IF
  77.     LOOP UNTIL i = 0
  78.     EXIT SUB
  80.  

BTW I was halfway through the first run that I was expecting to take 3+ hours but only takes <20 mins, when I realized we didn't need any permutation that started with 0, that cuts out 1/10th of them? O well...

@SMcNeill
So Einstein your theory worked! :)

I knew it should.  I was just too lazy to prove it.  So what do I win?  Two cookies for my browser?  ;D
Title: Re: All Digits
Post by: bplus on September 21, 2020, 11:38:11 pm
Quote
I knew it should.  I was just too lazy to prove it.  So what do I win?  Two cookies for my browser?  ;D

I think you've had enough bytes. ;-)
Title: Re: All Digits
Post by: SMcNeill on September 21, 2020, 11:38:51 pm
And actually, you can cut it down to 2 lines, if you use the string value directly, rather than store it in a$ first.

One counter, one IF condition checker...  I can’t see it getting any more simplified than that.
Title: Re: All Digits
Post by: bplus on September 21, 2020, 11:41:17 pm
What!?

Oh I see 2 lines, wow!

Working...
Title: Re: All Digits
Post by: luke on September 22, 2020, 01:37:25 am
Quote from: bplus on September 21, 2020, 10:12:25 pm
I already anticipated playing games with spaces and said this
Ah, I didn't realise you meant the formatter and indenter as well - I took it to mean it just had to compile in QB64 1.4, and not my local branch which has a _NUMSQUARECUBEALLDIGITS function
Title: Re: All Digits
Post by: bplus on September 22, 2020, 01:34:57 pm
After numerous tries attempting to do a 1 Liner with colon the bas program hangs in checking file... before compile and Run:
  [ This attachment cannot be displayed inline in 'Print Page' view ]  

Here is what the abbreviated program looks like:
Code: QB64: [Select]
  1. 1 n = n + 1: IF INSTR(" 4761328509", LEFT$(STR$(n * n) + _TRIM$(STR$(n ^ 3)) + SPC(9), 11)) THEN PRINT n, n ^ 2, n ^ 3 ELSE GOTO 1
  2.  
  3.  
" 4761328509" in INSTR call was replaced by all permutations of 10 digits minus the ones starting with 0
created with this file:

Code: QB64: [Select]
  1. _TITLE "All Digits 1 liner with colon Program Writer" 'B+ add value translator 2019-03-31
  2. 'from "Permutations wo recursion"  translate from SmallBasic to QB64 2019-03-31
  3. 'from "Permutations" translation from: PowerBASIC, tsh copy from Liberty link 2017-02-04
  4. ' 2020-09-21  OK for a 2 Liner version of All Digits following up on Steve's ideas
  5. '             OK let's use a colon and not waste space in IDE ;-))
  6. ' 2020-09-22 That program got constantly got stuck in checking file, never compliled.
  7. ' So I used another permutation generator to write a DAT file that generates all the permutations of 10 digits.
  8. ' This program will open that file and skip down to line 362,881 which ends all permutations that start with 0
  9. ' and begins with permuations that start with 1. That cuts 1/10 of 3,628,810 permutations out from line which
  10. ' should make the program easier to check and run. Let's see...
  11. '    NOPE: again gets stuck checking the file, even with 10% less permutations in the string.
  12.  
  13.  
  14. SCREEN _NEWIMAGE(800, 600, 32)
  15. _SCREENMOVE 300, 40
  16.  
  17. 'here is the simple model of the line to write tested to make sure it did find 69
  18. '1 n = n + 1: IF INSTR(" 4761328509", LEFT$(STR$(n * n) + _TRIM$(STR$(n ^ 3)) + SPC(9), 11)) THEN PRINT n, n ^ 2, n ^ 3 ELSE GOTO 1
  19.  
  20. ' now replace " 4761328509" with All Permutations of 10 digits except those that start with 0
  21. OPEN "All Digits 1 Liner with colon.bas" FOR OUTPUT AS #1 ' output .bas program file
  22. OPEN "10 Digit Permutations.DAT" FOR INPUT AS #2
  23.  
  24. PRINT #1, "1 n = n + 1: IF INSTR(" + CHR$(34);
  27.     i = i + 1
  28.     LINE INPUT #2, fline$
  29.     IF i > 362880 AND _TRIM$(fline$) <> "" THEN
  30.         PRINT fline$
  31.         'IF i < 362890 THEN   ' debugging tests
  32.         PRINT #1, " "; fline$;
  33.         'ELSE         ' debugging tests
  34.         'EXIT WHILE    ' debugging tests
  35.         'END IF           ' debugging tests
  36.     END IF
  39. PRINT #1, CHR$(34) + ", LEFT$(STR$(n * n) + _TRIM$(STR$(n ^ 3)) + SPC(9), 11)) THEN PRINT n, n ^ 2, n ^ 3 ELSE GOTO 1"
  41. PRINT "Bas program file ready."
  42.  

Attached is: 10 Digit Permutations.DAT file in case anyone else wants to take a shot at it. Might be handy for other things too.

Now you may well ask why the colon after saying no colons, well I didn't say no colons I said colons will count as extra lines, in this case this would be counted as a "2 Liner" but I just thought it would look cool to see only 1 line that says GOTO itself at the end of it. Oh well. In byte counts, colons count the same as CR + LF so there is that side of it too.

I think it's getting hung at INSTR with the extra-extra long literal string and would not be saved by actual 2 liner without colon.
Text Only | Text with Attachments