Transpose guitar chords

[Cody Fendant]

I had the task of transposing some guitar chords the other day. A very simple form of music notation along the lines of:

    C F G G7

needing to go up a semitone to

    C# F# G# G#7

And I thought "this will be easy to do with perl..."

This is the best I could come up with:

use strict;
use warnings;

my %notes_hash = (
    'A'  => 0,
    'A#' => 1,
    'B'  => 2,
    'C'  => 3,
    'C#' => 4,
    'D'  => 5,
    'D#' => 6,
    'E'  => 7,
    'F'  => 8,
    'F#' => 9,
    'G'  => 10,
    'G#' => 11
);

my @notes_array = ( sort( keys(%notes_hash) ) );

sub transpose {
    my ( $note,      $amount )    = @_;
    my ( $base_note, $modifiers ) = $note =~ m/^([ABCDEFG]#?)(.*)/;
    return 
    $notes_array[ ( ( $notes_hash{$base_note} + $amount ) % 12 ) ]
      . $modifiers;
}

print transpose( 'C#7', 1 );

But as you can see, it's not elegant. I'm curious how other Monks might approach this problem.

[Musical scales are modular, in case Monks don't know.]

[ELISHEVA]

Your code doesn't look inelegant to me. However, you've made a very significant simplifying assumption in your code sample, namely that each tone in the 12 tone scale has exactly one letter note value.

As you know, many notes in the 12 scale have in fact two letter representations (Bb=A#, E#=F, E=Fb, and so on). After you have transposed the note, converting it back into letter values (natural, sharp, flat) requires knowing not just the shift, but also the intended key signature. Otherwise you have no way of knowing if you need D# or Eb. Therefore the "amount" parameter is not enough to print out transposed chords. My own attempt taking into account key signatures might look something like this:

my %Tone =( A => 0, B => 2, C => 3, D => 5, E => 7, F => 8, G=>10);
my @Notes;
foreach my $natural ('A'..'G') {
  my $i = $Tone{$natural};
  my $iFlat = $i ? $i-1 : 11;

  $Tone{$natural.'#'} = $i+1;
  $Tone{$natural.'b'} = $iFlat;

  $Notes[$iFlat][0]=$natural.'b';
  $Notes[$i][0] = $natural;
  $Notes[$i][1] = $natural;
  $Notes[$i+1][1]=$natural.'#';
}

#print "Tone: ". Dumper(\%Tone);
#print "Notes: ". Dumper(\@Notes);


sub transpose {
  my ($key, $aChord, $toKey) = @_;
  my @aTransposed;
  my $iShift = $Tone{$toKey} - $Tone{$key};
  my $iIndex = ($toKey =~ /^F|.b$/) ? 0 : 1; # F uses flats

  push @aTransposed, $Notes[($Tone{$_}+$iShift) % 12][$iIndex]
    for @$aChord;
  return \@aTransposed;
}

# demo
local $"='-';
for ('A'..'G','Eb','Bb') {
  print "C-E-G => $_ : @{transpose('C',[qw(C E G)],$_)}\n";
}

# which outputs 
C-E-G => A : A-C#-E
C-E-G => B : B-D#-F#
C-E-G => C : C-E-G
C-E-G => D : D-F#-A
C-E-G => E : E-G#-B
C-E-G => F : F-A-C
C-E-G => G : G-B-D
C-E-G => Eb : Eb-G-Bb
C-E-G => Bb : Bb-D-F

Note: I only eyeballed the chords - I'm not super good with purely written chords and didn't check my work on the keyboard, so if you see a mistake I apologize in advance.

[Anonymous Monk]

This is only correct for major mode. Minor key signatures reverse the use of sharps and flats.

[ELISHEVA]

Good point. You are right that the code above is only for major keys.

Minor keys are a bit more complex though than "reverse the use of sharps and flats". For the minor scales, only D,G switch from flats to sharps. F and all flat keys (Ab,Bb, etc) uses flats in both major and minor modes. B,E and all sharp keys (A#,B#,etc) use sharps for both major and minor modes. A goes from sharps to all naturals, and C goes from all naturals to flats. See Key signature.

So here is the script revised to take into account minor keys as well as major keys (changes marked with <== ):

use strict;
use warnings;

my %Tone =( A => 0, B => 2, C => 3, D => 5, E => 7, F => 8, G=>10);
my @Notes;
foreach my $natural ('A'..'G') {
  my $i = $Tone{$natural};
  my $iFlat = $i ? $i-1 : 11;

  $Tone{$natural.'#'} = $i+1;
  $Tone{$natural.'b'} = $iFlat;

  $Notes[$iFlat][0]=$natural.'b';
  $Notes[$i][0] = $natural;
  $Notes[$i][1] = $natural;
  $Notes[$i+1][1]=$natural.'#';
}

#print "Tone: ". Dumper(\%Tone);
#print "Notes: ". Dumper(\@Notes);


sub transpose {
  my ($key, $aChord, $toKey) = @_;
  my @aTransposed;

  my $bMinor = $key =~ /m$/ ? 1 : 0;           # <==
  $key= $key =~ /^(.*)m$/ ? $1 : $key;         # <==
  $toKey= $toKey =~ /^(.*)m$/ ? $1 : $toKey;   # <==

  my $iShift = $Tone{$toKey} - $Tone{$key};

  my $iIndex = $bMinor                         # <==
    ? ($toKey =~ /^(?:C|D|F|G|.b)$/ ? 0 : 1) # minor key
    : ($toKey =~ /^(?:F|.b)$/ ? 0 : 1); # F uses flats in major

  push @aTransposed, $Notes[($Tone{$_}+$iShift) % 12][$iIndex]
    for @$aChord;
  return \@aTransposed;
}

# demo
local $"='-';
print "Major modes\n";
for ('A'..'G','Eb','Bb', 'D', 'E') {
  print "C-E-G => $_ : @{transpose('C',[qw(C E G)],$_)}\n";
}

print "Minor modes\n";
for ('A'..'G','Eb','Bb', 'D', 'E') {
  print "C-Eb-G => $_ : @{transpose('Cm',[qw(C Eb G)],qq{${_}m})}\n";
}

# outputs
Major modes
C-E-G => A : A-C#-E
C-E-G => B : B-D#-F#
C-E-G => C : C-E-G
C-E-G => D : D-F#-A
C-E-G => E : E-G#-B
C-E-G => F : F-A-C
C-E-G => G : G-B-D
C-E-G => Eb : Eb-G-Bb
C-E-G => Bb : Bb-D-F
C-E-G => D : D-F#-A
C-E-G => E : E-G#-B
Minor modes
C-Eb-G => A : A-C-E
C-Eb-G => B : B-D-F#
C-Eb-G => C : C-Eb-G
C-Eb-G => D : D-F-A
C-Eb-G => E : E-G-B
C-Eb-G => F : F-Ab-C
C-Eb-G => G : G-Bb-D
C-Eb-G => Eb : Eb-Gb-Bb
C-Eb-G => Bb : Bb-Db-F
C-Eb-G => D : D-F-A
C-Eb-G => E : E-G-B

And should anyone else see room for improvement, please post!

[ig]

There are various modules on CPAN that you might find helpful. Try searching for transpose (skip the modules dealing with matrices, etc.), guitar, chord or tab. Several of the modules have transpose functions.

[johngg]

Being about as musical as a brick, I can't comment about how you transpose the notes. I do think you'd be better off setting up the array first and then deriving the hash from it rather than the other way around; it saves you having to sort. The no warnings qw{ qw }; is to silence warnings where Perl thinks we are trying to put comments inside a qw{ ... } list.

knoppix@Microknoppix:~$ perl -Mstrict -MData::Dumper -wE '
> my @notesArr  = do {
>    no warnings qw{ qw };
>    qw{ A A# B C C# D D# E F F# G G# };
>    };
> my $value     = 0;
> my %notesHash = map { $_ => $value ++ } @notesArr;
> print Data::Dumper->Dumpxs(
>    [ \ @notesArr, \ %notesHash ],
>    [ qw{ *notesArr *notesHash } ]
>    );'
@notesArr = (
              'A',
              'A#',
              'B',
              'C',
              'C#',
              'D',
              'D#',
              'E',
              'F',
              'F#',
              'G',
              'G#'
            );
%notesHash = (
               'F' => 8,
               'A' => 0,
               'A#' => 1,
               'C#' => 4,
               'E' => 7,
               'B' => 2,
               'D#' => 6,
               'C' => 3,
               'D' => 5,
               'G#' => 11,
               'F#' => 9,
               'G' => 10
             );
knoppix@Microknoppix:~$

I hope this is of interest.