🅱️ode 🅱️ritique
In this thread: post code that you would like other users to "improve."
Example: User A submits good binary search algorithm
User B "improves" it by replacing variable names with animals, and for some reason it doesn't halt on some inputs.
Generally this is about the opposite of positive style critique, so the program should still work correctly, but clever underhandedness is okay too.
You do not have to improve a submission before submitting code for review, but it's nice for organization.
This is 🅱️ode 🅱️ritique, so the most clever answer wins.
Unsigned 8-bit no-input BF interpreter (byte output instead of char) (@yBASIC ruleset*)
hi,, i just downloaded smilebasic. it is not a very concise language. is there anything I can do to make my code smaller?
___$="[<>+-[].]*" +"$" ___ =. __$ ="........" __% =. __ =(!.<<!.+!.+!.) _ =. ____=. @_ _=__$[__%]=="_"__%=__%+!. _=(_<<!.)+(__$[__%]=="_")__%=__%+!. _=(_<<!.)+(__$[__%]=="_")__%=__%+!. _=(_<<!.)+(__$[__%]=="_")__%=__%+!. _=(_<<!.)+(__$[__%]=="_")__%=__%+!. _=(_<<!.)+(__$[__%]=="_")__%=__%+!. _=(_<<!.)+(__$[__%]=="_")__%=__%+!. _=(_<<!.)+(__$[__%]=="_")__%=__%+!. __%=__%-(!.+!.<<!.+!.) _$=___$[___] GOTO"@________"+"_"*((_$==">")+(_$=="<")*(!.+!.)+(_$=="[")*(!.+!.+!.)+(_$=="]")*(!.+!.+!.+!.)+(_$=="+")*(!.+!.+!.+!.+!.)+(_$=="-")*(!.+!.+!.<<!.)+(_$==".")*(!.+!.+!.+!.+!.+!.+!.)) @________ __$[__%]="._"[(_<<(!.+!.+!.<<!.+!.+!.))<.]__%=__%+!. __$[__%]="._"[(_<<(!.+(!.+!.+!.<<!.+!.+!.)))<.]__%=__%+!. __$[__%]="._"[(_<<((!.<<!.)+(!.+!.+!.<<!.+!.+!.)))<.]__%=__%+!. __$[__%]="._"[(_<<(!.+!.+!.+(!.+!.+!.<<!.+!.+!.)))<.]__%=__%+!. __$[__%]="._"[(_<<(!.+!.+!.+!.+!.+!.+!.<<!.+!.))<.]__%=__%+!. __$[__%]="._"[(_<<(!.+(!.+!.+!.+!.+!.+!.+!.<<!.+!.)))<.]__%=__%+!. __$[__%]="._"[(_<<((!.<<!.+!.+!.+!.)-!.<<!.))<.]__%=__%+!. __$[__%]="._"[(_<<((!.<<!.+!.+!.+!.+!.)-!.))<.] __%=__%-!.-!.-!.-!.-!.-!.-!. @________________________________ ___=___+!. GOTO"@_"+"_"*(___$[___]=="$") @_________ __%=__%+(!.+!.<<!.+!.) __$=__$+"........"*(__%==__) __=__+(!.+!.<<!.+!.)*(__%==__) GOTO@________________________________ @__________ __%=__%-(!.+!.<<!.+!.) __$="........"*(__%<.)+__$ __=__+(!.+!.<<!.+!.)*(__%<.) __%=__%+(!.+!.<<!.+!.)*(__%<.) GOTO@________________________________ @___________ ____=!. GOTO"@____"+"_"*!!_ @____ ___=___+!. ____=____+(___$[___]=="[") ____=____-(___$[___]=="]") GOTO"@____"+"_"*!____ @_____ GOTO@________________________________ @____________ ____=. @______ ____=____+(___$[___]=="]") ____=____-(___$[___]=="[") ___=___-!. GOTO"@______"+"_"*!____ @_______ GOTO@________________________________ @_____________ _=_+!. GOTO@________ @______________ _=_-!. GOTO@________ @_______________ ?_ GOTO@________________________________ @__?annotated * @yBASIC is a Turing-complete SmileBASIC subset that only allows alphanumeric characters to be used for the goto instruction, any other occurrence of [A-Za-z0-9] or non-ASCII characters is illegal
Hold My Beer Kind PersonPRINT "Hello, World!"This program does not use enough modern programming techniques please improve it
UnnecessarilyLongFunctionName "H","e","l","l","o"," ","W","o","r","l","d","!" DEF UnnecessarilyLongFunctionName OptionalLetter1, OptionalLetter2, OptionalLetter3, OptionalLetter4, OptionalLetter5, EffMyLife, OptionalLetter6, OptionalLetter7, OptionalLetter8, OptionalLetter9, OptionalLetter10, EffMyLifeTheSequel WAIT 5 'suspense LOCATE 0,10 'originality PRINT OptionalLetter1; OptionalLetter2; OptionalLetter3; OptionalLetter4; OptionalLetter5; ","; EffMyLife; OptionalLetter6; OptionalLetter7; OptionalLetter8; OptionalLetter9; OptionalLetter10; EffMyLifeTheSequel 'Grand Finale END 'Emotional EndingEDIT Jr. :yeah that’s how it’s supposed to go
PRlNT "H-hewwo, world! owo" DEF PRlNT S$ VAR O IF MILLISEC>O THEN REPEAT WAIT O+1 'build up speed until MILLISEC overflows UNTIL MILLISEC<O ENDIF FOR I=O TO LEN(S$)-1 IF S$[I]=="o" THEN 'optimize for perfect filled circle creation WIDTH OUT O GCIRCLE CSRX*O+O/2,CSRY*O+O/2,O,8 GFILL CSRX*O+O/2,CSRY*O+O/2,RGB(zero,nothing,zilch,8),8 GCIRCLE CSRX*O+O/2,CSRY*O+O/2,O,RGB(255,255,247) ?""+" "; ELSE ?S$[I]; ENDIF NEXT ? IF.<MILLISEC THEN ACLS:PRlNT S$ 'sneaky check ENDedit 1: did some testing and actually this is about 1000x faster than PRINT edit 2: oops sorry only when MILLISEC is negative edit oatmeal: more optimizations
I gave modernizing it a shot. Unfortunately, I couldn't make SmileBASIC communicate with a Ruby on Rails PHP++.js WebApp to queue a cloud job on an IoT refrigerator and write to a mySQL database. also, please donate to my gofundme so I can afford my senior year of undergrad in compsci :^) edit: fixed highlighting with new modePRINT "Hello, World!"This program does not use enough modern programming techniques please improve it
OPTION STRICT
ACLS
FORBID_PIRACY
'some constants
DIM MAX_INT = &h7FFFFFFF
DIM E = 2.7182818284
DIM AGEOFEARTH = 4.54e9
DIM EARTHGRAVITY = 9.80665
DIM AVOGADRO = 6.02214e23
DIM HAIRCOLOR = #GREEN
DIM FEIGENBAUM = 4.6692016091
'enum CASE
DIM CASE_UPPERCASE$ = "UPPER"
DIM CASE_LOWERCASE$ = "LOWER"
DIM CASE_TITLECASE$ = "TITLE"
'enum MOOD
DIM MOOD_EXCITED$ = "!"
DIM MOOD_SERIOUS$ = "."
DIM MOOD_PLAYFUL$ = "~"
DIM MOOD_HESITANT$ = "..."
DIM MOOD_DOUBTFUL$ = "?"
DIM ERRORS$[0]
COMMON DEF Main
VAR world$, hello_world_string$
New "World",(params(CASE_TITLECASE$+","+MOOD_EXCITED$)) OUT world$
IF Any(ERRORS$) == "Yes" THEN
throw "Something went wrong!!"
ENDIF
Helloify ToString(world$) OUT hello_world_string$
IF Any(ERRORS$) == "Yes" THEN
throw "Something went wrong!!"
ENDIF
PRINT hello_world_string$
die
END
'Helloify string_to_helloify$:
'Helloifies a string by making it more
'hello-y. Please do not give it empty
'strings because it does not like that!
'Parameters:
' string_to_helloify$ : string to make
' more hello-y
DEF Helloify string_to_helloify$ OUT helloified_string$
IF len(string_to_helloify$) < 1 THEN
PUSH ERRORS$, "i don't like your input :("
ENDIF
helloified_string$ = "Hello, " + string_to_helloify$
END
DEF ToString(s$)
return s$
END
'World:
'Parameters:
' worldparams$[
' enum CASE : the casing of the world
' text
' enum MOOD : the mood of the world
' text
' ]
DEF World_Factory worldparams$[] OUT world$
DIM CASE = 0
DIM MOOD = 1
VAR base_world$ = "wOrLd"
IF worldparams$[CASE] == CASE_UPPERCASE$ THEN
world$ = ToUpper$(base_world$)
ELSEIF worldparams$[CASE] == CASE_LOWERCASE$ THEN
world$ = ToLower$(base_world$)
ELSEIF worldparams$[CASE] == CASE_TITLECASE$ THEN
world$ = ToTitleCase$(base_world$)
ELSE
PUSH ERRORS$, "bad case argument"
ENDIF
world$ = world$ + worldparams$[MOOD]
END
'String:
'Parameters:
' stringparams$[
' str VALUE : the string contents
' ]
DEF String_Factory stringparams$[] OUT string$
DIM VALUE = 0
string$ = stringparams$[VALUE]
END
DEF New type$, params%[] OUT object$
CALL type$+"_Factory", params% OUT object$
END
'Any(array$[]):
'Determine if there are Any(tm) elements
'in array$
DEF Any(array$[])
IF LEN(array$) THEN RETURN "Yes" ELSE RETURN "No"
END
'ToUpper$(string$):
'Convert lowercase latin letters to their
'uppercase equivalents
'Parameters:
' string$ : string to convert
DEF ToUpper$(string$)
VAR S$, I
New "String",(params(string$)) OUT S$
IF Any(ERRORS$) == "Yes" THEN
throw "Something went wrong!!"
ENDIF
FOR I=0 TO LEN(S$)-1
VAR N=ASC(S$[I])
IF N>=97 && N<=122 THEN S$[I]=CHR$(N-32)
NEXT
RETURN S$
END
'ToLower$(string$):
'Convert uppercase latin letters to their
'lowercase equivalents
'Parameters:
' string$ : string to convert
DEF ToLower$(string$)
VAR S$, I
New "String",(params(string$)) OUT S$
IF Any(ERRORS$) == "Yes" THEN
throw "Something went wrong!!"
ENDIF
FOR I=0 TO LEN(S$)-1
VAR N=ASC(S$[I])
IF N>=65 && N<=90 THEN S$[I]=CHR$(N+32)
NEXT
RETURN S$
END
'ToTitleCase$(string$):
'Upcase latin letters at the start of words
'Parameters:
' string$ : string to convert
DEF ToTitleCase$(string$)
VAR S$, I, W
New "String",(params(string$)) OUT S$
IF Any(ERRORS$) == "Yes" THEN
throw "Something went wrong!!"
ENDIF
FOR I=0 TO LEN(S$)-1
VAR N=ASC(S$[I])
IF N>=97 && N<=122 && (I-1<0 || ASC(S$[I-1])==32) THEN
S$[I]=CHR$(N-32)
ELSEIF N>=65 && N<=90 THEN
S$[I]=CHR$(N+32)
ENDIF
NEXT
RETURN S$
END
'TODO: implement using counting sort?
DEF throw message$
COLOR #TRED
PRINT message$
COLOR #TWHITE
DIE
END
DEF die
STOP
END
'params(paramstring$):
'Convert a comma-delimited String of parameters
'to an array of parameters for use in Object
'initialization
'Arguments:
' paramstring$ : a comma-delimited list of
' arguments to parameterify
DEF params(paramstring$)
VAR my_param_string$ =paramstring$* !.
DIM temporary_param_list_variable$[0]
VAR temporary_param_variable$
VAR delimiter_index = INSTR(my_param_string$,",")
WHILE delimiter_index > -1
temporary_param_variable$ = LEFT$(my_param_string$,delimiter_index)
PUSH temporary_param_list_variable$,temporary_param_variable$
my_param_string$ = MID$(my_param_string$,delimiter_index+1,MAX_INT)
delimiter_index = INSTR(my_param_string$,",")
WEND
PUSH temporary_param_list_variable$,my_param_string$
RETURN temporary_param_list_variable$
END
DEF FORBID_PIRACY IF!VERSION THEN CONTROLLER.
END
MainThe constant death march toward modernization is a dangerous effort to optimize the future at the cost of our past. I propose a countermethod, instead adopting the styles of assembly; you can see there is a kind of beautiful clarity in the bones of the machine, in full view as the onion skins are pullled away.
@_ENTRY
MOV SP$,@HELLO
GOSUB @PUTSTR
PUTCHR 10 'LINE ENDING
END
@PUTSTR
POPB A
IF EQU(A,0) THEN RETURN
PUTCHR A
GOTO @PUTSTR
@HELLO DATA "Hello, world!",0
DEF MOV _,L
RESTORE L
READ SP$
SP$=SP$+CHR$(0)
END
DEF POPB _
A=ASC(SHIFT(SP$))
END
DEF EQU(A,B)
RETURN A==B
END
DEF PUTCHR V
PRINT CHR$(V);
ENDI wonder if I can post an entire game here...
Could you please make your ToUpper$, ToLower$, and ToTitleCase$ functions work with non-ascii letters?I gave modernizing it a shot. Unfortunately, I couldn't make SmileBASIC communicate with a Ruby on Rails PHP++.js WebApp to queue a cloud job on an IoT refrigerator and write to a mySQL database. also, please donate to my gofundme so I can afford my senior year of undergrad in compsci :^)PRINT "Hello, World!"This program does not use enough modern programming techniques please improve it...
Could you please make your ToUpper$, ToLower$, and ToTitleCase$ functions work with non-ascii letters?sure
def ToUpper$(string$)
'optimization for 1-length strings :)
if(len(string$) == 1) then
return chr$(abs(asc(string$[.]) - 32))
endif
var safe_string$, stringbuilder$, index%
'clone string$ to prevent race conditions
New "String",(params(string$)) OUT safe_string$
'allocate an empty string for returning
New "String",(params("")) OUT stringbuilder$
while safe_string$>""
Inc stringbuilder$, ToUpper$(pop(safe_string$))
wend
return stringbuilder$
end
others
def ToLower$(string$)
'optimization for 1-length strings :)
if(len(string$) == 1) then
return chr$(abs(asc(string$[.]) + 32))
endif
var safe_string$
var stringbuilder$
'clone string$ to prevent race conditions
New "String",(params(string$)) OUT safe_string$
'allocate an empty string for returning
New "String",(params("")) OUT stringbuilder$
while safe_string$>""
Inc stringbuilder$, ToLower$(pop(safe_string$))
wend
return stringbuilder$
end
def ToTitleCase$(string$)
var safe_string$,
var stringbuilder$
var last_char$ = " "
'clone string$ to prevent race conditions
New "String",(params(string$)) OUT safe_string$
'allocate an empty string for returning
New "String",(params("")) OUT stringbuilder$
while safe_string$>""
if(last_char$ == " ") then
Inc stringbuilder$, ToUpper$(pop(safe_string$))
else
Inc stringbuilder$, ToLower$(pop(safe_string$))
endif
last_char$ = stringbuilder$[len(stringbuilder$ - 1)]
wend
return stringbuilder$
endexplanation: indiscriminately shifts characters up/down 32 codepoints. Even better on characters less than 32, which will reflect back up due to abs()... i.e. chr$(0) becomes space, as does chr$(64) "@"
ToTitleCase$() doesn't even pay attention to spaces in the source string, but should upcase words in the new string
also, why are we allocating two new strings just to change the case?
fake bonus recursive call.
Here is my Fibonacci algorithm which runs in O(1) time:
INPUT N 'Calculate PHI by dividing large adjacent Fibonacci numbers: VAR A=1,B=0 VAR I FOR I=1 TO 900 'Generate first 900 Fibonacci numbers INC A,B SWAP A,B NEXT VAR PHI=B/A 'Get Nth number in the Fibonacci sequence in 1 step: PRINT ROUND(POW(PHI,N)/SQR(5))
Also you should use RGBREAD instead of GOTO