Rosetta Code: Determine if a string has all the same charact

[David Drake]

I created the code below for the surprisingly complex task "Determine if a string has all the same characters (found here: rosettacode.org/wiki/Determine_if_a_string_has_all_the_same_characters).  The task reads:


Given a character string (which may be empty, or have a length of zero characters):

- create a function/procedure/routine to:

- determine if all the characters in the string are the same
- indicate if or which character is different from the previous character
- display each string and its length (as the strings are being examined)
- a zero─length (empty) string shall be considered as all the same character(s)
- process the strings from left─to─right
- if all the same character, display a message saying such
- if not all the same character, then:
- display a message saying such
- display what character is different
- only the 1st different character need be displayed
- display where the different character is in the string
- the above messages can be part of a single message
- display the hexadecimal value of the different character

Use (at least) these seven test values (strings):

- a string of length 0 (an empty string)
- a string of length 3 which contains three blanks
- a string of length 1 which contains: 2
- a string of length 3 which contains: 333
- a string of length 3 which contains: .55
- a string of length 6 which contains: tttTTT
- a string of length 9 with a blank in the middle: 4444 444k

Show all output here on this page.



dim st$(7), message$(7,4)
q$=chr$(34)
st$(1)=""
st$(2)="   "
st$(3)="2"
st$(4)="333"
st$(5)=".55"
st$(6)="tttTTT"
st$(7)="4444 444k"

for a = 1 to 7
   test$=st$(a)
   if len(test$)=0 then message$(a,1)="All the same characters (empty string).":goto [skip]
   if len(test$)=1 then message$(a,1)="All the same characters (string of 1 character).":goto [skip]
   lastChar$=left$(test$,1)
   for b = 2 to len(test$)
       nextChar$=mid$(test$,b,1)
       if nextChar$<>lastChar$ then
           message$(a,1)="Not all the same characters. "
           message$(a,2)="Character number "+str$(b)+", "+q$+nextChar$+q$+", is not the same as character number "+str$(b-1)+", "+q$+lastChar$+q$+"."
           message$(a,3)="HexDec value of "+q$+nextChar$+q$+" is "+dechex$(asc(nextChar$))+"."
           exit for
       end if
   next b

   if message$(a,1)="" then message$(a,1)="All the same characters."

[skip]
next a

for a = 1 to 7
   print "For this string: ";q$;st$(a);q$;" of length ";len(st$(a));"..."
   for b = 1 to 3
       print message$(a,b)
   next b
   print "----------------------"
next a
end


I suspect there is a better way to do this.  Comments and suggestions are welcome.

[tsh73]

as a variant
st$(1)=""
st$(2)="   "
st$(3)="2"
st$(4)="333"
st$(5)=".55"
st$(6)="tttTTT"
st$(7)="4444 444k"

q$="'"

print "string", "length", "all same", "1st diff", "hex", "position"
print "-------------------------------------------------------------------------------"
for a = 1 to 7
   s$= st$(a)
   p = posDiff(s$)
   print q$;s$;q$, len(s$),
   if p >0 then
       c$=mid$(s$,p,1)
       print "no", q$;c$;q$, dechex$(asc(c$)), p
   else
       print "yes"
   end if
next a

end

function posDiff(a$)    'returns position of first differing character in a string
   for i = 1 to len(a$)-1
       if mid$(a$,i,1)<>mid$(a$,i+1,1) then posDiff = i+1: exit function
   next
end function