Visualize a string/sequence, emphasizing certain substrings

Question

I need to visualize a sequence, with the ability to emphasize certain segments.

For example, take this sequence seq:

seq = "-----------------DTLCIGYHANNSTDTVDTVLEKNVTVTHSVNLLEDKHNGKLCK
LRGVAPLHLGKCNIAGWILGNPECESLSTASSWSYIVETPSSDNGTCYPGDFIDYEELREQLSSVSSFER
FEIFPKTSSWPNHDSNKGVTAACPHAGAKSFYKNLIWLVKKGNSYPKLSKSYINDKGKEVLVLWGIHHPS
TSADQQSLYQNADTYVFVGSSRYSKKFKPEIAIRPKVRDQEGRMNYYWTLVEPGDKITFEATGNLVVPRY
AFAMERNAGSGIIISDTPVHDCNTTCQTPKGAINTSLPFQNIHPITIGKCPKYVKSTKLRLATGLRNIPS
G----LFGAIAGFIEGGWTGMVDGWYGYHHQNEQGSGYAADLKSTQNAIDEITNKVNSVIEKMNTQFTAV
GKEFNHLEKRIENLNKKVDDGFLDIWTYNAELLVLLENERTLDYHDSNVKNLYEKVRSQLKNNAKEIGNG
CFEFYHKCDNTCMESVKNGTYDYPKYSEEAKLNREEIDS-------------------------------
--------------------------------------------------------------------"

The list of segments I want to emphasize:

segments = {"AGSGIIISDTPVHDC", "AIDEITNKVNSVIEK", "AKSFYKNLIWLVKKG"}

I'm thinking that something that looks like this would work for the emphasis, where the black line is the length of the sequence, and the blue boxes are the segments:

To get start and ending positions of each segment, we can use StringPosition[seq, #] & /@ segments.

Now I'm not sure which visualization tool would help me visualize this sequence and emphasize the segment using these start and end positions.

Answer 1

Graphics[{Gray, EdgeForm[Gray], FaceForm[LightBlue], 
   SequenceReplace[Flatten[Join[{1}, {#[[1]] - 1, 
     Rectangle[{#[[1]], -5}, {#[[2]], 5}], #[[2]] + 1} & /@ 
   StringPosition[seq, Alternatives @@ segments], {StringLength @ seq}]],
 {a_Integer, b_Integer} :> Line[{{a, 0}, {b, 0}}]]}, ImageSize -> 800]

Also

Graphics[{EdgeForm[Gray], FaceForm[LightBlue], 
  Rectangle[{#[[1]], -5}, {#[[2]], 5}]& /@ StringPosition[seq, Alternatives @@ segments]},
  Axes -> {True, False}, Ticks -> None, 
  PlotRange -> {{0, StringLength @ seq}, Automatic}, ImageSize -> 800, 
  Method -> {"AxesInFront" -> False}]

Alternatively, use NumberLinePlot:

NumberLinePlot[Interval/@StringPosition[seq,  Alternatives @@ segments], 
 Spacings -> 0, Ticks -> None, ImageSize -> 600, 
 PlotStyle -> Directive[Opacity[1], PointSize[0], CapForm["Butt"], Thickness[.02]], 
 PlotRange->{{0, StringLength @ seq}, Automatic}]

Answer 2

seq must be a string

Graphics[{Blue, Line[{{0, 15}, {StringLength@seq, 15}}], 
Rectangle[{#, 0}, {#2, 30}] & @@@ StringPosition[seq, segments]}]   

Answer 3

Using Interval functionality:

seq = "-----------------DTLCIGYHANNSTDTVDTVLEKNVTVTHSVNLLEDKHNGKLCK
LRGVAPLHLGKCNIAGWILGNPECESLSTASSWSYIVETPSSDNGTCYPGDFIDYEELREQLSSVSSFER
FEIFPKTSSWPNHDSNKGVTAACPHAGAKSFYKNLIWLVKKGNSYPKLSKSYINDKGKEVLVLWGIHHPS
TSADQQSLYQNADTYVFVGSSRYSKKFKPEIAIRPKVRDQEGRMNYYWTLVEPGDKITFEATGNLVVPRY
AFAMERNAGSGIIISDTPVHDCNTTCQTPKGAINTSLPFQNIHPITIGKCPKYVKSTKLRLATGLRNIPS
G----LFGAIAGFIEGGWTGMVDGWYGYHHQNEQGSGYAADLKSTQNAIDEITNKVNSVIEKMNTQFTAV
GKEFNHLEKRIENLNKKVDDGFLDIWTYNAELLVLLENERTLDYHDSNVKNLYEKVRSQLKNNAKEIGNG
CFEFYHKCDNTCMESVKNGTYDYPKYSEEAKLNREEIDS-------------------------------
--------------------------------------------------------------------";

segments = {"AGSGIIISDTPVHDC", "AIDEITNKVNSVIEK", "AKSFYKNLIWLVKKG"};

pos = StringPosition[seq, segments];
iv = Interval @@ pos
arr = Array[Boole@IntervalMemberQ[iv, #] &, {StringLength@seq}];
width = 30;

ArrayPlot[ConstantArray[arr, width], 
 ColorRules -> {1 -> Red, 0 -> Yellow}, Frame -> False, 
 Mesh -> {Range[width/2, width/2], None}, MeshStyle -> Black, 
 Axes -> {True, False}]]