pharo-users@lists.pharo.org

Any question about pharo is welcome

View all threads

how can I improve this

RW
Roelof Wobben
Mon, Sep 14, 2020 7:15 PM

Hello,

I have solved the hamming challenge of exercism where I have to find in
how many places two strings are different.

my solution is :

distanceStrand1: aString strand2: aString2
    aString size == aString2 size
        ifFalse: [ DomainError signal: (self messageFor: aString
strand2: aString2) ].
    ^ (1 to: aString size)
        sumNumbers: [ :index |
            (aString at: index) == (aString2 at: index)
                ifTrue: [ 0 ]
                ifFalse: [ 1 ] ]

messageFor: aString strand2: aString2
    aString notEmpty & aString2 notEmpty
        ifTrue: [ ^ 'left and right strands must be of equal length' ].
    aString ifEmpty: [ ^ 'left strand must not be empty' ].
    ^ 'right strand must not be empty'

Can this be improved?

Roelof

Hello, I have solved the hamming challenge of exercism where I have to find in how many places two strings are different. my solution is : distanceStrand1: aString strand2: aString2     aString size == aString2 size         ifFalse: [ DomainError signal: (self messageFor: aString strand2: aString2) ].     ^ (1 to: aString size)         sumNumbers: [ :index |             (aString at: index) == (aString2 at: index)                 ifTrue: [ 0 ]                 ifFalse: [ 1 ] ] messageFor: aString strand2: aString2     aString notEmpty & aString2 notEmpty         ifTrue: [ ^ 'left and right strands must be of equal length' ].     aString ifEmpty: [ ^ 'left strand must not be empty' ].     ^ 'right strand must not be empty' Can this be improved? Roelof
HM
Hernán Morales Durand
Mon, Sep 14, 2020 8:19 PM

Hi Roelof,

Maybe something like this:

String>>hammingDistanceTo: aString
" Answer the amount of substitutions between the receiver and
aString. Both must be of equal length "

^ (1 to: self size) count: [ : i | (self at: i) ~= (aString at: i) ]

El lun., 14 sept. 2020 a las 16:15, Roelof Wobben via Pharo-users (<
pharo-users@lists.pharo.org>) escribió:

Hello,

I have solved the hamming challenge of exercism where I have to find in
how many places two strings are different.

my solution is :

distanceStrand1: aString strand2: aString2
aString size == aString2 size
ifFalse: [ DomainError signal: (self messageFor: aString
strand2: aString2) ].
^ (1 to: aString size)
sumNumbers: [ :index |
(aString at: index) == (aString2 at: index)
ifTrue: [ 0 ]
ifFalse: [ 1 ] ]

messageFor: aString strand2: aString2
aString notEmpty & aString2 notEmpty
ifTrue: [ ^ 'left and right strands must be of equal length' ].
aString ifEmpty: [ ^ 'left strand must not be empty' ].
^ 'right strand must not be empty'

Can this be improved?

Roelof

Hi Roelof, Maybe something like this: String>>hammingDistanceTo: aString " Answer the amount of substitutions between the receiver and aString. Both must be of equal length " ^ (1 to: self size) count: [ : i | (self at: i) ~= (aString at: i) ] El lun., 14 sept. 2020 a las 16:15, Roelof Wobben via Pharo-users (< pharo-users@lists.pharo.org>) escribió: > Hello, > > I have solved the hamming challenge of exercism where I have to find in > how many places two strings are different. > > my solution is : > > distanceStrand1: aString strand2: aString2 > aString size == aString2 size > ifFalse: [ DomainError signal: (self messageFor: aString > strand2: aString2) ]. > ^ (1 to: aString size) > sumNumbers: [ :index | > (aString at: index) == (aString2 at: index) > ifTrue: [ 0 ] > ifFalse: [ 1 ] ] > > > messageFor: aString strand2: aString2 > aString notEmpty & aString2 notEmpty > ifTrue: [ ^ 'left and right strands must be of equal length' ]. > aString ifEmpty: [ ^ 'left strand must not be empty' ]. > ^ 'right strand must not be empty' > > > Can this be improved? > > Roelof >
RW
Roelof Wobben
Mon, Sep 14, 2020 8:22 PM

Nice one but I learned I can never trust the input of a user
but I think I can use that code instead of my big code.

I will try it tomorrow after some good sleep.

Roelof

Op 14-9-2020 om 22:19 schreef Hernán Morales Durand:

Hi Roelof,

Maybe something like this:

String>>hammingDistanceTo: aString
	" Answer the amount of substitutions between the receiver and aString. Both must be of equal length "

	^ (1 to: self size) count: [ : i | (self at: i) ~= (aString at: i) ]

El lun., 14 sept. 2020 a las 16:15, Roelof Wobben via Pharo-users (<pharo-users@lists.pharo.org>) escribió:

Hello,

I have solved the hamming challenge of exercism where I have to find in
how many places two strings are different.

my solution is :

distanceStrand1: aString strand2: aString2
aString size == aString2 size
ifFalse: [ DomainError signal: (self messageFor: aString
strand2: aString2) ].
^ (1 to: aString size)
sumNumbers: [ :index |
(aString at: index) == (aString2 at: index)
ifTrue: [ 0 ]
ifFalse: [ 1 ] ]

