stripLineInfographics[ dataInitial_, OptionsPattern[ { "Ordering"->True, "Reverse"->False, "Gaps"->{50,50}, "ColorFunctionLeft"->ColorData["Rainbow"], "ColorFunctionRight"-> Function[Blend[ColorData[3,"ColorList"],#]], "ImageSize"->1500, "Background"->GrayLevel[0.95] } ] ]:= Module[ { circle, zeroElement, countSegmentPartition, ordering, data, totalsForRows, rowsMainSegments, rowsColsSegments, totalForCols, colsMainSegments, colsRowsSegments, segmentMaker, $colorizationMax, rightLabels, leftLabels, preData, dataOriginal }, If[ Head[dataInitial]===Association, {rightLabels,leftLabels,preData}= Transpose[ KeyValueMap[ {#1,#2[[;;,1]],#2[[;;,2]]}&,dataInitial ] ]; leftLabels=Flatten@leftLabels; dataOriginal= Module[{n=Length[Flatten[preData]],k=Length[preData],acc}, acc={0}~Join~Accumulate[Length/@preData]; Transpose@ Table[ ConstantArray[0,{acc[[i]]}] ~ Join ~ preData[[i]] ~ Join ~ ConstantArray[0,{n-acc[[i+1]]}], {i,1,k} ] ] ]; If[ OptionValue["Reverse"], {rightLabels,leftLabels}={leftLabels,rightLabels}; dataOriginal=Transpose[dataOriginal], (* else *) Nothing ]; circle[pos_,radius_,{min_,max_},numberOfCirclePartition_:50]:= If[ min==max, zeroElement[ pos+radius{Cos[min],Sin[min]}+0{Cos[min],Sin[min]} ], (* else *) Table[ pos + radius{Cos[a],Sin[a]} + 0{Cos[(min+max)/2],Sin[(min+max)/2]}, {a,min,max,(max-min)/numberOfCirclePartition} ] ]; countSegmentPartition[ data_List,{startOfSegment_,endOfSegment_},gapPercent_:0 ]:= Module[ { segmentLength=endOfSegment-startOfSegment, segmentLengh, segments, segmentActialLength, delta }, segmentActialLength=(1-gapPercent/100)segmentLength; delta=(gapPercent/100)segmentLength/(Length[data]+1); If[ Total[data]==0, ConstantArray[ zeroElement[{startOfSegment,endOfSegment}], Length[data] ], (* else *) segments= N[ startOfSegment + segmentActialLength * Partition[Prepend[Accumulate[data],0],2,1] / Total[data] ] ; (* #+0.01{1,-1}(-Subtract@@#)*gapPercent/2&/@segments *) Map[ delta+#&, Table[ (i-1)delta+segments[[i]], {i,1,Length[data]} ] ] ] ]; ordering= If[ OptionValue["Ordering"], Ordering[dataOriginal,All,Total[#1]>Total[#2]&], (* else *) Range[1,Length[dataOriginal]] ]; data=dataOriginal[[ordering]]; totalsForRows=Total/@data; rowsMainSegments= countSegmentPartition[ totalsForRows,{Pi/2,3Pi/2},OptionValue["Gaps"][[1]] ]; rowsColsSegments= Apply[ countSegmentPartition[#1,#2,0]&, Transpose[{data,rowsMainSegments}], {1} ]; totalForCols=Total/@Transpose[data]; colsMainSegments= countSegmentPartition[ totalForCols,{Pi/2,-Pi/2},OptionValue["Gaps"][[2]] ]; colsRowsSegments= Apply[ countSegmentPartition[#1,#2,0]&, Transpose[{Transpose@data,colsMainSegments}], {1} ]; segmentMaker[ {{segmentFirst_,segmentSecond_},{colorization_}}, colorizationMax_ ]:= Module[{splineFragmentFirst,splineFragmentSecond}, If[ Head[segmentFirst]===zeroElement || Head[segmentSecond]===zeroElement, Nothing, (* else *) {splineFragmentFirst,splineFragmentSecond}= Map[ circle[{0,0},1,#]&, {segmentFirst,segmentSecond} ]; If[ FreeQ[ {splineFragmentFirst,splineFragmentSecond}, zeroElement ], { Opacity[0.8] , OptionValue["ColorFunctionLeft"][ 1-(colorization-1)/(colorizationMax-1) ] (* ; Blend[ ColorData[$colorScheme,"ColorList"], (colorization-1)/(colorizationMax-1) ] *) , With[ { reversedSplineFragmentSecond= Reverse[splineFragmentSecond] }, FilledCurve[ BezierCurve[ Join[ splineFragmentFirst, { Mean[ { splineFragmentFirst[ [-1] ], {0,0}, reversedSplineFragmentSecond[ [1] ] } ] }, reversedSplineFragmentSecond, { Mean[ { reversedSplineFragmentSecond[ [-1] ], {0,0}, splineFragmentFirst[ [1] ] } ], splineFragmentFirst[ [1] ] } ], SplineDegree->2 ] ] ] }, (* else *) Nothing ] ] ]; $colorizationMax=Length[rowsColsSegments]; Graphics[ { SortBy[ MapIndexed[ Map[ segmentMaker[#,$colorizationMax]&, Outer[Sequence,Transpose[#1],{#2},1] ]&, Transpose[ { rowsColsSegments, Transpose@colsRowsSegments } ] ], ByteCount ], Table[ (circle[{0,0},1,#]&@rowsMainSegments[[i]]) /. { zeroElement[point_]:>Point[point], line:{_List..}:> { CapForm["Round"] , AbsoluteThickness[5] , (* Blend[ ColorData[ $colorScheme,"ColorList" ], (i-1)/($colorizationMax-1) ]; *) OptionValue["ColorFunctionLeft"][ 1-(i-1)/($colorizationMax-1) ] , Line[line] } }, {i,1,Length[rowsMainSegments]} ], Table[ (circle[{0,0},1,#]&@colsMainSegments[[i]]) /. { zeroElement[point_]:>Point[point], line:{_List..}:> { AbsoluteThickness[5], CapForm["Round"], OptionValue["ColorFunctionRight"][ 1 - (i-1)/(Length[colsMainSegments]-1) ], Line[line] } }, {i,1,Length[colsMainSegments]} ], Text[ Style[#1,FontFamily->"Open Sans",14], 1.025{Cos[#],Sin[#]}&[Mean@#2], {1,0}, {Cos[#+Pi],Sin[#+Pi]}&[Mean@#2] ]&@@@ Transpose[ {leftLabels[[ordering]],rowsMainSegments} ], Text[ Style[#1,FontFamily->"Open Sans",14], 1.025{Cos[#],Sin[#]}&[Mean@#2], {-1,0}, {Cos[#],Sin[#]}&[Mean@#2] ]&@@@ Transpose[{rightLabels,colsMainSegments}] }, ImageSize->OptionValue["ImageSize"], Background->OptionValue["Background"] ] ]