messageFor: aString strand2: aString2
aString notEmpty & aString2 notEmpty
ifTrue: [ ^ 'left and right strands must be of equal length' ].
aString ifEmpty: [ ^ 'left strand must not be empty' ].
^ 'right strand must not be empty'

Can this be improved?

Roelof

RW
Roelof Wobben
Tue, Sep 15, 2020 4:59 AM

Op 14-9-2020 om 22:19 schreef Hernán Morales Durand:

^ (1 to: self size) count: [ : i | (self at: i) ~= (aString at: i) ]

With that code I get a few problems but this is working

distanceStrand1: aString strand2: aString2
aString size == aString2 size
ifFalse: [ DomainError signal: (self messageFor: aString strand2: aString2) ].
^ (1 to: aString size)
count: [ :i | (aString2 at: i) ~= (aString at: i) ]

Roelof

RO
Richard O'Keefe
Tue, Sep 15, 2020 1:23 PM

SequenceableCollection has with:do:.
Add
with: other count: testBlock
|r|
r := 0.
self with: other do: [:x :y |
(testBlock value: x value: y) ifTrue: [r := r + 1]].
^r

I have this in my library anyway.  Now

distanceStrand1: a strand2: b
^a with: b count: [:x :y | x ~= y]

#with:do: already checks that the sequences have the same size;
it's too confusing if the error reported in this case is different
from the error for #with:do:.

On Tue, 15 Sep 2020 at 16:59, Roelof Wobben via Pharo-users <
pharo-users@lists.pharo.org> wrote:

Op 14-9-2020 om 22:19 schreef Hernán Morales Durand:

^ (1 to: self size) count: [ : i | (self at: i) ~= (aString at: i) ]

With that code I get a few problems but this is working

distanceStrand1: aString strand2: aString2
aString size == aString2 size
ifFalse: [ DomainError signal: (self messageFor: aString strand2:
aString2) ].
^ (1 to: aString size)
count: [ :i | (aString2 at: i) ~= (aString at: i) ]

Roelof

SequenceableCollection has with:do:. Add with: other count: testBlock |r| r := 0. self with: other do: [:x :y | (testBlock value: x value: y) ifTrue: [r := r + 1]]. ^r I have this in my library anyway. Now distanceStrand1: a strand2: b ^a with: b count: [:x :y | x ~= y] #with:do: already checks that the sequences have the same size; it's too confusing if the error reported in this case is different from the error for #with:do:. On Tue, 15 Sep 2020 at 16:59, Roelof Wobben via Pharo-users < pharo-users@lists.pharo.org> wrote: > Op 14-9-2020 om 22:19 schreef Hernán Morales Durand: > > ^ (1 to: self size) count: [ : i | (self at: i) ~= (aString at: i) ] > > > > With that code I get a few problems but this is working > > distanceStrand1: aString strand2: aString2 > aString size == aString2 size > ifFalse: [ DomainError signal: (self messageFor: aString strand2: > aString2) ]. > ^ (1 to: aString size) > count: [ :i | (aString2 at: i) ~= (aString at: i) ] > > Roelof > > >
RW
Roelof Wobben
Tue, Sep 15, 2020 1:42 PM

Oke,

I can try this but im afraid the test which test a particular error il fail.
The error messages are given.

And I miss you. yes, SequenceableCollection has with do:
but should I add the with count to it ?

Roelof

Op 15-9-2020 om 15:23 schreef Richard O'Keefe:

SequenceableCollection has with:do:.

Add

with: other count: testBlock

|r|

r := 0.

self with: other do: [:x :y |

(testBlock value: x value: y) ifTrue: [r := r + 1]].

^r

I have this in my library anyway. Now

distanceStrand1: a strand2: b

^a with: b count: [:x :y | x ~= y]

#with:do: already checks that the sequences have the same size;

it's too confusing if the error reported in this case is different

from the error for #with:do:.

On Tue, 15 Sep 2020 at 16:59, Roelof Wobben via Pharo-users <pharo-users@lists.pharo.org> wrote:

Op 14-9-2020 om 22:19 schreef Hernán Morales Durand:

^ (1 to: self size) count: [ : i | (self at: i) ~= (aString at: i) ]

With that code I get a few problems but this is working

distanceStrand1: aString strand2: aString2
aString size == aString2 size
ifFalse: [ DomainError signal: (self messageFor: aString strand2: aString2) ].
^ (1 to: aString size)
count: [ :i | (aString2 at: i) ~= (aString at: i) ]

Roelof

RW
Roelof Wobben
Tue, Sep 15, 2020 1:51 PM

Op 15-9-2020 om 15:42 schreef Roelof Wobben via Pharo-users:

with: other count: testBlock

|r|

r := 0.

self with: other do: [:x :y |

(testBlock value: x value: y) ifTrue: [r := r + 1]].

^r

nope, all the test on a error are yellow and this two test on counting are yellow.

test03_SingleLetterDifferentStrands
| result |
result := hammingCalculator distanceStrand1: 'G' strand2: 'T'.
self assert: result equals:

gives 0 instead of 9.

and this one fails :

test05_LongDifferentStrands
| result |
result := hammingCalculator
distanceStrand1: 'GGACGGATTCTG'
strand2: 'AGGACGGATTCT'.
self assert: result equals: 9

also this one gives 0 instead of 9.